From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2153) id 41EB4393A416; Tue, 11 Jan 2022 22:51:56 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 41EB4393A416 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Jakub Jelinek To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-6506] Implement CONVERT specifier for OPEN. X-Act-Checkin: gcc X-Git-Author: Thomas Koenig X-Git-Refname: refs/heads/master X-Git-Oldrev: e79f6e61d5849408c3137dbfa5d49e7066f9df7b X-Git-Newrev: 9840285d877c5820d75d1347fc2a4f176ab31b11 Message-Id: <20220111225156.41EB4393A416@sourceware.org> Date: Tue, 11 Jan 2022 22:51:56 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 11 Jan 2022 22:51:56 -0000 https://gcc.gnu.org/g:9840285d877c5820d75d1347fc2a4f176ab31b11 commit r12-6506-g9840285d877c5820d75d1347fc2a4f176ab31b11 Author: Thomas Koenig 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) {