re PR libfortran/16339 (Unformatted i/o on large arrays inefficient)

2005-10-07  Janne Blomqvist <jblomqvi@cc.hut.fi>

	PR fortran/16339
	PR fortran/23363
	* io/io.h: Add read and write members to stream, define access
	macros.
	* io/transfer.c (read_block_direct): New function.
	(write_block_direct): New function.
	(unformatted_read): Change to use read_block_direct.
	(unformatted_write): Change to use write_block_direct.
	* io/unix.c: Remove mmap includes and defines.
	(writen): Remove.
	(readn): Remove.
	(reset_stream): New function.
	(do_read): New function.
	(do_write): New function.
	(fd_flush): Change to use do_write() instead of writen().
	(fd_alloc_r_at): Change to use do_read().
	(fd_seek): Change return type to try, as the prototype. Add check
	to avoid syscall overhead if possible.
	(fd_read): New function.
	(fd_write): New function.
	(fd_open): Set pointers for new functions.
	(mem_read): New function.
	(mem_write): New function.
	(open_internal): Set pointers for new functions.
	(is_seekable): Clean up comment.

From-SVN: r105101

libgfortran/ChangeLog

@@ -1,3 +1,31 @@
+2005-10-07  Janne Blomqvist <jblomqvi@cc.hut.fi>
+
+	PR fortran/16339
+	PR fortran/23363
+	* io/io.h: Add read and write members to stream, define access
+	macros.
+	* io/transfer.c (read_block_direct): New function.
+	(write_block_direct): New function.
+	(unformatted_read): Change to use read_block_direct.
+	(unformatted_write): Change to use write_block_direct.
+	* io/unix.c: Remove mmap includes and defines.
+	(writen): Remove.
+	(readn): Remove.
+	(reset_stream): New function.
+	(do_read): New function.
+	(do_write): New function.
+	(fd_flush): Change to use do_write() instead of writen().
+	(fd_alloc_r_at): Change to use do_read().
+	(fd_seek): Change return type to try, as the prototype. Add check
+	to avoid syscall overhead if possible.
+	(fd_read): New function.
+	(fd_write): New function.
+	(fd_open): Set pointers for new functions.
+	(mem_read): New function.
+	(mem_write): New function.
+	(open_internal): Set pointers for new functions.
+	(is_seekable): Clean up comment.
+
 2005-10-07  Jerry DeLisle  <jvdelisle@verizon.net>
 
         * io/transfer.c (write_block): Add test for end-of-file condition,

libgfortran/io/io.h

@@ -56,6 +56,8 @@ typedef struct stream
   try (*close) (struct stream *);
   try (*seek) (struct stream *, gfc_offset);
   try (*truncate) (struct stream *);
+  int (*read) (struct stream *, void *, size_t *);
+  int (*write) (struct stream *, const void *, size_t *);
 }
 stream;
 
@@ -73,6 +75,8 @@ stream;
 
 #define sseek(s, pos) ((s)->seek)(s, pos)
 #define struncate(s) ((s)->truncate)(s)
