re PR libfortran/38199 (missed optimization: I/O performance)

2014-03-12  Jerry DeLisle  <jvdelisle@gcc.gnu>

	PR libfortran/38199
	* io/read.c (read_decimal): Quickly skip spaces to avoid calls
	to next_char.
	* io/unit.c (is_trim_ok): New helper function to check various
	conditions to see if its OK to trim the internal unit string.
	(get_internal_unit): Use LEN_TRIM to shorten selected internal
	unit strings for optimizing READ. Enable this optimization for
	formatted READ.
	* io/list_read.c (finish_list_read): Don't call eat_line for
	internal units.

From-SVN: r208528

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 83749aa6b1f516331c9cd036508d5615b204033e..f32b34cd8a485c8245050dccda25275bff0d47b7 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,16 @@
+2014-03-12  Jerry DeLisle  <jvdelisle@gcc.gnu>
+
+       PR libfortran/38199
+       * io/read.c (read_decimal): Quickly skip spaces to avoid calls
+       to next_char.
+       * io/unit.c (is_trim_ok): New helper function to check various
+       conditions to see if its OK to trim the internal unit string.
+       (get_internal_unit): Use LEN_TRIM to shorten selected internal
+       unit strings for optimizing READ. Enable this optimization for
+       formatted READ.
+       * io/list_read.c (finish_list_read): Don't call eat_line for
+       internal units.
+        
 2014-03-08  Jerry DeLisle  <jvdelisle@gcc.gnu>
 
        PR libfortran/38199

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 4a26db96a96f0da832dc18eda4d899b1d5c95a47..2467569d639679d406222592a0e1d175334fcaa8 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2104,11 +2104,14 @@ finish_list_read (st_parameter_dt *dtp)
       return;
     }
 
-  err = eat_line (dtp);
-  if (err == LIBERROR_END)
+  if (!is_internal_unit (dtp))
     {
-      free_line (dtp);
-      hit_eof (dtp);
+      err = eat_line (dtp);
+      if (err == LIBERROR_END)
+       {
+         free_line (dtp);
+         hit_eof (dtp);
+       }
     }
 }
 

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 331edc23d39c9b650cc2e05819a056d7b1f448ac..64f2ddf49a194b6628a13c691b1591d3dddc1590 100644 (file)
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -677,7 +677,13 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
        
       if (c == ' ')
         {
-         if (dtp->u.p.blank_status == BLANK_NULL) continue;
+         if (dtp->u.p.blank_status == BLANK_NULL)
+           {
+             /* Skip spaces.  */
+             for ( ; w > 0; p++, w--)
+               if (*p != ' ') break; 
+             continue;
+           }
          if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
         }
         

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 901d66fa0c1bc2196152fe9a6a5716b6398184bd..e522195e5dddc06954ea957b9848faab773b6441 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -375,6 +375,38 @@ find_or_create_unit (int n)
 }
 
 
+/* Helper function to check rank, stride, format string, and namelist.
+   This is used for optimization. You can't trim out blanks or shorten
+   the string if trailing spaces are significant.  */
+static bool
+is_trim_ok (st_parameter_dt *dtp)
+{
+  /* Check rank and stride.  */
+  if (dtp->internal_unit_desc
+      && (GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc) > 1
+         || GFC_DESCRIPTOR_STRIDE(dtp->internal_unit_desc, 0) != 1))
+    return false;
+  /* Format strings can not have 'BZ' or '/'.  */
+  if (dtp->common.flags & IOPARM_DT_HAS_FORMAT)
+    {
+      char *p = dtp->format;
+      off_t i;
+      if (dtp->common.flags & IOPARM_DT_HAS_BLANK)
+       return false;
+      for (i = 0; i < dtp->format_len; i++)
+       {
+         if (p[i] == '/') return false;
+         if (p[i] == 'b' || p[i] == 'B')
+           if (p[i+1] == 'z' || p[i+1] == 'Z')
+             return false;
+       }
+    }
+  if (dtp->u.p.ionml) /* A namelist.  */
+    return false;
+  return true;
+}
+
+
 gfc_unit *
 get_internal_unit (st_parameter_dt *dtp)
 {
@@ -402,6 +434,22 @@ get_internal_unit (st_parameter_dt *dtp)
      some other file I/O unit.  */
   iunit->unit_number = -1;
 
+  /* As an optimization, adjust the unit record length to not
+     include trailing blanks. This will not work under certain conditions
+     where trailing blanks have significance.  */
+  if (dtp->u.p.mode == READING && is_trim_ok (dtp))
+    {
+      int len;
+      if (dtp->common.unit == 0)
+         len = string_len_trim (dtp->internal_unit_len,
+                                                  dtp->internal_unit);
+      else
+         len = string_len_trim_char4 (dtp->internal_unit_len,
+                             (const gfc_char4_t*) dtp->internal_unit);
+      dtp->internal_unit_len = len; 
+      iunit->recl = dtp->internal_unit_len;
+    }
+
   /* Set up the looping specification from the array descriptor, if any.  */
 
   if (is_array_io (dtp))
@@ -414,27 +462,6 @@ get_internal_unit (st_parameter_dt *dtp)
 
       start_record *= iunit->recl;
     }
-  else
-    {
-      /* If we are not processing an array, adjust the unit record length not
-        to include trailing blanks for list-formatted reads.  */
-      if (dtp->u.p.mode == READING && !(dtp->common.flags & IOPARM_DT_HAS_FORMAT))
-       {
-         if (dtp->common.unit == 0)
-           {
-             dtp->internal_unit_len =
-               string_len_trim (dtp->internal_unit_len, dtp->internal_unit);
-             iunit->recl = dtp->internal_unit_len;
-           }
-         else
-           {
-             dtp->internal_unit_len =
-               string_len_trim_char4 (dtp->internal_unit_len,
-                                      (const gfc_char4_t*) dtp->internal_unit);
-             iunit->recl = dtp->internal_unit_len;
-           }
-       }
-    }
 
   /* Set initial values for unit parameters.  */
   if (dtp->common.unit)