gfc_charlen_type);
export_proto(transfer_array);
+static void us_read (st_parameter_dt *, int);
+static void us_write (st_parameter_dt *, int);
+static void next_record_r_unf (st_parameter_dt *, int);
+static void next_record_w_unf (st_parameter_dt *, int);
+
static const st_option advance_opt[] = {
{"yes", ADVANCE_YES},
{"no", ADVANCE_NO},
char *source;
int nread;
- if (!is_stream_io (dtp))
+ if (is_stream_io (dtp))
+ {
+ if (sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ {
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return NULL;
+ }
+ }
+ else
{
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length)
{
*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 -= (gfc_offset) *length;
+ if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
+ (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
+ dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
+ {
+ source = read_sf (dtp, length, 0);
+ dtp->u.p.current_unit->strm_pos +=
+ (gfc_offset) (*length + dtp->u.p.sf_seen_eor);
+ return source;
+ }
+ dtp->u.p.current_unit->bytes_left -= (gfc_offset) *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_EOR, NULL);
+ source = NULL;
}
}
- else
+
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
+
+ return source;
+}
+
+
+/* Reads a block directly into application data space. This is for
+ unformatted files. */
+
+static void
+read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
+{
+ 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))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
- return NULL;
+ return;
}
- if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+ to_read_record = *nbytes;
+ have_read_record = to_read_record;
+ if (sread (dtp->u.p.current_unit->s, buf, &have_read_record) != 0)
{
- source = read_sf (dtp, length, 0);
- dtp->u.p.current_unit->strm_pos +=
- (gfc_offset) (*length + dtp->u.p.sf_seen_eor);
- return source;
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
}
- 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;
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record;
- 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;
- }
+ if (to_read_record != have_read_record)
+ {
+ /* Short read, e.g. if we hit EOF. For stream files,
+ we have to set the end-of-file condition. */
+ generate_error (&dtp->common, ERROR_END, NULL);
+ return;
}
-
- dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
+ return;
}
- return source;
-}
-
-
-/* Reads a block directly into application data space. */
-static void
-read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
-{
- int *length;
- void *data;
- size_t nread;
-
- if (!is_stream_io (dtp))
+ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
{
- /* 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->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;
- }
+ short_record = 1;
+ to_read_record = (size_t) dtp->u.p.current_unit->bytes_left;
+ *nbytes = to_read_record;
+ }
- *nbytes = (size_t) dtp->u.p.current_unit->bytes_left;
+ else
+ {
+ short_record = 0;
+ to_read_record = *nbytes;
}
- if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
- dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
+ dtp->u.p.current_unit->bytes_left -= to_read_record;
+
+ if (sread (dtp->u.p.current_unit->s, buf, &to_read_record) != 0)
{
- length = (int *) nbytes;
- data = read_sf (dtp, length, 0); /* Special case. */
- memcpy (buf, data, (size_t) *length);
+ generate_error (&dtp->common, ERROR_OS, NULL);
return;
}
- dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
- }
- else
- {
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ if (to_read_record != *nbytes)
{
- generate_error (&dtp->common, ERROR_END, NULL);
+ /* Short read, e.g. if we hit EOF. Apparently, we read
+ more than was written to the last record. */
+ *nbytes = to_read_record;
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return;
+ }
+
+ if (short_record)
+ {
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
return;
}
+ return;
}
- nread = *nbytes;
- if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
+ /* Unformatted sequential. We loop over the subrecords, reading
+ until the request has been fulfilled or the record has run out
+ of continuation subrecords. */
+
+ if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
{
- generate_error (&dtp->common, ERROR_OS, NULL);
+ generate_error (&dtp->common, ERROR_END, NULL);
return;
}
- if (!is_stream_io (dtp))
+ /* Check whether we exceed the total record length. */
+
+ if (dtp->u.p.current_unit->flags.has_recl)
{
- if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) nread;
+ to_read_record =
+ *nbytes > (size_t) dtp->u.p.current_unit->bytes_left ?
+ *nbytes : (size_t) dtp->u.p.current_unit->bytes_left;
+ short_record = 1;
}
else
- dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
+ {
+ to_read_record = *nbytes;
+ short_record = 0;
+ }
+ have_read_record = 0;
- if (nread != *nbytes) /* Short read, e.g. if we hit EOF. */
+ while(1)
{
- if (!is_stream_io (dtp))
- generate_error (&dtp->common, ERROR_EOR, NULL);
+ if (dtp->u.p.current_unit->bytes_left_subrecord
+ < (gfc_offset) to_read_record)
+ {
+ to_read_subrecord = (size_t) dtp->u.p.current_unit->bytes_left_subrecord;
+ to_read_record -= to_read_subrecord;
+ }
+ else
+ {
+ to_read_subrecord = to_read_record;
+ to_read_record = 0;
+ }
+
+ dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord;
+
+ have_read_subrecord = to_read_subrecord;
+ if (sread (dtp->u.p.current_unit->s, buf + have_read_record,
+ &have_read_subrecord) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+ }
+
+ have_read_record += have_read_subrecord;
+
+ if (to_read_subrecord != have_read_subrecord)
+
+ {
+ /* Short read, e.g. if we hit EOF. This means the record
+ structure has been corrupted, or the trailing record
+ marker would still be present. */
+
+ *nbytes = have_read_record;
+ generate_error (&dtp->common, ERROR_CORRUPT_FILE, NULL);
+ return;
+ }
+
+ if (to_read_record > 0)
+ {
+ if (dtp->u.p.current_unit->continued)
+ {
+ next_record_r_unf (dtp, 0);
+ us_read (dtp, 1);
+ }
+ else
+ {
+ /* Let's make sure the file position is correctly set for the
+ next read statement. */
+
+ next_record_r_unf (dtp, 0);
+ us_read (dtp, 0);
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return;
+ }
+ }
else
- generate_error (&dtp->common, ERROR_END, NULL);
+ {
+ /* Normal exit, the read request has been fulfilled. */
+ break;
+ }
}
+
+ dtp->u.p.current_unit->bytes_left -= have_read_record;
+ if (short_record)
+ {
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return;
+ }
+ return;
}
{
char *dest;
- if (!is_stream_io (dtp))
+ if (is_stream_io (dtp))
+ {
+ if (sseek (dtp->u.p.current_unit->s,
+ dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return NULL;
+ }
+ }
+ else
{
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
{
}
dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
+ }
+ dest = salloc_w (dtp->u.p.current_unit->s, &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 (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 ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+ dtp->u.p.size_used += (gfc_offset) length;
+
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
+
+ return dest;
+}
+
+
+/* High level interface to swrite(), taking care of errors. This is only
+ called for unformatted files. There are three cases to consider:
+ Stream I/O, unformatted direct, unformatted sequential. */
+
+static try
+write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
+{
+
+ size_t have_written, to_write_subrecord;
+ int short_record;
+
+
+ /* Stream I/O. */
+
+ if (is_stream_io (dtp))
{
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, ERROR_OS, NULL);
- return NULL;
+ return FAILURE;
}
- dest = salloc_w (dtp->u.p.current_unit->s, &length);
-
- if (dest == NULL)
+ if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
{
- generate_error (&dtp->common, ERROR_END, NULL);
- return NULL;
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return FAILURE;
}
- dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
- }
-
- return dest;
-}
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
+ return SUCCESS;
+ }
-/* High level interface to swrite(), taking care of errors. */
+ /* Unformatted direct access. */
-static try
-write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
-{
- if (!is_stream_io (dtp))
+ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
{
- /* 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->flags.access == ACCESS_DIRECT)
- generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
- else
- generate_error (&dtp->common, ERROR_EOR, NULL);
- return FAILURE;
- }
+ generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+ return FAILURE;
}
+ if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return FAILURE;
+ }
+
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
+
+ return SUCCESS;
+
+ }
+
+ /* Unformatted sequential. */
+
+ have_written = 0;
+
+ if (dtp->u.p.current_unit->flags.has_recl
+ && (gfc_offset) nbytes > dtp->u.p.current_unit->bytes_left)
+ {
+ nbytes = dtp->u.p.current_unit->bytes_left;
+ short_record = 1;
}
else
{
- if (sseek (dtp->u.p.current_unit->s,
- dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
+ short_record = 0;
+ }
+
+ while (1)
+ {
+
+ to_write_subrecord =
+ (size_t) dtp->u.p.current_unit->bytes_left_subrecord < nbytes ?
+ (size_t) dtp->u.p.current_unit->bytes_left_subrecord : nbytes;
+
+ dtp->u.p.current_unit->bytes_left_subrecord -=
+ (gfc_offset) to_write_subrecord;
+
+ if (swrite (dtp->u.p.current_unit->s, buf + have_written,
+ &to_write_subrecord) != 0)
{
generate_error (&dtp->common, ERROR_OS, NULL);
return FAILURE;
}
- }
- if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
- {
- generate_error (&dtp->common, ERROR_OS, NULL);
- return FAILURE;
- }
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) to_write_subrecord;
+ nbytes -= to_write_subrecord;
+ have_written += to_write_subrecord;
- if (!is_stream_io (dtp))
+ if (nbytes == 0)
+ break;
+
+ next_record_w_unf (dtp, 1);
+ us_write (dtp, 1);
+ }
+ dtp->u.p.current_unit->bytes_left -= have_written;
+ if (short_record)
{
- if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) nbytes;
+ generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
+ return FAILURE;
}
- else
- dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
-
return SUCCESS;
}
/* By now, all complex variables have been split into their
constituent reals. For types with padding, we only need to
read kind bytes. We don't care about the contents
- of the padding. */
+ of the padding. If we hit a short record, then sz is
+ adjusted accordingly, making later reads no-ops. */
sz = kind;
for (i=0; i<nelems; i++)
/* Preposition a sequential unformatted file while reading. */
static void
-us_read (st_parameter_dt *dtp)
+us_read (st_parameter_dt *dtp, int continued)
{
char *p;
int n;
return;
if (compile_options.record_marker == 0)
- n = sizeof (gfc_offset);
+ n = sizeof (GFC_INTEGER_4);
else
n = compile_options.record_marker;
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
{
- switch (compile_options.record_marker)
+ switch (nr)
{
- case 0:
- memcpy (&i, p, sizeof(gfc_offset));
- break;
-
case sizeof(GFC_INTEGER_4):
memcpy (&i4, p, sizeof (i4));
i = i4;
}
}
else
- switch (compile_options.record_marker)
+ switch (nr)
{
- case 0:
- reverse_memcpy (&i, p, sizeof(gfc_offset));
- break;
-
case sizeof(GFC_INTEGER_4):
reverse_memcpy (&i4, p, sizeof (i4));
i = i4;
break;
}
- dtp->u.p.current_unit->bytes_left = i;
+ if (i >= 0)
+ {
+ dtp->u.p.current_unit->bytes_left_subrecord = i;
+ dtp->u.p.current_unit->continued = 0;
+ }
+ else
+ {
+ dtp->u.p.current_unit->bytes_left_subrecord = -i;
+ dtp->u.p.current_unit->continued = 1;
+ }
+
+ if (! continued)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
}
amount to writing a bogus length that will be filled in later. */
static void
-us_write (st_parameter_dt *dtp)
+us_write (st_parameter_dt *dtp, int continued)
{
size_t nbytes;
gfc_offset dummy;
dummy = 0;
if (compile_options.record_marker == 0)
- nbytes = sizeof (gfc_offset);
+ nbytes = sizeof (GFC_INTEGER_4);
else
nbytes = compile_options.record_marker ;
if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0)
generate_error (&dtp->common, ERROR_OS, NULL);
- /* For sequential unformatted, we write until we have more bytes
- than can fit in the record markers. If disk space runs out first,
- it will error on the write. */
- dtp->u.p.current_unit->recl = max_offset;
+ /* For sequential unformatted, if RECL= was not specified in the OPEN
+ we write until we have more bytes than can fit in the subrecord
+ markers, then we write a new subrecord. */
- dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+ dtp->u.p.current_unit->bytes_left_subrecord =
+ dtp->u.p.current_unit->recl_subrecord;
+ dtp->u.p.current_unit->continued = continued;
}
case UNFORMATTED_SEQUENTIAL:
if (dtp->u.p.mode == READING)
- us_read (dtp);
+ us_read (dtp, 0);
else
- us_write (dtp);
+ us_write (dtp, 0);
break;
return index;
}
-/* Space to the next record for read mode. If the file is not
- seekable, we read MAX_READ chunks until we get to the right
+
+
+/* Skip to the end of the current record, taking care of an optional
+ record marker of size bytes. If the file is not seekable, we
+ read chunks of size MAX_READ until we get to the right
position. */
#define MAX_READ 4096
static void
+skip_record (st_parameter_dt *dtp, size_t bytes)
+{
+ gfc_offset new;
+ int rlength, length;
+ char *p;
+
+ dtp->u.p.current_unit->bytes_left_subrecord += bytes;
+ if (dtp->u.p.current_unit->bytes_left_subrecord == 0)
+ return;
+
+ 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, new) == FAILURE)
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ }
+ else
+ { /* Seek by reading data. */
+ while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
+ {
+ rlength = length =
+ (MAX_READ > dtp->u.p.current_unit->bytes_left_subrecord) ?
+ MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord;
+
+ p = salloc_r (dtp->u.p.current_unit->s, &rlength);
+ if (p == NULL)
+ {
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+ }
+
+ dtp->u.p.current_unit->bytes_left_subrecord -= length;
+ }
+ }
+
+}
+
+#undef MAX_READ
+
+/* Advance to the next record reading unformatted files, taking
+ care of subrecords. If complete_record is nonzero, we loop
+ until all subrecords are cleared. */
+
+static void
+next_record_r_unf (st_parameter_dt *dtp, int complete_record)
+{
+ size_t bytes;
+
+ bytes = compile_options.record_marker == 0 ?
+ sizeof (GFC_INTEGER_4) : compile_options.record_marker;
+
+ while(1)
+ {
+
+ /* Skip over tail */
+
+ skip_record (dtp, bytes);
+
+ if ( ! (complete_record && dtp->u.p.current_unit->continued))
+ return;
+
+ us_read (dtp, 1);
+ }
+}
+
+/* Space to the next record for read mode. */
+
+static void
next_record_r (st_parameter_dt *dtp)
{
- gfc_offset new, record;
- int bytes_left, rlength, length;
+ gfc_offset record;
+ int length, bytes_left;
char *p;
switch (current_mode (dtp))
return;
case UNFORMATTED_SEQUENTIAL:
-
- /* Skip over tail */
- dtp->u.p.current_unit->bytes_left +=
- compile_options.record_marker == 0 ?
- sizeof (gfc_offset) : compile_options.record_marker;
-
- /* Fall through... */
+ next_record_r_unf (dtp, 1);
+ break;
case FORMATTED_DIRECT:
case UNFORMATTED_DIRECT:
- if (dtp->u.p.current_unit->bytes_left == 0)
- break;
-
- 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;
-
- /* Direct access files do not generate END conditions,
- only I/O errors. */
- if (sseek (dtp->u.p.current_unit->s, new) == FAILURE)
- generate_error (&dtp->common, ERROR_OS, NULL);
-
- }
- else
- { /* Seek by reading data. */
- while (dtp->u.p.current_unit->bytes_left > 0)
- {
- rlength = length = (MAX_READ > dtp->u.p.current_unit->bytes_left) ?
- MAX_READ : dtp->u.p.current_unit->bytes_left;
-
- p = salloc_r (dtp->u.p.current_unit->s, &rlength);
- if (p == NULL)
- {
- generate_error (&dtp->common, ERROR_OS, NULL);
- break;
- }
-
- dtp->u.p.current_unit->bytes_left -= length;
- }
- }
+ skip_record (dtp, 0);
break;
case FORMATTED_STREAM:
char p[sizeof (GFC_INTEGER_8)];
if (compile_options.record_marker == 0)
- len = sizeof (gfc_offset);
+ len = sizeof (GFC_INTEGER_4);
else
len = compile_options.record_marker;
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
{
- switch (compile_options.record_marker)
+ switch (len)
{
- case 0:
- return swrite (dtp->u.p.current_unit->s, &buf, &len);
- break;
-
case sizeof (GFC_INTEGER_4):
buf4 = buf;
return swrite (dtp->u.p.current_unit->s, &buf4, &len);
}
else
{
- switch (compile_options.record_marker)
+ switch (len)
{
- case 0:
- reverse_memcpy (p, &buf, sizeof (gfc_offset));
- return swrite (dtp->u.p.current_unit->s, p, &len);
- break;
-
case sizeof (GFC_INTEGER_4):
buf4 = buf;
reverse_memcpy (p, &buf4, sizeof (GFC_INTEGER_4));
case sizeof (GFC_INTEGER_8):
buf8 = buf;
- reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_4));
+ reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_8));
return swrite (dtp->u.p.current_unit->s, p, &len);
break;
}
+/* Position to the next (sub)record in write mode for
+ unformatted sequential files. */
+
+static void
+next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
+{
+ gfc_offset c, m, m_write;
+ size_t record_marker;
+
+ /* Bytes written. */
+ m = dtp->u.p.current_unit->recl_subrecord
+ - dtp->u.p.current_unit->bytes_left_subrecord;
+ 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. */
+
+ if (dtp->u.p.current_unit->continued)
+ m_write = -m;
+ else
+ m_write = m;
+
+ if (write_us_marker (dtp, m_write) != 0)
+ goto io_error;
+
+ if (compile_options.record_marker == 0)
+ record_marker = sizeof (GFC_INTEGER_4);
+ else
+ record_marker = compile_options.record_marker;
+
+ /* Seek to the head and overwrite the bogus length with the real
+ length. */
+
+ if (sseek (dtp->u.p.current_unit->s, c - m - record_marker)
+ == FAILURE)
+ goto io_error;
+
+ if (next_subrecord)
+ m_write = -m;
+ else
+ m_write = m;
+
+ if (write_us_marker (dtp, m_write) != 0)
+ goto io_error;
+
+ /* Seek past the end of the current record. */
+
+ if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE)
+ goto io_error;
+
+ return;
+
+ io_error:
+ generate_error (&dtp->common, ERROR_OS, NULL);
+ return;
+
+}
/* Position to the next record in write mode. */
static void
next_record_w (st_parameter_dt *dtp, int done)
{
- gfc_offset c, m, record, max_pos;
+ gfc_offset m, record, max_pos;
int length;
char *p;
- size_t record_marker;
/* Zero counters for X- and T-editing. */
max_pos = dtp->u.p.max_pos;
break;
case UNFORMATTED_SEQUENTIAL:
- /* Bytes written. */
- m = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
- c = file_position (dtp->u.p.current_unit->s);
-
- /* Write the length tail. */
-
- if (write_us_marker (dtp, m) != 0)
- goto io_error;
-
- if (compile_options.record_marker == 4)
- record_marker = sizeof(GFC_INTEGER_4);
- else
- record_marker = sizeof (gfc_offset);
-
- /* Seek to the head and overwrite the bogus length with the real
- length. */
-
- if (sseek (dtp->u.p.current_unit->s, c - m - record_marker)
- == FAILURE)
- goto io_error;
-
- if (write_us_marker (dtp, m) != 0)
- goto io_error;
-
- /* Seek past the end of the current record. */
-
- if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE)
- goto io_error;
-
+ next_record_w_unf (dtp, 0);
break;
case FORMATTED_STREAM:
else
length = (int) dtp->u.p.current_unit->bytes_left;
}
+
if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
{
generate_error (&dtp->common, ERROR_END, NULL);
}
if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
- finish_list_read (dtp);
- 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)
- {
- /* Most systems buffer lines, so force the partial record
- to be written out. */
- if (!is_internal_unit (dtp))
- flush (dtp->u.p.current_unit->s);
- dtp->u.p.seen_dollar = 0;
- return;
- }
- next_record (dtp, 1);
+ finish_list_read (dtp);
+ sfree (dtp->u.p.current_unit->s);
+ return;
}
- else
+
+ if (is_stream_io (dtp))
{
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
next_record (dtp, 1);
flush (dtp->u.p.current_unit->s);
+ sfree (dtp->u.p.current_unit->s);
+ return;
+ }
+
+ dtp->u.p.current_unit->current_record = 0;
+
+ if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar)
+ {
+ dtp->u.p.seen_dollar = 0;
+ sfree (dtp->u.p.current_unit->s);
+ return;
+ }
+
+ if (dtp->u.p.advance_status == ADVANCE_NO)
+ {
+ flush (dtp->u.p.current_unit->s);
+ return;
}
+ next_record (dtp, 1);
sfree (dtp->u.p.current_unit->s);
}
OSDN Git Service
