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 (); }