Update copyright years.

[thirdparty/gcc.git] / libgfortran / io / file_pos.c

diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 2caf601453dfd41757d8642cbc31030aa6e320a2..2bc05b293f8c1cb75347c588b08b2b26668029de 100644 (file)
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -1,5 +1,4 @@
-/* Copyright (C) 2002-2003, 2005, 2006, 2007, 2009, 2010
-   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).
@@ -26,6 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #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,
@@ -37,7 +37,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
    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)
@@ -83,7 +83,7 @@ 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:
@@ -104,6 +104,11 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
   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);
@@ -119,7 +124,7 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
         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)
            {
@@ -140,15 +145,21 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
        }
       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;
 
@@ -182,6 +193,7 @@ void
 st_backspace (st_parameter_filepos *fpp)
 {
   gfc_unit *u;
+  bool needs_unlock = false;
 
   library_start (&fpp->common);
 
@@ -209,6 +221,17 @@ st_backspace (st_parameter_filepos *fpp)
       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)
     {
@@ -262,7 +285,12 @@ st_backspace (st_parameter_filepos *fpp)
 
  done:
   if (u != NULL)
-    unlock_unit (u);
+    {
+      unlock_unit (u);
+
+      if (ASYNC_IO && u->au && needs_unlock)
+       UNLOCK (&u->au->io_lock);
+    }
 
   library_end ();
 }
@@ -275,6 +303,7 @@ void
 st_endfile (st_parameter_filepos *fpp)
 {
   gfc_unit *u;
+  bool needs_unlock = false;
 
   library_start (&fpp->common);
 
@@ -289,6 +318,17 @@ st_endfile (st_parameter_filepos *fpp)
          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)
        {
@@ -317,6 +357,7 @@ st_endfile (st_parameter_filepos *fpp)
 
       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;
     }
@@ -357,6 +398,8 @@ st_endfile (st_parameter_filepos *fpp)
          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;
@@ -364,11 +407,15 @@ st_endfile (st_parameter_filepos *fpp)
          if (u == NULL)
            return;
          u->endfile = AFTER_ENDFILE;
+         u->last_char = EOF - 1;
        }
     }
 
-  done:
-    unlock_unit (u);
+ done:
+  if (ASYNC_IO && u->au && needs_unlock)
+    UNLOCK (&u->au->io_lock);
+
+  unlock_unit (u);
 
   library_end ();
 }
@@ -381,6 +428,7 @@ void
 st_rewind (st_parameter_filepos *fpp)
 {
   gfc_unit *u;
+  bool needs_unlock = true;
 
   library_start (&fpp->common);
 
@@ -392,6 +440,17 @@ st_rewind (st_parameter_filepos *fpp)
                        "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.  */
 
@@ -405,10 +464,14 @@ st_rewind (st_parameter_filepos *fpp)
          u->last_record = 0;
 
          if (sseek (u->s, 0, SEEK_SET) < 0)
-           generate_error (&fpp->common, LIBERROR_OS, NULL);
+           {
+             generate_error (&fpp->common, LIBERROR_OS, NULL);
+             library_end ();
+             return;
+           }
 
          /* Set this for compatibilty with g77 for /dev/null.  */
-         if (file_length (u->s) == 0)
+         if (ssize (u->s) == 0)
            u->endfile = AT_ENDFILE;
          else
            {
@@ -419,9 +482,14 @@ st_rewind (st_parameter_filepos *fpp)
          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);
     }
 
@@ -436,23 +504,39 @@ void
 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 ();
 }