+#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
+#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
 
 /* Representation of a namelist object in libgfortran
 

libgfortran/io/transfer.c

@@ -286,6 +286,60 @@ read_block (int *length)
 }
 
 
+/* Reads a block directly into application data space.  */
+
+static void
+read_block_direct (void * buf, size_t * nbytes)
+{
+  int *length;
+  void *data;
+  size_t nread;
+
+  if (current_unit->flags.form == FORM_FORMATTED &&
+      current_unit->flags.access == ACCESS_SEQUENTIAL)
+    {
+      length = (int*) nbytes;
+      data = read_sf (length);	/* Special case.  */
+      memcpy (buf, data, (size_t) *length);
+      return;
+    }
+
+  if (current_unit->bytes_left < *nbytes)
+    {
+      if (current_unit->flags.pad == PAD_NO)
+	{
+	  generate_error (ERROR_EOR, NULL); /* Not enough data left.  */
+	  return;
+	}
+
+      *nbytes = current_unit->bytes_left;
+    }
+
+  current_unit->bytes_left -= *nbytes;
+
+  nread = *nbytes;
+  if (sread (current_unit->s, buf, &nread) != 0)
+    {
+      generate_error (ERROR_OS, NULL);
+      return;
+    }
+
+  if (ioparm.size != NULL)
+    *ioparm.size += (GFC_INTEGER_4) nread;
+
+  if (nread != *nbytes)
+    {				/* Short read, e.g. if we hit EOF.  */
+      if (current_unit->flags.pad == PAD_YES)
+	{
+	  memset (((char *) buf) + nread, ' ', *nbytes - nread);
+	  *nbytes = nread;
+	}
+      else
+	generate_error (ERROR_EOR, NULL);
+    }
+}
+
+
 /* Function for writing a block of bytes to the current file at the
    current position, advancing the file pointer. We are given a length
    and return a pointer to a buffer that the caller must (completely)
@@ -318,39 +372,49 @@ write_block (int length)
 }
 
 
+/* Writes a block directly without necessarily allocating space in a
+   buffer.  */
+
+static void
+write_block_direct (void * buf, size_t * nbytes)
+{
+  if (current_unit->bytes_left < *nbytes)
+    generate_error (ERROR_EOR, NULL);
+
+  current_unit->bytes_left -= (gfc_offset) *nbytes;
+
+  if (swrite (current_unit->s, buf, nbytes) != 0)
+    generate_error (ERROR_OS, NULL);
+
+  if (ioparm.size != NULL)
+    *ioparm.size += (GFC_INTEGER_4) *nbytes;
+}
+
+
 /* Master function for unformatted reads.  */
 
 static void
 unformatted_read (bt type, void *dest, int length, size_t nelems)
 {
-  void *source;
+  size_t len;
-  int w;
 
-  length *= nelems;
+  len = length * nelems;
 
   /* Transfer functions get passed the kind of the entity, so we have
      to fix this for COMPLEX data which are twice the size of their
      kind.  */
   if (type == BT_COMPLEX)
-    length *= 2;
+    len *= 2;
 
-  w = length;
+  read_block_direct (dest, &len);
-  source = read_block (&w);
-
-  if (source != NULL)
-    {
-      memcpy (dest, source, w);
-      if (length != w)
-	memset (((char *) dest) + w, ' ', length - w);
-    }
 }
 
+
 /* Master function for unformatted writes.  */
 
 static void
 unformatted_write (bt type, void *source, int length, size_t nelems)
 {
-  void *dest;
   size_t len;
 
   len = length * nelems;
@@ -359,9 +423,7 @@ unformatted_write (bt type, void *source, int length, size_t nelems)
   if (type == BT_COMPLEX)
     len *= 2;
 
-  dest = write_block (len);
+  write_block_direct (source, &len);
-  if (dest != NULL)
-    memcpy (dest, source, len);
 }
 
 

libgfortran/io/unix.c

@@ -40,9 +40,6 @@ Boston, MA 02110-1301, USA.  */
 #include <fcntl.h>
 #include <assert.h>
 
-#ifdef HAVE_SYS_MMAN_H
-#include <sys/mman.h>
-#endif
 #include <string.h>
 #include <errno.h>
 
@@ -53,10 +50,6 @@ Boston, MA 02110-1301, USA.  */
 #define PATH_MAX 1024
 #endif
 
-#ifndef MAP_FAILED
-#define MAP_FAILED ((void *) -1)
-#endif
-
 #ifndef PROT_READ
 #define PROT_READ 1
 #endif
@@ -231,58 +224,104 @@ is_preconnected (stream * s)
     return 0;
 }
 
-/* write()-- Write a buffer to a descriptor, allowing for short writes */
 
-static int
+/* Reset a stream after reading/writing. Assumes that the buffers have
-writen (int fd, char *buffer, int len)
+   been flushed.  */
+
+inline static void
+reset_stream (unix_stream * s, size_t bytes_rw)
 {
-  int n, n0;
+  s->physical_offset += bytes_rw;
-
+  s->logical_offset = s->physical_offset;
-  n0 = len;
+  if (s->file_length != -1 && s->physical_offset > s->file_length)
-
+    s->file_length = s->physical_offset;
-  while (len > 0)
-    {
-      n = write (fd, buffer, len);
-      if (n < 0)
-	return n;
-
-      buffer += n;
-      len -= n;
-    }
-
-  return n0;
 }
 
 
-#if 0
+/* Read bytes into a buffer, allowing for short reads.  If the nbytes
-/* readn()-- Read bytes into a buffer, allowing for short reads.  If
+ * argument is less on return than on entry, it is because we've hit
- * fewer than len bytes are returned, it is because we've hit the end
+ * the end of file. */
- * of file. */
 
 static int
