public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-6506] Implement CONVERT specifier for OPEN.
@ 2022-01-11 22:51 Jakub Jelinek
0 siblings, 0 replies; only message in thread
From: Jakub Jelinek @ 2022-01-11 22:51 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:9840285d877c5820d75d1347fc2a4f176ab31b11
commit r12-6506-g9840285d877c5820d75d1347fc2a4f176ab31b11
Author: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sun Jan 9 16:35:21 2022 +0100
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:
---
gcc/flag-types.h | 10 +++-
gcc/fortran/libgfortran.h | 12 ++++-
libgfortran/Makefile.in | 1 +
libgfortran/io/file_pos.c | 7 ++-
libgfortran/io/inquire.c | 18 +++++++
libgfortran/io/open.c | 33 +++++++++++-
libgfortran/io/transfer.c | 127 ++++++++++++++++++++++++++++++++++++++++++----
7 files changed, 193 insertions(+), 15 deletions(-)
diff --git a/gcc/flag-types.h b/gcc/flag-types.h
index 649021f37a8..d92c167d274 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 9055730e517..ddba41c04f3 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 fa5e21578c8..cf500a002e8 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 45db53496e4..18b1feaefc4 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 600e979a642..e42f2eb6628 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 dfa04d0a805..c9276c72748 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 a57eb676c2f..8e4f64db177 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)
{
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-01-11 22:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-11 22:51 [gcc r12-6506] Implement CONVERT specifier for OPEN Jakub Jelinek
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).