Implement CONVERT specifier for OPEN.

This patch, based on Jakub's work, implements the CONVERT
specifier for the power-ieee128 brach.  It allows specifying
the conversion as r16_ieee,big_endian and the other way around,
based on a table.  Setting the conversion via environment
variable and via program option does not yet work.

gcc/ChangeLog:

	* flag-types.h (enum gfc_convert): Add flags for
	conversion.

gcc/fortran/ChangeLog:

	* libgfortran.h (unit_convert): Add flags.

libgfortran/ChangeLog:

	* Makefile.in: Regenerate.
	* io/file_pos.c (unformatted_backspace): Mask off
	R16 parts for convert.
	* io/inquire.c (inquire_via_unit): Add cases for
	R16 parts.
	* io/open.c (st_open): Add cases for R16 conversion.
	* io/transfer.c (unformatted_read): Adjust for R16 conversions.
	(unformatted_write): Likewise.
	(us_read): Mask of R16 bits.
	(data_transfer_init): Likewiese.
	(write_us_marker): Likewise.

diff --git a/gcc/flag-types.h b/gcc/flag-types.h
index cfd2a5f6f50211093509f692acef47a9c717d515..345592aea6d6fa4d5ff9949fefabe8f69485d831 100644 (file)
--- a/gcc/flag-types.h
+++ b/gcc/flag-types.h
@@ -424,7 +424,15 @@ enum gfc_convert
   GFC_FLAG_CONVERT_NATIVE = 0,
   GFC_FLAG_CONVERT_SWAP,
   GFC_FLAG_CONVERT_BIG,
-  GFC_FLAG_CONVERT_LITTLE
+  GFC_FLAG_CONVERT_LITTLE,
+  GFC_FLAG_CONVERT_R16_IEEE = 4,
+  GFC_FLAG_CONVERT_R16_IEEE_SWAP,
+  GFC_FLAG_CONVERT_R16_IEEE_BIG,
+  GFC_FLAG_CONVERT_R16_IEEE_LITTLE,
+  GFC_FLAG_CONVERT_R16_IBM = 8,
+  GFC_FLAG_CONVERT_R16_IBM_SWAP,
+  GFC_FLAG_CONVERT_R16_IBM_BIG,
+  GFC_FLAG_CONVERT_R16_IBM_LITTLE,
 };
 
 

diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 13cefdb677b615c4d5b9fdbc6a92a72187e9ad5f..146a00d2eb6f9d0b5a54ff1d26c3412241b196e5 100644 (file)
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -86,14 +86,22 @@ along with GCC; see the file COPYING3.  If not see
 #define GFC_INVALID_UNIT   -3
 
 /* Possible values for the CONVERT I/O specifier.  */
-/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flags.h.  */
+/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flag-types.h.  */
 typedef enum
 {
   GFC_CONVERT_NONE = -1,
   GFC_CONVERT_NATIVE = 0,
   GFC_CONVERT_SWAP,
   GFC_CONVERT_BIG,
-  GFC_CONVERT_LITTLE
+  GFC_CONVERT_LITTLE,
+  GFC_CONVERT_R16_IEEE = 4,
+  GFC_CONVERT_R16_IEEE_SWAP,
+  GFC_CONVERT_R16_IEEE_BIG,
+  GFC_CONVERT_R16_IEEE_LITTLE,
+  GFC_CONVERT_R16_IBM = 8,
+  GFC_CONVERT_R16_IBM_SWAP,
+  GFC_CONVERT_R16_IBM_BIG,
+  GFC_CONVERT_R16_IBM_LITTLE,
 }
 unit_convert;
 

diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 5de1b19ea0bad273209f86db1b5e56e2f8c26d36..dc2a95c082ff0491f6b8c067632cb2977e3d6a18 100644 (file)
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -719,6 +719,7 @@ pdfdir = @pdfdir@
 prefix = @prefix@
 program_transform_name = @program_transform_name@
 psdir = @psdir@
+runstatedir = @runstatedir@
 sbindir = @sbindir@
 sharedstatedir = @sharedstatedir@
 srcdir = @srcdir@

diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 7e71ca577e000300d9f0f6c2d560e5101b1e48da..aaf8b0aef1f0dbb63d02de81be4fc6c91ca2c2b6 100644 (file)
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -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)
            {

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 05e2c1fdf18345249f9c4afbe72b53d48f6cdc7f..6f7e15904ef509b9855129ea5a452ce41d7ad729 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -642,6 +642,24 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u)
            p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
            break;
 
