-/* Copyright (C) 2002-2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2024 Free Software Foundation, Inc.
Contributed by Andy Vaught and Janne Blomqvist
This file is part of the GNU Fortran runtime library (libgfortran).
#include "io.h"
#include "fbuf.h"
#include "unix.h"
+#include "async.h"
#include <string.h>
/* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
record, and we have to sift backwards to find the newline before
that or the start of the file, whichever comes first. */
-static const int READ_CHUNK = 4096;
+#define READ_CHUNK 4096
static void
formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
goto io_error;
u->last_record--;
u->endfile = NO_ENDFILE;
-
+ u->last_char = EOF - 1;
return;
io_error:
ssize_t length;
int continued;
char p[sizeof (GFC_INTEGER_8)];
+ int convert = u->flags.convert;
+
+#ifdef HAVE_GFC_REAL_17
+ convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+#endif
if (compile_options.record_marker == 0)
length = sizeof (GFC_INTEGER_4);
goto io_error;
/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
- if (likely (u->flags.convert == GFC_CONVERT_NATIVE))
+ if (likely (convert == GFC_CONVERT_NATIVE))
{
switch (length)
{
}
else
{
+ uint32_t u32;
+ uint64_t u64;
switch (length)
{
case sizeof(GFC_INTEGER_4):
- reverse_memcpy (&m4, p, sizeof (m4));
+ memcpy (&u32, p, sizeof (u32));
+ u32 = __builtin_bswap32 (u32);
+ memcpy (&m4, &u32, sizeof (m4));
m = m4;
break;
case sizeof(GFC_INTEGER_8):
- reverse_memcpy (&m8, p, sizeof (m8));
+ memcpy (&u64, p, sizeof (u64));
+ u64 = __builtin_bswap64 (u64);
+ memcpy (&m8, &u64, sizeof (m8));
m = m8;
break;
st_backspace (st_parameter_filepos *fpp)
{
gfc_unit *u;
+ bool needs_unlock = false;
library_start (&fpp->common);
goto done;
}
+ if (ASYNC_IO && u->au)
+ {
+ if (async_wait (&(fpp->common), u->au))
+ return;
+ else
+ {
+ needs_unlock = true;
+ LOCK (&u->au->io_lock);
+ }
+ }
+
/* Make sure format buffer is flushed and reset. */
if (u->flags.form == FORM_FORMATTED)
{
done:
if (u != NULL)
- unlock_unit (u);
+ {
+ unlock_unit (u);
+
+ if (ASYNC_IO && u->au && needs_unlock)
+ UNLOCK (&u->au->io_lock);
+ }
library_end ();
}
st_endfile (st_parameter_filepos *fpp)
{
gfc_unit *u;
+ bool needs_unlock = false;
library_start (&fpp->common);
if (u->flags.access == ACCESS_DIRECT)
{
generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
- "Cannot perform ENDFILE on a file opened"
- " for DIRECT access");
+ "Cannot perform ENDFILE on a file opened "
+ "for DIRECT access");
+ goto done;
+ }
+
+ if (ASYNC_IO && u->au)
+ {
+ if (async_wait (&(fpp->common), u->au))
+ return;
+ else
+ {
+ needs_unlock = true;
+ LOCK (&u->au->io_lock);
+ }
+ }
+
+ 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;
}
unit_truncate (u, stell (u->s), &fpp->common);
u->endfile = AFTER_ENDFILE;
+ u->last_char = EOF - 1;
if (0 == stell (u->s))
u->flags.position = POSITION_REWIND;
- done:
- unlock_unit (u);
}
+ 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;
+ u_flags.share = SHARE_UNSPECIFIED;
+ u_flags.cc = CC_UNSPECIFIED;
+
+ 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;
+ u->last_char = EOF - 1;
+ }
+ }
+
+ done:
+ if (ASYNC_IO && u->au && needs_unlock)
+ UNLOCK (&u->au->io_lock);
+
+ unlock_unit (u);
library_end ();
}
st_rewind (st_parameter_filepos *fpp)
{
gfc_unit *u;
+ bool needs_unlock = true;
library_start (&fpp->common);
"Cannot REWIND a file opened for DIRECT access");
else
{
+ if (ASYNC_IO && u->au)
+ {
+ if (async_wait (&(fpp->common), u->au))
+ return;
+ else
+ {
+ needs_unlock = true;
+ LOCK (&u->au->io_lock);
+ }
+ }
+
/* If there are previously written bytes from a write with ADVANCE="no",
add a record marker before performing the ENDFILE. */
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;
+ generate_error (&fpp->common, LIBERROR_OS, NULL);
+ library_end ();
+ return;
}
+
+ /* Set this for compatibilty with g77 for /dev/null. */
+ if (ssize (u->s) == 0)
+ u->endfile = AT_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. */
+ /* We are rewinding so we are not at the end. */
+ u->endfile = NO_ENDFILE;
}
-
+
u->current_record = 0;
u->strm_pos = 1;
u->read_bad = 0;
+ u->last_char = EOF - 1;
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
+
+ if (ASYNC_IO && u->au && needs_unlock)
+ UNLOCK (&u->au->io_lock);
+
unlock_unit (u);
}
st_flush (st_parameter_filepos *fpp)
{
gfc_unit *u;
+ bool needs_unlock = false;
library_start (&fpp->common);
u = find_unit (fpp->common.unit);
if (u != NULL)
{
+ if (ASYNC_IO && u->au)
+ {
+ if (async_wait (&(fpp->common), u->au))
+ return;
+ else
+ {
+ needs_unlock = true;
+ LOCK (&u->au->io_lock);
+ }
+ }
+
/* Make sure format buffer is flushed. */
if (u->flags.form == FORM_FORMATTED)
fbuf_flush (u, u->mode);
sflush (u->s);
+ u->last_char = EOF - 1;
unlock_unit (u);
}
else
/* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */
- generate_error (&fpp->common, LIBERROR_BAD_OPTION,
+ generate_error (&fpp->common, -LIBERROR_BAD_UNIT,
"Specified UNIT in FLUSH is not connected");
+ if (needs_unlock)
+ UNLOCK (&u->au->io_lock);
+
library_end ();
}
projects / thirdparty / gcc.git / blobdiff