void
st_open (void)
{
unit_flags flags;
gfc_unit *u = NULL;
library_start ();
/* Decode options. */
flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
find_option (ioparm.access, ioparm.access_len, access_opt,
"Bad ACCESS parameter in OPEN statement");
flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
find_option (ioparm.action, ioparm.action_len, action_opt,
"Bad ACTION parameter in OPEN statement");
flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
find_option (ioparm.blank, ioparm.blank_len, blank_opt,
"Bad BLANK parameter in OPEN statement");
flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
find_option (ioparm.delim, ioparm.delim_len, delim_opt,
"Bad DELIM parameter in OPEN statement");
flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
find_option (ioparm.pad, ioparm.pad_len, pad_opt,
"Bad PAD parameter in OPEN statement");
flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
find_option (ioparm.form, ioparm.form_len, form_opt,
"Bad FORM parameter in OPEN statement");
flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
find_option (ioparm.position, ioparm.position_len, position_opt,
"Bad POSITION parameter in OPEN statement");
flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
find_option (ioparm.status, ioparm.status_len, status_opt,
"Bad STATUS parameter in OPEN statement");
if (ioparm.unit < 0)
generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
if (flags.position != POSITION_UNSPECIFIED
&& flags.access == ACCESS_DIRECT)
generate_error (ERROR_BAD_OPTION,
"Cannot use POSITION with direct access files");
if (flags.position == POSITION_UNSPECIFIED)
flags.position = POSITION_ASIS;
if (ioparm.library_return != LIBRARY_OK)
{
library_end ();
return;
}
u = find_unit (ioparm.unit);
if (u == NULL)
new_unit (&flags);
else
already_open (u, &flags);
library_end ();
}
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 ();
}
