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_FORMATTED
)
153 formatted_backspace ();
155 unformatted_backspace ();