+#ifdef HAVE_GFC_REAL_17
+         case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IEEE:
+           p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IEEE" : "LITTLE_ENDIAN,R16_IEEE";
+           break;
+
+         case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IEEE:
+           p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IEEE" : "BIG_ENDIAN,R16_IEEE";
+           break;
+
+         case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IBM:
+           p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IBM" : "LITTLE_ENDIAN,R16_IBM";
+           break;
+
+         case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IBM:
+           p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IBM" : "BIG_ENDIAN,R16_IBM";
+           break;
+#endif
+
          default:
            internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
          }

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 3837d56704808af6bc950ff809ff4637306e78e4..56ab21bc7fb0bcc77a6bec052ca95f7d005647e3 100644 (file)
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -153,6 +153,28 @@ static const st_option convert_opt[] =
   { "swap", GFC_CONVERT_SWAP},
   { "big_endian", GFC_CONVERT_BIG},
   { "little_endian", GFC_CONVERT_LITTLE},
+#ifdef HAVE_GFC_REAL_17
+  /* Rather than write a special parsing routine, enumerate all the
+     possibilities here.  */
+  { "r16_ieee", GFC_CONVERT_R16_IEEE},
+  { "r16_ibm", GFC_CONVERT_R16_IBM},
+  { "native,r16_ieee", GFC_CONVERT_R16_IEEE},
+  { "native,r16_ibm", GFC_CONVERT_R16_IBM},
+  { "r16_ieee,native", GFC_CONVERT_R16_IEEE},
+  { "r16_ibm,native", GFC_CONVERT_R16_IBM},
+  { "swap,r16_ieee", GFC_CONVERT_R16_IEEE_SWAP},
+  { "swap,r16_ibm", GFC_CONVERT_R16_IBM_SWAP},
+  { "r16_ieee,swap", GFC_CONVERT_R16_IEEE_SWAP},
+  { "r16_ibm,swap", GFC_CONVERT_R16_IBM_SWAP},
+  { "big_endian,r16_ieee", GFC_CONVERT_R16_IEEE_BIG},
+  { "big_endian,r16_ibm", GFC_CONVERT_R16_IBM_BIG},
+  { "r16_ieee,big_endian", GFC_CONVERT_R16_IEEE_BIG},
+  { "r16_ibm,big_endian", GFC_CONVERT_R16_IBM_BIG},
+  { "little_endian,r16_ieee", GFC_CONVERT_R16_IEEE_LITTLE},
+  { "little_endian,r16_ibm", GFC_CONVERT_R16_IBM_LITTLE},
+  { "r16_ieee,little_endian", GFC_CONVERT_R16_IEEE_LITTLE},
+  { "r16_ibm,little_endian",  GFC_CONVERT_R16_IBM_LITTLE},
+#endif
   { NULL, 0}
 };
 
@@ -820,7 +842,14 @@ st_open (st_parameter_open *opp)
       else
        conv = compile_options.convert;
     }
-  
+
+  flags.convert = 0;
+
+#ifdef HAVE_GFC_REAL_17
+  flags.convert = conv & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+  conv &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+#endif
+
   switch (conv)
     {
     case GFC_CONVERT_NATIVE:
@@ -840,7 +869,7 @@ st_open (st_parameter_open *opp)
       break;
     }
 
-  flags.convert = conv;
+  flags.convert |= conv;
 
   if (flags.position != POSITION_UNSPECIFIED
       && flags.access == ACCESS_DIRECT)

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index e44b2df6058b7afa49086c38c7bf9b277ba86b07..1e7387419607e4f2a93fd7f2cdf40a09aa644ef5 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1088,6 +1088,8 @@ static void
 unformatted_read (st_parameter_dt *dtp, bt type,
                  void *dest, int kind, size_t size, size_t nelems)
 {
+  unit_convert convert;
+
   if (type == BT_CLASS)
     {
          int unit = dtp->u.p.current_unit->unit_number;
@@ -1126,8 +1128,8 @@ unformatted_read (st_parameter_dt *dtp, bt type,
     size *= GFC_SIZE_OF_CHAR_KIND(kind);
   read_block_direct (dtp, dest, size * nelems);
 
-  if (unlikely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_SWAP)
-      && kind != 1)
+  convert = dtp->u.p.current_unit->flags.convert;
+  if (unlikely (convert != GFC_CONVERT_NATIVE) && kind != 1)
     {
       /* Handle wide chracters.  */
       if (type == BT_CHARACTER)
@@ -1142,7 +1144,50 @@ unformatted_read (st_parameter_dt *dtp, bt type,
          nelems *= 2;
          size /= 2;
        }
+#ifndef HAVE_GFC_REAL_17
       bswap_array (dest, dest, size, nelems);
+#else
+      unit_convert bswap = convert & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+      if (bswap == GFC_CONVERT_SWAP)
+       bswap_array (dest, dest, size, nelems);
+
+      if ((convert & GFC_CONVERT_R16_IEEE)
+         && kind == 16
+         && (type == BT_REAL || type == BT_COMPLEX))
+       {
+         char *pd = dest;
+         for (size_t i = 0; i < nelems; i++)
+           {
+             GFC_REAL_16 r16;
+             GFC_REAL_17 r17;
+             memcpy (&r17, pd, 16);
+             r16 = r17;
+             memcpy (pd, &r16, 16);
+             pd += size;
+           }
+       }
+      else if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IBM)
+              && kind == 17
+              && (type == BT_REAL || type == BT_COMPLEX))
+       {
+         if (type == BT_COMPLEX && size == 32)
+           {
+             nelems *= 2;
+             size /= 2;
+           }
+
+         char *pd = dest;
+         for (size_t i = 0; i < nelems; i++)
+           {
+             GFC_REAL_16 r16;
+             GFC_REAL_17 r17;
+             memcpy (&r16, pd, 16);
+             r17 = r16;
+             memcpy (pd, &r17, 16);
+             pd += size;
+           }
+       }
+#endif /* HAVE_GFC_REAL_17.  */
     }
 }
 
