diff options
author | jb <jb@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-03-22 11:32:29 +0000 |
---|---|---|
committer | jb <jb@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-03-22 11:32:29 +0000 |
commit | b745b1d0ce78507d3c911143e2aee7f2c067663c (patch) | |
tree | 8474dfc61c5f221722e7a16263fff853402d1b3f /libgfortran | |
parent | 57e0da17009247647c267d8523411c89caaf22cc (diff) | |
download | gcc-b745b1d0ce78507d3c911143e2aee7f2c067663c.tar.gz |
Revert part of patch accidentally committed to trunk rather than fortran-dev (I hate svn)
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@144994 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/io/io.h | 126 | ||||
-rw-r--r-- | libgfortran/io/list_read.c | 67 | ||||
-rw-r--r-- | libgfortran/io/transfer.c | 704 | ||||
-rw-r--r-- | libgfortran/io/unit.c | 73 |
4 files changed, 440 insertions, 530 deletions
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index f1731652abf..1993158ef58 100644 --- a/libgfortran/io/io.h +++ b/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); diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index eba44781438..1f1023c10d2 100644 --- a/libgfortran/io/list_read.c +++ b/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); } } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 101f6f4d3bb..d50641bcce5 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -37,7 +37,6 @@ Boston, MA 02110-1301, USA. */ #include <string.h> #include <assert.h> #include <stdlib.h> -#include <errno.h> /* Calling conventions: Data transfer statements are unlike other @@ -184,58 +183,60 @@ current_mode (st_parameter_dt *dtp) heap. Hopefully this won't happen very often. */ char * -read_sf (st_parameter_dt *dtp, int * length, int no_error) +read_sf (st_parameter_dt *dtp, int *length, int no_error) { - static char *empty_string[0]; char *base, *p, q; - int n, lorig, memread, seen_comma; + int n, crlf; + gfc_offset pos; + size_t readlen; - /* If we hit EOF previously with the no_error flag set (i.e. X, T, - TR edit descriptors), and we now try to read again, this time - without setting no_error. */ - if (!no_error && dtp->u.p.at_eof) - { - *length = 0; - hit_eof (dtp); - return NULL; - } + if (*length > SCRATCH_SIZE) + dtp->u.p.line_buffer = get_mem (*length); + p = base = dtp->u.p.line_buffer; /* If we have seen an eor previously, return a length of 0. The caller is responsible for correctly padding the input field. */ if (dtp->u.p.sf_seen_eor) { *length = 0; - /* Just return something that isn't a NULL pointer, otherwise the - caller thinks an error occured. */ - return (char*) empty_string; + return base; } if (is_internal_unit (dtp)) { - memread = *length; - base = mem_alloc_r (dtp->u.p.current_unit->s, length); - if (unlikely (memread > *length)) + readlen = *length; + if (unlikely (sread (dtp->u.p.current_unit->s, p, &readlen) != 0 + || readlen < (size_t) *length)) { - hit_eof (dtp); + generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } - n = *length; + goto done; } - n = seen_comma = 0; + readlen = 1; + n = 0; - /* Read data into format buffer and scan through it. */ - lorig = *length; - base = p = fbuf_read (dtp->u.p.current_unit, length); - if (base == NULL) - return NULL; - - while (n < *length) + do { - q = *p; + if (unlikely (sread (dtp->u.p.current_unit->s, &q, &readlen) != 0)) + { + generate_error (&dtp->common, LIBERROR_END, NULL); + return NULL; + } - if (q == '\n' || q == '\r') + /* If we have a line without a terminating \n, drop through to + EOR below. */ + if (readlen < 1 && n == 0) + { + if (likely (no_error)) + break; + generate_error (&dtp->common, LIBERROR_END, NULL); + return NULL; + } + + if (readlen < 1 || q == '\n' || q == '\r') { /* Unexpected end of line. */ @@ -244,14 +245,23 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error) if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) dtp->u.p.eor_condition = 1; + crlf = 0; /* If we encounter a CR, it might be a CRLF. */ if (q == '\r') /* Probably a CRLF */ { - if (n < *length && *(p + 1) == '\n') - dtp->u.p.sf_seen_eor = 2; + readlen = 1; + pos = stream_offset (dtp->u.p.current_unit->s); + if (unlikely (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; } - else - dtp->u.p.sf_seen_eor = 1; /* Without padding, terminate the I/O statement without assigning the value. With padding, the value still needs to be assigned, @@ -265,6 +275,7 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error) } *length = n; + dtp->u.p.sf_seen_eor = (crlf ? 2 : 1); break; } /* Short circuit the read if a comma is found during numeric input. @@ -273,7 +284,6 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error) if (q == ',') if (dtp->u.p.sf_read_comma == 1) { - seen_comma = 1; notify_std (&dtp->common, GFC_STD_GNU, "Comma in formatted numeric read."); *length = n; @@ -281,31 +291,16 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error) } n++; - p++; - } - - fbuf_seek (dtp->u.p.current_unit, n + dtp->u.p.sf_seen_eor + seen_comma, - SEEK_CUR); - - /* A short read implies we hit EOF, unless we hit EOR, a comma, or - some other stuff. Set the relevant flags. */ - if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma) - { - if (no_error) - dtp->u.p.at_eof = 1; - else - { - hit_eof (dtp); - return NULL; - } + *p++ = q; + dtp->u.p.sf_seen_eor = 0; } + while (n < *length); done: - - dtp->u.p.current_unit->bytes_left -= n; + dtp->u.p.current_unit->bytes_left -= *length; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) n; + dtp->u.p.size_used += (GFC_IO_INT) *length; return base; } @@ -321,11 +316,12 @@ read_sf (st_parameter_dt *dtp, int * length, int no_error) opened with PAD=YES. The caller must assume tailing spaces for short reads. */ -void * -read_block_form (st_parameter_dt *dtp, int * nbytes) +try +read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes) { char *source; - int norig; + size_t nread; + int nb; if (!is_stream_io (dtp)) { @@ -342,14 +338,15 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) { /* Not enough data left. */ generate_error (&dtp->common, LIBERROR_EOR, NULL); - return NULL; + return FAILURE; } } if (unlikely (dtp->u.p.current_unit->bytes_left == 0)) { - hit_eof (dtp); - return NULL; + dtp->u.p.current_unit->endfile = AT_ENDFILE; + generate_error (&dtp->common, LIBERROR_END, NULL); + return FAILURE; } *nbytes = dtp->u.p.current_unit->bytes_left; @@ -360,36 +357,42 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) { - source = read_sf (dtp, nbytes, 0); + nb = *nbytes; + source = read_sf (dtp, &nb, 0); + *nbytes = nb; dtp->u.p.current_unit->strm_pos += (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor); - return source; + if (source == NULL) + return FAILURE; + memcpy (buf, source, *nbytes); + return SUCCESS; } - - /* If we reach here, we can assume it's direct access. */ - dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes; - norig = *nbytes; - source = fbuf_read (dtp->u.p.current_unit, nbytes); - fbuf_seek (dtp->u.p.current_unit, *nbytes, SEEK_CUR); + nread = *nbytes; + if (unlikely (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_IO_INT) *nbytes; + dtp->u.p.size_used += (GFC_IO_INT) nread; - if (norig != *nbytes) - { - /* Short read, this shouldn't happen. */ - if (!dtp->u.p.current_unit->pad_status == PAD_YES) + if (nread != *nbytes) + { /* Short read, this shouldn't happen. */ + if (likely (dtp->u.p.current_unit->pad_status == PAD_YES)) + *nbytes = nread; + else { generate_error (&dtp->common, LIBERROR_EOR, NULL); source = NULL; } } - dtp->u.p.current_unit->strm_pos += (gfc_offset) *nbytes; + dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; - return source; + return SUCCESS; } @@ -399,18 +402,18 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) static void read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) { - ssize_t to_read_record; - ssize_t have_read_record; - ssize_t to_read_subrecord; - ssize_t have_read_subrecord; + size_t to_read_record; + size_t have_read_record; + size_t to_read_subrecord; + size_t have_read_subrecord; int short_record; if (is_stream_io (dtp)) { to_read_record = *nbytes; - have_read_record = sread (dtp->u.p.current_unit->s, buf, - to_read_record); - if (unlikely (have_read_record < 0)) + have_read_record = to_read_record; + if (unlikely (sread (dtp->u.p.current_unit->s, buf, &have_read_record) + != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; @@ -422,7 +425,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) { /* Short read, e.g. if we hit EOF. For stream files, we have to set the end-of-file condition. */ - hit_eof (dtp); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } return; @@ -445,14 +448,14 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) dtp->u.p.current_unit->bytes_left -= to_read_record; - to_read_record = sread (dtp->u.p.current_unit->s, buf, to_read_record); - if (unlikely (to_read_record < 0)) + if (unlikely (sread (dtp->u.p.current_unit->s, buf, &to_read_record) + != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; } - if (to_read_record != (ssize_t) *nbytes) + if (to_read_record != *nbytes) { /* Short read, e.g. if we hit EOF. Apparently, we read more than was written to the last record. */ @@ -472,12 +475,18 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) until the request has been fulfilled or the record has run out of continuation subrecords. */ + if (unlikely (dtp->u.p.current_unit->endfile == AT_ENDFILE)) + { + generate_error (&dtp->common, LIBERROR_END, NULL); + return; + } + /* Check whether we exceed the total record length. */ if (dtp->u.p.current_unit->flags.has_recl && (*nbytes > (size_t) dtp->u.p.current_unit->bytes_left)) { - to_read_record = (ssize_t) dtp->u.p.current_unit->bytes_left; + to_read_record = (size_t) dtp->u.p.current_unit->bytes_left; short_record = 1; } else @@ -492,7 +501,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (dtp->u.p.current_unit->bytes_left_subrecord < (gfc_offset) to_read_record) { - to_read_subrecord = (ssize_t) dtp->u.p.current_unit->bytes_left_subrecord; + to_read_subrecord = (size_t) dtp->u.p.current_unit->bytes_left_subrecord; to_read_record -= to_read_subrecord; } else @@ -503,9 +512,9 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord; - have_read_subrecord = sread (dtp->u.p.current_unit->s, - buf + have_read_record, to_read_subrecord); - if (unlikely (have_read_subrecord) < 0) + have_read_subrecord = to_read_subrecord; + if (unlikely (sread (dtp->u.p.current_unit->s, buf + have_read_record, + &have_read_subrecord) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return; @@ -594,7 +603,7 @@ write_block (st_parameter_dt *dtp, int length) if (is_internal_unit (dtp)) { - dest = mem_alloc_w (dtp->u.p.current_unit->s, &length); + dest = salloc_w (dtp->u.p.current_unit->s, &length); if (dest == NULL) { @@ -632,22 +641,20 @@ static try write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) { - ssize_t have_written; - ssize_t to_write_subrecord; + size_t have_written, to_write_subrecord; int short_record; /* Stream I/O. */ if (is_stream_io (dtp)) { - have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes); - if (unlikely (have_written < 0)) + if (unlikely (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; } - dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written; + dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; return SUCCESS; } @@ -665,15 +672,14 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) if (buf == NULL && nbytes == 0) return SUCCESS; - have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes); - if (unlikely (have_written < 0)) + if (unlikely (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; } - dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written; - dtp->u.p.current_unit->bytes_left -= (gfc_offset) have_written; + dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes; + dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes; return SUCCESS; } @@ -703,9 +709,8 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) dtp->u.p.current_unit->bytes_left_subrecord -= (gfc_offset) to_write_subrecord; - to_write_subrecord = swrite (dtp->u.p.current_unit->s, - buf + have_written, to_write_subrecord); - if (unlikely (to_write_subrecord < 0)) + if (unlikely (swrite (dtp->u.p.current_unit->s, buf + have_written, + &to_write_subrecord) != 0)) { generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; @@ -927,6 +932,7 @@ static void formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, size_t size) { + char scratch[SCRATCH_SIZE]; int pos, bytes_used; const fnode *f; format_token t; @@ -953,6 +959,8 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, dtp->u.p.sf_read_comma = dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; + dtp->u.p.line_buffer = scratch; + for (;;) { /* If reversion has occurred and there is another real data item, @@ -1002,7 +1010,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, 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, SEEK_CUR); + 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; @@ -1213,7 +1221,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, break; case BT_REAL: if (f->u.real.w == 0) - write_real_g0 (dtp, p, kind, f->u.real.d); + write_real_g0 (dtp, p, kind, f->u.real.d); else write_d (dtp, f, p, kind); break; @@ -1243,6 +1251,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, dtp->u.p.skips += f->u.n; pos = bytes_used + dtp->u.p.skips - 1; dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos + 1; + /* Writes occur just before the switch on f->format, above, so that trailing blanks are suppressed, unless we are doing a non-advancing write in which case we want to output the blanks @@ -1307,17 +1316,24 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, /* Adjust everything for end-of-record condition */ if (dtp->u.p.sf_seen_eor && !is_internal_unit (dtp)) { - dtp->u.p.current_unit->bytes_left -= dtp->u.p.sf_seen_eor; - dtp->u.p.skips -= dtp->u.p.sf_seen_eor; + if (dtp->u.p.sf_seen_eor == 2) + { + /* The EOR was a CRLF (two bytes wide). */ + dtp->u.p.current_unit->bytes_left -= 2; + dtp->u.p.skips -= 2; + } + else + { + /* The EOR marker was only one byte wide. */ + dtp->u.p.current_unit->bytes_left--; + dtp->u.p.skips--; + } bytes_used = pos; dtp->u.p.sf_seen_eor = 0; } if (dtp->u.p.skips < 0) { - 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, SEEK_CUR); + move_pos_offset (dtp->u.p.current_unit->s, 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; @@ -1393,6 +1409,16 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, internal_error (&dtp->common, "Bad format node"); } + /* Free a buffer that we had to allocate during a sequential + formatted read of a block that was larger than the static + buffer. */ + + if (dtp->u.p.line_buffer != scratch) + { + free_mem (dtp->u.p.line_buffer); + dtp->u.p.line_buffer = scratch; + } + /* Adjust the item count and data pointer. */ if ((consume_data_flag > 0) && (n > 0)) @@ -1631,28 +1657,34 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, static void us_read (st_parameter_dt *dtp, int continued) { - ssize_t n, nr; + size_t n, nr; GFC_INTEGER_4 i4; GFC_INTEGER_8 i8; gfc_offset i; + if (dtp->u.p.current_unit->endfile == AT_ENDFILE) + return; + if (compile_options.record_marker == 0) n = sizeof (GFC_INTEGER_4); else n = compile_options.record_marker; - nr = sread (dtp->u.p.current_unit->s, &i, n); - if (unlikely (nr < 0)) + nr = n; + + if (unlikely (sread (dtp->u.p.current_unit->s, &i, &n) != 0)) { generate_error (&dtp->common, LIBERROR_BAD_US, NULL); return; } - else if (nr == 0) + + if (n == 0) { - hit_eof (dtp); + dtp->u.p.current_unit->endfile = AT_ENDFILE; return; /* end of file */ } - else if (unlikely (n != nr)) + + if (unlikely (n != nr)) { generate_error (&dtp->common, LIBERROR_BAD_US, NULL); return; @@ -1718,7 +1750,7 @@ us_read (st_parameter_dt *dtp, int continued) static void us_write (st_parameter_dt *dtp, int continued) { - ssize_t nbytes; + size_t nbytes; gfc_offset dummy; dummy = 0; @@ -1728,7 +1760,7 @@ us_write (st_parameter_dt *dtp, int continued) else nbytes = compile_options.record_marker ; - if (swrite (dtp->u.p.current_unit->s, &dummy, nbytes) != nbytes) + if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0) generate_error (&dtp->common, LIBERROR_OS, NULL); /* For sequential unformatted, if RECL= was not specified in the OPEN @@ -1930,7 +1962,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } - /* Check the record or position number. */ + /* Check the record number. */ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT && (cf & IOPARM_DT_HAS_REC) == 0) @@ -2079,71 +2111,65 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED) dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad; - - /* Check to see if we might be reading what we wrote before */ - - if (dtp->u.p.mode != dtp->u.p.current_unit->mode - && !is_internal_unit (dtp)) - { - int pos = fbuf_reset (dtp->u.p.current_unit); - if (pos != 0) - sseek (dtp->u.p.current_unit->s, pos, SEEK_CUR); - sflush(dtp->u.p.current_unit->s); - } - + /* Check the POS= specifier: that it is in range and that it is used with a unit that has been connected for STREAM access. F2003 9.5.1.10. */ if (((cf & IOPARM_DT_HAS_POS) != 0)) { if (is_stream_io (dtp)) - { - - if (dtp->pos <= 0) - { - generate_error (&dtp->common, LIBERROR_BAD_OPTION, - "POS=specifier must be positive"); - return; - } - - if (dtp->pos >= dtp->u.p.current_unit->maxrec) - { - generate_error (&dtp->common, LIBERROR_BAD_OPTION, - "POS=specifier too large"); - return; - } - - dtp->rec = dtp->pos; - - if (dtp->u.p.mode == READING) - { - /* Reset the endfile flag; if we hit EOF during reading - we'll set the flag and generate an error at that point - rather than worrying about it here. */ - dtp->u.p.current_unit->endfile = NO_ENDFILE; - } - - if (dtp->pos != dtp->u.p.current_unit->strm_pos) - { - fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); - sflush (dtp->u.p.current_unit->s); - if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1, SEEK_SET) < 0) - { - generate_error (&dtp->common, LIBERROR_OS, NULL); - return; - } - dtp->u.p.current_unit->strm_pos = dtp->pos; - } - } + { + + if (dtp->pos <= 0) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier must be positive"); + return; + } + + if (dtp->pos >= dtp->u.p.current_unit->maxrec) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier too large"); + return; + } + + dtp->rec = dtp->pos; + + if (dtp->u.p.mode == READING) + { + /* Required for compatibility between 4.3 and 4.4 runtime. Check + to see if we might be reading what we wrote before */ + if (dtp->u.p.current_unit->mode == WRITING) + { + fbuf_flush (dtp->u.p.current_unit, 1); + flush(dtp->u.p.current_unit->s); + } + + if (dtp->pos < file_length (dtp->u.p.current_unit->s)) + dtp->u.p.current_unit->endfile = NO_ENDFILE; + } + + if (dtp->pos != dtp->u.p.current_unit->strm_pos) + { + fbuf_flush (dtp->u.p.current_unit, 1); + flush (dtp->u.p.current_unit->s); + if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1) == FAILURE) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + dtp->u.p.current_unit->strm_pos = dtp->pos; + } + } else - { - generate_error (&dtp->common, LIBERROR_BAD_OPTION, - "POS=specifier not allowed, " - "Try OPEN with ACCESS='stream'"); - return; - } + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier not allowed, " + "Try OPEN with ACCESS='stream'"); + return; + } } - /* Sanity checks on the record number. */ if ((cf & IOPARM_DT_HAS_REC) != 0) @@ -2162,10 +2188,15 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } - /* Make sure format buffer is reset. */ - if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) - fbuf_reset (dtp->u.p.current_unit); + /* Check to see if we might be reading what we wrote before */ + if (dtp->u.p.mode == READING + && dtp->u.p.current_unit->mode == WRITING + && !is_internal_unit (dtp)) + { + 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. */ @@ -2180,28 +2211,37 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Position the file. */ if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1) - * dtp->u.p.current_unit->recl, SEEK_SET) < 0) - { - generate_error (&dtp->common, LIBERROR_OS, NULL); - return; - } + * dtp->u.p.current_unit->recl) == FAILURE) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } /* TODO: This is required to maintain compatibility between - 4.3 and 4.4 runtime. Remove when ABI changes from 4.3 */ + 4.3 and 4.4 runtime. Remove when ABI changes from 4.3 */ if (is_stream_io (dtp)) - dtp->u.p.current_unit->strm_pos = dtp->rec; - + dtp->u.p.current_unit->strm_pos = dtp->rec; + /* TODO: Un-comment this code when ABI changes from 4.3. if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM) - { - generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, - "Record number not allowed for stream access " - "data transfer"); - return; - } */ + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Record number not allowed for stream access " + "data transfer"); + return; + } */ + } + /* Overwriting an existing sequential file ? + it is always safe to truncate the file on the first write */ + if (dtp->u.p.mode == WRITING + && dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL + && dtp->u.p.current_unit->last_record == 0 + && !is_preconnected(dtp->u.p.current_unit->s)) + struncate(dtp->u.p.current_unit->s); + /* Bugware for badly written mixed C-Fortran I/O. */ flush_if_preconnected(dtp->u.p.current_unit->s); @@ -2354,8 +2394,8 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished) static void skip_record (st_parameter_dt *dtp, size_t bytes) { + gfc_offset new; size_t rlength; - ssize_t readb; static const size_t MAX_READ = 4096; char p[MAX_READ]; @@ -2365,10 +2405,12 @@ skip_record (st_parameter_dt *dtp, size_t bytes) if (is_seekable (dtp->u.p.current_unit->s)) { + new = file_position (dtp->u.p.current_unit->s) + + dtp->u.p.current_unit->bytes_left_subrecord; + /* Direct access files do not generate END conditions, only I/O errors. */ - if (sseek (dtp->u.p.current_unit->s, - dtp->u.p.current_unit->bytes_left_subrecord, SEEK_CUR) < 0) + if (sseek (dtp->u.p.current_unit->s, new) == FAILURE) generate_error (&dtp->common, LIBERROR_OS, NULL); } else @@ -2376,17 +2418,16 @@ skip_record (st_parameter_dt *dtp, size_t bytes) while (dtp->u.p.current_unit->bytes_left_subrecord > 0) { rlength = - (MAX_READ < (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ? + (MAX_READ > (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ? MAX_READ : (size_t) dtp->u.p.current_unit->bytes_left_subrecord; - readb = sread (dtp->u.p.current_unit->s, p, rlength); - if (readb < 0) + 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 -= readb; + dtp->u.p.current_unit->bytes_left_subrecord -= rlength; } } @@ -2434,8 +2475,8 @@ next_record_r (st_parameter_dt *dtp) { gfc_offset record; int bytes_left; + size_t length; char p; - int cc; switch (current_mode (dtp)) { @@ -2455,12 +2496,11 @@ next_record_r (st_parameter_dt *dtp) case FORMATTED_STREAM: case FORMATTED_SEQUENTIAL: - /* read_sf has already terminated input because of an '\n', or - we have hit EOF. */ - if (dtp->u.p.sf_seen_eor || dtp->u.p.at_eof) + length = 1; + /* sf_read has already terminated input because of an '\n' */ + if (dtp->u.p.sf_seen_eor) { dtp->u.p.sf_seen_eor = 0; - dtp->u.p.at_eof = 0; break; } @@ -2475,7 +2515,7 @@ next_record_r (st_parameter_dt *dtp) /* Now seek to this record. */ record = 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) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); break; @@ -2487,9 +2527,10 @@ next_record_r (st_parameter_dt *dtp) bytes_left = (int) dtp->u.p.current_unit->bytes_left; bytes_left = min_off (bytes_left, file_length (dtp->u.p.current_unit->s) - - stell (dtp->u.p.current_unit->s)); + - file_position (dtp->u.p.current_unit->s)); if (sseek (dtp->u.p.current_unit->s, - bytes_left, SEEK_CUR) < 0) + file_position (dtp->u.p.current_unit->s) + + bytes_left) == FAILURE) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); break; @@ -2499,37 +2540,42 @@ next_record_r (st_parameter_dt *dtp) } break; } - else + else do { - do + if (sread (dtp->u.p.current_unit->s, &p, &length) != 0) { - errno = 0; - cc = fbuf_getc (dtp->u.p.current_unit); - if (cc == EOF) - { - if (errno != 0) - generate_error (&dtp->common, LIBERROR_OS, NULL); - else - hit_eof (dtp); - break; - } - - if (is_stream_io (dtp)) - dtp->u.p.current_unit->strm_pos++; - - p = (char) cc; + generate_error (&dtp->common, LIBERROR_OS, NULL); + break; } - while (p != '\n'); + + if (length == 0) + { + dtp->u.p.current_unit->endfile = AT_ENDFILE; + break; + } + + if (is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos++; } + while (p != '\n'); + break; } + + if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL + && !dtp->u.p.namelist_mode + && dtp->u.p.current_unit->endfile == NO_ENDFILE + && (file_length (dtp->u.p.current_unit->s) == + file_position (dtp->u.p.current_unit->s))) + dtp->u.p.current_unit->endfile = AT_ENDFILE; + } /* Small utility function to write a record marker, taking care of byte swapping and of choosing the correct size. */ -static int +inline static int write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) { size_t len; @@ -2549,12 +2595,12 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) { case sizeof (GFC_INTEGER_4): buf4 = buf; - return swrite (dtp->u.p.current_unit->s, &buf4, len); + return swrite (dtp->u.p.current_unit->s, &buf4, &len); break; case sizeof (GFC_INTEGER_8): buf8 = buf; - return swrite (dtp->u.p.current_unit->s, &buf8, len); + return swrite (dtp->u.p.current_unit->s, &buf8, &len); break; default: @@ -2569,13 +2615,13 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) case sizeof (GFC_INTEGER_4): buf4 = buf; reverse_memcpy (p, &buf4, sizeof (GFC_INTEGER_4)); - return swrite (dtp->u.p.current_unit->s, p, len); + return swrite (dtp->u.p.current_unit->s, p, &len); break; case sizeof (GFC_INTEGER_8): buf8 = buf; reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_8)); - return swrite (dtp->u.p.current_unit->s, p, len); + return swrite (dtp->u.p.current_unit->s, p, &len); break; default: @@ -2598,7 +2644,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) /* Bytes written. */ m = dtp->u.p.current_unit->recl_subrecord - dtp->u.p.current_unit->bytes_left_subrecord; - c = stell (dtp->u.p.current_unit->s); + c = file_position (dtp->u.p.current_unit->s); /* Write the length tail. If we finish a record containing subrecords, we write out the negative length. */ @@ -2608,7 +2654,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) else m_write = m; - if (unlikely (write_us_marker (dtp, m_write) < 0)) + if (unlikely (write_us_marker (dtp, m_write) != 0)) goto io_error; if (compile_options.record_marker == 0) @@ -2619,8 +2665,8 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) /* Seek to the head and overwrite the bogus length with the real length. */ - if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker, - SEEK_SET) < 0)) + if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker) + == FAILURE)) goto io_error; if (next_subrecord) @@ -2628,13 +2674,13 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) else m_write = m; - if (unlikely (write_us_marker (dtp, m_write) < 0)) + if (unlikely (write_us_marker (dtp, m_write) != 0)) goto io_error; /* Seek past the end of the current record. */ - if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker, - SEEK_SET) < 0)) + if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker) + == FAILURE)) goto io_error; return; @@ -2645,35 +2691,6 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) } - -/* Utility function like memset() but operating on streams. Return - value is same as for POSIX write(). */ - -static ssize_t -sset (stream * s, int c, ssize_t nbyte) -{ - static const int WRITE_CHUNK = 256; - char p[WRITE_CHUNK]; - ssize_t bytes_left, trans; - - if (nbyte < WRITE_CHUNK) - memset (p, c, nbyte); - else - memset (p, c, WRITE_CHUNK); - - bytes_left = nbyte; - while (bytes_left > 0) - { - trans = (bytes_left < WRITE_CHUNK) ? bytes_left : WRITE_CHUNK; - trans = swrite (s, p, trans); - if (trans < 0) - return trans; - bytes_left -= trans; - } - - return nbyte - bytes_left; -} - /* Position to the next record in write mode. */ static void @@ -2682,6 +2699,9 @@ next_record_w (st_parameter_dt *dtp, int done) gfc_offset m, record, max_pos; int length; + /* 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; @@ -2696,11 +2716,8 @@ next_record_w (st_parameter_dt *dtp, int done) if (dtp->u.p.current_unit->bytes_left == 0) break; - fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END); - fbuf_flush (dtp->u.p.current_unit, WRITING); if (sset (dtp->u.p.current_unit->s, ' ', - dtp->u.p.current_unit->bytes_left) - != dtp->u.p.current_unit->bytes_left) + dtp->u.p.current_unit->bytes_left) == FAILURE) goto io_error; break; @@ -2709,7 +2726,7 @@ 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; - if (sset (dtp->u.p.current_unit->s, 0, length) != length) + if (sset (dtp->u.p.current_unit->s, 0, length) == FAILURE) goto io_error; } break; @@ -2740,7 +2757,8 @@ next_record_w (st_parameter_dt *dtp, int done) { length = (int) (max_pos - m); if (sseek (dtp->u.p.current_unit->s, - length, SEEK_CUR) < 0) + file_position (dtp->u.p.current_unit->s) + + length) == FAILURE) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return; @@ -2748,7 +2766,7 @@ next_record_w (st_parameter_dt *dtp, int done) length = (int) (dtp->u.p.current_unit->recl - max_pos); } - if (sset (dtp->u.p.current_unit->s, ' ', length) != length) + if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) { generate_error (&dtp->common, LIBERROR_END, NULL); return; @@ -2764,7 +2782,7 @@ next_record_w (st_parameter_dt *dtp, int done) /* Now seek to this record */ record = 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) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return; @@ -2787,7 +2805,8 @@ next_record_w (st_parameter_dt *dtp, int done) { length = (int) (max_pos - m); if (sseek (dtp->u.p.current_unit->s, - length, SEEK_CUR) < 0) + file_position (dtp->u.p.current_unit->s) + + length) == FAILURE) { generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return; @@ -2798,7 +2817,7 @@ next_record_w (st_parameter_dt *dtp, int done) length = (int) dtp->u.p.current_unit->bytes_left; } - if (sset (dtp->u.p.current_unit->s, ' ', length) != length) + if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) { generate_error (&dtp->common, LIBERROR_END, NULL); return; @@ -2807,27 +2826,23 @@ next_record_w (st_parameter_dt *dtp, int done) } else { + size_t len; + const char crlf[] = "\r\n"; + #ifdef HAVE_CRLF - const int len = 2; + len = 2; #else - const int len = 1; -#endif - fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END); - char * p = fbuf_alloc (dtp->u.p.current_unit, len); - if (!p) - goto io_error; -#ifdef HAVE_CRLF - *(p++) = '\r'; + len = 1; #endif - *p = '\n'; + if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0) + goto io_error; + if (is_stream_io (dtp)) { dtp->u.p.current_unit->strm_pos += len; if (dtp->u.p.current_unit->strm_pos < file_length (dtp->u.p.current_unit->s)) - unit_truncate (dtp->u.p.current_unit, - dtp->u.p.current_unit->strm_pos - 1, - &dtp->common); + struncate (dtp->u.p.current_unit->s); } } @@ -2865,7 +2880,7 @@ next_record (st_parameter_dt *dtp, int done) dtp->u.p.current_unit->current_record = 0; if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { - fp = stell (dtp->u.p.current_unit->s); + fp = file_position (dtp->u.p.current_unit->s); /* Calculate next record, rounding up partial records. */ dtp->u.p.current_unit->last_record = (fp + dtp->u.p.current_unit->recl - 1) / @@ -2877,8 +2892,6 @@ next_record (st_parameter_dt *dtp, int done) if (!done) pre_position (dtp); - - fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); } @@ -2927,6 +2940,7 @@ finalize_transfer (st_parameter_dt *dtp) if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING) { finish_list_read (dtp); + sfree (dtp->u.p.current_unit->s); return; } @@ -2941,9 +2955,10 @@ finalize_transfer (st_parameter_dt *dtp) next_record (dtp, 1); if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED - && stell (dtp->u.p.current_unit->s) >= dtp->rec) + && file_position (dtp->u.p.current_unit->s) >= dtp->rec) { - sflush (dtp->u.p.current_unit->s); + flush (dtp->u.p.current_unit->s); + sfree (dtp->u.p.current_unit->s); } return; } @@ -2952,8 +2967,9 @@ finalize_transfer (st_parameter_dt *dtp) if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar) { - fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); dtp->u.p.seen_dollar = 0; + fbuf_flush (dtp->u.p.current_unit, 1); + sfree (dtp->u.p.current_unit->s); return; } @@ -2965,17 +2981,15 @@ 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, dtp->u.p.mode); - sflush (dtp->u.p.current_unit->s); + fbuf_flush (dtp->u.p.current_unit, 0); + flush (dtp->u.p.current_unit->s); return; } - else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED - && dtp->u.p.mode == WRITING && !is_internal_unit (dtp)) - fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END); dtp->u.p.current_unit->saved_pos = 0; next_record (dtp, 1); + sfree (dtp->u.p.current_unit->s); } /* Transfer function for IOLENGTH. It doesn't actually do any @@ -3032,6 +3046,8 @@ void st_iolength_done (st_parameter_dt *dtp __attribute__((unused))) { free_ionml (dtp); + if (dtp->u.p.scratch != NULL) + free_mem (dtp->u.p.scratch); library_end (); } @@ -3047,6 +3063,29 @@ st_read (st_parameter_dt *dtp) library_start (&dtp->common); data_transfer_init (dtp, 1); + + /* Handle complications dealing with the endfile record. */ + + if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + switch (dtp->u.p.current_unit->endfile) + { + case NO_ENDFILE: + break; + + case AT_ENDFILE: + if (!is_internal_unit (dtp)) + { + generate_error (&dtp->common, LIBERROR_END, NULL); + dtp->u.p.current_unit->endfile = AFTER_ENDFILE; + dtp->u.p.current_unit->current_record = 0; + } + break; + + case AFTER_ENDFILE: + generate_error (&dtp->common, LIBERROR_ENDFILE, NULL); + dtp->u.p.current_unit->current_record = 0; + break; + } } extern void st_read_done (st_parameter_dt *); @@ -3058,6 +3097,8 @@ st_read_done (st_parameter_dt *dtp) finalize_transfer (dtp); free_format_data (dtp); free_ionml (dtp); + if (dtp->u.p.scratch != NULL) + free_mem (dtp->u.p.scratch); if (dtp->u.p.current_unit != NULL) unlock_unit (dtp->u.p.current_unit); @@ -3100,15 +3141,19 @@ st_write_done (st_parameter_dt *dtp) case NO_ENDFILE: /* Get rid of whatever is after this record. */ if (!is_internal_unit (dtp)) - unit_truncate (dtp->u.p.current_unit, - stell (dtp->u.p.current_unit->s), - &dtp->common); + { + flush (dtp->u.p.current_unit->s); + if (struncate (dtp->u.p.current_unit->s) == FAILURE) + generate_error (&dtp->common, LIBERROR_OS, NULL); + } dtp->u.p.current_unit->endfile = AT_ENDFILE; break; } free_format_data (dtp); free_ionml (dtp); + if (dtp->u.p.scratch != NULL) + free_mem (dtp->u.p.scratch); if (dtp->u.p.current_unit != NULL) unlock_unit (dtp->u.p.current_unit); @@ -3222,46 +3267,3 @@ void reverse_memcpy (void *dest, const void *src, size_t n) for (i=0; i<n; i++) *(d++) = *(s--); } - - -/* Once upon a time, a poor innocent Fortran program was reading a - file, when suddenly it hit the end-of-file (EOF). Unfortunately - the OS doesn't tell whether we're at the EOF or whether we already - went past it. Luckily our hero, libgfortran, keeps track of this. - Call this function when you detect an EOF condition. See Section - 9.10.2 in F2003. */ - -void -hit_eof (st_parameter_dt * dtp) -{ - dtp->u.p.current_unit->flags.position = POSITION_APPEND; - - if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) - switch (dtp->u.p.current_unit->endfile) - { - case NO_ENDFILE: - case AT_ENDFILE: - generate_error (&dtp->common, LIBERROR_END, NULL); - if (!is_internal_unit (dtp)) - { - dtp->u.p.current_unit->endfile = AFTER_ENDFILE; - dtp->u.p.current_unit->current_record = 0; - } - else - dtp->u.p.current_unit->endfile = AT_ENDFILE; - break; - - case AFTER_ENDFILE: - generate_error (&dtp->common, LIBERROR_ENDFILE, NULL); - dtp->u.p.current_unit->current_record = 0; - break; - } - else - { - /* Non-sequential files don't have an ENDFILE record, so we - can't be at AFTER_ENDFILE. */ - dtp->u.p.current_unit->endfile = AT_ENDFILE; - generate_error (&dtp->common, LIBERROR_END, NULL); - dtp->u.p.current_unit->current_record = 0; - } -} diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 21d4074e1a7..0af002d1a95 100644 --- a/libgfortran/io/unit.c +++ b/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); } |