This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, libgfortran] PR 25561 Part 1/2 Get rid of alloc stream


Hello,

compared to the previous submission

http://gcc.gnu.org/ml/gcc-patches/2008-05/msg00268.html

this patch now regtests cleanly due to the introduction of a format
buffer to correctly handle T and TL edit descriptors on non-seekable
files. Currently the default size of the format buffer is 4 KB. This is
perhaps a bit on the large side, my thinking was that it should be large
enough to cover everything but the most pathological testcases without
having to do a realloc. Perhaps a more modest, say, 512 bytes would be
more than enough to cover the common cases. The format buffer is flushed
after every write statement, relying on the underlying buffering to
avoid too much syscall overhead.

There is still a single use of salloc left in the library; however this
is only used for internal files, thus paving the way for using stdio for
external files as explained in the message linked above.

Performance-wise, at the moment it is roughly the same as without the
patch. For stream I/O there should be a performance increase, as the
patch reduces unnecessary seeks. Comparing the testio.f90 benchmark
Jerry provided with ifort 9.1, there is still lots of room for improvement.

For the NIST tests, it still fails FM111, FM406 and FM903 if I'm
interpreting the results correctly, but it seems 4.2 and 4.3 have the
same problems (406 passes on 4.2 and fails on 4.3) so I don't think it's
a regression?

Ok for trunk?

-- 
Janne Blomqvist
2008-05-13  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/25561
	* Makefile.am: Add fbuf.c to gfor_io_src.
	* Makefile.in: Regenerate.
	* io/io.h (read_block): Remove.
	(struct stream): Remove alloc_r_at function pointer.
	(salloc_r): Remove.
	(salloc_r_at): Remove.
	(salloc_w_at): Remove.
	(salloc_w): Remove offset argument.
	(struct fbuf): New struct for format buffer.
	(struct gfc_unit): Add fbuf.
	(read_block_form): New prototype.
	(fbuf_init): Likewise.
	(fbuf_destroy): Likewise.
	(fbuf_reset): Likewise.
	(fbuf_alloc): Likewise.
	(fbuf_flush): Likewise.
	(fbuf_seek): Likewise.
	* io/file_pos.c (formatted_backspace): Change to use sread.
	(unformatted_backspace): Likewise.
	(st_backspace): Flush format buffer.
	(st_rewind): Likewise.
	* io/list_read.c (next_char): Likewise.
	(nml_query): Tidying, flush format buffer.
	* io/open.c (new_unit): Init format buffer.
	* io/read.c (read_l): Change to use read_block_form.
	(read_a): Likewise.
	(read_decimal): Likewise.
	(read_radix): Likewise.
	(read_f): Likewise.
	(read_x): Empty reads also for stream I/O.
	* io/transfer.c (read_sf): Change to use sread.
	(read_block): Rename to read_block_form, change prototype, use sread.
	(read_block_direct): Don't seek stream files.
	(write_block): Change to use fbuf if external file, don't seek stream
	files.
	(write_buf): Don't seek stream files.
	(formatted_transfer_scalar): Use fbuf for external files.
	(us_read): Change to use sread.
	(pre_position): Do nothing for stream I/O.
	(data_transfer_init): Flush fbuf when switching from write to read, if
	POS is specified, seek stream file to correct offset.
	(skip_record): Change to use sread.
	(min_off): New function.
	(next_record_r): Change to use sread.
	(next_record_w): Change to use sset/sseek, flush fbuf.
	(finalize_transfer): Flush fbuf.
	* io/unit.c (init_units): Init fbuf for stdout, stderr.
	(close_unit_1): Destroy fbuf.
	(finish_last_advance_record): Flush fbuf, no need to seek.
	* io/unix.c (fd_alloc_r_at): Remove unused where argument.
	(fd_alloc_w_at): Likewise.
	(fd_read): Remove third argument to fd_alloc_r_at.
	(fd_write): Remove third argument to fd_alloc_w_at.
	(fd_sset): Likewise.
	(fd_open): Don't set alloc_r_at.
	(mem_alloc_r_at): Remove unused where argument.
	(mem_alloc_w_at): Likewise.
	(mem_read): Don't incorrectly return previous errno, remove unused
	third argument to alloc function.
	(mem_write): Likewise.
	(mem_set): Likewise.
	(open_internal): Don't set alloc_r_at pointer.
	* io/fbuf.c: New file.
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 93a4072..0f99c27 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -45,7 +45,8 @@ io/size_from_kind.c \
 io/transfer.c \
 io/unit.c \
 io/unix.c \
-io/write.c
+io/write.c \
+io/fbuf.c
 
 gfor_io_headers= \
 io/io.h
diff --git a/libgfortran/io/fbuf.c b/libgfortran/io/fbuf.c
new file mode 100644
index 0000000..ba6f710
--- /dev/null
+++ b/libgfortran/io/fbuf.c
@@ -0,0 +1,132 @@
+/* Copyright (C) 2008 Free Software Foundation, Inc.
+   Contributed by Janne Blomqvist
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with Libgfortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+
+#include "io.h"
+#include <string.h>
+#include <stdlib.h>
+
+
+void
+fbuf_init (gfc_unit * u, size_t len)
+{
+  if (len == 0)
+    len = 4096;			/* Default size one page.  */
+
+  u->fbuf = get_mem (sizeof (fbuf));
+  u->fbuf->buf = u->fbuf->ptr = get_mem (len);
+  u->fbuf->len = len;
+  u->fbuf->act = u->fbuf->flushed = 0;
+}
+
+
+void
+fbuf_reset (gfc_unit * u)
+{
+  u->fbuf->act = u->fbuf->flushed = 0;
+  u->fbuf->ptr = u->fbuf->buf;
+}
+
+
+void
+fbuf_destroy (gfc_unit * u)
+{
+  if (u->fbuf == NULL)
+    return;
+  if (u->fbuf->buf)
+    free_mem (u->fbuf->buf);
+  free_mem (u->fbuf);
+}
+
+
+/* Return a pointer to the current position in the buffer, and increase
+   the pointer by len. Makes sure that the buffer is big enough, 
+   reallocating if necessary.  */
+
+char *
+fbuf_alloc (gfc_unit * u, size_t len)
+{
+  size_t newlen, ptrpos;
+  char *dest;
+  if (u->fbuf->ptr + len > u->fbuf->buf + u->fbuf->len)
+    {
+      /* Round up to nearest multiple of the current buffer length.  */
+      ptrpos = u->fbuf->ptr - u->fbuf->buf;
+      newlen = ((ptrpos + len) / u->fbuf->len + 1) * u->fbuf->len;
+      dest = realloc (u->fbuf->buf, newlen);
+      if (dest == NULL)
+	return NULL;
+      u->fbuf->buf = dest;
+      u->fbuf->ptr = dest + ptrpos;
+      u->fbuf->len = newlen;
+    }
+  dest = u->fbuf->ptr;
+  u->fbuf->ptr += len;
+  if ((size_t) (u->fbuf->ptr - u->fbuf->buf) > u->fbuf->act)
+    u->fbuf->act = u->fbuf->ptr - u->fbuf->buf;
+  return dest;
+}
+
+
+int
+fbuf_flush (gfc_unit * u, int record_done)
+{
+  int status;
+  size_t nbytes;
+
+  if (!u->fbuf)
+    return 0;
+  if (u->fbuf->act - u->fbuf->flushed != 0)
+    {
+      if (record_done)
+        nbytes = u->fbuf->act - u->fbuf->flushed;
+      else	
+        nbytes = u->fbuf->ptr - u->fbuf->buf - u->fbuf->flushed;	
+      status = swrite (u->s, u->fbuf->buf + u->fbuf->flushed, &nbytes);
+      u->fbuf->flushed += nbytes;
+    }
+  else
+    status = 0;
+  if (record_done)
+    fbuf_reset (u);
+  return status;
+}
+
+
+int
+fbuf_seek (gfc_unit * u, gfc_offset off)
+{
+  gfc_offset pos = u->fbuf->ptr - u->fbuf->buf + off;
+  if (pos < 0)
+    return -1;
+  u->fbuf->ptr = u->fbuf->buf + pos;
+  if (pos > u->fbuf->act)
+    u->fbuf->act = pos;
+  return 0;
+}
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 94e2989..f486488 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -39,14 +39,14 @@ Boston, MA 02110-1301, USA.  */
    record, and we have to sift backwards to find the newline before
    that or the start of the file, whichever comes first.  */
 
