re PR fortran/78387 (OpenMP segfault/stack size exceeded writing to internal file)

2017-08-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/78387
	* io/list_read.c (nml_read_obj): Remove use of stash.
	* io/transfer.c (st_read_done, st_write_done): Likewise.
	* io/unit.c (stash_internal_unit): Delete function.
	(get_unit): Remove use of stash.
	(init_units): Likewise.
	(close_units): Likewise.
	* io/write.c (nml_write_obj): Likewise:

From-SVN: r251374

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 3b3cf7f86f952d6593a19dc6659694f31ac2740c..ba57e616f995b9560a280beb24ff7a718140268c 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,14 @@
+2017-08-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/78387
+       * io/list_read.c (nml_read_obj): Remove use of stash.
+       * io/transfer.c (st_read_done, st_write_done): Likewise.
+       * io/unit.c (stash_internal_unit): Delete function.
+       (get_unit): Remove use of stash.
+       (init_units): Likewise.
+       (close_units): Likewise.
+       * io/write.c (nml_write_obj): Likewise:
+
 2017-07-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/81581

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index b6cd66706bb079efbe9875a03b7bfec308e9b204..3c03a02cad8da0770aa7279e5d8073cf1aabc44f 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -3019,11 +3019,6 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
                    child_iomsg_len = IOMSG_LEN;
                  }
 
-               /* If reading from an internal unit, stash it to allow
-                  the child procedure to access it.  */
-               if (is_internal_unit (dtp))
-                 stash_internal_unit (dtp);
-
                /* Call the user defined formatted READ procedure.  */
                dtp->u.p.current_unit->child_dtio++;
                dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist,

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 298b29e8d3ef2e11ebe49256a42304d59ad2dd8b..529637061b12e883d77fba938dadef0b6f7315dc 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -4080,8 +4080,7 @@ st_read_done (st_parameter_dt *dtp)
   free_ionml (dtp);
 
   /* If this is a parent READ statement we do not need to retain the
-     internal unit structure for child use.  Free it and stash the unit
-     number for reuse.  */
+     internal unit structure for child use.  */
   if (dtp->u.p.current_unit != NULL
       && dtp->u.p.current_unit->child_dtio == 0)
     {
@@ -4095,7 +4094,6 @@ st_read_done (st_parameter_dt *dtp)
          if (dtp->u.p.current_unit->ls)
            free (dtp->u.p.current_unit->ls);
          dtp->u.p.current_unit->ls = NULL;
-         stash_internal_unit (dtp);
        }
       if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
        {
@@ -4153,8 +4151,7 @@ st_write_done (st_parameter_dt *dtp)
       free_ionml (dtp);
 
       /* If this is a parent WRITE statement we do not need to retain the
-        internal unit structure for child use.  Free it and stash the
-        unit number for reuse.  */
+        internal unit structure for child use.  */
       if (is_internal_unit (dtp) &&
          (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
        {
@@ -4165,7 +4162,6 @@ st_write_done (st_parameter_dt *dtp)
          if (dtp->u.p.current_unit->ls)
            free (dtp->u.p.current_unit->ls);
          dtp->u.p.current_unit->ls = NULL;
-         stash_internal_unit (dtp);
        }
       if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
        {

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index ef94294526a3628f5316d1e902a4b480c23ca986..e06867aa0a11c57cb351cd1bd578a85ecb1f70e4 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -94,16 +94,6 @@ static void newunit_free (int);
 /* Unit numbers assigned with NEWUNIT start from here.  */
 #define NEWUNIT_START -10
 
-
-#define NEWUNIT_STACK_SIZE 16
-
-/* A stack to save previously used newunit-assigned unit numbers to
-   allow them to be reused without reallocating the gfc_unit structure
-   which is still in the treap.  */
-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;
@@ -538,22 +528,6 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind)
 }
 
 
-/* stash_internal_unit()-- Push the internal unit number onto the
-   avaialble stack.  */
-void
-stash_internal_unit (st_parameter_dt *dtp)
-{
-  __gthread_mutex_lock (&unit_lock);
-  newunit_tos++;
-  if (newunit_tos >= NEWUNIT_STACK_SIZE)
-    internal_error (&dtp->common, "stash_internal_unit(): Stack Size Exceeded");
-  newunit_stack[newunit_tos].unit_number = dtp->common.unit;
-  newunit_stack[newunit_tos].unit = dtp->u.p.current_unit;
-  __gthread_mutex_unlock (&unit_lock);
-}
-
-
-
 /* get_unit()-- Returns the unit structure associated with the integer
    unit or the internal file.  */
 
@@ -572,49 +546,13 @@ get_unit (st_parameter_dt *dtp, int do_create)
       else
        internal_error (&dtp->common, "get_unit(): Bad internal unit KIND");
 
-      if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) != 0)
-       {
-         dtp->u.p.unit_is_internal = 1;
-         dtp->common.unit = newunit_alloc ();
-         unit = get_gfc_unit (dtp->common.unit, do_create);
-         set_internal_unit (dtp, unit, kind);
-         fbuf_init (unit, 128);
-         return unit;
-       }
-      else
-       {
-         __gthread_mutex_lock (&unit_lock);
-         if (newunit_tos)
-           {
-             dtp->common.unit = newunit_stack[newunit_tos].unit_number;
-             unit = newunit_stack[newunit_tos--].unit;
-             __gthread_mutex_unlock (&unit_lock);
-             unit->fbuf->act = unit->fbuf->pos = 0;
-           }
-         else
-           {
-             __gthread_mutex_unlock (&unit_lock);
-             dtp->common.unit = newunit_alloc ();
-             unit = xcalloc (1, sizeof (gfc_unit));
-             fbuf_init (unit, 128);
-           }
-         set_internal_unit (dtp, unit, kind);
-         return unit;
-       }
-    }
-
-  /* If an internal unit number is passed from the parent to the child
-     it should have been stashed on the newunit_stack ready to be used.
-     Check for it now and return the internal unit if found.  */
-  __gthread_mutex_lock (&unit_lock);
-  if (newunit_tos && (dtp->common.unit <= NEWUNIT_START)
-      && (dtp->common.unit == newunit_stack[newunit_tos].unit_number))
-    {
-      unit = newunit_stack[newunit_tos--].unit;
-      __gthread_mutex_unlock (&unit_lock);
+      dtp->u.p.unit_is_internal = 1;
+      dtp->common.unit = newunit_alloc ();
+      unit = get_gfc_unit (dtp->common.unit, do_create);
+      set_internal_unit (dtp, unit, kind);
+      fbuf_init (unit, 128);
       return unit;
     }
