PR 56981 Improve unbuffered performance on special files.

2013-04-29  Janne Blomqvist  <jb@gcc.gnu.org>

        PR fortran/56981
        * io/transfer.c (next_record_w_unf): First fix head marker, then
        write tail.
        (next_record): Call flush_if_unbuffered.
        * io/unix.c (struct unix_stream): Add field unbuffered.
        (flush_if_unbuffered): New function.
        (fd_to_stream): New argument.
        (open_external): Fix fd_to_stream call.
        (input_stream): Likewise.
        (output_stream): Likewise.
        (error_stream): Likewise.
        * io/unix.h (flush_if_unbuffered): New prototype.

From-SVN: r198390

libgfortran/ChangeLog

@@ -1,3 +1,18 @@
+2013-04-29  Janne Blomqvist  <jb@gcc.gnu.org>
+
+        PR fortran/56981
+        * io/transfer.c (next_record_w_unf): First fix head marker, then
+        write tail.
+        (next_record): Call flush_if_unbuffered.
+        * io/unix.c (struct unix_stream): Add field unbuffered.
+        (flush_if_unbuffered): New function.
+        (fd_to_stream): New argument.
+        (open_external): Fix fd_to_stream call.
+        (input_stream): Likewise.
+        (output_stream): Likewise.
+        (error_stream): Likewise.
+        * io/unix.h (flush_if_unbuffered): New prototype.
+
 2013-04-28  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	* intrinsics/system_clock.c (system_clock_4): Fix sign error in

libgfortran/io/transfer.c

@@ -3207,17 +3207,6 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
   m = dtp->u.p.current_unit->recl_subrecord
     - dtp->u.p.current_unit->bytes_left_subrecord;
 
-  /* Write the length tail.  If we finish a record containing
-     subrecords, we write out the negative length.  */
-
-  if (dtp->u.p.current_unit->continued)
-    m_write = -m;
-  else
-    m_write = m;
-
-  if (unlikely (write_us_marker (dtp, m_write) < 0))
-    goto io_error;
-
   if (compile_options.record_marker == 0)
     record_marker = sizeof (GFC_INTEGER_4);
   else
@@ -3226,7 +3215,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
   /* Seek to the head and overwrite the bogus length with the real
      length.  */
 
-  if (unlikely (sseek (dtp->u.p.current_unit->s, - m - 2 * record_marker, 
+  if (unlikely (sseek (dtp->u.p.current_unit->s, - m - record_marker, 
 		       SEEK_CUR) < 0))
     goto io_error;
 
@@ -3240,8 +3229,18 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
 
   /* Seek past the end of the current record.  */
 
-  if (unlikely (sseek (dtp->u.p.current_unit->s, m + record_marker, 
-		       SEEK_CUR) < 0))
+  if (unlikely (sseek (dtp->u.p.current_unit->s, m, SEEK_CUR) < 0))
+    goto io_error;
+
+  /* Write the length tail.  If we finish a record containing
+     subrecords, we write out the negative length.  */
+
+  if (dtp->u.p.current_unit->continued)
+    m_write = -m;
+  else
+    m_write = m;
+
+  if (unlikely (write_us_marker (dtp, m_write) < 0))
     goto io_error;
 
   return;
@@ -3503,6 +3502,7 @@ next_record (st_parameter_dt *dtp, int done)
     pre_position (dtp);
 
   fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
+  flush_if_unbuffered (dtp->u.p.current_unit->s);
 }
 
 

libgfortran/io/unix.c

@@ -212,6 +212,8 @@ typedef struct
   /* Cached stat(2) values.  */
   dev_t st_dev;
   ino_t st_ino;
+
+  bool unbuffered;  /* Buffer should be flushed after each I/O statement.  */
 }
 unix_stream;
 
@@ -442,7 +444,7 @@ raw_init (unix_stream * s)
 Buffered I/O functions. These functions have the same semantics as the
 raw I/O functions above, except that they are buffered in order to
 improve performance. The buffer must be flushed when switching from
-reading to writing and vice versa. Only supported for regular files.
+reading to writing and vice versa.
 *********************************************************************/
 
 static int
@@ -968,11 +970,26 @@ open_internal4 (char *base, int length, gfc_offset offset)
 }
 
 
+/* "Unbuffered" really means I/O statement buffering. For formatted
+   I/O, the fbuf manages this, and then uses raw I/O. For unformatted
+   I/O, buffered I/O is used, and the buffer is flushed at the end of
+   each I/O statement, where this function is called.  */
+
+int
+flush_if_unbuffered (stream* s)
+{
+  unix_stream* us = (unix_stream*) s;
+  if (us->unbuffered)
+    return sflush (s);
+  return 0;
+}
+
+
 /* fd_to_stream()-- Given an open file descriptor, build a stream
  * around it. */
 
 static stream *
-fd_to_stream (int fd)
+fd_to_stream (int fd, bool unformatted)
 {
   struct stat statbuf;
   unix_stream *s;
@@ -998,7 +1015,15 @@ fd_to_stream (int fd)
 	    || s->fd == STDERR_FILENO)))
     buf_init (s);
   else
-    raw_init (s);
+    {
+      if (unformatted)
+	{
+	  s->unbuffered = true;
+	  buf_init (s);
+	}
+      else
+	raw_init (s);
+    }
 
   return (stream *) s;
 }
@@ -1364,7 +1389,7 @@ open_external (st_parameter_open *opp, unit_flags *flags)
     return NULL;
   fd = fix_fd (fd);
 
-  return fd_to_stream (fd);
+  return fd_to_stream (fd, flags->form == FORM_UNFORMATTED);
 }
 
 
@@ -1374,7 +1399,7 @@ open_external (st_parameter_open *opp, unit_flags *flags)
 stream *
 input_stream (void)
 {
-  return fd_to_stream (STDIN_FILENO);
+  return fd_to_stream (STDIN_FILENO, false);
 }
 
 
@@ -1390,7 +1415,7 @@ output_stream (void)
   setmode (STDOUT_FILENO, O_BINARY);
 #endif
 
-  s = fd_to_stream (STDOUT_FILENO);
+  s = fd_to_stream (STDOUT_FILENO, false);
   return s;
 }
 
@@ -1407,7 +1432,7 @@ error_stream (void)
   setmode (STDERR_FILENO, O_BINARY);
 #endif
 
-  s = fd_to_stream (STDERR_FILENO);
+  s = fd_to_stream (STDERR_FILENO, false);
   return s;
 }
 

libgfortran/io/unix.h

@@ -167,6 +167,9 @@ internal_proto(inquire_readwrite);
 extern void flush_if_preconnected (stream *);
 internal_proto(flush_if_preconnected);
 
+extern int flush_if_unbuffered (stream*);
+internal_proto(flush_if_unbuffered);
+
 extern int stream_isatty (stream *);
 internal_proto(stream_isatty);