re PR fortran/25828 ([f2003] ACCESS='STREAM' io support)
2006-08-15 Jerry DeLisle <jvdelisle@gcc.gnu.org> 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. From-SVN: r116172
This commit is contained in:
parent
014ec6ee5f
commit
91b30ee5b9
|
@ -1,3 +1,34 @@
|
|||
2006-08-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
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 <coudert@clipper.ens.fr>
|
||||
|
||||
* intrinsics/bessel.c: Add prototypes for all functions.
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
nread = *length;
|
||||
source = salloc_r (dtp->u.p.current_unit->s, &nread);
|
||||
|
||||
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. */
|
||||
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
|
||||
dtp->u.p.size_used += (gfc_offset) nread;
|
||||
|
||||
dtp->u.p.current_unit->bytes_left -= *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;
|
||||
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,36 +442,60 @@ 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);
|
||||
/* 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);
|
||||
|
||||
if (dest == NULL)
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
|
||||
dest = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
|
||||
if (dest == NULL)
|
||||
if (is_internal_unit (dtp) && 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
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_END, NULL);
|
||||
return NULL;
|
||||
if (sseek (dtp->u.p.current_unit->s,
|
||||
(gfc_offset) (dtp->rec - 1)) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
dest = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
|
||||
if (dest == NULL)
|
||||
{
|
||||
generate_error (&dtp->common, ERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
dtp->rec += (GFC_IO_INT) length;
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
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);
|
||||
|
|
|
@ -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 */
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue