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 <ja...@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