void
new_unit (unit_flags * flags)
{
gfc_unit *u;
stream *s;
char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
/* Change unspecifieds to defaults. Leave (flags->action ==
ACTION_UNSPECIFIED) alone so open_external() can set it based on
what type of open actually works. */
if (flags->access == ACCESS_UNSPECIFIED)
flags->access = ACCESS_SEQUENTIAL;
if (flags->form == FORM_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL)
? FORM_FORMATTED : FORM_UNFORMATTED;
if (flags->delim == DELIM_UNSPECIFIED)
flags->delim = DELIM_NONE;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (ERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto cleanup;
}
}
if (flags->blank == BLANK_UNSPECIFIED)
flags->blank = BLANK_NULL;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (ERROR_OPTION_CONFLICT,
"BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto cleanup;
}
}
if (flags->pad == PAD_UNSPECIFIED)
flags->pad = PAD_YES;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (ERROR_OPTION_CONFLICT,
"PAD paramter conflicts with UNFORMATTED form in "
"OPEN statement");
goto cleanup;
}
}
if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
{
generate_error (ERROR_OPTION_CONFLICT,
"ACCESS parameter conflicts with SEQUENTIAL access in "
"OPEN statement");
goto cleanup;
}
else
if (flags->position == POSITION_UNSPECIFIED)
flags->position = POSITION_ASIS;
if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN;
/* Checks. */
if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
{
generate_error (ERROR_MISSING_OPTION,
"Missing RECL parameter in OPEN statement");
goto cleanup;
}
if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
{
generate_error (ERROR_BAD_OPTION,
"RECL parameter is non-positive in OPEN statement");
goto cleanup;
}
switch (flags->status)
{
case STATUS_SCRATCH:
if (ioparm.file == NULL)
break;
generate_error (ERROR_BAD_OPTION,
"FILE parameter must not be present in OPEN statement");
return;
case STATUS_OLD:
case STATUS_NEW:
case STATUS_REPLACE:
case STATUS_UNKNOWN:
if (ioparm.file != NULL)
break;
ioparm.file = tmpname;
ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit);
break;
default:
internal_error ("new_unit(): Bad status");
}
/* Make sure the file isn't already open someplace else.
Do not error if opening file preconnected to stdin, stdout, stderr. */
u = find_file ();
if (u != NULL
&& (options.stdin_unit < 0 || u->unit_number != options.stdin_unit)
&& (options.stdout_unit < 0 || u->unit_number != options.stdout_unit)
&& (options.stderr_unit < 0 || u->unit_number != options.stderr_unit))
{
generate_error (ERROR_ALREADY_OPEN, NULL);
goto cleanup;
}
/* Open file. */
s = open_external (flags);
if (s == NULL)
{
generate_error (ERROR_OS, NULL);
goto cleanup;
}
if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
flags->status = STATUS_OLD;
/* Create the unit structure. */
u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
memset (u, '\0', sizeof (gfc_unit) + ioparm.file_len);
u->unit_number = ioparm.unit;
u->s = s;
u->flags = *flags;
if (flags->position == POSITION_APPEND)
{
if (sseek (u->s, file_length (u->s)) == FAILURE)
generate_error (ERROR_OS, NULL);
u->endfile = AT_ENDFILE;
}
/* Unspecified recl ends up with a processor dependent value. */
u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset;
u->last_record = 0;
u->current_record = 0;
/* If the file is direct access, calculate the maximum record number
via a division now instead of letting the multiplication overflow
later. */
if (flags->access == ACCESS_DIRECT)
u->maxrec = g.max_offset / u->recl;
memmove (u->file, ioparm.file, ioparm.file_len);
u->file_len = ioparm.file_len;
insert_unit (u);
/* The file is now connected. Errors after this point leave the
file connected. Curiously, the standard requires that the
position specifier be ignored for new files so a newly connected
file starts out that the initial point. We still need to figure
out if the file is at the end or not. */
test_endfile (u);
cleanup:
/* Free memory associated with a temporary filename. */
if (flags->status == STATUS_SCRATCH)
free_mem (ioparm.file);
}
gfc_unit *
new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
{
gfc_unit *u2;
stream *s;
char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
/* Change unspecifieds to defaults. Leave (flags->action ==
ACTION_UNSPECIFIED) alone so open_external() can set it based on
what type of open actually works. */
if (flags->access == ACCESS_UNSPECIFIED)
flags->access = ACCESS_SEQUENTIAL;
if (flags->form == FORM_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL)
? FORM_FORMATTED : FORM_UNFORMATTED;
if (flags->async == ASYNC_UNSPECIFIED)
flags->async = ASYNC_NO;
if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN;
/* Checks. */
if (flags->delim == DELIM_UNSPECIFIED)
flags->delim = DELIM_NONE;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
}
if (flags->blank == BLANK_UNSPECIFIED)
flags->blank = BLANK_NULL;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
}
if (flags->pad == PAD_UNSPECIFIED)
flags->pad = PAD_YES;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"PAD parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
}
if (flags->decimal == DECIMAL_UNSPECIFIED)
flags->decimal = DECIMAL_POINT;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"DECIMAL parameter conflicts with UNFORMATTED form "
"in OPEN statement");
goto fail;
}
}
if (flags->encoding == ENCODING_UNSPECIFIED)
flags->encoding = ENCODING_DEFAULT;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"ENCODING parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
}
/* NB: the value for ROUND when it's not specified by the user does not
have to be PROCESSOR_DEFINED; the standard says that it is
processor dependent, and requires that it is one of the
possible value (see F2003, 9.4.5.13). */
if (flags->round == ROUND_UNSPECIFIED)
flags->round = ROUND_PROCDEFINED;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"ROUND parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
}
if (flags->sign == SIGN_UNSPECIFIED)
flags->sign = SIGN_PROCDEFINED;
else
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"SIGN parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
}
if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"ACCESS parameter conflicts with SEQUENTIAL access in "
"OPEN statement");
goto fail;
}
else
if (flags->position == POSITION_UNSPECIFIED)
flags->position = POSITION_ASIS;
if (flags->access == ACCESS_DIRECT
&& (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0)
{
generate_error (&opp->common, LIBERROR_MISSING_OPTION,
"Missing RECL parameter in OPEN statement");
goto fail;
}
if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0)
{
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"RECL parameter is non-positive in OPEN statement");
goto fail;
}
switch (flags->status)
{
case STATUS_SCRATCH:
if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
{
opp->file = NULL;
break;
}
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"FILE parameter must not be present in OPEN statement");
goto fail;
case STATUS_OLD:
case STATUS_NEW:
case STATUS_REPLACE:
case STATUS_UNKNOWN:
if ((opp->common.flags & IOPARM_OPEN_HAS_FILE))
break;
opp->file = tmpname;
opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d",
(int) opp->common.unit);
break;
default:
internal_error (&opp->common, "new_unit(): Bad status");
}
/* Make sure the file isn't already open someplace else.
Do not error if opening file preconnected to stdin, stdout, stderr. */
u2 = NULL;
if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0)
u2 = find_file (opp->file, opp->file_len);
if (u2 != NULL
&& (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit)
&& (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit)
&& (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit))
{
unlock_unit (u2);
generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL);
goto cleanup;
}
if (u2 != NULL)
unlock_unit (u2);
/* Open file. */
s = open_external (opp, flags);
if (s == NULL)
{
char *path, *msg;
size_t msglen;
path = (char *) gfc_alloca (opp->file_len + 1);
msglen = opp->file_len + 51;
msg = (char *) gfc_alloca (msglen);
unpack_filename (path, opp->file, opp->file_len);
switch (errno)
{
case ENOENT:
snprintf (msg, msglen, "File '%s' does not exist", path);
break;
case EEXIST:
snprintf (msg, msglen, "File '%s' already exists", path);
break;
case EACCES:
snprintf (msg, msglen,
"Permission denied trying to open file '%s'", path);
break;
case EISDIR:
snprintf (msg, msglen, "'%s' is a directory", path);
break;
default:
msg = NULL;
}
generate_error (&opp->common, LIBERROR_OS, msg);
goto cleanup;
}
if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
flags->status = STATUS_OLD;
/* Create the unit structure. */
u->file = xmalloc (opp->file_len);
if (u->unit_number != opp->common.unit)
internal_error (&opp->common, "Unit number changed");
u->s = s;
u->flags = *flags;
u->read_bad = 0;
u->endfile = NO_ENDFILE;
u->last_record = 0;
u->current_record = 0;
u->mode = READING;
u->maxrec = 0;
u->bytes_left = 0;
u->saved_pos = 0;
if (flags->position == POSITION_APPEND)
{
if (sseek (u->s, 0, SEEK_END) < 0)
generate_error (&opp->common, LIBERROR_OS, NULL);
u->endfile = AT_ENDFILE;
}
/* Unspecified recl ends up with a processor dependent value. */
if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
{
u->flags.has_recl = 1;
u->recl = opp->recl_in;
u->recl_subrecord = u->recl;
u->bytes_left = u->recl;
}
else
{
u->flags.has_recl = 0;
u->recl = max_offset;
if (compile_options.max_subrecord_length)
{
u->recl_subrecord = compile_options.max_subrecord_length;
}
else
{
switch (compile_options.record_marker)
{
case 0:
/* Fall through */
case sizeof (GFC_INTEGER_4):
u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH;
break;
case sizeof (GFC_INTEGER_8):
u->recl_subrecord = max_offset - 16;
break;
default:
runtime_error ("Illegal value for record marker");
break;
}
}
}
/* If the file is direct access, calculate the maximum record number
via a division now instead of letting the multiplication overflow
later. */
if (flags->access == ACCESS_DIRECT)
u->maxrec = max_offset / u->recl;
if (flags->access == ACCESS_STREAM)
{
u->maxrec = max_offset;
u->recl = 1;
u->bytes_left = 1;
u->strm_pos = stell (u->s) + 1;
}
memmove (u->file, opp->file, opp->file_len);
u->file_len = opp->file_len;
/* Curiously, the standard requires that the
position specifier be ignored for new files so a newly connected
file starts out at the initial point. We still need to figure
out if the file is at the end or not. */
test_endfile (u);
if (flags->status == STATUS_SCRATCH && opp->file != NULL)
free (opp->file);
if (flags->form == FORM_FORMATTED)
{
if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
fbuf_init (u, u->recl);
else
fbuf_init (u, 0);
}
else
u->fbuf = NULL;
return u;
cleanup:
/* Free memory associated with a temporary filename. */
if (flags->status == STATUS_SCRATCH && opp->file != NULL)
free (opp->file);
fail:
close_unit (u);
return NULL;
}
static void
edit_modes (gfc_unit * u, unit_flags * flags)
{
/* Complain about attempts to change the unchangeable. */
if (flags->status != STATUS_UNSPECIFIED &&
u->flags.status != flags->position)
generate_error (ERROR_BAD_OPTION,
"Cannot change STATUS parameter in OPEN statement");
if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
generate_error (ERROR_BAD_OPTION,
"Cannot change ACCESS parameter in OPEN statement");
if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
generate_error (ERROR_BAD_OPTION,
"Cannot change FORM parameter in OPEN statement");
if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
generate_error (ERROR_BAD_OPTION,
"Cannot change RECL parameter in OPEN statement");
if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access)
generate_error (ERROR_BAD_OPTION,
"Cannot change ACTION parameter in OPEN statement");
/* Status must be OLD if present. */
if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
generate_error (ERROR_BAD_OPTION,
"OPEN statement must have a STATUS of OLD");
if (u->flags.form == FORM_UNFORMATTED)
{
if (flags->delim != DELIM_UNSPECIFIED)
generate_error (ERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->blank != BLANK_UNSPECIFIED)
generate_error (ERROR_OPTION_CONFLICT,
"BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->pad != PAD_UNSPECIFIED)
generate_error (ERROR_OPTION_CONFLICT,
"PAD paramter conflicts with UNFORMATTED form in "
"OPEN statement");
}
if (ioparm.library_return == LIBRARY_OK)
{
/* Change the changeable: */
if (flags->blank != BLANK_UNSPECIFIED)
u->flags.blank = flags->blank;
if (flags->delim != DELIM_UNSPECIFIED)
u->flags.delim = flags->delim;
if (flags->pad != PAD_UNSPECIFIED)
u->flags.pad = flags->pad;
}
/* Reposition the file if necessary. */
switch (flags->position)
{
case POSITION_UNSPECIFIED:
case POSITION_ASIS:
break;
case POSITION_REWIND:
if (sseek (u->s, 0) == FAILURE)
goto seek_error;
u->current_record = 0;
u->last_record = 0;
test_endfile (u); /* We might be at the end. */
break;
case POSITION_APPEND:
if (sseek (u->s, file_length (u->s)) == FAILURE)
goto seek_error;
u->current_record = 0;
u->endfile = AT_ENDFILE; /* We are at the end. */
break;
seek_error:
generate_error (ERROR_OS, NULL);
break;
}
}
static void
edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
{
/* Complain about attempts to change the unchangeable. */
if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
u->flags.status != flags->status)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot change STATUS parameter in OPEN statement");
if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot change ACCESS parameter in OPEN statement");
if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot change FORM parameter in OPEN statement");
if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)
&& opp->recl_in != u->recl)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot change RECL parameter in OPEN statement");
if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action)
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Cannot change ACTION parameter in OPEN statement");
/* Status must be OLD if present. */
if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
flags->status != STATUS_UNKNOWN)
{
if (flags->status == STATUS_SCRATCH)
notify_std (&opp->common, GFC_STD_GNU,
"OPEN statement must have a STATUS of OLD or UNKNOWN");
else
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"OPEN statement must have a STATUS of OLD or UNKNOWN");
}
if (u->flags.form == FORM_UNFORMATTED)
{
if (flags->delim != DELIM_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->blank != BLANK_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->pad != PAD_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"PAD parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->decimal != DECIMAL_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"DECIMAL parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->encoding != ENCODING_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"ENCODING parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->round != ROUND_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"ROUND parameter conflicts with UNFORMATTED form in "
"OPEN statement");
if (flags->sign != SIGN_UNSPECIFIED)
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"SIGN parameter conflicts with UNFORMATTED form in "
"OPEN statement");
}
if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
{
/* Change the changeable: */
if (flags->blank != BLANK_UNSPECIFIED)
u->flags.blank = flags->blank;
if (flags->delim != DELIM_UNSPECIFIED)
u->flags.delim = flags->delim;
if (flags->pad != PAD_UNSPECIFIED)
u->flags.pad = flags->pad;
if (flags->decimal != DECIMAL_UNSPECIFIED)
u->flags.decimal = flags->decimal;
if (flags->encoding != ENCODING_UNSPECIFIED)
u->flags.encoding = flags->encoding;
if (flags->async != ASYNC_UNSPECIFIED)
u->flags.async = flags->async;
if (flags->round != ROUND_UNSPECIFIED)
u->flags.round = flags->round;
if (flags->sign != SIGN_UNSPECIFIED)
u->flags.sign = flags->sign;
}
/* Reposition the file if necessary. */
switch (flags->position)
{
case POSITION_UNSPECIFIED:
case POSITION_ASIS:
break;
case POSITION_REWIND:
if (sseek (u->s, 0, SEEK_SET) != 0)
goto seek_error;
u->current_record = 0;
u->last_record = 0;
test_endfile (u);
break;
case POSITION_APPEND:
if (sseek (u->s, 0, SEEK_END) < 0)
goto seek_error;
if (flags->access != ACCESS_STREAM)
u->current_record = 0;
u->endfile = AT_ENDFILE; /* We are at the end. */
break;
seek_error:
generate_error (&opp->common, LIBERROR_OS, NULL);
break;
}
unlock_unit (u);
}
