diff mbox

[libgfortran] PR78387 OpenMP segfault/stack size exceeded writing to internal file

Message ID 7a90e51a-70c1-e917-6a5a-32eff0b73e4f@charter.net
State New
Headers show

Commit Message

Jerry DeLisle Aug. 20, 2017, 5:12 a.m. UTC 
Hi all,

I have decided to simply delete the internal unit stack altogether.

The original intent was to save time with internal unit I/O by avoiding 
reallocating a gfc_unit structure every time an internal unit (aka string) is 
used for I/O.

After deleting and testing it appears no significant change in performance.

Regression tested on x86_64-linux. No new test case.

OK for trunk and then I think this should be backported to 7.

Regards,

Jerry

2017-08-20  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:

Comments

Jerry DeLisle Aug. 26, 2017, 7:28 p.m. UTC | #1 
ping - I will commit if I hear no objections.

Jerry

On 08/19/2017 10:12 PM, Jerry DeLisle wrote:
> Hi all,
> 
> I have decided to simply delete the internal unit stack altogether.
> 
> The original intent was to save time with internal unit I/O by avoiding
> reallocating a gfc_unit structure every time an internal unit (aka string) is
> used for I/O.
> 
> After deleting and testing it appears no significant change in performance.
> 
> Regression tested on x86_64-linux. No new test case.
> 
> OK for trunk and then I think this should be backported to 7.
> 
> Regards,
> 
> Jerry
> 
> 2017-08-20  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:
Thomas Koenig Aug. 27, 2017, 7:56 a.m. UTC | #2 
Hi Jerry,

> ping - I will commit if I hear no objections.

OK for trunk and gcc-7.  I thought Paul had already OK'd it,
which is why I didn't react.

Thanks a lot for the patch!

Regards

	Thomas
diff mbox

Patch

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index b6cd6670..3c03a02c 100644
--- 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 298b29e8..52963706 100644
--- 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 ef942945..e06867aa 100644
--- 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 8dbbb091..c9aad150 100644
--- 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)