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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@208438 138bc75d-0d04-0410-961f-82ee72b054a4

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.

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'));