aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/io')
-rw-r--r--libgfortran/io/io.h5
-rw-r--r--libgfortran/io/open.c2
-rw-r--r--libgfortran/io/transfer.c10
-rw-r--r--libgfortran/io/unit.c108
4 files changed, 98 insertions, 27 deletions
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index ea93fba..aaacc08 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -715,8 +715,9 @@ internal_proto (finish_last_advance_record);
extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
internal_proto (unit_truncate);
-extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_common *);
-internal_proto(get_unique_unit_number);
+extern int newunit_alloc (void);
+internal_proto(newunit_alloc);
+
/* open.c */
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index d074b02..2e7163d 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -812,7 +812,7 @@ st_open (st_parameter_open *opp)
if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
{
if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
- opp->common.unit = get_unique_unit_number(&opp->common);
+ opp->common.unit = newunit_alloc ();
else if (opp->common.unit < 0)
{
u = find_unit (opp->common.unit);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 902c020..7696cca 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2601,7 +2601,15 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
dtp->u.p.current_unit = get_unit (dtp, 1);
- if (dtp->u.p.current_unit->s == NULL)
+ if (dtp->u.p.current_unit == NULL)
+ {
+ /* This means we tried to access an external unit < 0 without
+ having opened it first with NEWUNIT=. */
+ generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+ "Invalid unit number in statement");
+ return;
+ }
+ else if (dtp->u.p.current_unit->s == NULL)
{ /* Open the unit with some default flags. */
st_parameter_open opp;
unit_convert conv;
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 274b24b..41cd52f 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -29,6 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "unix.h"
#include <stdlib.h>
#include <string.h>
+#include <assert.h>
/* IO locking rules:
@@ -68,12 +69,34 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
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
@@ -81,6 +104,7 @@ static GFC_INTEGER_4 next_available_newunit = GFC_FIRST_NEWUNIT;
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;
@@ -551,7 +575,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
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);
@@ -567,7 +591,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
}
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);
}
@@ -579,8 +603,12 @@ get_unit (st_parameter_dt *dtp, int do_create)
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);
}
@@ -734,6 +762,9 @@ close_unit_1 (gfc_unit *u, int locked)
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);
@@ -788,6 +819,9 @@ close_units (void)
free (newunit_stack[newunit_tos].unit->s);
free (newunit_stack[newunit_tos--].unit);
}
+
+ free (newunits);
+
#ifdef HAVE_FREELOCALE
freelocale (c_locale);
#endif
@@ -885,25 +919,53 @@ finish_last_advance_record (gfc_unit *u)
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;
}
generated by cgit v1.1 at 2025-05-28 17:23:01 +0000