1 /* Copyright (C) 2002-2003 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
6 Libgfortran is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 Libgfortran is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with Libgfortran; see the file COPYING. If not, write to
18 the Free Software Foundation, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include "libgfortran.h"
25 /* backspace.c -- Implement the BACKSPACE statement */
27 /* formatted_backspace(void)-- Move the file back one line. The
28 * current position is after the newline that terminates the previous
29 * record, and we have to sift backwards to find the newline before
30 * that or the start of the file, whichever comes first. */
32 #define READ_CHUNK 4096
35 formatted_backspace (void)
41 base = file_position (current_unit->s) - 1;
45 n = (base < READ_CHUNK) ? base : READ_CHUNK;
48 p = salloc_r_at (current_unit->s, &n, base);
52 /* Because we've moved backwords from the current position, it
53 * should not be possible to get a short read. Because it isn't
54 * clear what to do about such thing, we ignore the possibility. */
56 /* There is no memrchr() in the C library, so we have to do it
74 /* base is the new pointer. Seek to it exactly */
77 if (sseek (current_unit->s, base) == FAILURE)
79 current_unit->last_record--;
84 generate_error (ERROR_OS, NULL);
88 /* unformatted_backspace()-- Move the file backwards for an
89 * unformatted sequential file. We are guaranteed to be between
90 * records on entry and we have to shift to the previous record. */
93 unformatted_backspace (void)
98 length = sizeof (gfc_offset);
100 p = (gfc_offset *) salloc_r_at (current_unit->s, &length,
101 file_position (current_unit->s) - length);
105 new = file_position (current_unit->s) - *p - length;
106 if (sseek (current_unit->s, new) == FAILURE)
109 current_unit->last_record--;
113 generate_error (ERROR_OS, NULL);
124 u = find_unit (ioparm.unit);
127 generate_error (ERROR_BAD_UNIT, NULL);
133 /* Ignore direct access. Non-advancing I/O is only allowed for
134 * formatted sequential I/O and the next direct access transfer
135 * repositions the file anyway. */
137 if (u->flags.access == ACCESS_DIRECT)
140 /* Check for special cases involving the ENDFILE record first */
142 if (u->endfile == AFTER_ENDFILE)
143 u->endfile = AT_ENDFILE;
146 if (u->current_record)
149 if (file_position (u->s) == 0)
150 goto done; /* Common special case */
152 if (u->flags.form == FORM_UNFORMATTED)
153 formatted_backspace ();
155 unformatted_backspace ();