* [power-ieee128] fortran, libgfortran: Add remaining missing *_r17 symbols
2022-01-04 14:36 ` Thomas Koenig
@ 2022-01-04 17:28 ` Jakub Jelinek
2022-01-04 20:16 ` Thomas Koenig
2022-01-04 18:08 ` [power-ieee128] fortran, libgfortran: Assorted -mabi=ieeelongdouble I/O fixes Jakub Jelinek
1 sibling, 1 reply; 6+ messages in thread
From: Jakub Jelinek @ 2022-01-04 17:28 UTC (permalink / raw)
To: Thomas Koenig
Cc: Michael Meissner, Segher Boessenkool, fortran, Peter Bergner,
Bill Schmidt, gcc-patches, David Edelsohn
Hi!
Following patch adds remaining missing *_r17 entrypoints, so that
we have 91 *_r16 and 91 *_r17 entrypoints (and 24 *_c16 and 24 *_c17).
This fixes:
FAIL: gfortran.dg/dec_math.f90 -O0 execution test
FAIL: gfortran.dg/dec_math.f90 -O1 execution test
FAIL: gfortran.dg/dec_math.f90 -O2 execution test
FAIL: gfortran.dg/dec_math.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions execution test
FAIL: gfortran.dg/dec_math.f90 -O3 -g execution test
FAIL: gfortran.dg/dec_math.f90 -Os execution test
FAIL: gfortran.dg/ieee/dec_math_1.f90 -O0 execution test
FAIL: gfortran.dg/ieee/dec_math_1.f90 -O1 execution test
FAIL: gfortran.dg/ieee/dec_math_1.f90 -O2 execution test
FAIL: gfortran.dg/ieee/dec_math_1.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions execution test
FAIL: gfortran.dg/ieee/dec_math_1.f90 -O3 -g execution test
FAIL: gfortran.dg/ieee/dec_math_1.f90 -Os execution test
Ok for power-ieee128?
2022-01-04 Jakub Jelinek <jakub@redhat.com>
gcc/fortran/
* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Use
gfc_type_abi_kind.
libgfortran/
* libgfortran.h (GFC_REAL_17_INFINITY, GFC_REAL_17_QUIET_NAN): Define.
(__erfcieee128): Declare.
* intrinsics/trigd.c (_gfortran_sind_r17, _gfortran_cosd_r17,
_gfortran_tand_r17): Define for HAVE_GFC_REAL_17.
* intrinsics/random.c (random_r17, arandom_r17, rnumber_17): Define.
* intrinsics/erfc_scaled.c (ERFC_SCALED): Define.
(erfc_scaled_r16): Use ERFC_SCALED macro.
(erfc_scaled_r17): Define.
--- gcc/fortran/trans-intrinsic.c.jj 2021-12-31 11:08:18.642826955 +0000
+++ gcc/fortran/trans-intrinsic.c 2022-01-04 15:32:29.789881496 +0000
@@ -881,7 +881,7 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrin
{
snprintf (name, sizeof (name), PREFIX ("%s_%c%d"), m->name,
ts->type == BT_COMPLEX ? 'c' : 'r',
- ts->kind);
+ gfc_type_abi_kind (ts));
}
argtypes = NULL;
--- libgfortran/libgfortran.h.jj 2022-01-04 10:27:56.528323600 +0000
+++ libgfortran/libgfortran.h 2022-01-04 16:44:54.075203222 +0000
@@ -309,6 +309,9 @@ typedef GFC_UINTEGER_4 gfc_char4_t;
# define GFC_REAL_16_INFINITY __builtin_infq ()
# endif
# endif
+# ifdef HAVE_GFC_REAL_17
+# define GFC_REAL_17_INFINITY __builtin_inff128 ()
+# endif
#endif
#if __FLT_HAS_QUIET_NAN__
# define GFC_REAL_4_QUIET_NAN __builtin_nanf ("")
@@ -327,6 +330,9 @@ typedef GFC_UINTEGER_4 gfc_char4_t;
# define GFC_REAL_16_QUIET_NAN nanq ("")
# endif
# endif
+# ifdef HAVE_GFC_REAL_17
+# define GFC_REAL_17_QUIET_NAN __builtin_nanf128 ("")
+# endif
#endif
typedef struct descriptor_dimension
@@ -1954,6 +1960,8 @@ extern __float128 __coshieee128 (__float
__attribute__ ((__nothrow__, __leaf__));
extern __float128 __cosieee128 (__float128)
__attribute__ ((__nothrow__, __leaf__));
+extern __float128 __erfcieee128 (__float128)
+ __attribute__ ((__nothrow__, __leaf__));
extern __float128 __erfieee128 (__float128)
__attribute__ ((__nothrow__, __leaf__));
extern __float128 __expieee128 (__float128)
--- libgfortran/intrinsics/trigd.c.jj 2021-12-31 11:00:58.083137032 +0000
+++ libgfortran/intrinsics/trigd.c 2022-01-04 16:29:56.585599529 +0000
@@ -289,3 +289,42 @@ see the files COPYING3 and COPYING.RUNTI
#undef HAVE_INFINITY_KIND
#endif /* HAVE_GFC_REAL_16 */
+
+#ifdef HAVE_GFC_REAL_17
+
+/* Build _gfortran_sind_r17, _gfortran_cosd_r17, and _gfortran_tand_r17 */
+
+#define KIND 17
+#define TINY 0x1.p-16400 /* ~= 1.28e-4937 */
+#undef SIND_SMALL /* not precise */
+
+/* Proper float128 precision. */
+#define COSD_SMALL 0x1.p-51 /* ~= 4.441e-16 */
+#define COSD30 8.66025403784438646763723170752936183e-01
+#define PIO180H 1.74532925199433197605003442731685936e-02
+#define PIO180L -2.39912634365882824665106671063098954e-17
+
+/* libquadmath or glibc 2.32+: HAVE_*Q are never defined. They must be available. */
+#define ENABLE_SIND
+#define ENABLE_COSD
+#define ENABLE_TAND
+
+#ifdef GFC_REAL_17_INFINITY
+#define HAVE_INFINITY_KIND
+#endif
+
+#include "trigd_lib.inc"
+
+#undef KIND
+#undef TINY
+#undef COSD_SMALL
+#undef SIND_SMALL
+#undef COSD30
+#undef PIO180H
+#undef PIO180L
+#undef ENABLE_SIND
+#undef ENABLE_COSD
+#undef ENABLE_TAND
+#undef HAVE_INFINITY_KIND
+
+#endif /* HAVE_GFC_REAL_17 */
--- libgfortran/intrinsics/random.c.jj 2021-12-31 11:00:58.083137032 +0000
+++ libgfortran/intrinsics/random.c 2022-01-04 16:40:37.819575318 +0000
@@ -79,6 +79,16 @@ export_proto(arandom_r16);
#endif
+#ifdef HAVE_GFC_REAL_17
+
+extern void random_r17 (GFC_REAL_17 *);
+iexport_proto(random_r17);
+
+extern void arandom_r17 (gfc_array_r17 *);
+export_proto(arandom_r17);
+
+#endif
+
#ifdef __GTHREAD_MUTEX_INIT
static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT;
#else
@@ -161,6 +171,27 @@ rnumber_16 (GFC_REAL_16 *f, GFC_UINTEGER
}
#endif
+#ifdef HAVE_GFC_REAL_17
+
+/* For REAL(KIND=16), we only need to mask off the lower bits. */
+
+static void
+rnumber_17 (GFC_REAL_17 *f, GFC_UINTEGER_8 v1, GFC_UINTEGER_8 v2)
+{
+ GFC_UINTEGER_8 mask;
+#if GFC_REAL_17_RADIX == 2
+ mask = ~ (GFC_UINTEGER_8) 0u << (128 - GFC_REAL_17_DIGITS);
+#elif GFC_REAL_17_RADIX == 16
+ mask = ~ (GFC_UINTEGER_8) 0u << ((32 - GFC_REAL_17_DIGITS) * 4);
+#else
+#error "GFC_REAL_17_RADIX has unknown value"
+#endif
+ v2 = v2 & mask;
+ *f = (GFC_REAL_17) v1 * GFC_REAL_17_LITERAL(0x1.p-64)
+ + (GFC_REAL_17) v2 * GFC_REAL_17_LITERAL(0x1.p-128);
+}
+#endif
+
/*
@@ -445,6 +476,28 @@ iexport(random_r16);
#endif
+/* This function produces a REAL(16) value from the uniform distribution
+ with range [0,1). */
+
+#ifdef HAVE_GFC_REAL_17
+
+void
+random_r17 (GFC_REAL_17 *x)
+{
+ GFC_UINTEGER_8 r1, r2;
+ prng_state* rs = get_rand_state();
+
+ if (unlikely (!rs->init))
+ init_rand_state (rs, false);
+ r1 = prng_next (rs);
+ r2 = prng_next (rs);
+ rnumber_17 (x, r1, r2);
+}
+iexport(random_r17);
+
+
+#endif
+
/* This function fills a REAL(4) array with values from the uniform
distribution with range [0,1). */
@@ -691,6 +744,77 @@ arandom_r16 (gfc_array_r16 *x)
/* Advance to the next element. */
dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ index_type n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so probably not worth it. */
+ dest -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n];
+ }
+ }
+ }
+}
+
+#endif
+
+#ifdef HAVE_GFC_REAL_17
+
+/* This function fills a REAL(16) array with values from the uniform
+ distribution with range [0,1). */
+
+void
+arandom_r17 (gfc_array_r17 *x)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ GFC_REAL_17 *dest;
+ prng_state* rs = get_rand_state();
+
+ dest = x->base_addr;
+
+ dim = GFC_DESCRIPTOR_RANK (x);
+
+ for (index_type n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = GFC_DESCRIPTOR_STRIDE(x,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(x,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ stride0 = stride[0];
+
+ if (unlikely (!rs->init))
+ init_rand_state (rs, false);
+
+ while (dest)
+ {
+ /* random_r17 (dest); */
+ uint64_t r1 = prng_next (rs);
+ uint64_t r2 = prng_next (rs);
+ rnumber_17 (dest, r1, r2);
+
+ /* Advance to the next element. */
+ dest += stride0;
count[0]++;
/* Advance to the next source element. */
index_type n = 0;
--- libgfortran/intrinsics/erfc_scaled.c.jj 2021-12-31 11:00:58.073136812 +0000
+++ libgfortran/intrinsics/erfc_scaled.c 2022-01-04 16:59:43.734737473 +0000
@@ -75,52 +75,91 @@ see the files COPYING3 and COPYING.RUNTI
#endif
+#define ERFC_SCALED(k) \
+GFC_REAL_ ## k \
+erfc_scaled_r ## k (GFC_REAL_ ## k x) \
+{ \
+ if (x < _THRESH) \
+ { \
+ return _INF; \
+ } \
+ if (x < 12) \
+ { \
+ /* Compute directly as ERFC_SCALED(x) = ERFC(x) * EXP(X**2). \
+ This is not perfect, but much better than netlib. */ \
+ return _ERFC(x) * _EXP(x * x); \
+ } \
+ else \
+ { \
+ /* Calculate ERFC_SCALED(x) using a power series in 1/x: \
+ ERFC_SCALED(x) = 1 / (x * sqrt(pi)) \
+ * (1 + Sum_n (-1)**n * (1 * 3 * 5 * ... * (2n-1)) \
+ / (2 * x**2)**n) \
+ */ \
+ GFC_REAL_ ## k sum = 0, oldsum; \
+ GFC_REAL_ ## k inv2x2 = 1 / (2 * x * x); \
+ GFC_REAL_ ## k fac = 1; \
+ int n = 1; \
+ \
+ while (n < 200) \
+ { \
+ fac *= - (2*n - 1) * inv2x2; \
+ oldsum = sum; \
+ sum += fac; \
+ \
+ if (sum == oldsum) \
+ break; \
+ \
+ n++; \
+ } \
+ \
+ return (1 + sum) / x * (_M_2_SQRTPI / 2); \
+ } \
+}
+
#if defined(_ERFC) && defined(_EXP)
extern GFC_REAL_16 erfc_scaled_r16 (GFC_REAL_16);
export_proto(erfc_scaled_r16);
-GFC_REAL_16
-erfc_scaled_r16 (GFC_REAL_16 x)
-{
- if (x < _THRESH)
- {
- return _INF;
- }
- if (x < 12)
- {
- /* Compute directly as ERFC_SCALED(x) = ERFC(x) * EXP(X**2).
- This is not perfect, but much better than netlib. */
- return _ERFC(x) * _EXP(x * x);
- }
- else
- {
- /* Calculate ERFC_SCALED(x) using a power series in 1/x:
- ERFC_SCALED(x) = 1 / (x * sqrt(pi))
- * (1 + Sum_n (-1)**n * (1 * 3 * 5 * ... * (2n-1))
- / (2 * x**2)**n)
- */
- GFC_REAL_16 sum = 0, oldsum;
- GFC_REAL_16 inv2x2 = 1 / (2 * x * x);
- GFC_REAL_16 fac = 1;
- int n = 1;
-
- while (n < 200)
- {
- fac *= - (2*n - 1) * inv2x2;
- oldsum = sum;
- sum += fac;
+ERFC_SCALED(16)
- if (sum == oldsum)
- break;
-
- n++;
- }
+#endif
- return (1 + sum) / x * (_M_2_SQRTPI / 2);
- }
-}
+#undef _THRESH
+#undef _M_2_SQRTPI
+#undef _INF
+#undef _ERFC
+#undef _EXP
#endif
+#ifdef HAVE_GFC_REAL_17
+
+/* For quadruple-precision, netlib's implementation is
+ not accurate enough. We provide another one. */
+
+# define _THRESH -106.566990228185312813205074546585730Q
+# define _M_2_SQRTPI M_2_SQRTPIq
+# define _INF __builtin_inff128()
+# ifdef POWER_IEEE128
+# define _ERFC(x) __erfcieee128(x)
+# define _EXP(x) __expieee128(x)
+# else
+# define _ERFC(x) erfcq(x)
+# define _EXP(x) expq(x)
+# endif
+
+extern GFC_REAL_17 erfc_scaled_r17 (GFC_REAL_17);
+export_proto(erfc_scaled_r17);
+
+ERFC_SCALED(17)
+
+#undef _THRESH
+#undef _M_2_SQRTPI
+#undef _INF
+#undef _ERFC
+#undef _EXP
+#undef ERFC_SCALED
+
#endif
Jakub
^ permalink raw reply [flat|nested] 6+ messages in thread* Re: [power-ieee128] fortran, libgfortran: Assorted -mabi=ieeelongdouble I/O fixes
2022-01-04 14:36 ` Thomas Koenig
2022-01-04 17:28 ` [power-ieee128] fortran, libgfortran: Add remaining missing *_r17 symbols Jakub Jelinek
@ 2022-01-04 18:08 ` Jakub Jelinek
2022-01-04 20:38 ` Thomas Koenig
1 sibling, 1 reply; 6+ messages in thread
From: Jakub Jelinek @ 2022-01-04 18:08 UTC (permalink / raw)
To: Thomas Koenig
Cc: Michael Meissner, Segher Boessenkool, fortran, Peter Bergner,
Bill Schmidt, gcc-patches, David Edelsohn
Hi!
This test FAILs because
f951: Error: '-mabi=ieeelongdouble' requires full ISA 2.06 support
compiler exited with status 1
FAIL: gfortran.dg/pr47614.f -O0 (test for excess errors)
As powerpc64le* only supports -mcpu=power8 and newer, I think we shouldn't
be testing with that option.
Ok for power-ieee128?
All the remaining FAILs I get are due to the -flto -mgnu-attribute issues
or FAIL also with -mabi=ibmlongdouble.
Though, I'm still unsure on what we should do with the array descriptors.
typedef struct dtype_type
{
size_t elem_len;
int version;
signed char rank;
signed char type;
signed short attribute;
}
dtype_type;
Is elem_len really element length, or kind, or both?
It seems a lot of code uses that interchangeably, is there anything where
we'd rely on whether it is the IBM extended real(kind=16) or IEEE quad
real(kind=16) (either in libgfortran or elsewhere)?
At least in libgfortran/generates/*, GFC_DESCRIPTOR_SIZE is mostly used
as mask_kind (I think the mask arrays are always logical not real/complex,
right?), or for logical stuff like matmul_l*.
2022-01-04 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/pr47614.f: Don't use -mcpu=power4 for
powerpc64le*-*-linux*.
--- gcc/testsuite/gfortran.dg/pr47614.f.jj 2021-12-31 11:00:53.733041354 +0000
+++ gcc/testsuite/gfortran.dg/pr47614.f 2022-01-04 17:51:05.422663254 +0000
@@ -1,6 +1,7 @@
! { dg-do run { target { powerpc*-*-* } } }
! { dg-skip-if "" { powerpc*-*-darwin* } }
! { dg-options "-O3 -funroll-loops -ffast-math -mcpu=power4" }
+! { dg-options "-O3 -funroll-loops -ffast-math" { target powerpc64le*-*-linux* } }
SUBROUTINE SFCPAR(ZET,NZ,ZMH,TSL,TMES)
Jakub
^ permalink raw reply [flat|nested] 6+ messages in thread