diff options
Diffstat (limited to 'libgfortran/io/transfer.c')
| -rw-r--r-- | libgfortran/io/transfer.c | 357 |
1 files changed, 237 insertions, 120 deletions
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); |