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

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

	PR libfortran/38199
	* io/list_read.c (next_char): Delete unuseful error checks.
	(eat_spaces): For character array reading, skip ahead over
	spaces rather than call next_char multiple times.

From-SVN: r208438

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c82daa2..1a3539d 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2014-03-08  Jerry DeLisle  <jvdelisle@gcc.gnu>
+
+       PR libfortran/38199
+       * io/list_read.c (next_char): Delete unuseful error checks.
+       (eat_spaces): For character array reading, skip ahead over
+       spaces rather than call next_char multiple times.
+
 2014-03-08  Tobias Burnus  <burnus@net-b.de>
 
        * libgfortran.h (unlikely, likely): Add usage comment.

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index d1d09b5..4a26db9 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -160,7 +160,7 @@ next_char (st_parameter_dt *dtp)
 
       dtp->u.p.line_buffer_pos = 0;
       dtp->u.p.line_buffer_enabled = 0;
-    }    
+    }
 
   /* Handle the end-of-record and end-of-file conditions for
      internal array unit.  */
@@ -208,16 +208,16 @@ next_char (st_parameter_dt *dtp)
          c = cc;
        }
 
-      if (length < 0)
+      if (unlikely (length < 0))
        {
          generate_error (&dtp->common, LIBERROR_OS, NULL);
          return '\0';
        }
-  
+
       if (is_array_io (dtp))
        {
          /* Check whether we hit EOF.  */ 
-         if (length == 0)
+         if (unlikely (length == 0))
            {
              generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
              return '\0';
@@ -264,6 +264,48 @@ eat_spaces (st_parameter_dt *dtp)
 {
   int c;
 
+  /* If internal character array IO, peak ahead and seek past spaces.
+     This is an optimazation to eliminate numerous calls to
+     next character unique to character arrays with large character
+     lengths (PR38199). */
+  if (is_array_io (dtp))
+    {
+      gfc_offset offset = stell (dtp->u.p.current_unit->s);
+      gfc_offset limit = dtp->u.p.current_unit->bytes_left;
+
+      if (dtp->common.unit) /* kind=4 */
+       {
+         gfc_char4_t cc;
+         limit *= (sizeof (gfc_char4_t));
+         do
+           {
+             cc = dtp->internal_unit[offset];
+             offset += (sizeof (gfc_char4_t));
+             dtp->u.p.current_unit->bytes_left--;
+           }
+         while (offset < limit && (cc == (gfc_char4_t)' '
+                 || cc == (gfc_char4_t)'\t'));
+         /* Back up, seek ahead, and fall through to complete the
+            process so that END conditions are handled correctly.  */
+         dtp->u.p.current_unit->bytes_left++;
+         sseek (dtp->u.p.current_unit->s,
+                 offset-(sizeof (gfc_char4_t)), SEEK_SET);
+       }
+      else
+       {
+         do
+           {
+             c = dtp->internal_unit[offset++];
+             dtp->u.p.current_unit->bytes_left--;
+           }
+         while (offset < limit && (c == ' ' || c == '\t'));
+         /* Back up, seek ahead, and fall through to complete the
+            process so that END conditions are handled correctly.  */
+         dtp->u.p.current_unit->bytes_left++;
+         sseek (dtp->u.p.current_unit->s, offset-1, SEEK_SET);
+       }
+    }
+  /* Now skip spaces, EOF and EOL are handled in next_char.  */
   do
     c = next_char (dtp);
   while (c != EOF && (c == ' ' || c == '\t'));