@@ -1156,6 +1201,8 @@ static void
 unformatted_write (st_parameter_dt *dtp, bt type,
                   void *source, int kind, size_t size, size_t nelems)
 {
+  unit_convert convert;
+
   if (type == BT_CLASS)
     {
          int unit = dtp->u.p.current_unit->unit_number;
@@ -1190,8 +1237,14 @@ unformatted_write (st_parameter_dt *dtp, bt type,
          return;
     }
 
-  if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)
-      || kind == 1)
+  convert = dtp->u.p.current_unit->flags.convert;
+  if (likely (convert == GFC_CONVERT_NATIVE) || kind == 1
+#ifdef HAVE_GFC_REAL_17
+      || ((type == BT_REAL || type == BT_COMPLEX)
+         && ((kind == 16 && convert == GFC_CONVERT_R16_IBM)
+             || (kind == 17 && convert == GFC_CONVERT_R16_IEEE)))
+#endif
+      )
     {
       size_t stride = type == BT_CHARACTER ?
                  size * GFC_SIZE_OF_CHAR_KIND(kind) : size;
@@ -1233,9 +1286,50 @@ unformatted_write (st_parameter_dt *dtp, bt type,
          else
            nc = nrem;
 
-         bswap_array (buffer, p, size, nc);
+#ifdef HAVE_GFC_REAL_17
+         if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IEEE)
+             && kind == 16
+             && (type == BT_REAL || type == BT_COMPLEX))
+           {
+             for (size_t i = 0; i < nc; i++)
+               {
+                 GFC_REAL_16 r16;
+                 GFC_REAL_17 r17;
+                 memcpy (&r16, p, 16);
+                 r17 = r16;
+                 memcpy (&buffer[i * 16], &r17, 16);
+                 p += 16;
+               }
+             if ((dtp->u.p.current_unit->flags.convert
+                  & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM))
+                 == GFC_CONVERT_SWAP)
+               bswap_array (buffer, buffer, size, nc);
+           }
+         else if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IBM)
+                  && kind == 17
+                  && (type == BT_REAL || type == BT_COMPLEX))
+           {
+             for (size_t i = 0; i < nc; i++)
+               {
+                 GFC_REAL_16 r16;
+                 GFC_REAL_17 r17;
+                 memcpy (&r17, p, 16);
+                 r16 = r17;
+                 memcpy (&buffer[i * 16], &r16, 16);
+                 p += 16;
+               }
+             if ((dtp->u.p.current_unit->flags.convert
+                  & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM))
+                 == GFC_CONVERT_SWAP)
+               bswap_array (buffer, buffer, size, nc);
+           }
+         else
+#endif
+           {
+             bswap_array (buffer, p, size, nc);
+             p += size * nc;
+           }
          write_buf (dtp, buffer, size * nc);
-         p += size * nc;
          nrem -= nc;
        }
       while (nrem > 0);
@@ -2691,8 +2785,12 @@ us_read (st_parameter_dt *dtp, int continued)
       return;
     }
 
+  int convert = dtp->u.p.current_unit->flags.convert;
+#ifdef HAVE_GFC_REAL_17
+  convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+#endif
   /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here.  */
-  if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE))
+  if (likely (convert == GFC_CONVERT_NATIVE))
     {
       switch (nr)
        {
@@ -2894,6 +2992,13 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       if (conv == GFC_CONVERT_NONE)
        conv = compile_options.convert;
 
+      u_flags.convert = 0;
+
+#ifdef HAVE_GFC_REAL_17
+      u_flags.convert = conv & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+      conv &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+#endif
+
       switch (conv)
        {
        case GFC_CONVERT_NATIVE:
@@ -2913,7 +3018,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
          break;
        }
 
-      u_flags.convert = conv;
+      u_flags.convert |= conv;
 
       opp.common = dtp->common;
       opp.common.flags &= IOPARM_COMMON_MASK;
@@ -3710,8 +3815,12 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
   else
     len = compile_options.record_marker;
 
+  int convert = dtp->u.p.current_unit->flags.convert;
+#ifdef HAVE_GFC_REAL_17
+  convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+#endif
   /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here.  */
-  if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE))
+  if (likely (convert == GFC_CONVERT_NATIVE))
     {
       switch (len)
        {