-readn (int fd, char *buffer, int len)
+do_read (unix_stream * s, void * buf, size_t * nbytes)
 {
-  int nread, n;
+  ssize_t trans;
+  size_t bytes_left;
+  char *buf_st;
+  int status;
 
-  nread = 0;
+  status = 0;
+  bytes_left = *nbytes;
+  buf_st = (char *) buf;
 
-  while (len > 0)
+  /* We must read in a loop since some systems don't restart system
+     calls in case of a signal.  */
+  while (bytes_left > 0)
     {
-      n = read (fd, buffer, len);
+      /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
-      if (n < 0)
+	 so we must read in chunks smaller than SSIZE_MAX.  */
-	return n;
+      trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
-
+      trans = read (s->fd, buf_st, trans);
-      if (n == 0)
+      if (trans < 0)
-	return nread;
+	{
-
+	  if (errno == EINTR)
-      buffer += n;
+	    continue;
-      nread += n;
+	  else
-      len -= n;
+	    {
+	      status = errno;
+	      break;
+	    }
+	}
+      else if (trans == 0) /* We hit EOF.  */
+	break;
+      buf_st += trans;
+      bytes_left -= trans;
     }
 
-  return nread;
+  *nbytes -= bytes_left;
+  return status;
+}
+
+
+/* Write a buffer to a stream, allowing for short writes.  */
+
+static int
+do_write (unix_stream * s, const void * buf, size_t * nbytes)
+{
+  ssize_t trans;
+  size_t bytes_left;
+  char *buf_st;
+  int status;
+
+  status = 0;
+  bytes_left = *nbytes;
+  buf_st = (char *) buf;
+
+  /* We must write in a loop since some systems don't restart system
+     calls in case of a signal.  */
+  while (bytes_left > 0)
+    {
+      /* Requests between SSIZE_MAX and SIZE_MAX are undefined by SUSv3,
+	 so we must write in chunks smaller than SSIZE_MAX.  */
+      trans = (bytes_left < SSIZE_MAX) ? bytes_left : SSIZE_MAX;
+      trans = write (s->fd, buf_st, trans);
+      if (trans < 0)
+	{
+	  if (errno == EINTR)
+	    continue;
+	  else
+	    {
+	      status = errno;
+	      break;
+	    }
+	}
+      buf_st += trans;
+      bytes_left -= trans;
+    }
+
+  *nbytes -= bytes_left;
+  return status;
 }
-#endif
 
 
 /* get_oserror()-- Get the most recent operating system error.  For
@@ -308,11 +347,14 @@ sys_exit (int code)
     File descriptor stream functions
 *********************************************************************/
 
+
 /* fd_flush()-- Write bytes that need to be written */
 
 static try
 fd_flush (unix_stream * s)
 {
+  size_t writelen;
+
   if (s->ndirty == 0)
     return SUCCESS;;
 
@@ -320,16 +362,20 @@ fd_flush (unix_stream * s)
       lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
     return FAILURE;
 
-  if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
+  writelen = s->ndirty;
-	      s->ndirty) < 0)
+  if (do_write (s, s->buffer + (s->dirty_offset - s->buffer_offset),
+		&writelen) != 0)
     return FAILURE;
 
-  s->physical_offset = s->dirty_offset + s->ndirty;
+  s->physical_offset = s->dirty_offset + writelen;
 
   /* don't increment file_length if the file is non-seekable */
   if (s->file_length != -1 && s->physical_offset > s->file_length)
       s->file_length = s->physical_offset; 
-  s->ndirty = 0;
+
+  s->ndirty -= writelen;
+  if (s->ndirty != 0)
+    return FAILURE;
 
   return SUCCESS;
 }
@@ -394,7 +440,7 @@ static char *
 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
 {
   gfc_offset m;
-  int n;
+  size_t n;
 
   if (where == -1)
     where = s->logical_offset;
@@ -416,8 +462,8 @@ fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
   if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
     return NULL;
 
-  n = read (s->fd, s->buffer + s->active, s->len - s->active);
+  n = s->len - s->active;
-  if (n < 0)
+  if (do_read (s, s->buffer + s->active, &n) != 0)
     return NULL;
 
   s->physical_offset = where + n;
@@ -502,9 +548,15 @@ fd_sfree (unix_stream * s)
 }
 
 
-static int
+static try
 fd_seek (unix_stream * s, gfc_offset offset)
 {
+  if (s->physical_offset == offset) /* Are we lucky and avoid syscall?  */
+    {
+      s->logical_offset = offset;
+      return SUCCESS;
+    }
+
   s->physical_offset = s->logical_offset = offset;
 
   return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
@@ -543,6 +595,104 @@ fd_truncate (unix_stream * s)
 }
 
 
