Part 1 of PR 25561.
authorJanne Blomqvist <jb@gcc.gnu.org>
Thu, 15 May 2008 15:53:34 +0000 (18:53 +0300)
committerJanne Blomqvist <jb@gcc.gnu.org>
Thu, 15 May 2008 15:53:34 +0000 (18:53 +0300)
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
libgfortran/Makefile.in
libgfortran/io/file_pos.c
libgfortran/io/io.h
libgfortran/io/list_read.c
libgfortran/io/open.c
libgfortran/io/read.c
libgfortran/io/transfer.c
libgfortran/io/unit.c
libgfortran/io/unix.c

index 1c2fa4c22c075873adf02205369d8100bab19a95..ed7ad21801ca10d9bfdb43050a05b9514f1b4ceb 100644 (file)
@@ -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
index dc44e4a29d7c7a57186c668b780e2f144b68b752..1db39915eab31fa876d69787a9a0741a425a9d23 100644 (file)
@@ -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
index 94e29899fb13e2364b880decd674ed74dbb368ed..f4864884f33162ffbae8d26c0ecf3ad9ce36d43f 100644 (file)
@@ -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)
index 30d4051f126cce09b7f1a01f561096cc656b1685..e554d8cccbc4b927dbb505edb84790bf77e53119 100644 (file)
@@ -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);
index d3e932e4074b85159052dc503ab4bfa040fbb2c0..3837f7ecf2e5cdae108793d10986c42b55f6cf57 100644 (file)
@@ -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);
     }
index 83e37ee22fdff0f0ce73c9b2916ac5e084e8f613..e16386cabd783a8c7b814108da62d8c4d58e6bc5 100644 (file)
@@ -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:
index ce86ec00b8f8c0c42abb579ce2ac31565e7ddc90..a09d663dc1ca67ed7478d9c9b56e08b33bfff6a3 100644 (file)
@@ -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;
 }
+
index 7071ab9128aa5454b18d02fb58c6679cee63e33d..8353f3ddb74c9495f1a5990dea7232fb132b55c8 100644 (file)
@@ -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;
     }
index 9f9e3513dab0cd4a0941c9ac3baa861dcdaef59c..69563187553348d1b85714647aa10de61c93b0e6 100644 (file)
@@ -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))
index 3896f04db61c1fb32accb4e230c3ad8e5420cf78..295838022852f013c85884bcec811b4d8c3953de 100644 (file)
@@ -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;