From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from us-smtp-delivery-124.mimecast.com (us-smtp-delivery-124.mimecast.com [170.10.133.124]) by sourceware.org (Postfix) with ESMTPS id 1BADB3858403 for ; Mon, 3 Jan 2022 15:36:32 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 1BADB3858403 Received: from mimecast-mx01.redhat.com (mimecast-mx01.redhat.com [209.132.183.4]) by relay.mimecast.com with ESMTP with STARTTLS (version=TLSv1.2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id us-mta-574-HJgZuGI6PfWgJSDtqtBx5g-1; Mon, 03 Jan 2022 10:36:28 -0500 X-MC-Unique: HJgZuGI6PfWgJSDtqtBx5g-1 Received: from smtp.corp.redhat.com (int-mx01.intmail.prod.int.phx2.redhat.com [10.5.11.11]) (using TLSv1.2 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by mimecast-mx01.redhat.com (Postfix) with ESMTPS id 65A87801B2A; Mon, 3 Jan 2022 15:36:26 +0000 (UTC) Received: from tucnak.zalov.cz (unknown [10.2.16.169]) by smtp.corp.redhat.com (Postfix) with ESMTPS id D4E0B7EA31; Mon, 3 Jan 2022 15:36:25 +0000 (UTC) Received: from tucnak.zalov.cz (localhost [127.0.0.1]) by tucnak.zalov.cz (8.16.1/8.16.1) with ESMTPS id 203FaMVU1355995 (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384 bits=256 verify=NOT); Mon, 3 Jan 2022 16:36:22 +0100 Received: (from jakub@localhost) by tucnak.zalov.cz (8.16.1/8.16.1/Submit) id 203FaLXV1355994; Mon, 3 Jan 2022 16:36:21 +0100 Date: Mon, 3 Jan 2022 16:36:21 +0100 From: Jakub Jelinek To: Thomas Koenig Cc: Michael Meissner , Bill Schmidt , "fortran@gcc.gnu.org" , Segher Boessenkool , Peter Bergner , David Edelsohn , gcc-patches@gcc.gnu.org Subject: [power-ieee128] libgfortran: -mabi=ieeelongdouble I/O Message-ID: <20220103153621.GL2664@tucnak> Reply-To: Jakub Jelinek MIME-Version: 1.0 X-Scanned-By: MIMEDefang 2.79 on 10.5.11.11 X-Mimecast-Spam-Score: 0 X-Mimecast-Originator: redhat.com Content-Type: text/plain; charset=us-ascii Content-Disposition: inline X-Spam-Status: No, score=-5.4 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, 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: Mon, 03 Jan 2022 15:36:34 -0000 Hi! The following patch adds the library side of -mabi=ieeelongdouble I/O support. There is one issue to be resolved though, for the sake of libgfortran.a built on an older powerpc64le-linux system (glibc older than 2.32) and then deployed on glibc 2.32 or later, I believe we want to use _gfortran_transfer_real128_write etc. APIs so that we force in libquadmath in that case. The following patch does that, but unfortunately it means that right now those 512: 00000000001a31d0 56 FUNC GLOBAL DEFAULT 11 _gfortran_transfer_real128@@GFORTRAN_8 [: 8] 920: 00000000001a3210 56 FUNC GLOBAL DEFAULT 11 _gfortran_transfer_real128_write@@GFORTRAN_8 [: 8] 487: 00000000001a3290 56 FUNC GLOBAL DEFAULT 11 _gfortran_transfer_complex128_write@@GFORTRAN_8 [: 8] 574: 00000000001a3250 56 FUNC GLOBAL DEFAULT 11 _gfortran_transfer_complex128@@GFORTRAN_8 [: 8] symbols. But those symbols weren't exported on powerpc64le-linux in GCC 8, 9, 10 or 11, so they shouldn't be exported @@GFORTRAN_8, but @@GFORTRAN_12. So, either we'd need to add e.g. preprocessing support for gfortran.map or some other way how to make certain symbols appear conditionally at different symbol versions, or another option would be to choose different symbol names for those for the powerpc64le-linux cases (e.g. _gfortran_transfer_{real,complex}ieee128{,_write}). Any preferences? 2022-01-03 Jakub Jelinek * libgfortran.h (__acoshieee128, __acosieee128, __asinhieee128, __asinieee128, __atan2ieee128, __atanhieee128, __atanieee128, __coshieee128, __cosieee128, __erfieee128, __expieee128, __fabsieee128, __jnieee128, __log10ieee128, __logieee128, __powieee128, __sinhieee128, __sinieee128, __sqrtieee128, __tanhieee128, __tanieee128, __ynieee128): Formatting fixes. (__strtoieee128, __snprintfieee128): Declare. * io/io.h (default_width_for_float, default_precision_for_float): Handle kind == 17. * io/size_from_kind.c (size_from_real_kind, size_from_complex_kind): Likewise. * io/read.c (set_integer, si_max, convert_real, convert_infnan, read_f): Likewise. * io/write.c (extract_uint, size_from_kind, set_fnode_default): Likewise. * io/write_float.def (DTOA2Q, FDTOA2Q): Define for HAVE_GFC_REAL_17. (determine_en_precision, get_float_string): Handle kind == 17. * io/transfer128.c: Use also for HAVE_GFC_REAL_17, but don't drag in libquadmath if POWER_IEEE128. --- libgfortran/libgfortran.h.jj 2021-12-31 11:45:06.121158716 +0000 +++ libgfortran/libgfortran.h 2022-01-03 14:32:45.063730903 +0000 @@ -1936,28 +1936,54 @@ internal_proto(cshift1_16_c17); /* Prototypes for the POWER __ieee128 functions. */ #ifdef POWER_IEEE128 -extern __float128 __acoshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __acosieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __asinhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __asinieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __atan2ieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __atanhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __atanieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __coshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __cosieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __erfieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __expieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __fabsieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __jnieee128 (int, __float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __log10ieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __logieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __powieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __sinhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __sinieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __sqrtieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __tanhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __tanieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); -extern __float128 __ynieee128 (int , __float128) __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __acoshieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __acosieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __asinhieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __asinieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __atan2ieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __atanhieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __atanieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __coshieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __cosieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __erfieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __expieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __fabsieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __jnieee128 (int, __float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __log10ieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __logieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __powieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __sinhieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __sinieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __sqrtieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __tanhieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __tanieee128 (__float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __ynieee128 (int , __float128) + __attribute__ ((__nothrow__, __leaf__)); +extern __float128 __strtoieee128 (const char *, char **) + __attribute__ ((__nothrow__, __leaf__)); +extern int __snprintfieee128 (char *, size_t, const char *, ...) + __attribute__ ((__nothrow__)); #endif --- libgfortran/io/io.h.jj 2021-12-31 11:00:58.083137032 +0000 +++ libgfortran/io/io.h 2021-12-31 16:26:44.181125298 +0000 @@ -1063,7 +1063,8 @@ default_width_for_float (int kind) { case 4: return 15; case 8: return 25; - case 16: return 42; + case 16: + case 17: return 42; default: return 0; } } @@ -1075,7 +1076,8 @@ default_precision_for_float (int kind) { case 4: return 7; case 8: return 16; - case 16: return 33; + case 16: + case 17: return 33; default: return 0; } } --- libgfortran/io/size_from_kind.c.jj 2021-12-31 11:00:58.083137032 +0000 +++ libgfortran/io/size_from_kind.c 2021-12-31 16:19:50.182058780 +0000 @@ -49,6 +49,10 @@ size_from_real_kind (int kind) case 16: return sizeof (GFC_REAL_16); #endif +#ifdef HAVE_GFC_REAL_17 + case 17: + return sizeof (GFC_REAL_17); +#endif default: return kind; } @@ -76,6 +80,10 @@ size_from_complex_kind (int kind) case 16: return sizeof (GFC_COMPLEX_16); #endif +#ifdef HAVE_GFC_COMPLEX_17 + case 17: + return sizeof (GFC_COMPLEX_17); +#endif default: return 2 * kind; } --- libgfortran/io/read.c.jj 2021-12-31 11:08:19.052835974 +0000 +++ libgfortran/io/read.c 2022-01-03 12:12:19.999171427 +0000 @@ -47,6 +47,14 @@ set_integer (void *dest, GFC_INTEGER_LAR switch (length) { #ifdef HAVE_GFC_INTEGER_16 +#ifdef HAVE_GFC_REAL_17 + case 17: + { + GFC_INTEGER_16 tmp = value; + memcpy (dest, (void *) &tmp, 16); + } + break; +#endif /* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */ case 10: case 16: @@ -96,7 +104,14 @@ si_max (int length) #endif switch (length) - { + { +#if defined HAVE_GFC_REAL_17 + case 17: + value = 1; + for (int n = 1; n < 4 * 16; n++) + value = (value << 2) + 3; + return value; +#endif #if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10 case 16: case 10: @@ -181,6 +196,15 @@ convert_real (st_parameter_dt *dtp, void # endif #endif +#if defined(HAVE_GFC_REAL_17) + case 17: +# if defined(POWER_IEEE128) + *((GFC_REAL_17*) dest) = __strtoieee128 (buffer, &endptr); +# else + *((GFC_REAL_17*) dest) = __qmath_(strtoflt128) (buffer, &endptr); +# endif +#endif + default: internal_error (&dtp->common, "Unsupported real kind during IO"); } @@ -260,6 +284,15 @@ convert_infnan (st_parameter_dt *dtp, vo # endif #endif +#if defined(HAVE_GFC_REAL_17) + case 17: + if (is_inf) + *((GFC_REAL_17*) dest) = plus ? __builtin_infl () : -__builtin_infl (); + else + *((GFC_REAL_17*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl (""); + break; +#endif + default: internal_error (&dtp->common, "Unsupported real kind during IO"); } @@ -1225,6 +1258,12 @@ zero: break; #endif +#ifdef HAVE_GFC_REAL_17 + case 17: + *((GFC_REAL_17 *) dest) = 0.0; + break; +#endif + default: internal_error (&dtp->common, "Unsupported real kind during IO"); } --- libgfortran/io/write.c.jj 2021-12-31 11:08:19.052835974 +0000 +++ libgfortran/io/write.c 2022-01-03 13:28:40.269478670 +0000 @@ -649,6 +649,15 @@ extract_uint (const void *p, int len) i = (GFC_UINTEGER_16) tmp; } break; +# ifdef HAVE_GFC_REAL_17 + case 17: + { + GFC_INTEGER_16 tmp = 0; + memcpy ((void *) &tmp, p, 16); + i = (GFC_UINTEGER_16) tmp; + } + break; +# endif #endif default: internal_error (NULL, "bad integer kind"); @@ -1518,6 +1527,9 @@ size_from_kind (st_parameter_dt *dtp, co size = 4932 + 3; break; case 16: +#ifdef HAVE_GFC_REAL_17 + case 17: +#endif size = 4932 + 3; break; default: @@ -1674,6 +1686,13 @@ set_fnode_default (st_parameter_dt *dtp, f->u.real.e = 4; #endif break; +#ifdef HAVE_GFC_REAL_17 + case 17: + f->u.real.w = 45; + f->u.real.d = 36; + f->u.real.e = 4; + break; +#endif default: internal_error (&dtp->common, "bad real kind"); break; --- libgfortran/io/write_float.def.jj 2021-12-31 11:00:58.093137252 +0000 +++ libgfortran/io/write_float.def 2022-01-03 14:33:12.694336419 +0000 @@ -834,8 +834,16 @@ snprintf (buffer, size, "%+-#.*e", (prec snprintf (buffer, size, "%+-#.*Le", (prec), (val)) -#if defined(GFC_REAL_16_IS_FLOAT128) -#define DTOA2Q(prec,val) \ +#if defined(HAVE_GFC_REAL_17) +# if defined(POWER_IEEE128) +# define DTOA2Q(prec,val) \ +__snprintfieee128 (buffer, size, "%+-#.*Le", (prec), (val)) +# else +# define DTOA2Q(prec,val) \ +quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val)) +# endif +#elif defined(GFC_REAL_16_IS_FLOAT128) +# define DTOA2Q(prec,val) \ quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val)) #endif @@ -849,10 +857,17 @@ snprintf (buffer, size, "%+-#.*f", (prec snprintf (buffer, size, "%+-#.*Lf", (prec), (val)) -#if defined(GFC_REAL_16_IS_FLOAT128) -#define FDTOA2Q(prec,val) \ -quadmath_snprintf (buffer, size, "%+-#.*Qf", \ - (prec), (val)) +#if defined(HAVE_GFC_REAL_17) +# if defined(POWER_IEEE128) +# define FDTOA2Q(prec,val) \ +__snprintfieee128 (buffer, size, "%+-#.*Lf", (prec), (val)) +# else +# define FDTOA2Q(prec,val) \ +quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val)) +# endif +#elif defined(GFC_REAL_16_IS_FLOAT128) +# define FDTOA2Q(prec,val) \ +quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val)) #endif @@ -925,6 +940,11 @@ determine_en_precision (st_parameter_dt # endif break; #endif +#ifdef HAVE_GFC_REAL_17 + case 17: + EN_PREC(16,Q) +#endif + break; default: internal_error (NULL, "bad real kind"); } @@ -1128,6 +1148,11 @@ get_float_string (st_parameter_dt *dtp, # endif break; #endif +#ifdef HAVE_GFC_REAL_17 + case 17: + FORMAT_FLOAT(16,Q) + break; +#endif default: internal_error (NULL, "bad real kind"); } --- libgfortran/io/transfer128.c.jj 2021-12-31 11:00:58.083137032 +0000 +++ libgfortran/io/transfer128.c 2022-01-03 14:40:41.734177007 +0000 @@ -28,7 +28,7 @@ see the files COPYING3 and COPYING.RUNTI #include "io.h" -#if defined(GFC_REAL_16_IS_FLOAT128) +#if defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_GFC_REAL_17) /* The prototypes for the called procedures in transfer.c. */ @@ -65,8 +65,10 @@ export_proto(transfer_complex128_write); write_float; the pointer assignment with USED attribute make sure that there is a non-weakref dependence if the quadmath functions are used. That avoids segfault when libquadmath is statically linked. */ +# if !defined(HAVE_GFC_REAL_17) || !defined(POWER_IEEE128) static void __attribute__((used)) *tmp1 = strtoflt128; static void __attribute__((used)) *tmp2 = quadmath_snprintf; +# endif void transfer_real128 (st_parameter_dt *dtp, void *p, int kind) Jakub