+
+
+/* Stream read function. Avoids using a buffer for big reads. The
+   interface is like POSIX read(), but the nbytes argument is a
+   pointer; on return it contains the number of bytes written. The
+   function return value is the status indicator (0 for success).  */
+
+static int
+fd_read (unix_stream * s, void * buf, size_t * nbytes)
+{
+  void *p;
+  int tmp, status;
+
+  if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+    {
+      tmp = *nbytes;
+      p = fd_alloc_r_at (s, &tmp, -1);
+      if (p)
+	{
+	  *nbytes = tmp;
+	  memcpy (buf, p, *nbytes);
+	  return 0;
+	}
+      else
+	{
+	  *nbytes = 0;
+	  return errno;
+	}
+    }
+
+  /* If the request is bigger than BUFFER_SIZE we flush the buffers
+     and read directly.  */
+  if (fd_flush (s) == FAILURE)
+    {
+      *nbytes = 0;
+      return errno;
+    }
+
+  if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
+    {
+      *nbytes = 0;
+      return errno;
+    }
+
+  status = do_read (s, buf, nbytes);
+  reset_stream (s, *nbytes);
+  return status;
+}
+
+
+/* Stream write function. Avoids using a buffer for big writes. The
+   interface is like POSIX write(), but the nbytes argument is a
+   pointer; on return it contains the number of bytes written. The
+   function return value is the status indicator (0 for success).  */
+
+static int
+fd_write (unix_stream * s, const void * buf, size_t * nbytes)
+{
+  void *p;
+  int tmp, status;
+
+  if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+    {
+      tmp = *nbytes;
+      p = fd_alloc_w_at (s, &tmp, -1);
+      if (p)
+	{
+	  *nbytes = tmp;
+	  memcpy (p, buf, *nbytes);
+	  return 0;
+	}
+      else
+	{
+	  *nbytes = 0;
+	  return errno;
+	}
+    }
+
+  /* If the request is bigger than BUFFER_SIZE we flush the buffers
+     and write directly.  */
+  if (fd_flush (s) == FAILURE)
+    {
+      *nbytes = 0;
+      return errno;
+    }
+
+  if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
+    {
+      *nbytes = 0;
+      return errno;
+    }
+
+  status =  do_write (s, buf, nbytes);
+  reset_stream (s, *nbytes);
+  return status;
+}
+
+
 static try
 fd_close (unix_stream * s)
 {
@@ -576,12 +726,15 @@ fd_open (unix_stream * s)
   s->st.close = (void *) fd_close;
   s->st.seek = (void *) fd_seek;
   s->st.truncate = (void *) fd_truncate;
+  s->st.read = (void *) fd_read;
+  s->st.write = (void *) fd_write;
 
   s->buffer = NULL;
 }
 
 
 
+
 /*********************************************************************
   memory stream functions - These are used for internal files
 
@@ -638,6 +791,60 @@ mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
 }
 
 
+/* Stream read function for internal units. This is not actually used
+   at the moment, as all internal IO is formatted and the formatted IO
+   routines use mem_alloc_r_at.  */
+
+static int
+mem_read (unix_stream * s, void * buf, size_t * nbytes)
+{
+  void *p;
+  int tmp;
+
+  tmp = *nbytes;
+  p = mem_alloc_r_at (s, &tmp, -1);
+  if (p)
+    {
+      *nbytes = tmp;
+      memcpy (buf, p, *nbytes);
+      return 0;
+    }
+  else
+    {
+      *nbytes = 0;
+      return errno;
+    }
+}
+
+
+/* Stream write function for internal units. This is not actually used
+   at the moment, as all internal IO is formatted and the formatted IO
+   routines use mem_alloc_w_at.  */
+
+static int
+mem_write (unix_stream * s, const void * buf, size_t * nbytes)
+{
+  void *p;
+  int tmp;
+
+  errno = 0;
+
+  tmp = *nbytes;
+  p = mem_alloc_w_at (s, &tmp, -1);
+  if (p)
+    {
+      *nbytes = tmp;
+      memcpy (p, buf, *nbytes);
+      return 0;
+    }
+  else
+    {
+      *nbytes = 0;
+      return errno;
+    }
+}
+
+
 static int
 mem_seek (unix_stream * s, gfc_offset offset)
 {
@@ -712,6 +919,8 @@ open_internal (char *base, int length)
   s->st.close = (void *) mem_close;
   s->st.seek = (void *) mem_seek;
   s->st.truncate = (void *) mem_truncate;
+  s->st.read = (void *) mem_read;
+  s->st.write = (void *) mem_write;
 
   return (stream *) s;
 }
@@ -1350,9 +1559,8 @@ file_position (stream * s)
 int
 is_seekable (stream * s)
 {
-  /* by convention, if file_length == -1, the file is not seekable
+  /* By convention, if file_length == -1, the file is not
-     note that a mmapped file is always seekable, an fd_ file may
+     seekable.  */
-     or may not be. */
   return ((unix_stream *) s)->file_length!=-1;
 }