-  __gthread_mutex_unlock (&unit_lock);
 
   /* Has to be an external unit.  */
   dtp->u.p.unit_is_internal = 0;
@@ -752,10 +690,6 @@ init_units (void)
   max_offset = 0;
   for (i = 0; i < sizeof (max_offset) * 8 - 1; i++)
     max_offset = max_offset + ((gfc_offset) 1 << i);
-
-  /* Initialize the newunit stack.  */
-  memset (newunit_stack, 0, NEWUNIT_STACK_SIZE * sizeof(gfc_saved_unit));
-  newunit_tos = 0;
 }
 
 
@@ -837,14 +771,6 @@ close_units (void)
     close_unit_1 (unit_root, 1);
   __gthread_mutex_unlock (&unit_lock);
 
-  while (newunit_tos != 0)
-    if (newunit_stack[newunit_tos].unit)
-      {
-       fbuf_destroy (newunit_stack[newunit_tos].unit);
-       free (newunit_stack[newunit_tos].unit->s);
-       free (newunit_stack[newunit_tos--].unit);
-      }
-
   free (newunits);
 
 #ifdef HAVE_FREELOCALE

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 8dbbb0912e3c0e9d8206e66cf8e7a7ff94a29216..c9aad15009006255c91ca4d6858b4912221a6ec4 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2248,11 +2248,6 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
                      child_iomsg_len = IOMSG_LEN;
                    }
 
-                 /* If writing to an internal unit, stash it to allow
-                    the child procedure to access it.  */
-                 if (is_internal_unit (dtp))
-                   stash_internal_unit (dtp);
-                     
                  /* Call the user defined formatted WRITE procedure.  */
                  dtp->u.p.current_unit->child_dtio++;
                  if (obj->type == BT_DERIVED)