From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from cc-smtpout2.netcologne.de (cc-smtpout2.netcologne.de [IPv6:2001:4dd0:100:1062:25:2:0:2]) by sourceware.org (Postfix) with ESMTPS id B72903858D3C; Sun, 9 Jan 2022 16:08:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org B72903858D3C Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 379211288D; Sun, 9 Jan 2022 17:08:25 +0100 (CET) Received: from [IPv6:2a0a:a540:3bd5:0:7285:c2ff:fe6c:992d] (2a0a-a540-3bd5-0-7285-c2ff-fe6c-992d.ipv6dyn.netcologne.de [IPv6:2a0a:a540:3bd5:0:7285:c2ff:fe6c:992d]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA id A553011D8D; Sun, 9 Jan 2022 17:08:21 +0100 (CET) To: "fortran@gcc.gnu.org" , gcc-patches Cc: Jakub Jelinek , Michael Meissner From: Thomas Koenig Subject: [power-ieee128, patch, committed] Implement CONVERT specifier Message-ID: <4c8605ae-4614-38d2-72c2-e5fa22cdba72@netcologne.de> Date: Sun, 9 Jan 2022 17:08:21 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.14.0 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------6B4871F55559860A33EAA37A" Content-Language: en-US X-NetCologne-Spam: L X-Rspamd-Queue-Id: A553011D8D X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sun, 09 Jan 2022 16:08:30 -0000 This is a multi-part message in MIME format. --------------6B4871F55559860A33EAA37A Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Hi, I just pushed the attached patch to the branch. It works with the attached test case for -mabi=ibmlongdouble and -mabi=ieeelongdouble. The test case is not quite ready for inclusion in the test suite; it still leaves its last data files behind, and it needs to be dejagnuified and put with the right options into the right directory. Not quite sure how to do this. Still to do: the environment variables and -fconvert. For the -fconvert option, I would like to see the same sort of syntax as in the convert option, something like -fconvert=r16_ieee,big-endian but I do not know how to massage the *.opt files to accomplish that. Regarding specifying via environment variables: Next on my agenda. So, here's the patch. 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. --------------6B4871F55559860A33EAA37A Content-Type: text/x-fortran; charset=UTF-8; name="write-convert.f90" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="write-convert.f90" ! { dg-do run } program tescht implicit none real (kind=16), parameter :: one_third = 3 call test_sanity call test_sanity("r16_ieee") call test_sanity("r16_ieee,big_endian") call test_sanity("r16_ibm") call test_sanity("big_endian,r16_ibm") call test_ibm("r16_ibm") call test_ibm("r16_ibm,swap") call test_ibm("r16_ibm,big_endian") call test_ibm("r16_ibm,little_endian") call test_ibm("swap,r16_ibm") call test_ibm("big_endian,r16_ibm") call test_ibm("little_endian,r16_ibm") contains subroutine test_sanity(convert) character(len=*), optional :: convert real(kind=16) :: a, b, c, d complex(kind=16) :: c1, c2 real(kind=16) :: arr(2) complex(kind=16), dimension(10) :: c_arr real(kind=16), dimension(10) :: a_arr, b_arr integer :: i if (present(convert)) then open(10,file="dat",form="unformatted",convert=convert,status="replace") else open(10,file="dat",form="unformatted",status="replace") end if a = atan(1._16)*4 ! Writing a single value and reading it back again write (10) a rewind (10) read (10) b if (abs(a-b) > 1e-30) stop 10 ! Writing out a KIND=16 complex number and reading ! it back again rewind(10) c1 = cmplx(a, one_third,16) rewind(10) write (10) c1 rewind(10) c2 = 0 read (10) c2 if (abs(c1 - c2) > 1e-10) stop 11 ! Reading it back in as two reals rewind(10) read (10) c,d if (abs(c-a) > 1e-30 .or. abs(d-one_third) > 1e-30) stop 12 ! Reading it back as an array of two reals rewind(10) read (10) arr if (abs(arr(1) - a) > 1e-30 .or. abs(arr(2) - one_third) > 1e-30) stop 13 close(10) ! Writing out a complex array c_arr = [(1._16/(1._16+cmplx(0,i,16)),i=1,size(c_arr))] rewind(10) write (10) c_arr rewind(10) read (10) (a_arr(i), b_arr(i),i=1,10) if (any (abs(real(c_arr)-a_arr) > 1e-30) .or. any(abs(aimag(c_arr)-b_arr) > 1e-30)) stop 14 end subroutine test_sanity subroutine test_ibm(convert) ! Specific checks for writing and reading IBM long doubles as pairs ! of doubles. character(len=*) :: convert double precision:: x1, x2, x3, x4 real(kind=16) :: a, b, c complex(kind=16) :: c1, c2 real(kind=16) :: rf(2) a = atan(1._16)*4 open (10,file=convert // ".dat",status="replace",form ="unformatted",convert=convert) ! Writing a single value and reading it back again write (10) a rewind(10) read (10) b if (abs(a-b) > 1e-30) stop 1 return ! Writing out a KIND=16 value and reading it back again as a ! pair of doubles. rewind(10) read (10) x1, x2 b = real(x1,kind=16) + real(x2,kind=16) if (abs(a-b) > 1e-30) stop 2 ! Writing out a KIND=16 complex number and reading ! it back again rewind (10) c1 = cmplx(a, one_third,16) write (10) c1 rewind (10) read (10) c2 if (abs(c1 - c2) > 1e-10) stop 3 ! Reading it back as a KIND=16 REAL array rewind(10) read (10) rf if (abs(rf(1) - a) > 1e-30 .or. abs(rf(2) - one_third) > 1e-30) stop 4 ! Reading it back as four double precision values rewind (10) read (10) x1, x2, x3, x4 b = real(x1,kind=16) + real(x2,kind=16) if (abs(b-a) > 1e-30) stop 4 c = real(x3,kind=16) + real(x4,kind=16) if (abs(c-one_third) > 1e-30) stop 5 close (10) end subroutine test_ibm end program tescht --------------6B4871F55559860A33EAA37A Content-Type: text/x-patch; charset=UTF-8; name="p5a.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="p5a.diff" 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) { --------------6B4871F55559860A33EAA37A--