commit dd9c65c7338ceed5ef30e768e4530d73141918c5
Author: Fritz Reese <foreese@gcc.gnu.org>
Date: Wed Apr 22 11:45:22 2020 -0400
Follow-on to: Provide some further math library fallbacks [PR94694]
Protect the trigd functions in libgfortran from unavailable math functions.
libgfortran/ChangeLog:
2020-04-22 Fritz Reese <foreese@gcc.gnu.org>
* intrinsics/trigd.c, intrinsics/trigd_lib.inc, intrinsics/trigd.inc:
Guard against unavailable math functions.
Use suffixes from kinds.h based on the REAL kind.
gcc/fortran/ChangeLog:
2020-04-22 Fritz Reese <foreese@gcc.gnu.org>
* trigd_fe.inc: Use mpfr to compute cosd(30) rather than a host-
precision floating point literal based on an invalid macro.
@@ -29,17 +29,20 @@ along with GCC; see the file COPYING3. If not see
#define ISFINITE(x) mpfr_number_p(x)
#define D2R(x) deg2rad(x)
+#define ENABLE_SIND
+#define ENABLE_COSD
+#define ENABLE_TAND
+
#define SIND simplify_sind
#define COSD simplify_cosd
#define TAND simplify_tand
-#ifdef HAVE_GFC_REAL_16
-#define COSD30 8.66025403784438646763723170752936183e-01Q
-#else
-#define COSD30 8.66025403784438646763723170752936183e-01L
-#endif
-
-#define SET_COSD30(x) mpfr_set_ld((x), COSD30, GFC_RND_MODE)
+/* cosd(30) === sqrt(3) / 2. */
+#define SET_COSD30(x) do { \
+ mpfr_set_ui (x, 3, GFC_RND_MODE); \
+ mpfr_sqrt (x, x, GFC_RND_MODE); \
+ mpfr_div_ui (x, x, 2, GFC_RND_MODE); \
+ } while (0)
static RETTYPE SIND (FTYPE);
static RETTYPE COSD (FTYPE);
@@ -27,6 +27,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <math.h>
+/* Body of library functions which are cannot be implemented on the current
+ * platform because it lacks a capability, such as an underlying trigonometric
+ * function (sin, cos, tan) or C99 floating-point function (fabs, fmod). */
+#define STRINGIFY_EXPAND(x) #x
+#define ERROR_RETURN(f, k, x) runtime_error (#f " is unavailable for" \
+ " REAL(KIND=" STRINGIFY_EXPAND(k) ") because the system math library" \
+ " lacks support for it"); \
+ RETURN(x)
/*
For real x, let {x}_P or x_P be the closest representible number in the
@@ -65,141 +73,219 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
*/
+#ifdef HAVE_GFC_REAL_4
+
/* Build _gfortran_sind_r4, _gfortran_cosd_r4, and _gfortran_tand_r4 */
-#define FTYPE GFC_REAL_4
-#define SIND sind_r4
-#define COSD cosd_r4
-#define TAND tand_r4
-#define SUFFIX(x) x ## f
+#define KIND 4
+#define TINY 0x1.p-100 /* ~= 7.889e-31 */
+#define COSD_SMALL 0x1.p-7 /* = 7.8125e-3 */
+#define SIND_SMALL 0x1.p-5 /* = 3.125e-2 */
+#define COSD30 8.66025388e-01
+#define PIO180H 1.74560547e-02 /* high 12 bits. */
+#define PIO180L -2.76216747e-06 /* Next 24 bits. */
+
+#if defined(HAVE_FABSF) && defined(HAVE_FMODF) && defined(HAVE_COPYSIGNF)
+
+#ifdef HAVE_SINF
+#define ENABLE_SIND
+#endif
+
+#ifdef HAVE_COSF
+#define ENABLE_COSD
+#endif
+
+#ifdef HAVE_TANF
+#define ENABLE_TAND
+#endif
-#define TINY 0x1.p-100f /* ~= 7.889e-31 */
-#define COSD_SMALL 0x1.p-7f /* = 7.8125e-3 */
-#define SIND_SMALL 0x1.p-5f /* = 3.125e-2 */
-#define COSD30 8.66025388e-01f
+#endif /* HAVE_FABSF && HAVE_FMODF && HAVE_COPYSIGNF */
-#define PIO180H 1.74560547e-02f /* high 12 bits. */
-#define PIO180L -2.76216747e-06f /* Next 24 bits. */
+#ifdef GFC_REAL_4_INFINITY
+#define HAVE_INFINITY_KIND
+#endif
#include "trigd_lib.inc"
-#undef FTYPE
+#undef KIND
#undef TINY
#undef COSD_SMALL
#undef SIND_SMALL
#undef COSD30
#undef PIO180H
#undef PIO180L
-#undef SIND
-#undef COSD
-#undef TAND
-#undef SUFFIX
+#undef ENABLE_SIND
+#undef ENABLE_COSD
+#undef ENABLE_TAND
+#undef HAVE_INFINITY_KIND
+#endif /* HAVE_GFC_REAL_4... */
-/* Build _gfortran_sind_r8, _gfortran_cosd_r8, and _gfortran_tand_r8. */
-#define FTYPE GFC_REAL_8
-#define SIND sind_r8
-#define COSD cosd_r8
-#define TAND tand_r8
-#define SUFFIX(x) x
+#ifdef HAVE_GFC_REAL_8
-#define TINY 0x1.p-1000 /* ~= 9.33e-302 (min exp -1074) */
+/* Build _gfortran_sind_r8, _gfortran_cosd_r8, and _gfortran_tand_r8 */
+
+#define KIND 8
+#define TINY 0x1.p-1000 /* ~= 9.33e-302 (min exp -1074) */
#define COSD_SMALL 0x1.p-21 /* ~= 4.768e-7 */
#define SIND_SMALL 0x1.p-19 /* ~= 9.537e-7 */
#define COSD30 8.6602540378443860e-01
-
#define PIO180H 1.7453283071517944e-02 /* high 21 bits. */
#define PIO180L 9.4484253514332993e-09 /* Next 53 bits. */
+#if defined(HAVE_FABS) && defined(HAVE_FMOD) && defined(HAVE_COPYSIGN)
+
+#ifdef HAVE_SIN
+#define ENABLE_SIND
+#endif
+
+#ifdef HAVE_COS
+#define ENABLE_COSD
+#endif
+
+#ifdef HAVE_TAN
+#define ENABLE_TAND
+#endif
+
+#endif /* HAVE_FABS && HAVE_FMOD && HAVE_COPYSIGN */
+
+#ifdef GFC_REAL_8_INFINITY
+#define HAVE_INFINITY_KIND
+#endif
+
#include "trigd_lib.inc"
-#undef FTYPE
+#undef KIND
#undef TINY
#undef COSD_SMALL
#undef SIND_SMALL
#undef COSD30
#undef PIO180H
#undef PIO180L
-#undef SIND
-#undef COSD
-#undef TAND
-#undef SUFFIX
+#undef ENABLE_SIND
+#undef ENABLE_COSD
+#undef ENABLE_TAND
+#undef HAVE_INFINITY_KIND
+#endif /* HAVE_GFC_REAL_8... */
-/* Build _gfortran_sind_r10, _gfortran_cosd_r10, and _gfortran_tand_r10. */
#ifdef HAVE_GFC_REAL_10
-#define FTYPE GFC_REAL_10
-#define SIND sind_r10
-#define COSD cosd_r10
-#define TAND tand_r10
-#define SUFFIX(x) x ## l /* L */
+/* Build _gfortran_sind_r10, _gfortran_cosd_r10, and _gfortran_tand_r10 */
-#define TINY 0x1.p-16400L /* ~= 1.28e-4937 (min exp -16494) */
-#define COSD_SMALL 0x1.p-26L /* ~= 1.490e-8 */
+#define KIND 10
+#define TINY 0x1.p-16400 /* ~= 1.28e-4937 (min exp -16494) */
+#define COSD_SMALL 0x1.p-26 /* ~= 1.490e-8 */
#undef SIND_SMALL /* not precise */
-#define COSD30 8.66025403784438646787e-01L
+#define COSD30 8.66025403784438646787e-01
+#define PIO180H 1.74532925229868851602e-02 /* high 32 bits */
+#define PIO180L -3.04358939097084072823e-12 /* Next 64 bits */
+
+#if defined(HAVE_FABSL) && defined(HAVE_FMODL) && defined(HAVE_COPYSIGNL)
+
+#ifdef HAVE_SINL
+#define ENABLE_SIND
+#endif
-#define PIO180H 1.74532925229868851602e-02L /* high 32 bits */
-#define PIO180L -3.04358939097084072823e-12L /* Next 64 bits */
+#ifdef HAVE_COSL
+#define ENABLE_COSD
+#endif
+
+#ifdef HAVE_TANL
+#define ENABLE_TAND
+#endif
+
+#endif /* HAVE_FABSL && HAVE_FMODL && HAVE_COPYSIGNL */
+
+#ifdef GFC_REAL_10_INFINITY
+#define HAVE_INFINITY_KIND
+#endif
#include "trigd_lib.inc"
-#undef FTYPE
+
+#undef KIND
#undef TINY
#undef COSD_SMALL
#undef SIND_SMALL
#undef COSD30
#undef PIO180H
#undef PIO180L
-#undef SIND
-#undef COSD
-#undef TAND
-#undef SUFFIX
-#endif /* HAVE_GFC_REAL_10 */
+#undef ENABLE_SIND
+#undef ENABLE_COSD
+#undef ENABLE_TAND
+#undef HAVE_INFINITY_KIND
+#endif /* HAVE_GFC_REAL_10 */
-/* Build _gfortran_sind_r16, _gfortran_cosd_r16, and _gfortran_tand_r16. */
#ifdef HAVE_GFC_REAL_16
-#define FTYPE GFC_REAL_16
-#define SIND sind_r16
-#define COSD cosd_r16
-#define TAND tand_r16
+/* Build _gfortran_sind_r16, _gfortran_cosd_r16, and _gfortran_tand_r16 */
+
+#define KIND 16
+#define TINY 0x1.p-16400 /* ~= 1.28e-4937 */
+#undef SIND_SMALL /* not precise */
+
+#if GFC_REAL_16_DIGITS == 64
+/* 80 bit precision, use constants from REAL(10). */
+#define COSD_SMALL 0x1.p-26 /* ~= 1.490e-8 */
+#define COSD30 8.66025403784438646787e-01
+#define PIO180H 1.74532925229868851602e-02 /* high 32 bits */
+#define PIO180L -3.04358939097084072823e-12 /* Next 64 bits */
-#ifdef GFC_REAL_16_IS_FLOAT128 /* libquadmath. */
-#define SUFFIX(x) x ## q
#else
-#define SUFFIX(x) x ## l
-#endif /* GFC_REAL_16_IS_FLOAT128 */
+/* 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
+#endif
-#define TINY SUFFIX(0x1.p-16400) /* ~= 1.28e-4937 */
-#define COSD_SMALL SUFFIX(0x1.p-51) /* ~= 4.441e-16 */
-#undef SIND_SMALL /* not precise */
-#define COSD30 SUFFIX(8.66025403784438646763723170752936183e-01)
-#define PIO180H SUFFIX(1.74532925199433197605003442731685936e-02)
-#define PIO180L SUFFIX(-2.39912634365882824665106671063098954e-17)
+#ifdef GFC_REAL_16_IS_LONG_DOUBLE
+
+#if defined(HAVE_FABSL) && defined(HAVE_FMODL) && defined(HAVE_COPYSIGNL)
+
+#ifdef HAVE_SINL
+#define ENABLE_SIND
+#endif
+
+#ifdef HAVE_COSL
+#define ENABLE_COSD
+#endif
+
+#ifdef HAVE_TANL
+#define ENABLE_TAND
+#endif
+
+#endif /* HAVE_FABSL && HAVE_FMODL && HAVE_COPYSIGNL */
+
+#else
+
+/* libquadmath: HAVE_*Q are never defined. They must be available. */
+#define ENABLE_SIND
+#define ENABLE_COSD
+#define ENABLE_TAND
+
+#endif /* GFC_REAL_16_IS_LONG_DOUBLE */
+
+#ifdef GFC_REAL_16_INFINITY
+#define HAVE_INFINITY_KIND
+#endif
#include "trigd_lib.inc"
-#undef FTYPE
+#undef KIND
+#undef TINY
#undef COSD_SMALL
#undef SIND_SMALL
#undef COSD30
#undef PIO180H
#undef PIO180L
-#undef PIO180
-#undef D2R
-#undef CPYSGN
-#undef FABS
-#undef FMOD
-#undef SIN
-#undef COS
-#undef TAN
-#undef SIND
-#undef COSD
-#undef TAND
-#undef SUFFIX
+#undef ENABLE_SIND
+#undef ENABLE_COSD
+#undef ENABLE_TAND
+#undef HAVE_INFINITY_KIND
+
#endif /* HAVE_GFC_REAL_16 */
@@ -33,10 +33,7 @@ libgfortran, these should be overridden using macros which will use native
operations conforming to the same API. From the FE, the GMP/MPFR functions can
be used as-is.
-The following macros and GMP/FMPR functions are used and must be defined.
-
-
-Types and names:
+The following macros are used and must be defined, unless listed as [optional]:
FTYPE
Type name for the real-valued parameter.
@@ -56,32 +53,45 @@ ITYPE
SIND, COSD, TRIGD
Names for the degree-valued trig functions defined by this module.
+ENABLE_SIND, ENABLE_COSD, ENABLE_TAND
+ Whether the degree-valued trig functions can be enabled.
+
+ERROR_RETURN(f, k, x)
+ If ENABLE_<xxx>D is not defined, this is substituted to assert an
+ error condition for function f, kind k, and parameter x.
+ The function argument is one of {sind, cosd, tand}.
-Literal values:
+ISFINITE(x)
+ Whether x is a regular number or zero (not inf or NaN).
-TINY [optional]
- Value subtracted from 1 to cause rase INEXACT for COSD(x)
- for x << 1. If not set, COSD(x) for x <= COSD_SMALL simply returns 1.
+D2R(x)
+ Convert x from radians to degrees.
-COSD_SMALL [optional]
- Value such that x <= COSD_SMALL implies COSD(x) = 1 to within the
+SET_COSD30(x)
+ Set x to COSD(30), or equivalently, SIND(60).
+
+TINY_LITERAL [optional]
+ Value subtracted from 1 to cause raise INEXACT for COSD(x) for x << 1.
+ If not set, COSD(x) for x <= COSD_SMALL_LITERAL simply returns 1.
+
+COSD_SMALL_LITERAL [optional]
+ Value such that x <= COSD_SMALL_LITERAL implies COSD(x) = 1 to within the
precision of FTYPE. If not set, this condition is not checked.
-SIND_SMALL [optional]
- Value such that x <= SIND_SMALL implies SIND(x) = D2R(x) to within
+SIND_SMALL_LITERAL [optional]
+ Value such that x <= SIND_SMALL_LITERAL implies SIND(x) = D2R(x) to within
the precision of FTYPE. If not set, this condition is not checked.
-COSD30
- Value of SIND(60) and COSD(30).
-
*/
+#ifdef SIND
/* Compute sind(x) = sin(x * pi / 180). */
RETTYPE
SIND (FTYPE x)
{
+#ifdef ENABLE_SIND
if (ISFINITE (x))
{
FTYPE s, one;
@@ -92,12 +102,12 @@ SIND (FTYPE x)
mpfr_copysign (s, one, x, GFC_RND_MODE);
mpfr_clear (one);
-#ifdef SIND_SMALL
+#ifdef SIND_SMALL_LITERAL
/* sin(x) = x as x -> 0; but only for some precisions. */
FTYPE ax;
mpfr_init (ax);
mpfr_abs (ax, x, GFC_RND_MODE);
- if (mpfr_cmp_ld (ax, SIND_SMALL) < 0)
+ if (mpfr_cmp_ld (ax, SIND_SMALL_LITERAL) < 0)
{
D2R (x);
mpfr_clear (ax);
@@ -109,7 +119,7 @@ SIND (FTYPE x)
#else
mpfr_abs (x, x, GFC_RND_MODE);
-#endif /* SIND_SMALL */
+#endif /* SIND_SMALL_LITERAL */
/* Reduce angle to x in [0,360]. */
FTYPE period;
@@ -213,30 +223,37 @@ SIND (FTYPE x)
mpfr_sub (x, x, x, GFC_RND_MODE);
RETURN (x);
+
+#else
+ ERROR_RETURN(sind, KIND, x);
+#endif // ENABLE_SIND
}
+#endif // SIND
+#ifdef COSD
/* Compute cosd(x) = cos(x * pi / 180). */
RETTYPE
COSD (FTYPE x)
{
-#if defined(TINY) && defined(COSD_SMALL)
- static const volatile FTYPE tiny = TINY;
+#ifdef ENABLE_COSD
+#if defined(TINY_LITERAL) && defined(COSD_SMALL_LITERAL)
+ static const volatile FTYPE tiny = TINY_LITERAL;
#endif
if (ISFINITE (x))
{
-#ifdef COSD_SMALL
+#ifdef COSD_SMALL_LITERAL
FTYPE ax;
mpfr_init (ax);
mpfr_abs (ax, x, GFC_RND_MODE);
/* No spurious underflows!. In radians, cos(x) = 1-x*x/2 as x -> 0. */
- if (mpfr_cmp_ld (ax, COSD_SMALL) <= 0)
+ if (mpfr_cmp_ld (ax, COSD_SMALL_LITERAL) <= 0)
{
mpfr_set_ui (x, 1, GFC_RND_MODE);
-#ifdef TINY
+#ifdef TINY_LITERAL
/* Cause INEXACT. */
if (!mpfr_zero_p (ax))
mpfr_sub_d (x, x, tiny, GFC_RND_MODE);
@@ -250,7 +267,7 @@ COSD (FTYPE x)
mpfr_clear (ax);
#else
mpfr_abs (x, x, GFC_RND_MODE);
-#endif /* COSD_SMALL */
+#endif /* COSD_SMALL_LITERAL */
/* Reduce angle to ax in [0,360]. */
FTYPE period;
@@ -354,14 +371,21 @@ COSD (FTYPE x)
mpfr_sub (x, x, x, GFC_RND_MODE);
RETURN (x);
+
+#else
+ ERROR_RETURN(cosd, KIND, x);
+#endif // ENABLE_COSD
}
+#endif // COSD
+#ifdef TAND
/* Compute tand(x) = tan(x * pi / 180). */
RETTYPE
TAND (FTYPE x)
{
+#ifdef ENABLE_TAND
if (ISFINITE (x))
{
FTYPE s, one;
@@ -372,12 +396,12 @@ TAND (FTYPE x)
mpfr_copysign (s, one, x, GFC_RND_MODE);
mpfr_clear (one);
-#ifdef SIND_SMALL
+#ifdef SIND_SMALL_LITERAL
/* tan(x) = x as x -> 0; but only for some precisions. */
FTYPE ax;
mpfr_init (ax);
mpfr_abs (ax, x, GFC_RND_MODE);
- if (mpfr_cmp_ld (ax, SIND_SMALL) < 0)
+ if (mpfr_cmp_ld (ax, SIND_SMALL_LITERAL) < 0)
{
D2R (x);
mpfr_clear (ax);
@@ -389,7 +413,7 @@ TAND (FTYPE x)
#else
mpfr_abs (x, x, GFC_RND_MODE);
-#endif /* SIND_SMALL */
+#endif /* SIND_SMALL_LITERAL */
/* Reduce angle to x in [0,360]. */
FTYPE period;
@@ -459,6 +483,11 @@ TAND (FTYPE x)
mpfr_sub (x, x, x, GFC_RND_MODE);
RETURN (x);
+
+#else
+ ERROR_RETURN(tand, KIND, x);
+#endif // ENABLE_TAND
}
+#endif // TAND
/* vim: set ft=c: */
@@ -29,12 +29,11 @@ This replaces all GMP/MPFR functions used by trigd.inc with native versions.
The precision is defined by FTYPE defined before including this file.
The module which includes this file must define the following:
-FTYPE -- floating point type
-SIND, COSD, TAND -- names of the functions to define
-SUFFIX(x) -- add a literal suffix for floating point constants (f, ...)
+KIND -- floating point kind (4, 8, 10, 16)
+HAVE_INFINITY_KIND -- defined iff the platform has GFC_REAL_<KIND>_INFINITY
-COSD_SMALL [optional] -- for x <= COSD_SMALL, COSD(x) = 1 if set
TINY [optional] -- subtract from 1 under the above condition if set
+COSD_SMALL [optional] -- for x <= COSD_SMALL, COSD(x) = 1 if set
SIND_SMALL [optional] -- for x <= SIND_SMALL, SIND(x) = D2R(x) if set
COSD30 -- literal value of COSD(30) to the precision of FTYPE
PIO180H -- upper bits of pi/180 for FMA
@@ -42,6 +41,54 @@ PIO180L -- lower bits of pi/180 for FMA
*/
+/* FTYPE := GFC_REAL_<K> */
+#define FTYPE CONCAT_EXPAND(GFC_REAL_,KIND)
+
+/* LITERAL_SUFFIX := GFC_REAL_<K>_LITERAL_SUFFIX */
+#define LITERAL_SUFFIX CONCAT_EXPAND(FTYPE,_LITERAL_SUFFIX)
+
+/* LITERAL(X) := GFC_REAL_<K>_LITERAL(X) */
+#define LITERAL(x) CONCAT_EXPAND(x,LITERAL_SUFFIX)
+
+#define SIND CONCAT_EXPAND(sind_r, KIND)
+#define COSD CONCAT_EXPAND(cosd_r, KIND)
+#define TAND CONCAT_EXPAND(tand_r, KIND)
+
+#ifdef HAVE_INFINITY_KIND
+/* GFC_REAL_X_INFINITY */
+#define INFINITY_KIND CONCAT_EXPAND(FTYPE, _INFINITY)
+#else
+/* GFC_REAL_X_HUGE */
+#define INFINITY_KIND CONCAT_EXPAND(FTYPE, _HUGE)
+#endif
+
+#define CONCAT(x,y) x ## y
+#define CONCAT_EXPAND(x,y) CONCAT(x,y)
+
+#define COPYSIGN LITERAL(copysign)
+#define FMOD LITERAL(fmod)
+#define FABS LITERAL(fabs)
+#define FMA LITERAL(fma)
+#define SIN LITERAL(sin)
+#define COS LITERAL(cos)
+#define TAN LITERAL(tan)
+
+#ifdef TINY
+#define TINY_LITERAL LITERAL(TINY)
+#endif
+
+#ifdef COSD_SMALL
+#define COSD_SMALL_LITERAL LITERAL(COSD_SMALL)
+#endif
+
+#ifdef SIND_SMALL
+#define SIND_SMALL_LITERAL LITERAL(SIND_SMALL)
+#endif
+
+#define COSD30_LITERAL LITERAL(COSD30)
+#define PIO180H_LITERAL LITERAL(PIO180H)
+#define PIO180L_LITERAL LITERAL(PIO180L)
+
#define ITYPE int
#define GFC_RND_MODE 0
#define RETTYPE FTYPE
@@ -52,15 +99,15 @@ PIO180L -- lower bits of pi/180 for FMA
#define mpfr_init_set_ui(x, v, rnd) (x = (v))
#define mpfr_clear(x) do { } while (0)
#define mpfr_swap(x, y) do { FTYPE z = y; y = x; x = z; } while (0)
-#define mpfr_copysign(rop, op1, op2, rnd) rop = SUFFIX(copysign)((op1), (op2))
-#define mpfr_fmod(rop, x, d, rnd) (rop = SUFFIX(fmod)((x), (d)))
-#define mpfr_abs(rop, op, rnd) (rop = SUFFIX(fabs)(op))
+#define mpfr_copysign(rop, op1, op2, rnd) rop = COPYSIGN((op1), (op2))
+#define mpfr_fmod(rop, x, d, rnd) (rop = FMOD((x), (d)))
+#define mpfr_abs(rop, op, rnd) (rop = FABS(op))
#define mpfr_cmp_ld(x, y) ((x) - (y))
#define mpfr_cmp_ui(x, n) ((x) - (n))
#define mpfr_zero_p(x) ((x) == 0)
#define mpfr_set(rop, x, rnd) (rop = (x))
-#define mpfr_set_zero(rop, s) (rop = SUFFIX(copysign)(0, (s)))
-#define mpfr_set_inf(rop, s) (rop = ((s)*-2 + 1) * INFINITY)
+#define mpfr_set_zero(rop, s) (rop = COPYSIGN(0, (s)))
+#define mpfr_set_inf(rop, s) (rop = ((s)*-2 + 1) * INFINITY_KIND)
#define mpfr_set_ui(rop, n, rnd) (rop = (n))
#define mpfr_set_si(rop, n, rnd) (rop = (n))
#define mpfr_set_ld(rop, x, rnd) (rop = (x))
@@ -72,32 +119,63 @@ PIO180L -- lower bits of pi/180 for FMA
#define mpfr_sub(rop, op1, op2, rnd) (rop = ((op1) - (op2)))
#define mpfr_ui_sub(rop, op1, op2, rnd) (rop = ((op1) - (op2)))
#define mpfr_neg(rop, op, rnd) (rop = -(op))
-#define mpfr_sin(rop, x, rnd) (rop = SUFFIX(sin)(x))
-#define mpfr_cos(rop, x, rnd) (rop = SUFFIX(cos)(x))
-#define mpfr_tan(rop, x, rnd) (rop = SUFFIX(tan)(x))
+#define mpfr_sin(rop, x, rnd) (rop = SIN(x))
+#define mpfr_cos(rop, x, rnd) (rop = COS(x))
+#define mpfr_tan(rop, x, rnd) (rop = TAN(x))
#define mpz_init(n) do { } while (0)
#define mpz_clear(x) do { } while (0)
#define mpz_cmp_ui(x, y) ((x) - (y))
#define mpz_divisible_ui_p(n, d) ((n) % (d) == 0)
-#define FMA(x,y,z) SUFFIX(fma)((x), (y), (z))
-#define D2R(x) (x = FMA((x), PIO180H, (x) * PIO180L))
-
-#define SET_COSD30(x) (x = COSD30)
+#define D2R(x) (x = FMA((x), PIO180H_LITERAL, (x) * PIO180L_LITERAL))
+#define SET_COSD30(x) (x = COSD30_LITERAL)
+#ifdef SIND
extern FTYPE SIND (FTYPE);
export_proto (SIND);
+#endif
+#ifdef COSD
extern FTYPE COSD (FTYPE);
export_proto (COSD);
+#endif
+#ifdef TAND
extern FTYPE TAND (FTYPE);
export_proto (TAND);
+#endif
#include "trigd.inc"
+#undef FTYPE
+#undef LITERAL_SUFFIX
+#undef LITERAL
+#undef CONCAT3
+#undef CONCAT3_EXPAND
+#undef CONCAT
+#undef CONCAT_EXPAND
+#undef SIND
+#undef COSD
+#undef TAND
+#undef INFINITY_KIND
+
+#undef COPYSIGN
+#undef FMOD
+#undef FABS
+#undef FMA
+#undef SIN
+#undef COS
+#undef TAN
+
+#undef TINY_LITERAL
+#undef COSD_SMALL_LITERAL
+#undef SIND_SMALL_LITERAL
+#undef COSD30_LITERAL
+#undef PIO180H_LITERAL
+#undef PIO180L_LITERAL
+
#undef ITYPE
#undef GFC_RND_MODE
#undef RETTYPE
This patch here is a follow-on to Jakub's in his message "[PATCH] libgfortran: Provide some further math library fallbacks [PR94694]" at https://gcc.gnu.org/pipermail/fortran/2020-April/054252.html. I think this should be committed along with Jakub's patch in response to PRs 94586 and 94694. Though this patch alone does not fix either PR, it prevents the build from failing when the degree-valued trigonometric functions are ultimately unavailable on the target due to lack of math library builtins. If HAVE_* is not defined for the math functions required by the trigd implementations, the intrinsic functions are built only to throw a runtime_error. Prior to this, the libgfortran build would fail completely. These intrinsics are extensions, and before the original trigd patch the library could build even when these math functions were missing. Therefore, I think the compiler should not fail to build simply because the intrinsics are unsupported on the target. In theory, this patch would also fix the trigd build for targets which don't have a floating-point INFINITY defined, though I am unsure if any such targets exist. Furthermore, this patch replaces hard-coded floating point literal suffixes with the use of GFC_REAL_<kind>_LITERAL_SUFFIX, as defined by libgfortran's kinds.h. This could help targets with quirky definitions for real(16) such as HPUX, as in PR 94586. Similarly, the precision used for the constants COSD_SMALL, COSD30, et al. for the REAL(16) case are derived from the precision of GFC_REAL_16 rather than its long-double-ness, since for example on HPUX long double is actually 128 bits. This patch also fixes an issue which could have occurred in the front-end: the front-end attemped to use a host-sized floating-point literal to represent cosine of 30 degrees. This is of course nonsensical. The patch replaces this with the use of mpfr functions to compute the value as sqrt(3)/2 to the correct precision. I include this in the patch because it is also a target-specific issue with the degree-valued trigonometric intrinsics. Jakub has OK'd the patch and I recently authored the original trigd code being modified here. After his patch is committed I will commit this one unless others have comments or concerns. libgfortran/ChangeLog: 2020-04-22 Fritz Reese <foreese@gcc.gnu.org> * intrinsics/trigd.c, intrinsics/trigd_lib.inc, intrinsics/trigd.inc: Guard against unavailable math functions. Use suffixes from kinds.h based on the REAL kind. gcc/fortran/ChangeLog: 2020-04-22 Fritz Reese <foreese@gcc.gnu.org> * trigd_fe.inc: Use mpfr to compute cosd(30) rather than a host- precision floating point literal based on an invalid macro. --- Fritz Reese [Note: the only differences between this patch and the one in the PR is whitespace.]