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.

7 files changed, 193 insertions, 15 deletions

diff --git a/gcc/flag-types.h b/gcc/flag-types.h
index cfd2a5f6f50..345592aea6d 100644
--- 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 13cefdb677b..146a00d2eb6 100644
--- 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 5de1b19ea0b..dc2a95c082f 100644
--- 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 7e71ca577e0..aaf8b0aef1f 100644
--- 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 05e2c1fdf18..6f7e15904ef 100644
--- 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 3837d567048..56ab21bc7fb 100644
--- 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 e44b2df6058..1e738741960 100644
--- 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)
 	{