From patchwork Sun Jan 9 16:08:21 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1577464 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=TTeRm4jb; dkim-atps=neutral Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by bilbo.ozlabs.org (Postfix) with ESMTPS id 4JX22d0Vq8z9s9c for ; Mon, 10 Jan 2022 03:09:11 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9BA16388A034 for ; Sun, 9 Jan 2022 16:09:06 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9BA16388A034 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1641744546; bh=C9EHcB1G9cLoIyQGJKxrrqbjqftTMZXygI7PdA1OAaI=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=TTeRm4jbuR0AzKV28WRu6WLqIkjVAsThqzOjVD8TCGj0i8d6eKhurD0RZZuLjYatg VZPpHKxdxKhpL9mVzT11+Ahnz85wRjIGUNsVz2dKkvCO2rDAL1FIEnPHoB9J1hjS26 yNErI+Am0fYOg7gmYss//nWrhlhSci4XAqSLcafc= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org 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 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-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: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Cc: Jakub Jelinek , Michael Meissner Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" 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. 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) {