static void already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) { if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) { edit_modes (opp, u, flags); return; } /* If the file is connected to something else, close it and open a new unit. */ if (!compare_file_filename (u, opp->file, opp->file_len)) { #if !HAVE_UNLINK_OPEN_FILE char *path = NULL; if (u->file && u->flags.status == STATUS_SCRATCH) { path = (char *) gfc_alloca (u->file_len + 1); unpack_filename (path, u->file, u->file_len); } #endif if (sclose (u->s) == FAILURE) { unlock_unit (u); generate_error (&opp->common, LIBERROR_OS, "Error closing file in OPEN statement"); return; } u->s = NULL; if (u->file) free_mem (u->file); u->file = NULL; u->file_len = 0; #if !HAVE_UNLINK_OPEN_FILE if (path != NULL) unlink (path); #endif u = new_unit (opp, u, flags); if (u != NULL) unlock_unit (u); return; } edit_modes (opp, u, flags); }
int PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len) { int ret; gfc_unit * u = find_unit (*unit); if (u == NULL) return -1; fbuf_reset (u); if (u->mode == WRITING) { sflush (u->s); u->mode = READING; } memset (c, ' ', c_len); ret = sread (u->s, c, 1); unlock_unit (u); if (ret < 0) return ret; if (ret != 1) return -1; else return 0; }
void st_inquire (st_parameter_inquire *iqp) { gfc_unit *u; library_start (&iqp->common); if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0) { u = find_unit (iqp->common.unit); inquire_via_unit (iqp, u); } else { u = find_file (iqp->file, iqp->file_len); if (u == NULL) inquire_via_filename (iqp); else inquire_via_unit (iqp, u); } if (u != NULL) unlock_unit (u); library_end (); }
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 (); }
static gfc_offset gf_ftell (int unit) { gfc_unit * u = find_unit (unit); if (u == NULL) return -1; int pos = fbuf_reset (u); if (pos != 0) sseek (u->s, pos, SEEK_CUR); gfc_offset ret = stell (u->s); unlock_unit (u); return ret; }
static void already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) { if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) { edit_modes (opp, u, flags); return; } /* If the file is connected to something else, close it and open a new unit. */ if (!compare_file_filename (u, opp->file, opp->file_len)) { if (sclose (u->s) == -1) { unlock_unit (u); generate_error (&opp->common, LIBERROR_OS, "Error closing file in OPEN statement"); return; } u->s = NULL; #if !HAVE_UNLINK_OPEN_FILE if (u->filename && u->flags.status == STATUS_SCRATCH) remove (u->filename); #endif free (u->filename); u->filename = NULL; u = new_unit (opp, u, flags); if (u != NULL) unlock_unit (u); return; } edit_modes (opp, u, flags); }
GFC_LOGICAL_8 isatty_l8 (int *unit) { gfc_unit *u; GFC_LOGICAL_8 ret = 0; u = find_unit (*unit); if (u != NULL) { ret = (GFC_LOGICAL_8) stream_isatty (u->s); unlock_unit (u); } return ret; }
void ttynam (char ** name, gfc_charlen_type * name_len, int unit) { gfc_unit *u; u = find_unit (unit); if (u != NULL) { *name = xmalloc (TTY_NAME_MAX); int err = stream_ttyname (u->s, *name, TTY_NAME_MAX); if (err == 0) { *name_len = strlen (*name); unlock_unit (u); return; } free (*name); unlock_unit (u); } *name_len = 0; *name = NULL; }
void fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status) { gfc_unit * u = find_unit (*unit); ssize_t result = -1; if (u != NULL) { result = sseek(u->s, *offset, *whence); unlock_unit (u); } if (status) *status = (result < 0 ? -1 : 0); }
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 flush_i8 (GFC_INTEGER_8 *unit) { gfc_unit *us; /* flush all streams */ if (unit == NULL) flush_all_units (); else { us = find_unit (*unit); if (us != NULL) { sflush (us->s); unlock_unit (us); } } }
void ttynam_sub (int *unit, char * name, gfc_charlen_type name_len) { gfc_unit *u; int nlen; int err = 1; u = find_unit (*unit); if (u != NULL) { err = stream_ttyname (u->s, name, name_len); if (err == 0) { nlen = strlen (name); memset (&name[nlen], ' ', name_len - nlen); } unlock_unit (u); } if (err != 0) memset (name, ' ', name_len); }
int PREFIX(fputc) (const int * unit, char * c, gfc_charlen_type c_len __attribute__((unused))) { ssize_t s; gfc_unit * u = find_unit (*unit); if (u == NULL) return -1; fbuf_reset (u); if (u->mode == READING) { sflush (u->s); u->mode = WRITING; } s = swrite (u->s, c, 1); unlock_unit (u); if (s < 0) return -1; return 0; }
void st_flush (st_parameter_filepos *fpp) { gfc_unit *u; library_start (&fpp->common); u = find_unit (fpp->common.unit); if (u != NULL) { /* Make sure format buffer is flushed. */ if (u->flags.form == FORM_FORMATTED) fbuf_flush (u, u->mode); sflush (u->s); unlock_unit (u); } else /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */ generate_error (&fpp->common, LIBERROR_BAD_OPTION, "Specified UNIT in FLUSH is not connected"); 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 (); }
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 (); }
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 (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); }
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 (); }