Revert part of patch accidentally committed to trunk rather than fortran-dev (I hate svn)

From-SVN: r144994

libgfortran/io/io.h

@@ -49,59 +49,34 @@ struct st_parameter_dt;
 
 typedef struct stream
 {
-  ssize_t (*read) (struct stream *, void *, ssize_t);
-  ssize_t (*write) (struct stream *, const void *, ssize_t);
-  off_t (*seek) (struct stream *, off_t, int);
-  off_t (*tell) (struct stream *);
-  int (*truncate) (struct stream *, off_t);
-  int (*flush) (struct stream *);
-  int (*close) (struct stream *);
+  char *(*alloc_w_at) (struct stream *, int *);
+  try (*sfree) (struct stream *);
+  try (*close) (struct stream *);
+  try (*seek) (struct stream *, gfc_offset);
+  try (*trunc) (struct stream *);
+  int (*read) (struct stream *, void *, size_t *);
+  int (*write) (struct stream *, const void *, size_t *);
+  try (*set) (struct stream *, int, size_t);
 }
 stream;
 
-/* Inline functions for doing file I/O given a stream.  */
-static inline ssize_t
-sread (stream * s, void * buf, ssize_t nbyte)
-{
-  return s->read (s, buf, nbyte);
-}
+typedef enum
+{ SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC }
+io_mode;
 
-static inline ssize_t
-swrite (stream * s, const void * buf, ssize_t nbyte)
-{
-  return s->write (s, buf, nbyte);
-}
+/* Macros for doing file I/O given a stream.  */
 
-static inline off_t
-sseek (stream * s, off_t offset, int whence)
-{
-  return s->seek (s, offset, whence);
-}
+#define sfree(s) ((s)->sfree)(s)
+#define sclose(s) ((s)->close)(s)
 
-static inline off_t
-stell (stream * s)
-{
-  return s->tell (s);
-}
+#define salloc_w(s, len) ((s)->alloc_w_at)(s, len)
 
-static inline int
-struncate (stream * s, off_t length)
-{
-  return s->truncate (s, length);
-}
-
-static inline int
-sflush (stream * s)
-{
-  return s->flush (s);
-}
-
-static inline int
-sclose (stream * s)
-{
-  return s->close (s);
-}
+#define sseek(s, pos) ((s)->seek)(s, pos)
+#define struncate(s) ((s)->trunc)(s)
+#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
+#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
 
+#define sset(s, c, n) ((s)->set)(s, c, n)
 
 /* Macros for testing what kinds of I/O we are doing.  */
 
@@ -563,9 +538,10 @@ unit_flags;
 typedef struct fbuf
 {
   char *buf;			/* Start of buffer.  */
-  int len;			/* Length of buffer.  */
-  int act;			/* Active bytes in buffer.  */
-  int pos;			/* Current position in buffer.  */
+  size_t len;			/* Length of buffer.  */
+  size_t act;			/* Active bytes in buffer.  */
+  size_t flushed;		/* Flushed bytes from beginning of buffer.  */
+  size_t pos;			/* Current position in buffer.  */
 }
 fbuf;
 
@@ -707,12 +683,6 @@ internal_proto(open_external);
 extern stream *open_internal (char *, int, gfc_offset);
 internal_proto(open_internal);
 
-extern char * mem_alloc_w (stream *, int *);
-internal_proto(mem_alloc_w);
-
-extern char * mem_alloc_r (stream *, int *);
-internal_proto(mem_alloc_w);
-
 extern stream *input_stream (void);
 internal_proto(input_stream);
 
@@ -728,6 +698,12 @@ internal_proto(compare_file_filename);
 extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
 internal_proto(find_file);
 
+extern int stream_at_bof (stream *);
+internal_proto(stream_at_bof);
+
+extern int stream_at_eof (stream *);
+internal_proto(stream_at_eof);
+
 extern int delete_file (gfc_unit *);
 internal_proto(delete_file);
 
@@ -758,6 +734,9 @@ internal_proto(inquire_readwrite);
 extern gfc_offset file_length (stream *);
 internal_proto(file_length);
 
