re PR libfortran/78549 (Very slow formatted internal file output)

2017-11-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/78549
	* io/io.h (newunit_free): Add declaration. Clean some whitespace.
	* io/transfer.c (st_read_done, st_write_done): Call newunit_free.
	* io/unit.c (newunit_free): Change type from static void to void.

From-SVN: r254982

libgfortran/ChangeLog

+2017-11-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/78549
+	* io/io.h (newunit_free): Add declaration. Clean some whitespace.
+	* io/transfer.c (st_read_done, st_write_done): Call newunit_free.
+	* io/unit.c (newunit_free): Change type from static void to void.
+
 2017-11-19  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR fortran/44292

libgfortran/io/io.h

@@ -760,18 +760,21 @@ internal_proto(find_or_create_unit);
 extern gfc_unit *get_unit (st_parameter_dt *, int);
 internal_proto(get_unit);
 
-extern void unlock_unit (gfc_unit *);
+extern void unlock_unit(gfc_unit *);
 internal_proto(unlock_unit);
 
 extern void finish_last_advance_record (gfc_unit *u);
-internal_proto (finish_last_advance_record);
+internal_proto(finish_last_advance_record);
 
-extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
-internal_proto (unit_truncate);
+extern int unit_truncate(gfc_unit *, gfc_offset, st_parameter_common *);
+internal_proto(unit_truncate);
 
 extern int newunit_alloc (void);
 internal_proto(newunit_alloc);
 
+extern void newunit_free (int);
+internal_proto(newunit_free);
+
 
 /* open.c */
 

libgfortran/io/transfer.c

@@ -4087,8 +4087,9 @@ st_read_done (st_parameter_dt *dtp)
   if (dtp->u.p.current_unit != NULL
       && dtp->u.p.current_unit->child_dtio == 0)
     {
-      if (is_internal_unit (dtp) &&
-	  (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+      if (is_internal_unit (dtp))
+	{
+	  if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
 	    {
 	      free (dtp->u.p.current_unit->filename);
 	      dtp->u.p.current_unit->filename = NULL;
@@ -4098,6 +4099,8 @@ st_read_done (st_parameter_dt *dtp)
 		free (dtp->u.p.current_unit->ls);
 	      dtp->u.p.current_unit->ls = NULL;
 	    }
+	  newunit_free (dtp->common.unit);
+	}
       if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
 	{
 	  free_format_data (dtp->u.p.fmt);
@@ -4155,8 +4158,9 @@ st_write_done (st_parameter_dt *dtp)
 
       /* If this is a parent WRITE statement we do not need to retain the
 	 internal unit structure for child use.  */
-      if (is_internal_unit (dtp) &&
-	  (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+      if (is_internal_unit (dtp))
+	{
+	  if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
 	    {
 	      free (dtp->u.p.current_unit->filename);
 	      dtp->u.p.current_unit->filename = NULL;
@@ -4166,6 +4170,8 @@ st_write_done (st_parameter_dt *dtp)
 		free (dtp->u.p.current_unit->ls);
 	      dtp->u.p.current_unit->ls = NULL;
 	    }
+	  newunit_free (dtp->common.unit);
+	}
       if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
 	{
 	  free_format_data (dtp->u.p.fmt);

libgfortran/io/unit.c

@@ -89,7 +89,6 @@ static int newunit_size; /* Total number of elements in the newunits array.  */
    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
@@ -911,7 +910,7 @@ newunit_alloc (void)
 /* Free a previously allocated newunit= unit number.  unit_lock must
    be held when calling.  */
 
-static void
+void
 newunit_free (int unit)
 {
   int ind = -unit + NEWUNIT_START;