2006-02-12 Janne Blomqvist <jb@gcc.gnu.org>

	PR libgfortran/25949
	* io/io.h: Add set function pointer to struct stream.  
	* io/unix.c (fd_seek): Only update offset, don't seek.
	(fd_sset): New function.
	(fd_read): Call lseek directly if necessary.
	(fd_write): Likewise.
	(fd_open): Set pointer to fd_sset.
	(mem_set): New function.
	(open_internal): Set pointer to mem_set.
	* io/transfer.c (write_block_direct): Rename to write_buf, add
	error return, non-pointer length argument.
	(unformatted_write): Update to use write_buf.
	(us_write): Simplify by using swrite instead of salloc_w.
	(write_us_marker): New function.
	(new_record_w): Use sset instead of memset, use write_us_marker,
	simplify by using swrite instead of salloc_w.


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

4 files changed, 139 insertions, 86 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index a8e881d45fa..0876d0dced9 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,22 @@
+2006-02-12  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR libgfortran/25949
+	* io/io.h: Add set function pointer to struct stream.  
+	* io/unix.c (fd_seek): Only update offset, don't seek.
+	(fd_sset): New function.
+	(fd_read): Call lseek directly if necessary.
+	(fd_write): Likewise.
+	(fd_open): Set pointer to fd_sset.
+	(mem_set): New function.
+	(open_internal): Set pointer to mem_set.
+	* io/transfer.c (write_block_direct): Rename to write_buf, add
+	error return, non-pointer length argument.
+	(unformatted_write): Update to use write_buf.
+	(us_write): Simplify by using swrite instead of salloc_w.
+	(write_us_marker): New function.
+	(new_record_w): Use sset instead of memset, use write_us_marker,
+	simplify by using swrite instead of salloc_w.
+
 2006-02-08  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR libfortran/25425
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 31b4927cb6e..0d2d795e198 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -62,6 +62,7 @@ typedef struct stream
   try (*truncate) (struct stream *);
   int (*read) (struct stream *, void *, size_t *);
   int (*write) (struct stream *, const void *, size_t *);
+  try (*set) (struct stream *, int, size_t);
 }
 stream;
 
@@ -82,6 +83,8 @@ stream;
 #define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
 #define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
 
+#define sset(s, c, n) ((s)->set)(s, c, n)
+
 /* The array_loop_spec contains the variables for the loops over index ranges
    that are encountered.  Since the variables can be negative, ssize_t
    is used.  */
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 1d8330fe453..093852a99ec 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -377,22 +377,32 @@ write_block (st_parameter_dt *dtp, int length)
 }
 
 
-/* Writes a block directly without necessarily allocating space in a
-   buffer.  */
+/* High level interface to swrite(), taking care of errors.  */
 
-static void
-write_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
+static try
+write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
 {
-  if (dtp->u.p.current_unit->bytes_left < *nbytes)
-    generate_error (&dtp->common, ERROR_EOR, NULL);
+  if (dtp->u.p.current_unit->bytes_left < nbytes)
+    {
+      generate_error (&dtp->common, ERROR_EOR, NULL);
+      return FAILURE;
+    }
 
-  dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
+  dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
 
-  if (swrite (dtp->u.p.current_unit->s, buf, nbytes) != 0)
-    generate_error (&dtp->common, ERROR_OS, NULL);
+  if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
+    {
+      generate_error (&dtp->common, ERROR_OS, NULL);
+      return FAILURE;
+    }
 
   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    *dtp->size += (GFC_INTEGER_4) *nbytes;
+    {
+      *dtp->size += (GFC_INTEGER_4) nbytes;
+      return FAILURE;
+    }
+
+  return SUCCESS;
 }
 
 