+extern gfc_offset file_position (stream *);
+internal_proto(file_position);
+
 extern int is_seekable (stream *);
 internal_proto(is_seekable);
 
@@ -773,12 +752,18 @@ internal_proto(flush_if_preconnected);
 extern void empty_internal_buffer(stream *);
 internal_proto(empty_internal_buffer);
 
+extern try flush (stream *);
+internal_proto(flush);
+
 extern int stream_isatty (stream *);
 internal_proto(stream_isatty);
 
 extern char * stream_ttyname (stream *);
 internal_proto(stream_ttyname);
 
+extern gfc_offset stream_offset (stream *s);
+internal_proto(stream_offset);
+
 extern int unpack_filename (char *, const char *, int);
 internal_proto(unpack_filename);
 
@@ -822,9 +807,6 @@ internal_proto(update_position);
 extern void finish_last_advance_record (gfc_unit *u);
 internal_proto (finish_last_advance_record);
 
-extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
-internal_proto (unit_truncate);
-
 /* open.c */
 
 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
@@ -854,7 +836,7 @@ internal_proto(free_format_data);
 extern const char *type_name (bt);
 internal_proto(type_name);
 
-extern void * read_block_form (st_parameter_dt *, int *);
+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);
@@ -880,9 +862,6 @@ internal_proto (reverse_memcpy);
 extern void st_wait (st_parameter_wait *);
 export_proto(st_wait);
 
-extern void hit_eof (st_parameter_dt *);
-internal_proto(hit_eof);
-
 /* read.c */
 
 extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
@@ -989,39 +968,24 @@ extern size_t size_from_complex_kind (int);
 internal_proto(size_from_complex_kind);
 
 /* fbuf.c */
-extern void fbuf_init (gfc_unit *, int);
+extern void fbuf_init (gfc_unit *, size_t);
 internal_proto(fbuf_init);
 
 extern void fbuf_destroy (gfc_unit *);
 internal_proto(fbuf_destroy);
 
-extern int fbuf_reset (gfc_unit *);
+extern void fbuf_reset (gfc_unit *);
 internal_proto(fbuf_reset);
 
-extern char * fbuf_alloc (gfc_unit *, int);
+extern char * fbuf_alloc (gfc_unit *, size_t);
 internal_proto(fbuf_alloc);
 
-extern int fbuf_flush (gfc_unit *, unit_mode);
+extern int fbuf_flush (gfc_unit *, int);
 internal_proto(fbuf_flush);
 
-extern int fbuf_seek (gfc_unit *, int, int);
+extern int fbuf_seek (gfc_unit *, gfc_offset);
 internal_proto(fbuf_seek);
 
-extern char * fbuf_read (gfc_unit *, int *);
-internal_proto(fbuf_read);
-
-/* Never call this function, only use fbuf_getc().  */
-extern int fbuf_getc_refill (gfc_unit *);
-internal_proto(fbuf_getc_refill);
-
-static inline int
-fbuf_getc (gfc_unit * u)
-{
-  if (u->fbuf->pos < u->fbuf->act)
-    return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
-  return fbuf_getc_refill (u);
-}
-
 /* lock.c */
 extern void free_ionml (st_parameter_dt *);
 internal_proto(free_ionml);

libgfortran/io/list_read.c

@@ -33,7 +33,6 @@ Boston, MA 02110-1301, USA.  */
 
 #include "io.h"
 #include <string.h>
-#include <stdlib.h>
 #include <ctype.h>
 
 
