PR 48587 Newunit allocator
authorJanne Blomqvist <jb@gcc.gnu.org>
Sat, 15 Oct 2016 13:14:15 +0000 (16:14 +0300)
committerJanne Blomqvist <jb@gcc.gnu.org>
Sat, 15 Oct 2016 13:14:15 +0000 (16:14 +0300)
Currently GFortran newer reuses unit numbers allocated with NEWUNIT=,
instead having a simple counter that is decremented each time such a
unit is opened.  For a long running program which repeatedly opens
files with NEWUNIT= and closes them, the counter can wrap around and
cause an abort.  This patch replaces the counter with an allocator
that keeps track of which units numbers are allocated, and can reuse
them once they have been deallocated.  Since operating systems tend to
limit the number of simultaneous open files for a process to a
relatively modest number, a relatively simple approach with a linear
scan through an array suffices.  Though as a small optimization there
is a low water indicator keeping track of the index for which all unit
numbers below are already allocated.  This linear scan also ensures
that we always allocate the smallest available unit number.

2016-10-15  Janne Blomqvist  <jb@gcc.gnu.org>

        PR libfortran/48587
        * io/io.h (get_unique_unit_number): Remove prototype.
        (newunit_alloc): New prototype.
        * io/open.c (st_open): Call newunit_alloc.
        * io/unit.c (newunits,newunit_size,newunit_lwi): New static
        variables.
        (GFC_FIRST_NEWUNIT): Rename to NEWUNIT_START.
        (next_available_newunit): Remove variable.
        (get_unit): Call newunit_alloc, don't try to create negative
        external unit.
        (close_unit_1): Call newunit_free.
        (close_units): Free newunits array.
        (get_unique_number): Remove function.
        (newunit_alloc): New function.
        (newunit_free): New function.
        * io/transfer.c (data_transfer_init): Check for invalid unit
        number.

testsuite ChangeLog:

2016-10-15  Janne Blomqvist  <jb@gcc.gnu.org>

        PR libfortran/48587
        * gfortran.dg/negative_unit2.f90: New testcase.

From-SVN: r241199

gcc/testsuite/ChangeLog
libgfortran/ChangeLog
libgfortran/io/io.h
libgfortran/io/open.c
libgfortran/io/transfer.c
libgfortran/io/unit.c

index 849c6e49de6809cec913f47190c35c7023d7cb44..0e48772d7983fa9397320be88a9552a912038b51 100644 (file)
@@ -1,3 +1,8 @@
+2016-10-15  Janne Blomqvist  <jb@gcc.gnu.org>
+
+        PR libfortran/48587
+        * gfortran.dg/negative_unit2.f90: New test.
+
 2016-10-14  Jakub Jelinek  <jakub@redhat.com>
 
        PR middle-end/77959
index 62b5222609014ef825402717ed7769e38ae3380f..bf7af2b4dbbbab0b2ff05dfb41ad3dc26932eacf 100644 (file)
@@ -1,3 +1,23 @@
+2016-10-15  Janne Blomqvist  <jb@gcc.gnu.org>
+
+        PR libfortran/48587
+        * io/io.h (get_unique_unit_number): Remove prototype.
+        (newunit_alloc): New prototype.
+        * io/open.c (st_open): Call newunit_alloc.
+        * io/unit.c (newunits,newunit_size,newunit_lwi): New static
+        variables.
+        (GFC_FIRST_NEWUNIT): Rename to NEWUNIT_START.
+        (next_available_newunit): Remove variable.
+        (get_unit): Call newunit_alloc, don't try to create negative
+        external unit.
+        (close_unit_1): Call newunit_free.
+        (close_units): Free newunits array.
+        (get_unique_number): Remove function.
+        (newunit_alloc): New function.
+        (newunit_free): New function.
+        * io/transfer.c (data_transfer_init): Check for invalid unit
+        number.
+
 2016-10-09  Janne Blomqvist  <jb@gcc.gnu.org>
 
         PR libfortran/67585
index ea93fbaf99d5561cc1185671f4f319d2d8d7448c..aaacc089fc7e8d2186e5aa3ac31a3d1ebe5ba344 100644 (file)
@@ -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 */
 
index d074b020d8113c8d858ce3e0cbcf3f874162b7eb..2e7163d33c61dc6363d2657c81083ce3b425d150 100644 (file)
@@ -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);
index 902c02011ae38d2cf91e8bdce52e55555cc0da3b..7696cca2306f1d0538111d54a89ff1e85f8244d8 100644 (file)
@@ -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;
index 274b24b686eab0a18d476412604c7085f8bc2e76..41cd52f26063abeff66e47587b250a66831478ea 100644 (file)
@@ -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;
 }