-#define READ_CHUNK 4096
+static const unsigned int READ_CHUNK = 4096;
 
 static void
 formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
 {
   gfc_offset base;
-  char *p;
-  int n;
+  char p[READ_CHUNK];
+  size_t n;
 
   base = file_position (u->s) - 1;
 
@@ -54,9 +54,9 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
     {
       n = (base < READ_CHUNK) ? base : READ_CHUNK;
       base -= n;
-
-      p = salloc_r_at (u->s, &n, base);
-      if (p == NULL)
+      if (sseek (u->s, base) == FAILURE)
+        goto io_error;
+      if (sread (u->s, p, &n) != 0)
 	goto io_error;
 
       /* We have moved backwards from the current position, it should
@@ -66,15 +66,14 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
       /* There is no memrchr() in the C library, so we have to do it
          ourselves.  */
 
-      n--;
-      while (n >= 0)
+      while (n > 0)
 	{
+          n--;
 	  if (p[n] == '\n')
 	    {
 	      base += n + 1;
 	      goto done;
 	    }
-	  n--;
 	}
 
     }
@@ -104,9 +103,9 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
   gfc_offset m, new;
   GFC_INTEGER_4 m4;
   GFC_INTEGER_8 m8;
-  int length, length_read;
+  size_t length;
   int continued;
-  char *p;
+  char p[sizeof (GFC_INTEGER_8)];
 
   if (compile_options.record_marker == 0)
     length = sizeof (GFC_INTEGER_4);
@@ -115,12 +114,10 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
 
   do
     {
-      length_read = length;
-
-      p = salloc_r_at (u->s, &length_read,
-		       file_position (u->s) - length);
-      if (p == NULL || length_read != length)
-	goto io_error;
+      if (sseek (u->s, file_position (u->s) - length) == FAILURE)
+        goto io_error;
+      if (sread (u->s, p, &length) != 0)
+        goto io_error;
 
       /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here.  */
       if (u->flags.convert == GFC_CONVERT_NATIVE)
@@ -216,6 +213,9 @@ st_backspace (st_parameter_filepos *fpp)
 	goto done;
       }
 
+  /* Make sure format buffer is flushed.  */
+  fbuf_flush (u, 1);
+  
   /* Check for special cases involving the ENDFILE record first.  */
 
   if (u->endfile == AFTER_ENDFILE)
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 30d4051..e554d8c 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -49,8 +49,7 @@ struct st_parameter_dt;
 
 typedef struct stream
 {
-  char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
-  char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
+  char *(*alloc_w_at) (struct stream *, int *);
   try (*sfree) (struct stream *);
   try (*close) (struct stream *);
   try (*seek) (struct stream *, gfc_offset);
@@ -70,11 +69,7 @@ io_mode;
 #define sfree(s) ((s)->sfree)(s)
 #define sclose(s) ((s)->close)(s)
 
-#define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
-#define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
-
-#define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
-#define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
+#define salloc_w(s, len) ((s)->alloc_w_at)(s, len)
 
 #define sseek(s, pos) ((s)->seek)(s, pos)
 #define struncate(s) ((s)->trunc)(s)
@@ -528,6 +523,25 @@ typedef struct
 unit_flags;
 
 
+/* Formatting buffer. This is a temporary scratch buffer. Currently used only
+   by formatted writes. After every
+   formatted write statement, this buffer is flushed. This buffer is needed since
+   not all devices are seekable, and T or TL edit descriptors require 
+   moving backwards in the record.  However, advance='no' complicates the
+   situation, so the buffer must only be partially flushed from the end of the
+   last flush until the current position in the record. */
+
+typedef struct fbuf
+{
+  char *buf;			/* Start of buffer.  */
+  size_t len;			/* Length of buffer.  */
+  size_t act;			/* Active bytes in buffer.  */
+  size_t flushed;		/* Flushed bytes from beginning of buffer.  */
+  char *ptr;			/* Current position in buffer.  */
+}
+fbuf;
+
+
 typedef struct gfc_unit
 {
   int unit_number;
@@ -578,6 +592,9 @@ typedef struct gfc_unit
 
   int file_len;
   char *file;
+  
+  /* Formatting buffer.  */
+  struct fbuf *fbuf;
 }
 gfc_unit;
 
@@ -812,8 +829,8 @@ internal_proto(free_format_data);
 extern const char *type_name (bt);
 internal_proto(type_name);
 
-extern void *read_block (st_parameter_dt *, int *);
-internal_proto(read_block);
+extern try read_block_form (st_parameter_dt *, void *, size_t *);
+internal_proto(read_block_form);
 
 extern char *read_sf (st_parameter_dt *, int *, int);
 internal_proto(read_sf);
@@ -931,6 +948,25 @@ internal_proto(size_from_real_kind);
 extern size_t size_from_complex_kind (int);
 internal_proto(size_from_complex_kind);
 
+/* fbuf.c */
+extern void fbuf_init (gfc_unit *, size_t);
+internal_proto(fbuf_init);
+
+extern void fbuf_destroy (gfc_unit *);
+internal_proto(fbuf_destroy);
+
+extern void fbuf_reset (gfc_unit *);
+internal_proto(fbuf_reset);
+
+extern char * fbuf_alloc (gfc_unit *, size_t);
+internal_proto(fbuf_alloc);
+
+extern int fbuf_flush (gfc_unit *, int);
+internal_proto(fbuf_flush);
+
+extern int fbuf_seek (gfc_unit *, gfc_offset);
+internal_proto(fbuf_seek);
+
 /* lock.c */
 extern void free_ionml (st_parameter_dt *);
 internal_proto(free_ionml);
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 802bf9e..13829da 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -140,9 +140,9 @@ free_line (st_parameter_dt *dtp)
 static char
 next_char (st_parameter_dt *dtp)
 {
-  int length;
+  size_t length;
   gfc_offset record;
-  char c, *p;
+  char c;
 
   if (dtp->u.p.last_char != '\0')
     {
@@ -206,43 +206,40 @@ next_char (st_parameter_dt *dtp)
 
   length = 1;
 
-  p = salloc_r (dtp->u.p.current_unit->s, &length);
+  if (sread (dtp->u.p.current_unit->s, &c, &length) != 0)
+    {
+	generate_error (&dtp->common, LIBERROR_OS, NULL);
+	return '\0';
+    }
   
-  if (is_stream_io (dtp))
+  if (is_stream_io (dtp) && length == 1)
     dtp->u.p.current_unit->strm_pos++;
 
   if (is_internal_unit (dtp))
     {
       if (is_array_io (dtp))
 	{
-	  /* End of record is handled in the next pass through, above.  The
-	     check for NULL here is cautionary.  */
-	  if (p == NULL)
+	  /* 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--;
-	  c = *p;
 	}
       else
 	{
-	  if (p == NULL)
+	  if (dtp->u.p.at_eof) 
 	    longjmp (*dtp->u.p.eof_jump, 1);
 	  if (length == 0)
-	    c = '\n';
-	  else
-	    c = *p;
+	    {
+	      c = '\n';
+	      dtp->u.p.at_eof = 1;
+	    }
 	}
     }
   else
     {
-      if (p == NULL)
-	{
-	  generate_error (&dtp->common, LIBERROR_OS, NULL);
-	  return '\0';
-	}
       if (length == 0)
 	{
 	  if (dtp->u.p.advance_status == ADVANCE_NO)
@@ -255,8 +252,6 @@ next_char (st_parameter_dt *dtp)
 	  else
 	    longjmp (*dtp->u.p.eof_jump, 1);
 	}
-      else
-	c = *p;
     }
 done:
   dtp->u.p.at_eol = (c == '\n' || c == '\r');
@@ -2234,6 +2229,15 @@ nml_query (st_parameter_dt *dtp, char c)
   namelist_info * nl;
   index_type len;
   char * p;
+#ifdef HAVE_CRLF
+  static const index_type endlen = 3;
+  static const char endl[] = "\r\n";
+  static const char nmlend[] = "&end\r\n";
+#else
+  static const index_type endlen = 2;
+  static const char endl[] = "\n";
+  static const char nmlend[] = "&end\n";
+#endif
 
   if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
     return;
@@ -2260,59 +2264,35 @@ nml_query (st_parameter_dt *dtp, char c)
 	  /* "&namelist_name\n"  */
 
 	  len = dtp->namelist_name_len;
-#ifdef HAVE_CRLF
-	  p = write_block (dtp, len + 3);
-#else
-	  p = write_block (dtp, len + 2);
-#endif
-	  if (!p)
-	    goto query_return;
+	  p = write_block (dtp, len + endlen);
+          if (!p)
+            goto query_return;
 	  memcpy (p, "&", 1);
 	  memcpy ((char*)(p + 1), dtp->namelist_name, len);
-#ifdef HAVE_CRLF
-	  memcpy ((char*)(p + len + 1), "\r\n", 2);
-#else
-	  memcpy ((char*)(p + len + 1), "\n", 1);
-#endif
+	  memcpy ((char*)(p + len + 1), &endl, endlen - 1);
 	  for (nl = dtp->u.p.ionml; nl; nl = nl->next)
 	    {
 	      /* " var_name\n"  */
 
 	      len = strlen (nl->var_name);
-#ifdef HAVE_CRLF
-	      p = write_block (dtp, len + 3);
-#else
-	      p = write_block (dtp, len + 2);
-#endif
+              p = write_block (dtp, len + endlen);
 	      if (!p)
 		goto query_return;
 	      memcpy (p, " ", 1);
 	      memcpy ((char*)(p + 1), nl->var_name, len);
-#ifdef HAVE_CRLF
-	      memcpy ((char*)(p + len + 1), "\r\n", 2);
-#else
-	      memcpy ((char*)(p + len + 1), "\n", 1);
-#endif
+	      memcpy ((char*)(p + len + 1), &endl, endlen - 1);
 	    }
 
 	  /* "&end\n"  */
 
-#ifdef HAVE_CRLF
-	  p = write_block (dtp, 6);
-#else
-	  p = write_block (dtp, 5);
-#endif
-	  if (!p)
+          p = write_block (dtp, endlen + 3);
 	    goto query_return;
-#ifdef HAVE_CRLF
-	  memcpy (p, "&end\r\n", 6);
-#else
-	  memcpy (p, "&end\n", 5);
-#endif
+          memcpy (p, &nmlend, endlen + 3);
 	}
 
       /* Flush the stream to force immediate output.  */
 
+      fbuf_flush (dtp->u.p.current_unit, 1);
       flush (dtp->u.p.current_unit->s);
       unlock_unit (dtp->u.p.current_unit);
     }
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 83e37ee..e16386c 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -626,6 +626,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 
   if (flags->status == STATUS_SCRATCH && opp->file != NULL)
     free_mem (opp->file);
+    
+  if (flags->form == FORM_FORMATTED && (flags->action != ACTION_READ))
+    fbuf_init (u, 0);
+  else
+    u->fbuf = NULL;
+    
+    
   return u;
 
  cleanup:
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index ce86ec0..a09d663 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA.  */
 
 /* read.c -- Deal with formatted reads */
 
+
 /* set_integer()-- All of the integer assignments come here to
  * actually place the value into memory.  */
 
@@ -192,11 +193,13 @@ void
 read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
   char *p;
-  int w;
+  size_t w;
 
   w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+
+  p = gfc_alloca (w);
+
+  if (read_block_form (dtp, p, &w) == FAILURE)
     return;
 
   while (*p == ' ')
@@ -238,24 +241,29 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 void
 read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
 {
-  char *source;
-  int w, m, n;
+  char *s;
+  int m, n, wi, status;
+  size_t w;
 
-  w = f->u.w;
-  if (w == -1) /* '(A)' edit descriptor  */
-    w = length;
+  wi = f->u.w;
+  if (wi == -1) /* '(A)' edit descriptor  */
+    wi = length;
+
+  w = wi;
+
+  s = gfc_alloca (w);
 
   dtp->u.p.sf_read_comma = 0;
-  source = read_block (dtp, &w);
+  status = read_block_form (dtp, s, &w);
   dtp->u.p.sf_read_comma =
     dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
-  if (source == NULL)
+  if (status == FAILURE)
     return;
-  if (w > length)
-     source += (w - length);
+  if (w > (size_t) length)
+     s += (w - length);
 
-  m = (w > length) ? length : w;
-  memcpy (p, source, m);
+  m = ((int) w > length) ? length : (int) w;
+  memcpy (p, s, m);
 
   n = length - w;
   if (n > 0)
@@ -323,14 +331,19 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
   GFC_UINTEGER_LARGEST value, maxv, maxv_10;
   GFC_INTEGER_LARGEST v;
-  int w, negative;
+  int w, negative; 
+  size_t wu;
   char c, *p;
 
-  w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+  wu = f->u.w;
+
+  p = gfc_alloca (wu);
+
+  if (read_block_form (dtp, p, &wu) == FAILURE)
     return;
 
+  w = wu;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -406,7 +419,7 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
 		  "Value overflowed during integer read");
   next_record (dtp, 1);
-  return;
+
 }
 
 
@@ -423,12 +436,17 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
   GFC_INTEGER_LARGEST v;
   int w, negative;
   char c, *p;
+  size_t wu;
 
-  w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+  wu = f->u.w;
+
+  p = gfc_alloca (wu);
+
+  if (read_block_form (dtp, p, &wu) == FAILURE)
     return;
 
+  w = wu;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -552,7 +570,7 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
   generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
 		  "Value overflowed during integer read");
   next_record (dtp, 1);
-  return;
+
 }
 
 
@@ -565,6 +583,7 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
 void
 read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
+  size_t wu;
   int w, seen_dp, exponent;
   int exponent_sign, val_sign;
   int ndigits;
@@ -576,11 +595,15 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 
   val_sign = 1;
   seen_dp = 0;
-  w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+  wu = f->u.w;
+
+  p = gfc_alloca (wu);
+
+  if (read_block_form (dtp, p, &wu) == FAILURE)
     return;
 
+  w = wu;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     goto zero;
@@ -842,7 +865,6 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (buffer != scratch)
      free_mem (buffer);
 
-  return;
 }
 
 
