#include "unix.h"
#include <stdlib.h>
#include <string.h>
+#include <assert.h>
/* IO locking rules:
on it. unlock_unit or close_unit must be always called only with the
private lock held. */
-/* Subroutines related to units */
-/* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */
-#define GFC_FIRST_NEWUNIT -10
+
+/* Table of allocated newunit values. A simple solution would be to
+ map OS file descriptors (fd's) to unit numbers, e.g. with newunit =
+ -fd - 2, however that doesn't work since Fortran allows an existing
+ unit number to be reassociated with a new file. Thus the simple
+ approach may lead to a situation where we'd try to assign a
+ (negative) unit number which already exists. Hence we must keep
+ track of allocated newunit values ourselves. This is the purpose of
+ the newunits array. The indices map to newunit values as newunit =
+ -index + NEWUNIT_FIRST. E.g. newunits[0] having the value true
+ means that a unit with number NEWUNIT_FIRST exists. Similar to
+ POSIX file descriptors, we always allocate the lowest (in absolute
+ value) available unit number.
+ */
+static bool *newunits;
+static int newunit_size; /* Total number of elements in the newunits array. */
+/* Low water indicator for the newunits array. Below the LWI all the
+ units are allocated, above and equal to the LWI there may be both
+ allocated and free units. */
+static int newunit_lwi;
+static void newunit_free (int);
+
+/* Unit numbers assigned with NEWUNIT start from here. */
+#define NEWUNIT_START -10
+
+
#define NEWUNIT_STACK_SIZE 16
-static GFC_INTEGER_4 next_available_newunit = GFC_FIRST_NEWUNIT;
/* A stack to save previously used newunit-assigned unit numbers to
allow them to be reused without reallocating the gfc_unit structure
static gfc_saved_unit newunit_stack[NEWUNIT_STACK_SIZE];
static int newunit_tos = 0; /* Index to Top of Stack. */
+
#define CACHE_SIZE 3
static gfc_unit *unit_cache[CACHE_SIZE];
gfc_offset max_offset;
if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) != 0)
{
dtp->u.p.unit_is_internal = 1;
- dtp->common.unit = get_unique_unit_number (&dtp->common);
+ dtp->common.unit = newunit_alloc ();
unit = get_gfc_unit (dtp->common.unit, do_create);
set_internal_unit (dtp, unit, kind);
fbuf_init (unit, 128);
}
else
{
- dtp->common.unit = get_unique_unit_number (&dtp->common);
+ dtp->common.unit = newunit_alloc ();
unit = xcalloc (1, sizeof (gfc_unit));
fbuf_init (unit, 128);
}
dtp->u.p.unit_is_internal = 0;
dtp->internal_unit = NULL;
dtp->internal_unit_desc = NULL;
- unit = get_gfc_unit (dtp->common.unit, do_create);
- return unit;
+ /* For an external unit with unit number < 0 creating it on the fly
+ is not allowed, such units must be created with
+ OPEN(NEWUNIT=...). */
+ if (dtp->common.unit < 0)
+ return get_gfc_unit (dtp->common.unit, 0);
+ return get_gfc_unit (dtp->common.unit, do_create);
}
free_format_hash_table (u);
fbuf_destroy (u);
+ if (u->unit_number <= NEWUNIT_START)
+ newunit_free (u->unit_number);
+
if (!locked)
__gthread_mutex_unlock (&u->lock);
free (newunit_stack[newunit_tos].unit->s);
free (newunit_stack[newunit_tos--].unit);
}
+
+ free (newunits);
+
#ifdef HAVE_FREELOCALE
freelocale (c_locale);
#endif
fbuf_flush (u, u->mode);
}
+
/* Assign a negative number for NEWUNIT in OPEN statements or for
internal units. */
-GFC_INTEGER_4
-get_unique_unit_number (st_parameter_common *common)
+int
+newunit_alloc (void)
{
- GFC_INTEGER_4 num;
-
-#ifdef HAVE_SYNC_FETCH_AND_ADD
- num = __sync_fetch_and_add (&next_available_newunit, -1);
-#else
__gthread_mutex_lock (&unit_lock);
- num = next_available_newunit--;
- __gthread_mutex_unlock (&unit_lock);
-#endif
- /* Do not allow NEWUNIT numbers to wrap. */
- if (num > GFC_FIRST_NEWUNIT)
+ if (!newunits)
{
- generate_error (common, LIBERROR_INTERNAL, "NEWUNIT exhausted");
- return 0;
+ newunits = xcalloc (16, 1);
+ newunit_size = 16;
}
- return num;
+
+ /* Search for the next available newunit. */
+ for (int ii = newunit_lwi; ii < newunit_size; ii++)
+ {
+ if (!newunits[ii])
+ {
+ newunits[ii] = true;
+ newunit_lwi = ii + 1;
+ __gthread_mutex_unlock (&unit_lock);
+ return -ii + NEWUNIT_START;
+ }
+ }
+
+ /* Search failed, bump size of array and allocate the first
+ available unit. */
+ int old_size = newunit_size;
+ newunit_size *= 2;
+ newunits = xrealloc (newunits, newunit_size);
+ memset (newunits + old_size, 0, old_size);
+ newunits[old_size] = true;
+ newunit_lwi = old_size + 1;
+ __gthread_mutex_unlock (&unit_lock);
+ return -old_size + NEWUNIT_START;
+}
+
+
+/* Free a previously allocated newunit= unit number. unit_lock must
+ be held when calling. */
+
+static void
+newunit_free (int unit)
+{
+ int ind = -unit + NEWUNIT_START;
+ assert(ind >= 0 && ind < newunit_size);
+ newunits[ind] = false;
+ if (ind < newunit_lwi)
+ newunit_lwi = ind;
}