On Fri, Jan 07, 2022 at 11:26:15AM +0100, Thomas Koenig wrote:
> In
>
> https://gcc.gnu.org/pipermail/fortran/2021-October/056895.html
>
> I made a suggestion how how the format could look like. I used
> a plus sign instead of a comma because I thought the environment
> variable should follow the same syntax as the CONVERT specifier,
> and I did not want to think about having commas in there :-)
>
> Thinking about this again after some time, I think the syntax of
> the environment variable would be clearer if the keywords for
> the two conversions were separate, so somethig like
>
> big_endian;r16_ieee;r16_ibm:10-20;
>
> for the environment variable and
>
> CONVERT="big_endian,r16_ibm"
>
> would probably be better.
Here is completely untested patch that implements something,
but doesn't implement the gcc option stuff, nor the CONVERT=
syntax to supply multiple conversion options nor done anything
about env var nor any testcases.
But it tries to have the native/swap/big/little choice orthogonal from
native/r16_ieee/r16_ibm with r16_ieee and r16_ibm only supported on
ppc64le-linux.
For INQUIRE it has the so far perhaps manageable set of possibilities
handled so that it uses string literals and doesn't have to construct
those strings at runtime (haven't studied how it would need to be done).
I'm afraid I don't know that stuff enough to move forward from this.
--- gcc/fortran/libgfortran.h.jj 2022-01-07 18:41:55.473722388 +0100
+++ gcc/fortran/libgfortran.h 2022-01-07 19:14:23.881784305 +0100
@@ -86,14 +86,16 @@ along with GCC; see the file COPYING3.
#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_IBM = 8
}
unit_convert;
--- gcc/flag-types.h.jj 2022-01-07 18:41:55.452722678 +0100
+++ gcc/flag-types.h 2022-01-07 19:13:55.953170776 +0100
@@ -424,7 +424,9 @@ 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_IBM = 8
};
--- libgfortran/io/open.c.jj 2022-01-07 18:41:56.078714031 +0100
+++ libgfortran/io/open.c 2022-01-07 19:19:11.582780100 +0100
@@ -153,6 +153,10 @@ 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
+ { "r16_ieee", GFC_CONVERT_R16_IEEE},
+ { "r16_ibm", GFC_CONVERT_R16_IBM},
+#endif
{ NULL, 0}
};
@@ -820,7 +824,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 +851,7 @@ st_open (st_parameter_open *opp)
break;
}
- flags.convert = conv;
+ flags.convert |= conv;
if (flags.position != POSITION_UNSPECIFIED
&& flags.access == ACCESS_DIRECT)
--- libgfortran/io/transfer.c.jj 2022-01-07 18:41:56.080714003 +0100
+++ libgfortran/io/transfer.c 2022-01-07 20:43:36.146920392 +0100
@@ -1126,7 +1126,11 @@ unformatted_read (st_parameter_dt *dtp,
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)
+ int convert = dtp->u.p.current_unit->flags.convert;
+#ifdef HAVE_GFC_REAL_17
+ convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
+#endif
+ if (unlikely (convert == GFC_CONVERT_SWAP)
&& kind != 1)
{
/* Handle wide chracters. */
@@ -1144,6 +1148,48 @@ unformatted_read (st_parameter_dt *dtp,
}
bswap_array (dest, dest, size, nelems);
}
+#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))
+ {
+ 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 (&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
}
@@ -1233,9 +1279,50 @@ unformatted_write (st_parameter_dt *dtp,
else
nc = nrem;
- bswap_array (buffer, p, size, nc);
+#ofdef 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 +2778,12 @@ us_read (st_parameter_dt *dtp, int conti
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 +2985,13 @@ data_transfer_init (st_parameter_dt *dtp
if (conv == GFC_CONVERT_NONE)
conv = compile_options.convert;
+ u_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:
@@ -2913,7 +3011,7 @@ data_transfer_init (st_parameter_dt *dtp
break;
}
- u_flags.convert = conv;
+ u_flags.convert |= conv;
opp.common = dtp->common;
opp.common.flags &= IOPARM_COMMON_MASK;
@@ -3710,8 +3808,12 @@ write_us_marker (st_parameter_dt *dtp, c
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)
{
--- libgfortran/io/inquire.c.jj 2022-01-07 18:41:56.077714045 +0100
+++ libgfortran/io/inquire.c 2022-01-07 19:25:23.015604303 +0100
@@ -642,6 +642,24 @@ inquire_via_unit (st_parameter_inquire *
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");
}
--- libgfortran/io/file_pos.c.jj 2022-01-07 18:41:56.077714045 +0100
+++ libgfortran/io/file_pos.c 2022-01-07 19:22:50.466730018 +0100
@@ -104,6 +104,11 @@ unformatted_backspace (st_parameter_file
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_file
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)
{
Jakub