@@ -80,8 +79,9 @@ push_char (st_parameter_dt *dtp, char c)
 
   if (dtp->u.p.saved_string == NULL)
     {
-      dtp->u.p.saved_string = get_mem (SCRATCH_SIZE);
-      // memset below should be commented out.
+      if (dtp->u.p.scratch == NULL)
+	dtp->u.p.scratch = get_mem (SCRATCH_SIZE);
+      dtp->u.p.saved_string = dtp->u.p.scratch;
       memset (dtp->u.p.saved_string, 0, SCRATCH_SIZE);
       dtp->u.p.saved_length = SCRATCH_SIZE;
       dtp->u.p.saved_used = 0;
@@ -90,15 +90,15 @@ push_char (st_parameter_dt *dtp, char c)
   if (dtp->u.p.saved_used >= dtp->u.p.saved_length)
     {
       dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
-      new = realloc (dtp->u.p.saved_string, dtp->u.p.saved_length);
-      if (new == NULL)
-	generate_error (&dtp->common, LIBERROR_OS, NULL);
-      dtp->u.p.saved_string = new;
-      
-      // Also this should not be necessary.
-      memset (new + dtp->u.p.saved_used, 0, 
-	      dtp->u.p.saved_length - dtp->u.p.saved_used);
+      new = get_mem (2 * dtp->u.p.saved_length);
 
+      memset (new, 0, 2 * dtp->u.p.saved_length);
+
+      memcpy (new, dtp->u.p.saved_string, dtp->u.p.saved_used);
+      if (dtp->u.p.saved_string != dtp->u.p.scratch)
+	free_mem (dtp->u.p.saved_string);
+
+      dtp->u.p.saved_string = new;
     }
 
   dtp->u.p.saved_string[dtp->u.p.saved_used++] = c;
@@ -113,7 +113,8 @@ free_saved (st_parameter_dt *dtp)
   if (dtp->u.p.saved_string == NULL)
     return;
 
-  free_mem (dtp->u.p.saved_string);
+  if (dtp->u.p.saved_string != dtp->u.p.scratch)
+    free_mem (dtp->u.p.saved_string);
 
   dtp->u.p.saved_string = NULL;
   dtp->u.p.saved_used = 0;
@@ -139,10 +140,9 @@ free_line (st_parameter_dt *dtp)
 static char
 next_char (st_parameter_dt *dtp)
 {
-  ssize_t length;
+  size_t length;
   gfc_offset record;
   char c;
-  int cc;
 
   if (dtp->u.p.last_char != '\0')
     {
@@ -194,7 +194,7 @@ next_char (st_parameter_dt *dtp)
 	    }
 
 	  record *= dtp->u.p.current_unit->recl;
-	  if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0)
+	  if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
 	    longjmp (*dtp->u.p.eof_jump, 1);
 
 	  dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
@@ -204,15 +204,19 @@ next_char (st_parameter_dt *dtp)
 
   /* Get the next character and handle end-of-record conditions.  */
 
-  if (is_internal_unit (dtp))
+  length = 1;
+
+  if (sread (dtp->u.p.current_unit->s, &c, &length) != 0)
     {
-      length = sread (dtp->u.p.current_unit->s, &c, 1);
-      if (length < 0)
-	{
-	  generate_error (&dtp->common, LIBERROR_OS, NULL);
-	  return '\0';
-	}
+	generate_error (&dtp->common, LIBERROR_OS, NULL);
+	return '\0';
+    }
   
+  if (is_stream_io (dtp) && length == 1)
+    dtp->u.p.current_unit->strm_pos++;
+
+  if (is_internal_unit (dtp))
+    {
       if (is_array_io (dtp))
 	{
 	  /* Check whether we hit EOF.  */ 
@@ -236,20 +240,13 @@ next_char (st_parameter_dt *dtp)
     }
   else
     {
-      cc = fbuf_getc (dtp->u.p.current_unit);
-
-      if (cc == EOF)
+      if (length == 0)
 	{
 	  if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
 	    longjmp (*dtp->u.p.eof_jump, 1);
 	  dtp->u.p.current_unit->endfile = AT_ENDFILE;
 	  c = '\n';
 	}
-      else
-	c = (char) cc;
-      if (is_stream_io (dtp) && cc != EOF)
-	dtp->u.p.current_unit->strm_pos++;
-
     }
 done:
   dtp->u.p.at_eol = (c == '\n' || c == '\r');
@@ -1701,7 +1698,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
       dtp->u.p.input_complete = 0;
       dtp->u.p.repeat_count = 1;
       dtp->u.p.at_eol = 0;
-      
+
       c = eat_spaces (dtp);
       if (is_separator (c))
 	{
@@ -1856,8 +1853,6 @@ finish_list_read (st_parameter_dt *dtp)
 
   free_saved (dtp);
 
-  fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
-
   if (dtp->u.p.at_eol)
     {
       dtp->u.p.at_eol = 0;
@@ -2266,8 +2261,8 @@ nml_query (st_parameter_dt *dtp, char c)
 
       /* Flush the stream to force immediate output.  */
 
-      fbuf_flush (dtp->u.p.current_unit, WRITING);
-      sflush (dtp->u.p.current_unit->s);
+      fbuf_flush (dtp->u.p.current_unit, 1);
+      flush (dtp->u.p.current_unit->s);
       unlock_unit (dtp->u.p.current_unit);
     }
 
@@ -2908,7 +2903,7 @@ find_nml_name:
 	  st_printf ("%s\n", nml_err_msg);
 	  if (u != NULL)
 	    {
-	      sflush (u->s);
+	      flush (u->s);
 	      unlock_unit (u);
 	    }
         }

libgfortran/io/unit.c

@@ -540,8 +540,6 @@ init_units (void)
       u->file_len = strlen (stdin_name);
       u->file = get_mem (u->file_len);
       memmove (u->file, stdin_name, u->file_len);
-
-      fbuf_init (u, 0);
     
       __gthread_mutex_unlock (&u->lock);
     }
@@ -699,62 +697,15 @@ close_units (void)
 void
 update_position (gfc_unit *u)
 {
-  if (stell (u->s) == 0)
+  if (file_position (u->s) == 0)
     u->flags.position = POSITION_REWIND;
-  else if (file_length (u->s) == stell (u->s))
+  else if (file_length (u->s) == file_position (u->s))
     u->flags.position = POSITION_APPEND;
   else
     u->flags.position = POSITION_ASIS;
 }
 
 
-/* High level interface to truncate a file safely, i.e. flush format
-   buffers, check that it's a regular file, and generate error if that
-   occurs.  Just like POSIX ftruncate, returns 0 on success, -1 on
-   failure.  */
-
-int
-unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
-{
-  int ret;
-
-  /* Make sure format buffer is flushed.  */
-  if (u->flags.form == FORM_FORMATTED)
-    {
-      if (u->mode == READING)
-	pos += fbuf_reset (u);
-      else
-	fbuf_flush (u, u->mode);
-    }
-  
-  /* Don't try to truncate a special file, just pretend that it
-     succeeds.  */
-  if (is_special (u->s) || !is_seekable (u->s))
-    {
-      sflush (u->s);
-      return 0;
-    }
-
-  /* struncate() should flush the stream buffer if necessary, so don't
-     bother calling sflush() here.  */
-  ret = struncate (u->s, pos);
-
-  if (ret != 0)
-    {
-      generate_error (common, LIBERROR_OS, NULL);
-      u->endfile = NO_ENDFILE;
-      u->flags.position = POSITION_ASIS;
-    }
-  else
-    {
-      u->endfile = AT_ENDFILE;
-      u->flags.position = POSITION_APPEND;
-    }
-
-  return ret;
-}
-
-
 /* filename_from_unit()-- If the unit_number exists, return a pointer to the
    name of the associated file, otherwise return the empty string.  The caller
    must free memory allocated for the filename string.  */
@@ -795,25 +746,23 @@ finish_last_advance_record (gfc_unit *u)
 {
   
   if (u->saved_pos > 0)
-    fbuf_seek (u, u->saved_pos, SEEK_CUR);
+    fbuf_seek (u, u->saved_pos);
+    
+  fbuf_flush (u, 1);
 
   if (!(u->unit_number == options.stdout_unit
 	|| u->unit_number == options.stderr_unit))
     {
+      size_t len;
+
+      const char crlf[] = "\r\n";
 #ifdef HAVE_CRLF
-      const int len = 2;
+      len = 2;
 #else
-      const int len = 1;
+      len = 1;
 #endif
-      char *p = fbuf_alloc (u, len);
-      if (!p)
+      if (swrite (u->s, &crlf[2-len], &len) != 0)
 	os_error ("Completing record after ADVANCE_NO failed");
-#ifdef HAVE_CRLF
-      *(p++) = '\r';
-#endif
-      *p = '\n';
     }
-
-  fbuf_flush (u, u->mode);
 }