The attached patch addresses the problem identified in comment #22 of the PR.
For character array internal unit reads, eat_spaces must call next_char to
advance every single character until the end of the string is reached.  In the
case sited which is very contrived, this amounts to about 100000 calls to 
next_char.

For clarity, this test case:

      character buffer(1)*100000
      integer i,j

      j = 1234
      write(buffer(1),'(i4)') j

      DO j=1,9999
!        write(*,*) buffer(1)(1:4)
        read(buffer,*) i
!        write(*,*) i
      ENDDO
      end

Without the patch takes about 25 seconds to run.

With the patch this takes about 2.8 seconds.

The speedup is accomplished by simply skipping over spaces without calling
next_read, then backing up one character and letting the existing execution path
proceed, preserving all the end of record code needed in next_char.

I also remove some unneeded error checks.

Regression tested on X86_64 gnu.  No need for a new test case since no new
functionality is added.

OK for trunk? The PR is marked as a regression, so I think this could be the
last piece and call it done.

Regards,

Jerry

2014-03-08  Jerry DeLisle  <jvdeli...@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.
Index: list_read.c
===================================================================
--- list_read.c	(revision 208303)
+++ list_read.c	(working copy)
@@ -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,20 +208,8 @@ next_char (st_parameter_dt *dtp)
          c = cc;
        }
 
-      if (length < 0)
-	{
-	  generate_error (&dtp->common, LIBERROR_OS, NULL);
-	  return '\0';
-	}
-  
       if (is_array_io (dtp))
 	{
-	  /* Check whether we hit EOF.  */ 
-	  if (length == 0)
-	    {
-	      generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
-	      return '\0';
-	    } 
 	  dtp->u.p.current_unit->bytes_left--;
 	}
       else
@@ -264,6 +252,28 @@ 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;
+
+      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'));

Reply via email to