Commit 91b30ee5 by Jerry DeLisle

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
parent 014ec6ee
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;
}
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment