void
st_open (st_parameter_open *opp)
{
unit_flags flags;
gfc_unit *u = NULL;
GFC_INTEGER_4 cf = opp->common.flags;
unit_convert conv;
library_start (&opp->common);
/* Decode options. */
flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED :
find_option (&opp->common, opp->access, opp->access_len,
access_opt, "Bad ACCESS parameter in OPEN statement");
flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED :
find_option (&opp->common, opp->action, opp->action_len,
action_opt, "Bad ACTION parameter in OPEN statement");
flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED :
find_option (&opp->common, opp->blank, opp->blank_len,
blank_opt, "Bad BLANK parameter in OPEN statement");
flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED :
find_option (&opp->common, opp->delim, opp->delim_len,
delim_opt, "Bad DELIM parameter in OPEN statement");
flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED :
find_option (&opp->common, opp->pad, opp->pad_len,
pad_opt, "Bad PAD parameter in OPEN statement");
flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
find_option (&opp->common, opp->decimal, opp->decimal_len,
decimal_opt, "Bad DECIMAL parameter in OPEN statement");
flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED :
find_option (&opp->common, opp->encoding, opp->encoding_len,
encoding_opt, "Bad ENCODING parameter in OPEN statement");
flags.async = !(cf & IOPARM_OPEN_HAS_ASYNCHRONOUS) ? ASYNC_UNSPECIFIED :
find_option (&opp->common, opp->asynchronous, opp->asynchronous_len,
async_opt, "Bad ASYNCHRONOUS parameter in OPEN statement");
flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED :
find_option (&opp->common, opp->round, opp->round_len,
round_opt, "Bad ROUND parameter in OPEN statement");
flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED :
find_option (&opp->common, opp->sign, opp->sign_len,
sign_opt, "Bad SIGN parameter in OPEN statement");
flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
find_option (&opp->common, opp->form, opp->form_len,
form_opt, "Bad FORM parameter in OPEN statement");
flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED :
find_option (&opp->common, opp->position, opp->position_len,
position_opt, "Bad POSITION parameter in OPEN statement");
flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED :
find_option (&opp->common, opp->status, opp->status_len,
status_opt, "Bad STATUS parameter in OPEN statement");
/* First, we check wether the convert flag has been set via environment
variable. This overrides the convert tag in the open statement. */
conv = get_unformatted_convert (opp->common.unit);
if (conv == GFC_CONVERT_NONE)
{
/* Nothing has been set by environment variable, check the convert tag. */
if (cf & IOPARM_OPEN_HAS_CONVERT)
conv = find_option (&opp->common, opp->convert, opp->convert_len,
convert_opt,
"Bad CONVERT parameter in OPEN statement");
else
conv = compile_options.convert;
}
/* We use big_endian, which is 0 on little-endian machines
and 1 on big-endian machines. */
switch (conv)
{
case GFC_CONVERT_NATIVE:
case GFC_CONVERT_SWAP:
break;
case GFC_CONVERT_BIG:
conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
break;
case GFC_CONVERT_LITTLE:
conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
break;
default:
internal_error (&opp->common, "Illegal value for CONVERT");
break;
}
flags.convert = conv;
if (flags.position != POSITION_UNSPECIFIED
&& flags.access == ACCESS_DIRECT)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot use POSITION with direct access files");
if (flags.access == ACCESS_APPEND)
{
if (flags.position != POSITION_UNSPECIFIED
&& flags.position != POSITION_APPEND)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Conflicting ACCESS and POSITION flags in"
" OPEN statement");
notify_std (&opp->common, GFC_STD_GNU,
"Extension: APPEND as a value for ACCESS in OPEN statement");
flags.access = ACCESS_SEQUENTIAL;
flags.position = POSITION_APPEND;
}
if (flags.position == POSITION_UNSPECIFIED)
flags.position = POSITION_ASIS;
if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
{
if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
opp->common.unit = get_unique_unit_number(opp);
else if (opp->common.unit < 0)
{
u = find_unit (opp->common.unit);
if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Bad unit number in OPEN statement");
}
if (u == NULL)
u = find_or_create_unit (opp->common.unit);
if (u->s == NULL)
{
u = new_unit (opp, u, &flags);
if (u != NULL)
unlock_unit (u);
}
else
already_open (opp, u, &flags);
}
if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)
&& (opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
*opp->newunit = opp->common.unit;
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 ();
}