@@ -452,7 +462,7 @@ unformatted_write (st_parameter_dt *dtp, bt type,
     {
       size *= nelems;
 
-      write_block_direct (dtp, source, &size);
+      write_buf (dtp, source, size);
     }
   else
     {
@@ -479,7 +489,7 @@ unformatted_write (st_parameter_dt *dtp, bt type,
 	{
 	  reverse_memcpy(buffer, p, size);
  	  p+= size;
-	  write_block_direct (dtp, buffer, &sz);
+	  write_buf (dtp, buffer, sz);
 	}
     }
 }
@@ -1253,25 +1263,18 @@ us_read (st_parameter_dt *dtp)
 static void
 us_write (st_parameter_dt *dtp)
 {
-  char *p;
-  int length;
-
-  length = sizeof (gfc_offset);
-  p = salloc_w (dtp->u.p.current_unit->s, &length);
+  size_t nbytes;
+  gfc_offset dummy;
 
-  if (p == NULL)
-    {
-      generate_error (&dtp->common, ERROR_OS, NULL);
-      return;
-    }
+  dummy = 0;
+  nbytes = sizeof (gfc_offset);
 
-  memset (p, '\0', sizeof (gfc_offset));	/* Bogus value for now.  */
-  if (sfree (dtp->u.p.current_unit->s) == FAILURE)
+  if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0)
     generate_error (&dtp->common, ERROR_OS, NULL);
 
-  /* For sequential unformatted, we write until we have more bytes than
-     can fit in the record markers. If disk space runs out first, it will
-     error on the write.  */
+  /* For sequential unformatted, we write until we have more bytes
+     than can fit in the record markers. If disk space runs out first,
+     it will error on the write.  */
   dtp->u.p.current_unit->recl = max_offset;
 
   dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
@@ -1766,6 +1769,24 @@ next_record_r (st_parameter_dt *dtp)
 }
 
 
+/* Small utility function to write a record marker, taking care of
+   byte swapping.  */
+
+inline static int
+write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
+{
+  size_t len = sizeof (gfc_offset);
+  /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here.  */
+  if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
+    return swrite (dtp->u.p.current_unit->s, &buf, &len);
+  else {
+    gfc_offset p;
+    reverse_memcpy (&p, &buf, sizeof (gfc_offset));
+    return swrite (dtp->u.p.current_unit->s, &p, &len);
+  }
+}
+
+
 /* Position to the next record in write mode.  */
 
 static void
@@ -1785,15 +1806,10 @@ next_record_w (st_parameter_dt *dtp, int done)
       if (dtp->u.p.current_unit->bytes_left == 0)
 	break;
 
-      length = dtp->u.p.current_unit->bytes_left;
-      p = salloc_w (dtp->u.p.current_unit->s, &length);
-
-      if (p == NULL)
+      if (sset (dtp->u.p.current_unit->s, ' ', 
+		dtp->u.p.current_unit->bytes_left) == FAILURE)
 	goto io_error;
 
-      memset (p, ' ', dtp->u.p.current_unit->bytes_left);
-      if (sfree (dtp->u.p.current_unit->s) == FAILURE)
-	goto io_error;
       break;
 
     case UNFORMATTED_DIRECT:
@@ -1806,37 +1822,19 @@ next_record_w (st_parameter_dt *dtp, int done)
       m = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
       c = file_position (dtp->u.p.current_unit->s);
 
-      length = sizeof (gfc_offset);
-
       /* Write the length tail.  */
 
-      p = salloc_w (dtp->u.p.current_unit->s, &length);
-      if (p == NULL)
-	goto io_error;
-
-      /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here.  */
-      if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
-	memcpy (p, &m, sizeof (gfc_offset));
-      else
-	reverse_memcpy (p, &m, sizeof (gfc_offset));
-      
-      if (sfree (dtp->u.p.current_unit->s) == FAILURE)
+      if (write_us_marker (dtp, m) != 0)
 	goto io_error;
 
       /* Seek to the head and overwrite the bogus length with the real
 	 length.  */
 
-      p = salloc_w_at (dtp->u.p.current_unit->s, &length, c - m - length);
-      if (p == NULL)
-	generate_error (&dtp->common, ERROR_OS, NULL);
+      if (sseek (dtp->u.p.current_unit->s, c - m - sizeof (gfc_offset))
+		 == FAILURE)
+	goto io_error;
 
-      /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here.  */
-      if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
-	memcpy (p, &m, sizeof (gfc_offset));
-      else
-	reverse_memcpy (p, &m, sizeof (gfc_offset));
-	
-      if (sfree (dtp->u.p.current_unit->s) == FAILURE)
+      if (write_us_marker (dtp, m) != 0)
 	goto io_error;
 
       /* Seek past the end of the current record.  */
@@ -1870,13 +1868,11 @@ next_record_w (st_parameter_dt *dtp, int done)
 		  length = (int) (dtp->u.p.current_unit->recl - max_pos);
 		}
 
-	      p = salloc_w (dtp->u.p.current_unit->s, &length);
-	      if (p == NULL)
+	      if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
 		{
 		  generate_error (&dtp->common, ERROR_END, NULL);
 		  return;
 		}