@@ -850,19 +872,16 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
  * and never look at it. */
 
 void
-read_x (st_parameter_dt *dtp, int n)
+read_x (st_parameter_dt * dtp, int n)
 {
-  if (!is_stream_io (dtp))
-    {
-      if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
-	  && dtp->u.p.current_unit->bytes_left < n)
-	n = dtp->u.p.current_unit->bytes_left;
-
-      dtp->u.p.sf_read_comma = 0;
-      if (n > 0)
-	read_sf (dtp, &n, 1);
-      dtp->u.p.sf_read_comma = 1;
-    }
-  else
-    dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
+  if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
+      && dtp->u.p.current_unit->bytes_left < n)
+    n = dtp->u.p.current_unit->bytes_left;
+
+  dtp->u.p.sf_read_comma = 0;
+  if (n > 0)
+    read_sf (dtp, &n, 1);
+  dtp->u.p.sf_read_comma = 1;
+  dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
+
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 7071ab9..8353f3d 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA.  */
 #include "io.h"
 #include <string.h>
 #include <assert.h>
+#include <stdlib.h>
 
 
 /* Calling conventions:  Data transfer statements are unlike other
@@ -180,9 +181,10 @@ current_mode (st_parameter_dt *dtp)
 char *
 read_sf (st_parameter_dt *dtp, int *length, int no_error)
 {
-  char *base, *p, *q;
-  int n, readlen, crlf;
+  char *base, *p, q;
+  int n, crlf;
   gfc_offset pos;
+  size_t readlen;
 
   if (*length > SCRATCH_SIZE)
     dtp->u.p.line_buffer = get_mem (*length);
@@ -199,15 +201,12 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
   if (is_internal_unit (dtp))
     {
       readlen = *length;
-      q = salloc_r (dtp->u.p.current_unit->s, &readlen);
-      if (readlen < *length)
+      if (sread (dtp->u.p.current_unit->s, p, &readlen) != 0 || readlen < (size_t) *length)
 	{
 	  generate_error (&dtp->common, LIBERROR_END, NULL);
 	  return NULL;
 	}
 	
-      if (q != NULL)
-        memcpy (p, q, readlen);
       goto done;
     }
 
@@ -216,9 +215,11 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
 
   do
     {
-      q = salloc_r (dtp->u.p.current_unit->s, &readlen);
-      if (q == NULL)
-	break;
+      if (sread (dtp->u.p.current_unit->s, &q, &readlen) != 0)
+        {
+	  generate_error (&dtp->common, LIBERROR_END, NULL);
+	  return NULL;
+	}
 
       /* If we have a line without a terminating \n, drop through to
 	 EOR below.  */
