From 4d8ee55b7d3fd31406d095afb53a1fac983490c6 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Tue, 15 Aug 2006 23:06:44 +0000 Subject: [PATCH] 2006-08-15 Jerry DeLisle PR libgfortran/25828 * libgfortran.h: Rename GFC_LARGE_IO_INT to GFC_IO_INT. * io/file_pos.c (st_backspace): Ignore if access=STREAM. (st_rewind): Handle case of access=STREAM. * io/open.c (access_opt): Add STREAM_ACCESS. (edit_modes): Set current_record to zero only if not STREAM. (new_unit): Initialize maxrec, recl, and last_record for STREAM. * io/read.c (read_x): Advance file position for STREAM. * io/io.h (enum unit_access): Align IOPARM flags with frontend. Add ACCESS_STREAM. Add prototype for is_stream_io () function. Use GFC_IO_INT. * io/inquire.c (inquire_via_unit): Add text for access = "STREAM". * io/unit.c (is_stream_io): New function to return true if access = STREAM. * io/transfer.c (file_mode): Add modes for unformatted stream and formatted stream. (current_mode): Return appropriate file mode based on access flags. (read_block): Handle formatted stream reads. (read_block_direct): Handle unformatted stream reads. (write_block): Handle formatted stream writes. (write_buf): Handle unformatted stream writes. (unformatted_read): Fix up, use temporary for size. (pre_position): Position file for STREAM access. (data_transfer_init): Initialize for stream access, skip irrelevent error checks. (next_record_r),(next_record_w), and (next_record): Do nothing for stream I/O. (finalize_transfer): Flush when all done if stream I/O. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@116172 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/ChangeLog | 31 ++++ libgfortran/io/file_pos.c | 6 +- libgfortran/io/inquire.c | 6 + libgfortran/io/io.h | 43 +++--- libgfortran/io/open.c | 12 +- libgfortran/io/read.c | 22 +-- libgfortran/io/transfer.c | 357 ++++++++++++++++++++++++++++++---------------- libgfortran/io/unit.c | 9 ++ libgfortran/libgfortran.h | 4 +- 9 files changed, 336 insertions(+), 154 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index bb8b34410e2..773f80636db 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,34 @@ +2006-08-15 Jerry DeLisle + + PR libgfortran/25828 + * libgfortran.h: Rename GFC_LARGE_IO_INT to GFC_IO_INT. + * io/file_pos.c (st_backspace): Ignore if access=STREAM. + (st_rewind): Handle case of access=STREAM. + * io/open.c (access_opt): Add STREAM_ACCESS. + (edit_modes): Set current_record to zero only if not STREAM. + (new_unit): Initialize maxrec, recl, and last_record for STREAM. + * io/read.c (read_x): Advance file position for STREAM. + * io/io.h (enum unit_access): Align IOPARM flags with frontend. + Add ACCESS_STREAM. Add prototype for is_stream_io () function. + Use GFC_IO_INT. + * io/inquire.c (inquire_via_unit): Add text for access = "STREAM". + * io/unit.c (is_stream_io): New function to return true if access = + STREAM. + * io/transfer.c (file_mode): Add modes for unformatted stream and + formatted stream. (current_mode): Return appropriate file mode based + on access flags. + (read_block): Handle formatted stream reads. + (read_block_direct): Handle unformatted stream reads. + (write_block): Handle formatted stream writes. + (write_buf): Handle unformatted stream writes. + (unformatted_read): Fix up, use temporary for size. + (pre_position): Position file for STREAM access. + (data_transfer_init): Initialize for stream access, skip irrelevent + error checks. + (next_record_r),(next_record_w), and (next_record): Do nothing for + stream I/O. + (finalize_transfer): Flush when all done if stream I/O. + 2006-08-12 Francois-Xavier Coudert * intrinsics/bessel.c: Add prototypes for all functions. diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 05bb42dc804..3f6a332d979 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -205,7 +205,7 @@ st_backspace (st_parameter_filepos *fpp) sequential I/O and the next direct access transfer repositions the file anyway. */ - if (u->flags.access == ACCESS_DIRECT) + if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM) goto done; /* Check for special cases involving the ENDFILE record first. */ @@ -291,7 +291,7 @@ st_rewind (st_parameter_filepos *fpp) u = find_unit (fpp->common.unit); if (u != NULL) { - if (u->flags.access != ACCESS_SEQUENTIAL) + if (u->flags.access == ACCESS_DIRECT) generate_error (&fpp->common, ERROR_BAD_OPTION, "Cannot REWIND a file opened for DIRECT access"); else @@ -301,7 +301,7 @@ st_rewind (st_parameter_filepos *fpp) file now. Reset to read mode so two consecutive rewind statements do not delete the file contents. */ flush (u->s); - if (u->mode == WRITING) + if (u->mode == WRITING && u->flags.access != ACCESS_STREAM) struncate (u->s); u->mode = READING; diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 9044bf83e21..8a24f498575 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -75,6 +75,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) case ACCESS_DIRECT: p = "DIRECT"; break; + case ACCESS_STREAM: + p = "STREAM"; + break; default: internal_error (&iqp->common, "inquire_via_unit(): Bad access"); } @@ -145,6 +148,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) *iqp->recl_out = (u != NULL) ? u->recl : 0; + if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0) + *iqp->strm_pos_out = (u != NULL) ? u->last_record : 0; + if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) *iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0; diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index e16d4b6ec02..fba0ae83991 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -156,7 +156,7 @@ namelist_info; /* Options for the OPEN statement. */ typedef enum -{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, +{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM, ACCESS_UNSPECIFIED } unit_access; @@ -290,29 +290,31 @@ st_parameter_filepos; #define IOPARM_INQUIRE_HAS_NAMED (1 << 10) #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) -#define IOPARM_INQUIRE_HAS_FILE (1 << 13) -#define IOPARM_INQUIRE_HAS_ACCESS (1 << 14) -#define IOPARM_INQUIRE_HAS_FORM (1 << 15) -#define IOPARM_INQUIRE_HAS_BLANK (1 << 16) -#define IOPARM_INQUIRE_HAS_POSITION (1 << 17) -#define IOPARM_INQUIRE_HAS_ACTION (1 << 18) -#define IOPARM_INQUIRE_HAS_DELIM (1 << 19) -#define IOPARM_INQUIRE_HAS_PAD (1 << 20) -#define IOPARM_INQUIRE_HAS_NAME (1 << 21) -#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 22) -#define IOPARM_INQUIRE_HAS_DIRECT (1 << 23) -#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 24) -#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 25) -#define IOPARM_INQUIRE_HAS_READ (1 << 26) -#define IOPARM_INQUIRE_HAS_WRITE (1 << 27) -#define IOPARM_INQUIRE_HAS_READWRITE (1 << 28) -#define IOPARM_INQUIRE_HAS_CONVERT (1 << 29) +#define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13) +#define IOPARM_INQUIRE_HAS_FILE (1 << 14) +#define IOPARM_INQUIRE_HAS_ACCESS (1 << 15) +#define IOPARM_INQUIRE_HAS_FORM (1 << 16) +#define IOPARM_INQUIRE_HAS_BLANK (1 << 17) +#define IOPARM_INQUIRE_HAS_POSITION (1 << 18) +#define IOPARM_INQUIRE_HAS_ACTION (1 << 19) +#define IOPARM_INQUIRE_HAS_DELIM (1 << 20) +#define IOPARM_INQUIRE_HAS_PAD (1 << 21) +#define IOPARM_INQUIRE_HAS_NAME (1 << 22) +#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23) +#define IOPARM_INQUIRE_HAS_DIRECT (1 << 24) +#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25) +#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26) +#define IOPARM_INQUIRE_HAS_READ (1 << 27) +#define IOPARM_INQUIRE_HAS_WRITE (1 << 28) +#define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) +#define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) typedef struct { st_parameter_common common; GFC_INTEGER_4 *exist, *opened, *number, *named; GFC_INTEGER_4 *nextrec, *recl_out; + GFC_IO_INT *strm_pos_out; CHARACTER1 (file); CHARACTER2 (access); CHARACTER1 (form); @@ -351,7 +353,7 @@ struct format_data; typedef struct st_parameter_dt { st_parameter_common common; - GFC_LARGE_IO_INT rec; + GFC_IO_INT rec; GFC_INTEGER_4 *size, *iolength; gfc_array_char *internal_unit_desc; CHARACTER1 (format); @@ -709,6 +711,9 @@ internal_proto(is_internal_unit); extern int is_array_io (st_parameter_dt *); internal_proto(is_array_io); +extern int is_stream_io (st_parameter_dt *); +internal_proto(is_stream_io); + extern gfc_unit *find_unit (int); internal_proto(find_unit); diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 3515bef75ce..b3360792a22 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -40,6 +40,7 @@ static const st_option access_opt[] = { {"sequential", ACCESS_SEQUENTIAL}, {"direct", ACCESS_DIRECT}, {"append", ACCESS_APPEND}, + {"stream", ACCESS_STREAM}, {NULL, 0} }; @@ -214,7 +215,9 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) if (sseek (u->s, file_length (u->s)) == FAILURE) goto seek_error; - u->current_record = 0; + if (flags->access != ACCESS_STREAM) + u->current_record = 0; + u->endfile = AT_ENDFILE; /* We are at the end. */ break; @@ -432,6 +435,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) if (flags->access == ACCESS_DIRECT) u->maxrec = max_offset / u->recl; + + if (flags->access == ACCESS_STREAM) + { + u->maxrec = max_offset; + u->recl = 1; + u->last_record = 1; + } memmove (u->file, opp->file, opp->file_len); u->file_len = opp->file_len; diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index 9db5d583078..db9ff99cd12 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -841,13 +841,17 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) void read_x (st_parameter_dt *dtp, int n) { - if ((dtp->u.p.current_unit->flags.pad == 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; - + if (!is_stream_io (dtp)) + { + if ((dtp->u.p.current_unit->flags.pad == 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->rec += (GFC_IO_INT) n; } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index fc0613129d5..99e89794417 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -91,7 +91,7 @@ static const st_option advance_opt[] = { typedef enum { FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL, - FORMATTED_DIRECT, UNFORMATTED_DIRECT + FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM } file_mode; @@ -101,16 +101,23 @@ current_mode (st_parameter_dt *dtp) { file_mode m; + m = FORM_UNSPECIFIED; + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? FORMATTED_DIRECT : UNFORMATTED_DIRECT; } - else + else if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) { m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL; } + else if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM) + { + m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? + FORMATTED_STREAM : UNFORMATTED_STREAM; + } return m; } @@ -128,7 +135,7 @@ current_mode (st_parameter_dt *dtp) an I/O error. Given this, the solution is to read a byte at a time, stopping if - we hit the newline. For small locations, we use a static buffer. + we hit the newline. For small allocations, we use a static buffer. For larger allocations, we are forced to allocate memory on the heap. Hopefully this won't happen very often. */ @@ -256,56 +263,86 @@ read_block (st_parameter_dt *dtp, int *length) char *source; int nread; - if (dtp->u.p.current_unit->bytes_left < *length) + if (!is_stream_io (dtp)) { - /* For preconnected units with default record length, set bytes left - to unit record length and proceed, otherwise error. */ - if (dtp->u.p.current_unit->unit_number == options.stdin_unit - && dtp->u.p.current_unit->recl == DEFAULT_RECL) - dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; - else + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length) { - if (dtp->u.p.current_unit->flags.pad == PAD_NO) + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if (dtp->u.p.current_unit->unit_number == options.stdin_unit + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else { - /* Not enough data left. */ - generate_error (&dtp->common, ERROR_EOR, NULL); + if (dtp->u.p.current_unit->flags.pad == PAD_NO) + { + /* Not enough data left. */ + generate_error (&dtp->common, ERROR_EOR, NULL); + return NULL; + } + } + + if (dtp->u.p.current_unit->bytes_left == 0) + { + dtp->u.p.current_unit->endfile = AT_ENDFILE; + generate_error (&dtp->common, ERROR_END, NULL); return NULL; } + + *length = dtp->u.p.current_unit->bytes_left; } - if (dtp->u.p.current_unit->bytes_left == 0) + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && + dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + return read_sf (dtp, length, 0); /* Special case. */ + + dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length; + + nread = *length; + source = salloc_r (dtp->u.p.current_unit->s, &nread); + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (gfc_offset) nread; + + if (nread != *length) + { /* Short read, this shouldn't happen. */ + if (dtp->u.p.current_unit->flags.pad == PAD_YES) + *length = nread; + else + { + generate_error (&dtp->common, ERROR_EOR, NULL); + source = NULL; + } + } + } + else + { + if (sseek (dtp->u.p.current_unit->s, + (gfc_offset) (dtp->rec - 1)) == FAILURE) { - dtp->u.p.current_unit->endfile = AT_ENDFILE; generate_error (&dtp->common, ERROR_END, NULL); return NULL; } - *length = dtp->u.p.current_unit->bytes_left; - } - - if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && - dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) - return read_sf (dtp, length, 0); /* Special case. */ - - dtp->u.p.current_unit->bytes_left -= *length; - - nread = *length; - source = salloc_r (dtp->u.p.current_unit->s, &nread); + nread = *length; + source = salloc_r (dtp->u.p.current_unit->s, &nread); - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) nread; + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (gfc_offset) nread; - if (nread != *length) - { /* Short read, this shouldn't happen. */ - if (dtp->u.p.current_unit->flags.pad == PAD_YES) - *length = nread; - else - { - generate_error (&dtp->common, ERROR_EOR, NULL); - source = NULL; + if (nread != *length) + { /* Short read, this shouldn't happen. */ + if (dtp->u.p.current_unit->flags.pad == PAD_YES) + *length = nread; + else + { + generate_error (&dtp->common, ERROR_END, NULL); + source = NULL; + } } - } + dtp->rec += (GFC_IO_INT) nread; + } return source; } @@ -319,44 +356,57 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) void *data; size_t nread; - if (dtp->u.p.current_unit->bytes_left < *nbytes) + if (!is_stream_io (dtp)) { - /* For preconnected units with default record length, set bytes left - to unit record length and proceed, otherwise error. */ - if (dtp->u.p.current_unit->unit_number == options.stdin_unit - && dtp->u.p.current_unit->recl == DEFAULT_RECL) - dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; - else + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes) { - if (dtp->u.p.current_unit->flags.pad == PAD_NO) + /* For preconnected units with default record length, set + bytes left to unit record length and proceed, otherwise + error. */ + if (dtp->u.p.current_unit->unit_number == options.stdin_unit + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else { - /* Not enough data left. */ - generate_error (&dtp->common, ERROR_EOR, NULL); + if (dtp->u.p.current_unit->flags.pad == PAD_NO) + { + /* Not enough data left. */ + generate_error (&dtp->common, ERROR_EOR, NULL); + return; + } + } + + if (dtp->u.p.current_unit->bytes_left == 0) + { + dtp->u.p.current_unit->endfile = AT_ENDFILE; + generate_error (&dtp->common, ERROR_END, NULL); return; } + + *nbytes = (size_t) dtp->u.p.current_unit->bytes_left; } - if (dtp->u.p.current_unit->bytes_left == 0) + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && + dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) { - dtp->u.p.current_unit->endfile = AT_ENDFILE; - generate_error (&dtp->common, ERROR_END, NULL); + length = (int *) nbytes; + data = read_sf (dtp, length, 0); /* Special case. */ + memcpy (buf, data, (size_t) *length); return; } - *nbytes = dtp->u.p.current_unit->bytes_left; + dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes; } - - if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && - dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + else { - length = (int *) nbytes; - data = read_sf (dtp, length, 0); /* Special case. */ - memcpy (buf, data, (size_t) *length); - return; + if (sseek (dtp->u.p.current_unit->s, + (gfc_offset) (dtp->rec - 1)) == FAILURE) + { + generate_error (&dtp->common, ERROR_END, NULL); + return; + } } - dtp->u.p.current_unit->bytes_left -= *nbytes; - nread = *nbytes; if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0) { @@ -364,18 +414,20 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) return; } - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) nread; + if (!is_stream_io (dtp)) + { + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (gfc_offset) nread; + } + else + dtp->rec += (GFC_IO_INT) nread; - if (nread != *nbytes) - { /* Short read, e.g. if we hit EOF. */ - if (dtp->u.p.current_unit->flags.pad == PAD_YES) - { - memset (((char *) buf) + nread, ' ', *nbytes - nread); - *nbytes = nread; - } - else + if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */ + { + if (!is_stream_io (dtp)) generate_error (&dtp->common, ERROR_EOR, NULL); + else + generate_error (&dtp->common, ERROR_END, NULL); } } @@ -390,35 +442,59 @@ write_block (st_parameter_dt *dtp, int length) { char *dest; - if (dtp->u.p.current_unit->bytes_left < length) + if (!is_stream_io (dtp)) { - /* For preconnected units with default record length, set bytes left - to unit record length and proceed, otherwise error. */ - if ((dtp->u.p.current_unit->unit_number == options.stdout_unit - || dtp->u.p.current_unit->unit_number == options.stderr_unit) - && dtp->u.p.current_unit->recl == DEFAULT_RECL) - dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; - else + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length) { - generate_error (&dtp->common, ERROR_EOR, NULL); - return NULL; + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if ((dtp->u.p.current_unit->unit_number == options.stdout_unit + || dtp->u.p.current_unit->unit_number == options.stderr_unit) + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else + { + generate_error (&dtp->common, ERROR_EOR, NULL); + return NULL; + } } - } - dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; - dest = salloc_w (dtp->u.p.current_unit->s, &length); + dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; + + + dest = salloc_w (dtp->u.p.current_unit->s, &length); - if (dest == NULL) - { - generate_error (&dtp->common, ERROR_END, NULL); - return NULL; + if (dest == NULL) + { + generate_error (&dtp->common, ERROR_END, NULL); + return NULL; + } + + if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE) + generate_error (&dtp->common, ERROR_END, NULL); + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (gfc_offset) length; } + else + { + if (sseek (dtp->u.p.current_unit->s, + (gfc_offset) (dtp->rec - 1)) == FAILURE) + { + generate_error (&dtp->common, ERROR_END, NULL); + return NULL; + } - if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE) - generate_error (&dtp->common, ERROR_END, NULL); + dest = salloc_w (dtp->u.p.current_unit->s, &length); - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) length; + if (dest == NULL) + { + generate_error (&dtp->common, ERROR_END, NULL); + return NULL; + } + + dtp->rec += (GFC_IO_INT) length; + } return dest; } @@ -429,34 +505,52 @@ write_block (st_parameter_dt *dtp, int length) static try write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) { - if (dtp->u.p.current_unit->bytes_left < nbytes) + if (!is_stream_io (dtp)) { - /* For preconnected units with default record length, set bytes left - to unit record length and proceed, otherwise error. */ - if ((dtp->u.p.current_unit->unit_number == options.stdout_unit - || dtp->u.p.current_unit->unit_number == options.stderr_unit) - && dtp->u.p.current_unit->recl == DEFAULT_RECL) - dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; - else + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes) { - if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) - generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL); + /* For preconnected units with default record length, set + bytes left to unit record length and proceed, otherwise + error. */ + if ((dtp->u.p.current_unit->unit_number == options.stdout_unit + || dtp->u.p.current_unit->unit_number == options.stderr_unit) + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else - generate_error (&dtp->common, ERROR_EOR, NULL); + { + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL); + else + generate_error (&dtp->common, ERROR_EOR, NULL); + return FAILURE; + } + } + + dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes; + } + else + { + if (sseek (dtp->u.p.current_unit->s, + (gfc_offset) (dtp->rec - 1)) == FAILURE) + { + generate_error (&dtp->common, ERROR_OS, NULL); return FAILURE; } } - dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes; - if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) { generate_error (&dtp->common, ERROR_OS, NULL); return FAILURE; } - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) nbytes; + if (!is_stream_io (dtp)) + { + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (gfc_offset) nbytes; + } + else + dtp->rec += (GFC_IO_INT) nbytes; return SUCCESS; } @@ -469,18 +563,19 @@ unformatted_read (st_parameter_dt *dtp, bt type, void *dest, int kind, size_t size, size_t nelems) { + size_t i, sz; + /* Currently, character implies size=1. */ if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE || size == 1 || type == BT_CHARACTER) { - size *= nelems; - read_block_direct (dtp, dest, &size); + sz = size * nelems; + read_block_direct (dtp, dest, &sz); } else { char buffer[16]; char *p; - size_t i, sz; /* Break up complex into its constituent reals. */ if (type == BT_COMPLEX) @@ -721,7 +816,8 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, dtp->u.p.skips = dtp->u.p.pending_spaces = 0; } - bytes_used = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left); + bytes_used = (int)(dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left); switch (t) { @@ -1405,6 +1501,14 @@ pre_position (st_parameter_dt *dtp) switch (current_mode (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->rec = 1; + break; + case UNFORMATTED_SEQUENTIAL: if (dtp->u.p.mode == READING) us_read (dtp); @@ -1549,13 +1653,12 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "Missing format for FORMATTED data transfer"); - if (is_internal_unit (dtp) && dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) generate_error (&dtp->common, ERROR_OPTION_CONFLICT, "Internal file cannot be accessed by UNFORMATTED data transfer"); - /* Check the record number. */ + /* Check the record or position number. */ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT && (cf & IOPARM_DT_HAS_REC) == 0) @@ -1628,7 +1731,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; /* Sanity checks on the record number. */ - if ((cf & IOPARM_DT_HAS_REC) != 0) { if (dtp->rec <= 0) @@ -1664,8 +1766,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) } /* Position the file. */ - if (sseek (dtp->u.p.current_unit->s, - (dtp->rec - 1) * dtp->u.p.current_unit->recl) == FAILURE) + if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1) + * dtp->u.p.current_unit->recl) == FAILURE) { generate_error (&dtp->common, ERROR_OS, NULL); return; @@ -1723,7 +1825,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (read_flag) { - if (dtp->u.p.current_unit->read_bad) + if (dtp->u.p.current_unit->read_bad && !is_stream_io (dtp)) { generate_error (&dtp->common, ERROR_BAD_OPTION, "Cannot READ after a nonadvancing WRITE"); @@ -1813,6 +1915,11 @@ next_record_r (st_parameter_dt *dtp) switch (current_mode (dtp)) { + /* No records in STREAM I/O. */ + case FORMATTED_STREAM: + case UNFORMATTED_STREAM: + return; + case UNFORMATTED_SEQUENTIAL: /* Skip over tail */ @@ -2003,6 +2110,11 @@ next_record_w (st_parameter_dt *dtp, int done) switch (current_mode (dtp)) { + /* No records in STREAM I/O. */ + case FORMATTED_STREAM: + case UNFORMATTED_STREAM: + return; + case FORMATTED_DIRECT: if (dtp->u.p.current_unit->bytes_left == 0) break; @@ -2166,6 +2278,9 @@ next_record_w (st_parameter_dt *dtp, int done) void next_record (st_parameter_dt *dtp, int done) { + if (is_stream_io (dtp)) + return; + gfc_offset fp; /* File position. */ dtp->u.p.current_unit->read_bad = 0; @@ -2177,7 +2292,6 @@ next_record (st_parameter_dt *dtp, int done) /* keep position up to date for INQUIRE */ dtp->u.p.current_unit->flags.position = POSITION_ASIS; - dtp->u.p.current_unit->current_record = 0; if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { @@ -2238,7 +2352,7 @@ finalize_transfer (st_parameter_dt *dtp) if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING) finish_list_read (dtp); - else + else if (!is_stream_io (dtp)) { dtp->u.p.current_unit->current_record = 0; if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) @@ -2250,9 +2364,13 @@ finalize_transfer (st_parameter_dt *dtp) dtp->u.p.seen_dollar = 0; return; } - next_record (dtp, 1); } + else + { + flush (dtp->u.p.current_unit->s); + dtp->u.p.current_unit->last_record = dtp->rec; + } sfree (dtp->u.p.current_unit->s); } @@ -2325,7 +2443,6 @@ export_proto(st_read); void st_read (st_parameter_dt *dtp) { - library_start (&dtp->common); data_transfer_init (dtp, 1); diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index eca1b1eb98b..6a227845649 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -493,6 +493,15 @@ is_array_io (st_parameter_dt *dtp) } +/* is_stream_io () -- Determine if I/O is access="stream" mode */ + +int +is_stream_io (st_parameter_dt *dtp) +{ + return dtp->u.p.current_unit->flags.access == ACCESS_STREAM; +} + + /*************************/ /* Initialize everything */ diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 4d27b659233..0c0e6cd29be 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -200,10 +200,10 @@ typedef off_t gfc_offset; /* Define the type used for the current record number for large file I/O. The size must be consistent with the size defined on the compiler side. */ #ifdef HAVE_GFC_INTEGER_8 -typedef GFC_INTEGER_8 GFC_LARGE_IO_INT; +typedef GFC_INTEGER_8 GFC_IO_INT; #else #ifdef HAVE_GFC_INTEGER_4 -typedef GFC_INTEGER_4 GFC_LARGE_IO_INT; +typedef GFC_INTEGER_4 GFC_IO_INT; #else #error "GFC_INTEGER_4 should be available for the library to compile". #endif -- 2.11.0