For larger allocations, we are forced to allocate memory on the
heap. Hopefully this won't happen very often. */
-static char *
-read_sf (st_parameter_dt *dtp, int *length)
+char *
+read_sf (st_parameter_dt *dtp, int *length, int no_error)
{
char *base, *p, *q;
int n, readlen, crlf;
EOR below. */
if (readlen < 1 && n == 0)
{
+ if (no_error)
+ break;
generate_error (&dtp->common, ERROR_END, NULL);
return NULL;
}
so we can just continue with a short read. */
if (dtp->u.p.current_unit->flags.pad == PAD_NO)
{
+ if (no_error)
+ break;
generate_error (&dtp->common, ERROR_EOR, NULL);
return NULL;
}
dtp->u.p.current_unit->bytes_left -= *length;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size += *length;
+ dtp->u.p.size_used += (gfc_offset) *length;
return base;
}
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
- return read_sf (dtp, length); /* Special case. */
+ return read_sf (dtp, length, 0); /* Special case. */
dtp->u.p.current_unit->bytes_left -= *length;
source = salloc_r (dtp->u.p.current_unit->s, &nread);
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size += nread;
+ dtp->u.p.size_used += (gfc_offset) nread;
if (nread != *length)
{ /* Short read, this shouldn't happen. */
dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
{
length = (int *) nbytes;
- data = read_sf (dtp, length); /* Special case. */
+ data = read_sf (dtp, length, 0); /* Special case. */
memcpy (buf, data, (size_t) *length);
return;
}
}
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size += (GFC_INTEGER_4) nread;
+ dtp->u.p.size_used += (gfc_offset) nread;
if (nread != *nbytes)
{ /* Short read, e.g. if we hit EOF. */
}
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size += length;
+ dtp->u.p.size_used += (gfc_offset) length;
return dest;
}
}
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- {
- *dtp->size += (GFC_INTEGER_4) nbytes;
- return FAILURE;
- }
+ dtp->u.p.size_used += (gfc_offset) nbytes;
return SUCCESS;
}
{
char *p;
int n;
+ int nr;
+ GFC_INTEGER_4 i4;
+ GFC_INTEGER_8 i8;
gfc_offset i;
if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
return;
- n = sizeof (gfc_offset);
+ if (compile_options.record_marker == 0)
+ n = sizeof (gfc_offset);
+ else
+ n = compile_options.record_marker;
+
+ nr = n;
+
p = salloc_r (dtp->u.p.current_unit->s, &n);
if (n == 0)
return; /* end of file */
}
- if (p == NULL || n != sizeof (gfc_offset))
+ if (p == NULL || n != nr)
{
generate_error (&dtp->common, ERROR_BAD_US, NULL);
return;
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE)
- memcpy (&i, p, sizeof (gfc_offset));
+ {
+ switch (compile_options.record_marker)
+ {
+ case 0:
+ memcpy (&i, p, sizeof(gfc_offset));
+ break;
+
+ case sizeof(GFC_INTEGER_4):
+ memcpy (&i4, p, sizeof (i4));
+ i = i4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ memcpy (&i8, p, sizeof (i8));
+ i = i8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+ }
else
- reverse_memcpy (&i, p, sizeof (gfc_offset));
-
+ switch (compile_options.record_marker)
+ {
+ case 0:
+ reverse_memcpy (&i, p, sizeof(gfc_offset));
+ break;
+
+ case sizeof(GFC_INTEGER_4):
+ reverse_memcpy (&i4, p, sizeof (i4));
+ i = i4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ reverse_memcpy (&i8, p, sizeof (i8));
+ i = i8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+
dtp->u.p.current_unit->bytes_left = i;
}
gfc_offset dummy;
dummy = 0;
- nbytes = sizeof (gfc_offset);
+
+ if (compile_options.record_marker == 0)
+ nbytes = sizeof (gfc_offset);
+ else
+ nbytes = compile_options.record_marker ;
if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0)
generate_error (&dtp->common, ERROR_OS, NULL);
dtp->u.p.mode = read_flag ? READING : WRITING;
if ((cf & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size = 0; /* Initialize the count. */
+ dtp->u.p.size_used = 0; /* Initialize the count. */
dtp->u.p.current_unit = get_unit (dtp, 1);
if (dtp->u.p.current_unit->s == NULL)
{ /* Open the unit with some default flags. */
st_parameter_open opp;
+ unit_convert conv;
+
if (dtp->common.unit < 0)
{
close_unit (dtp->u.p.current_unit);
u_flags.blank = BLANK_UNSPECIFIED;
u_flags.pad = PAD_UNSPECIFIED;
u_flags.status = STATUS_UNKNOWN;
+
+ conv = get_unformatted_convert (dtp->common.unit);
+
+ if (conv == CONVERT_NONE)
+ conv = compile_options.convert;
+
+ /* We use l8_to_l4_offset, which is 0 on little-endian machines
+ and 1 on big-endian machines. */
+ switch (conv)
+ {
+ case CONVERT_NATIVE:
+ case CONVERT_SWAP:
+ break;
+
+ case CONVERT_BIG:
+ conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP;
+ break;
+
+ case CONVERT_LITTLE:
+ conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE;
+ break;
+
+ default:
+ internal_error (&opp.common, "Illegal value for CONVERT");
+ break;
+ }
+
+ u_flags.convert = conv;
+
opp.common = dtp->common;
opp.common.flags &= IOPARM_COMMON_MASK;
dtp->u.p.current_unit = new_unit (&opp, dtp->u.p.current_unit, &u_flags);
case UNFORMATTED_SEQUENTIAL:
/* Skip over tail */
- dtp->u.p.current_unit->bytes_left += sizeof (gfc_offset);
+ dtp->u.p.current_unit->bytes_left +=
+ compile_options.record_marker == 0 ?
+ sizeof (gfc_offset) : compile_options.record_marker;
/* Fall through... */
/* Small utility function to write a record marker, taking care of
- byte swapping. */
+ byte swapping and of choosing the correct size. */
inline static int
write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
{
- size_t len = sizeof (gfc_offset);
+ size_t len;
+ GFC_INTEGER_4 buf4;
+ GFC_INTEGER_8 buf8;
+ char p[sizeof (GFC_INTEGER_8)];
+
+ if (compile_options.record_marker == 0)
+ len = sizeof (gfc_offset);
+ 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)
- return swrite (dtp->u.p.current_unit->s, &buf, &len);
- else {
- gfc_offset p;
- reverse_memcpy (&p, &buf, sizeof (gfc_offset));
- return swrite (dtp->u.p.current_unit->s, &p, &len);
- }
+ {
+ switch (compile_options.record_marker)
+ {
+ 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);
+ break;
+
+ case sizeof (GFC_INTEGER_8):
+ buf8 = buf;
+ return swrite (dtp->u.p.current_unit->s, &buf8, &len);
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+ }
+ else
+ {
+ switch (compile_options.record_marker)
+ {
+ 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));
+ return swrite (dtp->u.p.current_unit->s, p, &len);
+ break;
+
+ case sizeof (GFC_INTEGER_8):
+ buf8 = buf;
+ reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_4));
+ return swrite (dtp->u.p.current_unit->s, p, &len);
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+ }
+
}
gfc_offset c, 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;
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 - sizeof (gfc_offset))
- == FAILURE)
+ if (sseek (dtp->u.p.current_unit->s, c - m - record_marker)
+ == FAILURE)
goto io_error;
if (write_us_marker (dtp, m) != 0)
/* Seek past the end of the current record. */
- if (sseek (dtp->u.p.current_unit->s, c + sizeof (gfc_offset)) == FAILURE)
+ if (sseek (dtp->u.p.current_unit->s, c + record_marker) == FAILURE)
goto io_error;
break;
jmp_buf eof_jump;
GFC_INTEGER_4 cf = dtp->common.flags;
+ if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+ *dtp->size = (GFC_INTEGER_4) dtp->u.p.size_used;
+
if (dtp->u.p.eor_condition)
{
generate_error (&dtp->common, ERROR_EOR, NULL);
OSDN Git Service