@@ -230,7 +231,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
 	  return NULL;
 	}
 
-      if (readlen < 1 || *q == '\n' || *q == '\r')
+      if (readlen < 1 || q == '\n' || q == '\r')
 	{
 	  /* Unexpected end of line.  */
 
@@ -241,12 +242,16 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
 
 	  crlf = 0;
 	  /* If we encounter a CR, it might be a CRLF.  */
-	  if (*q == '\r') /* Probably a CRLF */
+	  if (q == '\r') /* Probably a CRLF */
 	    {
 	      readlen = 1;
 	      pos = stream_offset (dtp->u.p.current_unit->s);
-	      q = salloc_r (dtp->u.p.current_unit->s, &readlen);
-	      if (*q != '\n' && readlen == 1) /* Not a CRLF after all.  */
+	      if (sread (dtp->u.p.current_unit->s, &q, &readlen) != 0)
+	        {
+		  generate_error (&dtp->common, LIBERROR_END, NULL);
+		  return NULL;
+		}
+	      if (q != '\n' && readlen == 1) /* Not a CRLF after all.  */
 		sseek (dtp->u.p.current_unit->s, pos);
 	      else
 		crlf = 1;
@@ -270,7 +275,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
       /*  Short circuit the read if a comma is found during numeric input.
 	  The flag is set to zero during character reads so that commas in
 	  strings are not ignored  */
-      if (*q == ',')
+      if (q == ',')
 	if (dtp->u.p.sf_read_comma == 1)
 	  {
 	    notify_std (&dtp->common, GFC_STD_GNU,
@@ -280,7 +285,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
 	  }
 
       n++;
-      *p++ = *q;
+      *p++ = q;
       dtp->u.p.sf_seen_eor = 0;
     }
   while (n < *length);
@@ -296,35 +301,25 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
 
 
 /* Function for reading the next couple of bytes from the current
-   file, advancing the current position.  We return a pointer to a
-   buffer containing the bytes.  We return NULL on end of record or
-   end of file.
+   file, advancing the current position. We return FAILURE on end of record or
+   end of file. This function is only for formatted I/O, unformatted uses
+   read_block_direct.
 
    If the read is short, then it is because the current record does not
    have enough data to satisfy the read request and the file was
    opened with PAD=YES.  The caller must assume tailing spaces for
    short reads.  */
 
-void *
-read_block (st_parameter_dt *dtp, int *length)
+try
+read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
 {
   char *source;
-  int nread;
+  size_t nread;
+  int nb;
 
-  if (is_stream_io (dtp))
-    {
-      if (dtp->u.p.current_unit->strm_pos - 1
-	  != file_position (dtp->u.p.current_unit->s)
-	  && sseek (dtp->u.p.current_unit->s,
-		    dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, LIBERROR_END, NULL);
-	  return NULL;
-	}
-    }
-  else
+  if (!is_stream_io (dtp))
     {
-      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length)
+      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
 	{
 	  /* For preconnected units with default record length, set bytes left
 	   to unit record length and proceed, otherwise error.  */
@@ -337,7 +332,7 @@ read_block (st_parameter_dt *dtp, int *length)
 		{
 		  /* Not enough data left.  */
 		  generate_error (&dtp->common, LIBERROR_EOR, NULL);
-		  return NULL;
+		  return FAILURE;
 		}
 	    }
 
@@ -345,10 +340,10 @@ read_block (st_parameter_dt *dtp, int *length)
 	    {
 	      dtp->u.p.current_unit->endfile = AT_ENDFILE;
 	      generate_error (&dtp->common, LIBERROR_END, NULL);
-	      return NULL;
+	      return FAILURE;
 	    }
 
-	  *length = dtp->u.p.current_unit->bytes_left;
+	  *nbytes = dtp->u.p.current_unit->bytes_left;
 	}
     }
 
@@ -356,23 +351,32 @@ read_block (st_parameter_dt *dtp, int *length)
       (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
        dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
     {
-      source = read_sf (dtp, length, 0);
+      nb = *nbytes;
+      source = read_sf (dtp, &nb, 0);
+      *nbytes = nb;
       dtp->u.p.current_unit->strm_pos +=
-	(gfc_offset) (*length + dtp->u.p.sf_seen_eor);
-      return source;
+	(gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
+      if (source == NULL)
+	return FAILURE;
+      memcpy (buf, source, *nbytes);
+      return SUCCESS;
     }
-  dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
+  dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
 
-  nread = *length;
-  source = salloc_r (dtp->u.p.current_unit->s, &nread);
+  nread = *nbytes;
+  if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
+    {
+      generate_error (&dtp->common, LIBERROR_OS, NULL);
+      return FAILURE;
+    }
 
   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
     dtp->u.p.size_used += (gfc_offset) nread;
 
-  if (nread != *length)
+  if (nread != *nbytes)
     {				/* Short read, this shouldn't happen.  */
       if (dtp->u.p.pad_status == PAD_YES)
-	*length = nread;
+	*nbytes = nread;
       else
 	{
 	  generate_error (&dtp->common, LIBERROR_EOR, NULL);
@@ -382,7 +386,7 @@ read_block (st_parameter_dt *dtp, int *length)
 
   dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
 
-  return source;
+  return SUCCESS;
 }
 
 
@@ -400,15 +404,6 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
 
   if (is_stream_io (dtp))
     {
-      if (dtp->u.p.current_unit->strm_pos - 1
-	  != file_position (dtp->u.p.current_unit->s)
-	  && sseek (dtp->u.p.current_unit->s,
-		    dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, LIBERROR_END, NULL);
-	  return;
-	}
-
       to_read_record = *nbytes;
       have_read_record = to_read_record;
       if (sread (dtp->u.p.current_unit->s, buf, &have_read_record) != 0)
@@ -576,18 +571,7 @@ write_block (st_parameter_dt *dtp, int length)
 {
   char *dest;
 
-  if (is_stream_io (dtp))
-    {
-      if (dtp->u.p.current_unit->strm_pos - 1
-	  != file_position (dtp->u.p.current_unit->s)
-	  && sseek (dtp->u.p.current_unit->s,
-		    dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, LIBERROR_OS, NULL);
-	  return NULL;
-	}
-    }
-  else
+  if (!is_stream_io (dtp))
     {
       if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
 	{
@@ -607,17 +591,29 @@ write_block (st_parameter_dt *dtp, int length)
       dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
     }
 
-  dest = salloc_w (dtp->u.p.current_unit->s, &length);
-
-  if (dest == NULL)
+  if (is_internal_unit (dtp))
     {
-      generate_error (&dtp->common, LIBERROR_END, NULL);
-      return NULL;
-    }
+    dest = salloc_w (dtp->u.p.current_unit->s, &length);
 
-  if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
-    generate_error (&dtp->common, LIBERROR_END, NULL);
+    if (dest == NULL)
+      {
+        generate_error (&dtp->common, LIBERROR_END, NULL);
+        return NULL;
+      }
 
+    if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
+      generate_error (&dtp->common, LIBERROR_END, NULL);
+    }
+  else
+    {
+      dest = fbuf_alloc (dtp->u.p.current_unit, length);
+      if (dest == NULL)
+        {
+          generate_error (&dtp->common, LIBERROR_OS, NULL);
+          return NULL;
+        }
+    }
+    
   if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
     dtp->u.p.size_used += (gfc_offset) length;
 
@@ -642,15 +638,6 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
 
   if (is_stream_io (dtp))
     {
-      if (dtp->u.p.current_unit->strm_pos - 1
-	  != file_position (dtp->u.p.current_unit->s)
-	  && sseek (dtp->u.p.current_unit->s,
-		    dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
-	{
-	  generate_error (&dtp->common, LIBERROR_OS, NULL);
-	  return FAILURE;
-	}
-
       if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
 	{
 	  generate_error (&dtp->common, LIBERROR_OS, NULL);
@@ -866,7 +853,7 @@ static void
 write_constant_string (st_parameter_dt *dtp, const fnode *f)
 {
   char c, delimiter, *p, *q;
-  int length;
+  int length; 
 
   length = f->u.string.length;
   if (length == 0)
@@ -875,7 +862,7 @@ write_constant_string (st_parameter_dt *dtp, const fnode *f)
   p = write_block (dtp, length);
   if (p == NULL)
     return;
-
+    
   q = f->u.string.p;
   delimiter = q[-1];
 
@@ -993,7 +980,10 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len,
 	    }
 	  if (dtp->u.p.skips < 0)
 	    {
-	      move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips);
+              if (is_internal_unit (dtp))  
+	        move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips);
+              else
+                fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips);
 	      dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips;
 	    }
 	  dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
@@ -1606,9 +1596,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
 static void
 us_read (st_parameter_dt *dtp, int continued)
 {
-  char *p;
-  int n;
-  int nr;
+  size_t n, nr;
   GFC_INTEGER_4 i4;
   GFC_INTEGER_8 i8;
   gfc_offset i;
@@ -1623,7 +1611,11 @@ us_read (st_parameter_dt *dtp, int continued)
 
   nr = n;
 
-  p = salloc_r (dtp->u.p.current_unit->s, &n);
+  if (sread (dtp->u.p.current_unit->s, &i, &n) != 0)
+    {
+      generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
+      return;
+    }
 
   if (n == 0)
     {
@@ -1631,7 +1623,7 @@ us_read (st_parameter_dt *dtp, int continued)
       return;  /* end of file */
     }
 
-  if (p == NULL || n != nr)
+  if (n != nr)
     {
       generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
       return;
@@ -1643,12 +1635,12 @@ us_read (st_parameter_dt *dtp, int continued)
       switch (nr)
 	{
 	case sizeof(GFC_INTEGER_4):
-	  memcpy (&i4, p, sizeof (i4));
+	  memcpy (&i4, &i, sizeof (i4));
 	  i = i4;
 	  break;
 
 	case sizeof(GFC_INTEGER_8):
-	  memcpy (&i8, p, sizeof (i8));
+	  memcpy (&i8, &i, sizeof (i8));
 	  i = i8;
 	  break;
 
@@ -1661,12 +1653,12 @@ us_read (st_parameter_dt *dtp, int continued)
       switch (nr)
 	{
 	case sizeof(GFC_INTEGER_4):
-	  reverse_memcpy (&i4, p, sizeof (i4));
+	  reverse_memcpy (&i4, &i, sizeof (i4));
 	  i = i4;
 	  break;
 
 	case sizeof(GFC_INTEGER_8):
-	  reverse_memcpy (&i8, p, sizeof (i8));
+	  reverse_memcpy (&i8, &i, sizeof (i8));
 	  i = i8;
 	  break;
 
@@ -1734,10 +1726,10 @@ pre_position (st_parameter_dt *dtp)
     {
     case FORMATTED_STREAM:
     case UNFORMATTED_STREAM:
-      /* There are no records with stream I/O.  Set the default position
-	 to the beginning of the file if no position was specified.  */
-      if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
-        dtp->u.p.current_unit->strm_pos = 1;
+      /* There are no records with stream I/O.  If the position was specified
+	 data_transfer_init has already positioned the file. If no position
+	 was specified, we continue from where we last left off.  I.e.
+	 there is nothing to do here.  */
       break;
     
     case UNFORMATTED_SEQUENTIAL:
@@ -2070,7 +2062,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       if (dtp->u.p.mode == READING
 	  && dtp->u.p.current_unit->mode == WRITING
 	  && !is_internal_unit (dtp))
-	flush(dtp->u.p.current_unit->s);
+        {
+          fbuf_flush (dtp->u.p.current_unit, 1);      
+	  flush(dtp->u.p.current_unit->s);
+        }
 
       /* Check whether the record exists to be read.  Only
 	 a partial record needs to exist.  */
@@ -2094,11 +2089,21 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	    }
 	}
       else
-	dtp->u.p.current_unit->strm_pos = dtp->rec;
+        {
+	  if (dtp->u.p.current_unit->strm_pos != dtp->rec)
+	    {
+	      fbuf_flush (dtp->u.p.current_unit, 1);
+	      flush (dtp->u.p.current_unit->s);
+	      if (sseek (dtp->u.p.current_unit->s, dtp->rec - 1) == FAILURE)
+	        {
+	          generate_error (&dtp->common, LIBERROR_OS, NULL);
+	          return;
+	        }
+	      dtp->u.p.current_unit->strm_pos = dtp->rec;
+	    }
+        }
 
     }
-  else
-    dtp->rec = 0;
 
   /* Overwriting an existing sequential file ?
      it is always safe to truncate the file on the first write */
@@ -2118,6 +2123,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos;
 
   pre_position (dtp);
+  
 
   /* Set up the subroutine that will handle the transfers.  */
 
@@ -2256,14 +2262,13 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished)
    read chunks of size MAX_READ until we get to the right
    position.  */
 
-#define MAX_READ 4096
-
 static void
 skip_record (st_parameter_dt *dtp, size_t bytes)
 {
   gfc_offset new;
-  int rlength, length;
-  char *p;
+  size_t rlength;
+  static const size_t MAX_READ = 4096;
+  char p[MAX_READ];
 
   dtp->u.p.current_unit->bytes_left_subrecord += bytes;
   if (dtp->u.p.current_unit->bytes_left_subrecord == 0)
@@ -2283,24 +2288,22 @@ skip_record (st_parameter_dt *dtp, size_t bytes)
     {			/* Seek by reading data.  */
       while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
 	{
-	  rlength = length =
-	    (MAX_READ > dtp->u.p.current_unit->bytes_left_subrecord) ?
+	  rlength = 
+	    (MAX_READ > (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ?
 	    MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord;
 
-	  p = salloc_r (dtp->u.p.current_unit->s, &rlength);
-	  if (p == NULL)
+	  if (sread (dtp->u.p.current_unit->s, p, &rlength) != 0)
 	    {
 	      generate_error (&dtp->common, LIBERROR_OS, NULL);
 	      return;
 	    }
 
-	  dtp->u.p.current_unit->bytes_left_subrecord -= length;
+	  dtp->u.p.current_unit->bytes_left_subrecord -= rlength;
 	}
     }
 
 }
 
-#undef MAX_READ
 
 /* Advance to the next record reading unformatted files, taking
    care of subrecords.  If complete_record is nonzero, we loop
@@ -2328,14 +2331,23 @@ next_record_r_unf (st_parameter_dt *dtp, int complete_record)
     }
 }
 
+
+static inline gfc_offset
+min_off (gfc_offset a, gfc_offset b)
+{
+  return (a < b ? a : b);
+}
+
+
 /* Space to the next record for read mode.  */
 
 static void
 next_record_r (st_parameter_dt *dtp)
 {
   gfc_offset record;
-  int length, bytes_left;
-  char *p;
+  int bytes_left;
+  size_t length;
+  char p;
 
   switch (current_mode (dtp))
     {
@@ -2384,18 +2396,24 @@ next_record_r (st_parameter_dt *dtp)
 	  else  
 	    {
 	      bytes_left = (int) dtp->u.p.current_unit->bytes_left;
-	      p = salloc_r (dtp->u.p.current_unit->s, &bytes_left);
-	      if (p != NULL)
-		dtp->u.p.current_unit->bytes_left
-		  = dtp->u.p.current_unit->recl;
+	      bytes_left = min_off (bytes_left, 
+		      file_length (dtp->u.p.current_unit->s)
+		      - file_position (dtp->u.p.current_unit->s));
+	      if (sseek (dtp->u.p.current_unit->s, 
+			  file_position (dtp->u.p.current_unit->s) 
+			  + bytes_left) == FAILURE)
+	        {
+		  generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
+		  break;
+		}
+	      dtp->u.p.current_unit->bytes_left
+		= dtp->u.p.current_unit->recl;
 	    } 
 	  break;
 	}
       else do
 	{
-	  p = salloc_r (dtp->u.p.current_unit->s, &length);
-
-	  if (p == NULL)
+	  if (sread (dtp->u.p.current_unit->s, &p, &length) != 0) 
 	    {
 	      generate_error (&dtp->common, LIBERROR_OS, NULL);
 	      break;
@@ -2410,7 +2428,7 @@ next_record_r (st_parameter_dt *dtp)
 	  if (is_stream_io (dtp))
 	    dtp->u.p.current_unit->strm_pos++;
 	}
-      while (*p != '\n');
+      while (p != '\n');
 
       break;
     }
@@ -2550,8 +2568,10 @@ next_record_w (st_parameter_dt *dtp, int done)
 {
   gfc_offset m, record, max_pos;
   int length;
-  char *p;
 
+  /* Flush and reset the format buffer.  */
+  fbuf_flush (dtp->u.p.current_unit, 1);
+  
   /* Zero counters for X- and T-editing.  */
   max_pos = dtp->u.p.max_pos;
   dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
@@ -2576,12 +2596,9 @@ next_record_w (st_parameter_dt *dtp, int done)
       if (dtp->u.p.current_unit->bytes_left > 0)
 	{
 	  length = (int) dtp->u.p.current_unit->bytes_left;
-	  p = salloc_w (dtp->u.p.current_unit->s, &length);
-	  memset (p, 0, length);
+	  if (sset (dtp->u.p.current_unit->s, 0, length) == FAILURE)
+	    goto io_error;
 	}
-
-      if (sfree (dtp->u.p.current_unit->s) == FAILURE)
-	goto io_error;
       break;
 
     case UNFORMATTED_SEQUENTIAL:
@@ -2609,7 +2626,13 @@ next_record_w (st_parameter_dt *dtp, int done)
 	      if (max_pos > m)
 		{
 		  length = (int) (max_pos - m);
-		  p = salloc_w (dtp->u.p.current_unit->s, &length);
+		  if (sseek (dtp->u.p.current_unit->s, 
+			      file_position (dtp->u.p.current_unit->s) 
+			      + length) == FAILURE)
+		    {
+		      generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
+		      return;
+		    }
 		  length = (int) (dtp->u.p.current_unit->recl - max_pos);
 		}
 
@@ -2651,7 +2674,13 @@ next_record_w (st_parameter_dt *dtp, int done)
 		  if (max_pos > m)
 		    {
 		      length = (int) (max_pos - m);
-		      p = salloc_w (dtp->u.p.current_unit->s, &length);
+		      if (sseek (dtp->u.p.current_unit->s, 
+				  file_position (dtp->u.p.current_unit->s)
+				  + length) == FAILURE)
+		        {
+			  generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
+			  return;
+			}
 		      length = (int) (dtp->u.p.current_unit->recl - max_pos);
 		    }
 		  else
@@ -2670,15 +2699,6 @@ next_record_w (st_parameter_dt *dtp, int done)
 	  size_t len;
 	  const char crlf[] = "\r\n";
 
-	  /* Move to the farthest position reached in preparation for
-	  completing the record.  (for file unit) */
-	  m = dtp->u.p.current_unit->recl -
-	    dtp->u.p.current_unit->bytes_left;
-	  if (max_pos > m)
-	    {
-	      length = (int) (max_pos - m);
-	      p = salloc_w (dtp->u.p.current_unit->s, &length);
-	    }
 #ifdef HAVE_CRLF
 	  len = 2;
 #else
@@ -2818,6 +2838,7 @@ finalize_transfer (st_parameter_dt *dtp)
   if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar)
     {
       dtp->u.p.seen_dollar = 0;
+      fbuf_flush (dtp->u.p.current_unit, 1);
       sfree (dtp->u.p.current_unit->s);
       return;
     }
@@ -2830,6 +2851,7 @@ finalize_transfer (st_parameter_dt *dtp)
 	- dtp->u.p.current_unit->bytes_left);
       dtp->u.p.current_unit->saved_pos =
 	dtp->u.p.max_pos > 0 ? dtp->u.p.max_pos - bytes_written : 0;
+      fbuf_flush (dtp->u.p.current_unit, 0);
       flush (dtp->u.p.current_unit->s);
       return;
     }
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 9f9e351..6956318 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -567,6 +567,8 @@ init_units (void)
       u->file_len = strlen (stdout_name);
       u->file = get_mem (u->file_len);
       memmove (u->file, stdout_name, u->file_len);
+      
+      fbuf_init (u, 0);
 
       __gthread_mutex_unlock (&u->lock);
     }
@@ -594,6 +596,9 @@ init_units (void)
       u->file_len = strlen (stderr_name);
       u->file = get_mem (u->file_len);
       memmove (u->file, stderr_name, u->file_len);
+      
+      fbuf_init (u, 256);  /* 256 bytes should be enough, probably not doing
+                              any kind of exotic formatting to stderr.  */
 
       __gthread_mutex_unlock (&u->lock);
     }
@@ -613,7 +618,7 @@ static int
 close_unit_1 (gfc_unit *u, int locked)
 {
   int i, rc;
-
+  
   /* If there are previously written bytes from a write with ADVANCE="no"
      Reposition the buffer before closing.  */
   if (u->previous_nonadvancing_write)
@@ -635,6 +640,8 @@ close_unit_1 (gfc_unit *u, int locked)
     free_mem (u->file);
   u->file = NULL;
   u->file_len = 0;
+  
+  fbuf_destroy (u);
 
   if (!locked)
     __gthread_mutex_unlock (&u->lock);
@@ -737,10 +744,11 @@ filename_from_unit (int n)
 void
 finish_last_advance_record (gfc_unit *u)
 {
-  char *p;
-
+  
   if (u->saved_pos > 0)
-    p = salloc_w (u->s, &u->saved_pos);
+    fbuf_seek (u, u->saved_pos);
+    
+  fbuf_flush (u, 1);
 
   if (!(u->unit_number == options.stdout_unit
 	|| u->unit_number == options.stderr_unit))
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 3896f04..2958380 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -530,12 +530,10 @@ fd_alloc (unix_stream * s, gfc_offset where,
  * NULL on I/O error. */
 
 static char *
-fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
+fd_alloc_r_at (unix_stream * s, int *len)
 {
   gfc_offset m;
-
-  if (where == -1)
-    where = s->logical_offset;
+  gfc_offset where = s->logical_offset;
 
   if (s->buffer != NULL && s->buffer_offset <= where &&
       where + *len <= s->buffer_offset + s->active)
@@ -593,12 +591,10 @@ fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
  * we've already buffered the data or we need to load it. */
 
 static char *
-fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
+fd_alloc_w_at (unix_stream * s, int *len)
 {
   gfc_offset n;
-
-  if (where == -1)
-    where = s->logical_offset;
+  gfc_offset where = s->logical_offset;
 
   if (s->buffer == NULL || s->buffer_offset > where ||
       where + *len > s->buffer_offset + s->len)
@@ -752,7 +748,7 @@ fd_sset (unix_stream * s, int c, size_t n)
       /* memset() in chunks of BUFFER_SIZE.  */
       trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE;
 
-      p = fd_alloc_w_at (s, &trans, -1);
+      p = fd_alloc_w_at (s, &trans);
       if (p)
 	  memset (p, c, trans);
       else
@@ -779,7 +775,7 @@ fd_read (unix_stream * s, void * buf, size_t * nbytes)
   if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
     {
       tmp = *nbytes;
-      p = fd_alloc_r_at (s, &tmp, -1);
+      p = fd_alloc_r_at (s, &tmp);
       if (p)
 	{
 	  *nbytes = tmp;
@@ -827,7 +823,7 @@ fd_write (unix_stream * s, const void * buf, size_t * nbytes)
   if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
     {
       tmp = *nbytes;
-      p = fd_alloc_w_at (s, &tmp, -1);
+      p = fd_alloc_w_at (s, &tmp);
       if (p)
 	{
 	  *nbytes = tmp;
@@ -890,7 +886,6 @@ fd_open (unix_stream * s)
   else
     s->method = SYNC_BUFFERED;
 
-  s->st.alloc_r_at = (void *) fd_alloc_r_at;
   s->st.alloc_w_at = (void *) fd_alloc_w_at;
   s->st.sfree = (void *) fd_sfree;
   s->st.close = (void *) fd_close;
@@ -918,12 +913,10 @@ fd_open (unix_stream * s)
 
 
 static char *
-mem_alloc_r_at (int_stream * s, int *len, gfc_offset where)
+mem_alloc_r_at (int_stream * s, int *len)
 {
   gfc_offset n;
-
-  if (where == -1)
-    where = s->logical_offset;
+  gfc_offset where = s->logical_offset;
 
   if (where < s->buffer_offset || where > s->buffer_offset + s->active)
     return NULL;
@@ -939,15 +932,13 @@ mem_alloc_r_at (int_stream * s, int *len, gfc_offset where)
 
 
 static char *
-mem_alloc_w_at (int_stream * s, int *len, gfc_offset where)
+mem_alloc_w_at (int_stream * s, int *len)
 {
   gfc_offset m;
+  gfc_offset where = s->logical_offset;
 
   assert (*len >= 0);  /* Negative values not allowed. */
   
-  if (where == -1)
-    where = s->logical_offset;
-
   m = where + *len;
 
   if (where < s->buffer_offset)
@@ -962,9 +953,7 @@ mem_alloc_w_at (int_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.  */
+/* Stream read function for internal units.  */
 
 static int
 mem_read (int_stream * s, void * buf, size_t * nbytes)
@@ -973,7 +962,7 @@ mem_read (int_stream * s, void * buf, size_t * nbytes)
   int tmp;
 
   tmp = *nbytes;
-  p = mem_alloc_r_at (s, &tmp, -1);
+  p = mem_alloc_r_at (s, &tmp);
   if (p)
     {
       *nbytes = tmp;
@@ -983,7 +972,7 @@ mem_read (int_stream * s, void * buf, size_t * nbytes)
   else
     {
       *nbytes = 0;
-      return errno;
+      return 0;
     }
 }
 
@@ -998,10 +987,8 @@ mem_write (int_stream * s, const void * buf, size_t * nbytes)
   void *p;
   int tmp;
 
-  errno = 0;
-
   tmp = *nbytes;
-  p = mem_alloc_w_at (s, &tmp, -1);
+  p = mem_alloc_w_at (s, &tmp);
   if (p)
     {
       *nbytes = tmp;
@@ -1011,7 +998,7 @@ mem_write (int_stream * s, const void * buf, size_t * nbytes)
   else
     {
       *nbytes = 0;
-      return errno;
+      return 0;
     }
 }
 
@@ -1038,7 +1025,7 @@ mem_set (int_stream * s, int c, size_t n)
 
   len = n;
   
-  p = mem_alloc_w_at (s, &len, -1);
+  p = mem_alloc_w_at (s, &len);
   if (p)
     {
       memset (p, c, len);
@@ -1104,7 +1091,6 @@ open_internal (char *base, int length, gfc_offset offset)
   s->logical_offset = 0;
   s->active = s->file_length = length;
 
-  s->st.alloc_r_at = (void *) mem_alloc_r_at;
   s->st.alloc_w_at = (void *) mem_alloc_w_at;
   s->st.sfree = (void *) mem_sfree;
   s->st.close = (void *) mem_close;

Attachment: signature.asc
Description: OpenPGP digital signature


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]