-	      memset(p, ' ', length);
 
 	      /* Now that the current record has been padded out,
 		 determine where the next record in the array is. */
@@ -1913,13 +1909,11 @@ next_record_w (st_parameter_dt *dtp, int done)
 		  else
 		    length = (int) dtp->u.p.current_unit->bytes_left;
 		}
-	      p = salloc_w (dtp->u.p.current_unit->s, &length);
-	      if (p == NULL)
+	      if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
 		{
 		  generate_error (&dtp->common, ERROR_END, NULL);
 		  return;
 		}
-	      memset (p, ' ', length);
 	    }
 	}
       else
@@ -1937,22 +1931,14 @@ next_record_w (st_parameter_dt *dtp, int done)
 		  p = salloc_w (dtp->u.p.current_unit->s, &length);
 		}
  	    }
+	  size_t len;
+	  const char crlf[] = "\r\n";
 #ifdef HAVE_CRLF
-	  length = 2;
-#else
-	  length = 1;
-#endif
-	  p = salloc_w (dtp->u.p.current_unit->s, &length);
-	  if (p)
-	    {  /* No new line for internal writes.  */
-#ifdef HAVE_CRLF
-	      p[0] = '\r';
-	      p[1] = '\n';
+	  len = 2;
 #else
-	      *p = '\n';
+	  len = 1;
 #endif
-	    }
-	  else
+	  if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0)
 	    goto io_error;
 	}
 
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 237f09e9930..40ad2d897bb 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -562,15 +562,9 @@ fd_sfree (unix_stream * s)
 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;
+  s->logical_offset = offset;
 
-  return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
+  return SUCCESS;
 }
 
 
@@ -606,6 +600,34 @@ fd_truncate (unix_stream * s)
 }
 
 
+/* Similar to memset(), but operating on a stream instead of a string.
+   Takes care of not using too much memory.  */
+
+static try
+fd_sset (unix_stream * s, int c, size_t n)
+{
+  size_t bytes_left;
+  int trans;
+  void *p;
+
+  bytes_left = n;
+
+  while (bytes_left > 0)
+    {
+      /* memset() in chunks of BUFFER_SIZE.  */
+      trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE;
+
+      p = fd_alloc_w_at (s, &trans, -1);
+      if (p)
+	  memset (p, c, trans);
+      else
+	return FAILURE;
+
+      bytes_left -= trans;
+    }
+
+  return SUCCESS;
+}
 
 
 /* Stream read function. Avoids using a buffer for big reads. The
@@ -644,7 +666,8 @@ fd_read (unix_stream * s, void * buf, size_t * nbytes)
       return errno;
     }
 
-  if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
+  if (is_seekable ((stream *) s) && s->physical_offset != s->logical_offset 
+      && lseek (s->fd, s->logical_offset, SEEK_SET) < 0)
     {
       *nbytes = 0;
       return errno;
@@ -692,7 +715,8 @@ fd_write (unix_stream * s, const void * buf, size_t * nbytes)
       return errno;
     }
 
-  if (is_seekable ((stream *) s) && fd_seek (s, s->logical_offset) == FAILURE)
+  if (is_seekable ((stream *) s) && s->physical_offset != s->logical_offset
+      && lseek (s->fd, s->logical_offset, SEEK_SET) < 0)
     {
       *nbytes = 0;
       return errno;
@@ -739,6 +763,7 @@ fd_open (unix_stream * s)
   s->st.truncate = (void *) fd_truncate;
   s->st.read = (void *) fd_read;
   s->st.write = (void *) fd_write;
+  s->st.set = (void *) fd_sset;
 
   s->buffer = NULL;
 }
@@ -870,6 +895,25 @@ mem_seek (unix_stream * s, gfc_offset offset)
 }
 
 
+static try
+mem_set (unix_stream * s, int c, size_t n)
+{
+  void *p;
+  int len;
+
+  len = n;
+  
+  p = mem_alloc_w_at (s, &len, -1);
+  if (p)
+    {
+      memset (p, c, len);
+      return SUCCESS;
+    }
+  else
+    return FAILURE;
+}
+
+
 static int
 mem_truncate (unix_stream * s __attribute__ ((unused)))
 {
@@ -932,6 +976,7 @@ open_internal (char *base, int length)
   s->st.truncate = (void *) mem_truncate;
   s->st.read = (void *) mem_read;
   s->st.write = (void *) mem_write;
+  s->st.set = (void *) mem_set;
 
   return (stream *) s;
 }