Part 1 of PR 25561.

2008-05-15  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.

From-SVN: r135373

libgfortran/Makefile.am

@@ -47,7 +47,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

libgfortran/Makefile.in

@@ -401,8 +401,8 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
 	fpu-target.h io/close.c io/file_pos.c io/format.c io/inquire.c \
 	io/intrinsics.c io/list_read.c io/lock.c io/open.c io/read.c \
 	io/size_from_kind.c io/transfer.c io/unit.c io/unix.c \
-	io/write.c intrinsics/associated.c intrinsics/abort.c \
-	intrinsics/access.c intrinsics/args.c \
+	io/write.c io/fbuf.c intrinsics/associated.c \
+	intrinsics/abort.c intrinsics/access.c intrinsics/args.c \
 	intrinsics/c99_functions.c intrinsics/chdir.c \
 	intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \
 	intrinsics/cshift0.c intrinsics/ctime.c \
@@ -691,7 +691,7 @@ am__objects_33 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
 	$(am__objects_32)
 am__objects_34 = close.lo file_pos.lo format.lo inquire.lo \
 	intrinsics.lo list_read.lo lock.lo open.lo read.lo \
-	size_from_kind.lo transfer.lo unit.lo unix.lo write.lo
+	size_from_kind.lo transfer.lo unit.lo unix.lo write.lo fbuf.lo
 am__objects_35 = associated.lo abort.lo access.lo args.lo \
 	c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
 	cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \
@@ -946,7 +946,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
@@ -1791,6 +1792,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r16.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbuf.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file_pos.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fmain.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fnum.Plo@am__quote@
@@ -5124,6 +5126,13 @@ write.lo: io/write.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@	$(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o write.lo `test -f 'io/write.c' || echo '$(srcdir)/'`io/write.c
 
+fbuf.lo: io/fbuf.c
+@am__fastdepCC_TRUE@	if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fbuf.lo -MD -MP -MF "$(DEPDIR)/fbuf.Tpo" -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c; \
+@am__fastdepCC_TRUE@	then mv -f "$(DEPDIR)/fbuf.Tpo" "$(DEPDIR)/fbuf.Plo"; else rm -f "$(DEPDIR)/fbuf.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	source='io/fbuf.c' object='fbuf.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c
+
 associated.lo: intrinsics/associated.c
 @am__fastdepCC_TRUE@	if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT associated.lo -MD -MP -MF "$(DEPDIR)/associated.Tpo" -c -o associated.lo `test -f 'intrinsics/associated.c' || echo '$(srcdir)/'`intrinsics/associated.c; \
 @am__fastdepCC_TRUE@	then mv -f "$(DEPDIR)/associated.Tpo" "$(DEPDIR)/associated.Plo"; else rm -f "$(DEPDIR)/associated.Tpo"; exit 1; fi

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)

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

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');
@@ -2226,6 +2221,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;
@@ -2252,59 +2256,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);
     }

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:

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;
 }
+

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

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;