-/* Copyright (C) 2002-2003, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2003, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught and Janne Blomqvist
This file is part of the GNU Fortran runtime library (libgfortran).
You should have received a copy of the GNU General Public License
along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include "config.h"
#include <string.h>
ENDFILE, and REWIND as well as the FLUSH statement. */
-/* formatted_backspace(void)-- Move the file back one line. The
+/* formatted_backspace(fpp, u)-- Move the file back one line. The
current position is after the newline that terminates the previous
record, and we have to sift backwards to find the newline before
that or the start of the file, whichever comes first. */
#define READ_CHUNK 4096
static void
-formatted_backspace (void)
+formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
{
gfc_offset base;
char *p;
int n;
- base = file_position (current_unit->s) - 1;
+ base = file_position (u->s) - 1;
do
{
n = (base < READ_CHUNK) ? base : READ_CHUNK;
base -= n;
- p = salloc_r_at (current_unit->s, &n, base);
+ p = salloc_r_at (u->s, &n, base);
if (p == NULL)
goto io_error;
/* base is the new pointer. Seek to it exactly. */
done:
- if (sseek (current_unit->s, base) == FAILURE)
+ if (sseek (u->s, base) == FAILURE)
goto io_error;
- current_unit->last_record--;
- current_unit->endfile = NO_ENDFILE;
+ u->last_record--;
+ u->endfile = NO_ENDFILE;
return;
io_error:
- generate_error (ERROR_OS, NULL);
+ generate_error (&fpp->common, ERROR_OS, NULL);
}
-/* unformatted_backspace() -- Move the file backwards for an unformatted
+/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
sequential file. We are guaranteed to be between records on entry and
we have to shift to the previous record. */
static void
-unformatted_backspace (void)
+unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
{
gfc_offset m, new;
- int length;
+ GFC_INTEGER_4 m4;
+ GFC_INTEGER_8 m8;
+ int length, length_read;
char *p;
- length = sizeof (gfc_offset);
+ if (compile_options.record_marker == 0)
+ length = sizeof (gfc_offset);
+ else
+ length = compile_options.record_marker;
+
+ length_read = length;
- p = salloc_r_at (current_unit->s, &length,
- file_position (current_unit->s) - length);
- if (p == NULL)
+ p = salloc_r_at (u->s, &length_read,
+ file_position (u->s) - length);
+ if (p == NULL || length_read != length)
goto io_error;
- memcpy (&m, p, sizeof (gfc_offset));
- new = file_position (current_unit->s) - m - 2*length;
- if (sseek (current_unit->s, new) == FAILURE)
+ /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
+ if (u->flags.convert == CONVERT_NATIVE)
+ {
+ switch (compile_options.record_marker)
+ {
+ case 0:
+ memcpy (&m, p, sizeof(gfc_offset));
+ break;
+
+ case sizeof(GFC_INTEGER_4):
+ memcpy (&m4, p, sizeof (m4));
+ m = m4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ memcpy (&m8, p, sizeof (m8));
+ m = m8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+ }
+ else
+ {
+ switch (compile_options.record_marker)
+ {
+ case 0:
+ reverse_memcpy (&m, p, sizeof(gfc_offset));
+ break;
+
+ case sizeof(GFC_INTEGER_4):
+ reverse_memcpy (&m4, p, sizeof (m4));
+ m = m4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ reverse_memcpy (&m8, p, sizeof (m8));
+ m = m8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+
+ }
+
+ if ((new = file_position (u->s) - m - 2*length) < 0)
+ new = 0;
+
+ if (sseek (u->s, new) == FAILURE)
goto io_error;
- current_unit->last_record--;
+ u->last_record--;
return;
io_error:
- generate_error (ERROR_OS, NULL);
+ generate_error (&fpp->common, ERROR_OS, NULL);
}
-extern void st_backspace (void);
+extern void st_backspace (st_parameter_filepos *);
export_proto(st_backspace);
void
-st_backspace (void)
+st_backspace (st_parameter_filepos *fpp)
{
gfc_unit *u;
- library_start ();
+ library_start (&fpp->common);
- u = find_unit (ioparm.unit);
+ u = find_unit (fpp->common.unit);
if (u == NULL)
{
- generate_error (ERROR_BAD_UNIT, NULL);
+ generate_error (&fpp->common, ERROR_BAD_UNIT, NULL);
goto done;
}
- current_unit = u;
-
/* Ignore direct access. Non-advancing I/O is only allowed for formatted
sequential I/O and the next direct access transfer repositions the file
anyway. */
- if (u->flags.access == ACCESS_DIRECT)
+ if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM)
goto done;
/* Check for special cases involving the ENDFILE record first. */
if (u->endfile == AFTER_ENDFILE)
- u->endfile = AT_ENDFILE;
+ {
+ u->endfile = AT_ENDFILE;
+ flush (u->s);
+ struncate (u->s);
+ }
else
{
if (file_position (u->s) == 0)
}
if (u->flags.form == FORM_FORMATTED)
- formatted_backspace ();
+ formatted_backspace (fpp, u);
else
- unformatted_backspace ();
+ unformatted_backspace (fpp, u);
u->endfile = NO_ENDFILE;
u->current_record = 0;
+ u->bytes_left = 0;
}
done:
+ if (u != NULL)
+ unlock_unit (u);
+
library_end ();
}
-extern void st_endfile (void);
+extern void st_endfile (st_parameter_filepos *);
export_proto(st_endfile);
void
-st_endfile (void)
+st_endfile (st_parameter_filepos *fpp)
{
gfc_unit *u;
- library_start ();
+ library_start (&fpp->common);
- u = get_unit (0);
+ u = find_unit (fpp->common.unit);
if (u != NULL)
{
- current_unit = u; /* next_record() needs this set. */
if (u->current_record)
- next_record (1);
+ {
+ 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);
+ }
- flush(u->s);
+ flush (u->s);
struncate (u->s);
u->endfile = AFTER_ENDFILE;
+ unlock_unit (u);
}
library_end ();
}
-extern void st_rewind (void);
+extern void st_rewind (st_parameter_filepos *);
export_proto(st_rewind);
void
-st_rewind (void)
+st_rewind (st_parameter_filepos *fpp)
{
gfc_unit *u;
- library_start ();
+ library_start (&fpp->common);
- u = find_unit (ioparm.unit);
+ u = find_unit (fpp->common.unit);
if (u != NULL)
{
- if (u->flags.access != ACCESS_SEQUENTIAL)
- generate_error (ERROR_BAD_OPTION,
+ if (u->flags.access == ACCESS_DIRECT)
+ generate_error (&fpp->common, ERROR_BAD_OPTION,
"Cannot REWIND a file opened for DIRECT access");
else
{
- /* If we have been writing to the file, the last written record
- is the last record in the file, so truncate the file now.
- Reset to read mode so two consecutive rewind statements do not
- delete the file contents. Flush buffer when switching mode. */
- if (u->mode == WRITING)
- {
- flush (u->s);
- struncate (u->s);
- }
+ /* Flush the buffers. If we have been writing to the file, the last
+ written record is the last record in the file, so truncate the
+ file now. Reset to read mode so two consecutive rewind
+ statements do not delete the file contents. */
+ flush (u->s);
+ if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
+ struncate (u->s);
+
u->mode = READING;
u->last_record = 0;
if (sseek (u->s, 0) == FAILURE)
- generate_error (ERROR_OS, NULL);
+ generate_error (&fpp->common, ERROR_OS, NULL);
u->endfile = NO_ENDFILE;
u->current_record = 0;
+ u->bytes_left = 0;
+ u->read_bad = 0;
test_endfile (u);
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
+ unlock_unit (u);
}
library_end ();
}
-extern void st_flush (void);
+extern void st_flush (st_parameter_filepos *);
export_proto(st_flush);
void
-st_flush (void)
+st_flush (st_parameter_filepos *fpp)
{
gfc_unit *u;
- library_start ();
+ library_start (&fpp->common);
- u = get_unit (0);
+ u = find_unit (fpp->common.unit);
if (u != NULL)
{
- current_unit = u; /* Just to be sure. */
- flush(u->s);
+ flush (u->s);
+ unlock_unit (u);
}
+ else
+ /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */
+ generate_error (&fpp->common, ERROR_BAD_OPTION,
+ "Specified UNIT in FLUSH is not connected");
library_end ();
}