void
st_rewind (st_parameter_filepos *fpp)
{
gfc_unit *u;
library_start (&fpp->common);
u = find_unit (fpp->common.unit);
if (u != NULL)
{
if (u->flags.access == ACCESS_DIRECT)
generate_error (&fpp->common, LIBERROR_BAD_OPTION,
"Cannot REWIND a file opened for DIRECT access");
else
{
/* If there are previously written bytes from a write with ADVANCE="no",
add a record marker before performing the ENDFILE. */
if (u->previous_nonadvancing_write)
finish_last_advance_record (u);
u->previous_nonadvancing_write = 0;
fbuf_reset (u);
u->last_record = 0;
if (sseek (u->s, 0, SEEK_SET) < 0)
generate_error (&fpp->common, LIBERROR_OS, NULL);
/* Handle special files like /dev/null differently. */
if (!is_special (u->s))
{
/* We are rewinding so we are not at the end. */
u->endfile = NO_ENDFILE;
}
else
{
/* Set this for compatibilty with g77 for /dev/null. */
if (file_length (u->s) == 0 && stell (u->s) == 0)
u->endfile = AT_ENDFILE;
/* Future refinements on special files can go here. */
}
u->current_record = 0;
u->strm_pos = 1;
u->read_bad = 0;
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
unlock_unit (u);
}
library_end ();
}
void
st_endfile (st_parameter_filepos *fpp)
{
gfc_unit *u;
library_start (&fpp->common);
u = find_unit (fpp->common.unit);
if (u != NULL)
{
if (u->flags.access == ACCESS_DIRECT)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot perform ENDFILE on a file opened"
" for DIRECT access");
goto done;
}
/* If there are previously written bytes from a write with ADVANCE="no",
add a record marker before performing the ENDFILE. */
if (u->previous_nonadvancing_write)
finish_last_advance_record (u);
u->previous_nonadvancing_write = 0;
if (u->current_record)
{
st_parameter_dt dtp;
dtp.common = fpp->common;
memset (&dtp.u.p, 0, sizeof (dtp.u.p));
dtp.u.p.current_unit = u;
next_record (&dtp, 1);
}
unit_truncate (u, stell (u->s), &fpp->common);
u->endfile = AFTER_ENDFILE;
if (0 == stell (u->s))
u->flags.position = POSITION_REWIND;
done:
unlock_unit (u);
}
library_end ();
}
void
st_backspace (st_parameter_filepos *fpp)
{
gfc_unit *u;
library_start (&fpp->common);
u = find_unit (fpp->common.unit);
if (u == NULL)
{
generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
goto done;
}
/* Direct access is prohibited, and so is unformatted stream access. */
if (u->flags.access == ACCESS_DIRECT)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot BACKSPACE a file opened for DIRECT access");
goto done;
}
if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot BACKSPACE an unformatted stream file");
goto done;
}
/* Make sure format buffer is flushed and reset. */
if (u->flags.form == FORM_FORMATTED)
{
int pos = fbuf_reset (u);
if (pos != 0)
sseek (u->s, pos, SEEK_CUR);
}
/* Check for special cases involving the ENDFILE record first. */
if (u->endfile == AFTER_ENDFILE)
{
u->endfile = AT_ENDFILE;
u->flags.position = POSITION_APPEND;
sflush (u->s);
}
else
{
if (stell (u->s) == 0)
{
u->flags.position = POSITION_REWIND;
goto done; /* Common special case */
}
if (u->mode == WRITING)
{
/* If there are previously written bytes from a write with
ADVANCE="no", add a record marker before performing the
BACKSPACE. */
if (u->previous_nonadvancing_write)
finish_last_advance_record (u);
u->previous_nonadvancing_write = 0;
unit_truncate (u, stell (u->s), &fpp->common);
u->mode = READING;
}
if (u->flags.form == FORM_FORMATTED)
formatted_backspace (fpp, u);
else
unformatted_backspace (fpp, u);
u->flags.position = POSITION_UNSPECIFIED;
u->endfile = NO_ENDFILE;
u->current_record = 0;
u->bytes_left = 0;
}
done:
if (u != NULL)
unlock_unit (u);
library_end ();
}
void
st_endfile (st_parameter_filepos *fpp)
{
gfc_unit *u;
library_start (&fpp->common);
u = find_unit (fpp->common.unit);
if (u != NULL)
{
if (u->flags.access == ACCESS_DIRECT)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot perform ENDFILE on a file opened "
"for DIRECT access");
goto done;
}
if (u->flags.access == ACCESS_SEQUENTIAL
&& u->endfile == AFTER_ENDFILE)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
"Cannot perform ENDFILE on a file already "
"positioned after the EOF marker");
goto done;
}
/* If there are previously written bytes from a write with ADVANCE="no",
add a record marker before performing the ENDFILE. */
if (u->previous_nonadvancing_write)
finish_last_advance_record (u);
u->previous_nonadvancing_write = 0;
if (u->current_record)
{
st_parameter_dt dtp;
dtp.common = fpp->common;
memset (&dtp.u.p, 0, sizeof (dtp.u.p));
dtp.u.p.current_unit = u;
next_record (&dtp, 1);
}
unit_truncate (u, stell (u->s), &fpp->common);
u->endfile = AFTER_ENDFILE;
if (0 == stell (u->s))
u->flags.position = POSITION_REWIND;
}
else
{
if (fpp->common.unit < 0)
{
generate_error (&fpp->common, LIBERROR_BAD_OPTION,
"Bad unit number in statement");
return;
}
u = find_or_create_unit (fpp->common.unit);
if (u->s == NULL)
{
/* Open the unit with some default flags. */
st_parameter_open opp;
unit_flags u_flags;
memset (&u_flags, '\0', sizeof (u_flags));
u_flags.access = ACCESS_SEQUENTIAL;
u_flags.action = ACTION_READWRITE;
/* Is it unformatted? */
if (!(fpp->common.flags & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT
| IOPARM_DT_IONML_SET)))
u_flags.form = FORM_UNFORMATTED;
else
u_flags.form = FORM_UNSPECIFIED;
u_flags.delim = DELIM_UNSPECIFIED;
u_flags.blank = BLANK_UNSPECIFIED;
u_flags.pad = PAD_UNSPECIFIED;
u_flags.decimal = DECIMAL_UNSPECIFIED;
u_flags.encoding = ENCODING_UNSPECIFIED;
u_flags.async = ASYNC_UNSPECIFIED;
u_flags.round = ROUND_UNSPECIFIED;
u_flags.sign = SIGN_UNSPECIFIED;
u_flags.status = STATUS_UNKNOWN;
u_flags.convert = GFC_CONVERT_NATIVE;
opp.common = fpp->common;
opp.common.flags &= IOPARM_COMMON_MASK;
u = new_unit (&opp, u, &u_flags);
if (u == NULL)
return;
u->endfile = AFTER_ENDFILE;
}
}
done:
unlock_unit (u);
library_end ();
}
