Protect the trigd functions in libgfortran from unavailable math functions.
libgfortran/ChangeLog: 2020-04-22 Fritz Reese <foreese@gcc.gnu.org> PR libfortran/94694 PR libfortran/94586 * 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.
This commit is contained in:
Fritz Reese
parent
966de09be9
commit
e8eecc2a91
|
|
@ -1,3 +1,8 @@
|
|||
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.
|
||||
|
||||
2020-04-22 José Rui Faustino de Sousa <jrfsousa@gmail.com>
|
||||
|
||||
PR fortran/90350
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
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.
|
||||
|
||||
2020-04-22 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR libfortran/94694
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
||||
#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
|
||||
#if defined(HAVE_FABSF) && defined(HAVE_FMODF) && defined(HAVE_COPYSIGNF)
|
||||
|
||||
#define PIO180H 1.74560547e-02f /* high 12 bits. */
|
||||
#define PIO180L -2.76216747e-06f /* Next 24 bits. */
|
||||
#ifdef HAVE_SINF
|
||||
#define ENABLE_SIND
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_COSF
|
||||
#define ENABLE_COSD
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_TANF
|
||||
#define ENABLE_TAND
|
||||
#endif
|
||||
|
||||
#endif /* HAVE_FABSF && HAVE_FMODF && HAVE_COPYSIGNF */
|
||||
|
||||
#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. */
|
||||
#ifdef HAVE_GFC_REAL_8
|
||||
|
||||
#define FTYPE GFC_REAL_8
|
||||
#define SIND sind_r8
|
||||
#define COSD cosd_r8
|
||||
#define TAND tand_r8
|
||||
#define SUFFIX(x) x
|
||||
/* Build _gfortran_sind_r8, _gfortran_cosd_r8, and _gfortran_tand_r8 */
|
||||
|
||||
#define TINY 0x1.p-1000 /* ~= 9.33e-302 (min exp -1074) */
|
||||
#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 */
|
||||
|
||||
#define PIO180H 1.74532925229868851602e-02L /* high 32 bits */
|
||||
#define PIO180L -3.04358939097084072823e-12L /* Next 64 bits */
|
||||
#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 */
|
||||
|
||||
#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
|
||||
#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 */
|
||||
|
||||
#ifdef GFC_REAL_16_IS_FLOAT128 /* libquadmath. */
|
||||
#define SUFFIX(x) x ## q
|
||||
#else
|
||||
#define SUFFIX(x) x ## l
|
||||
#endif /* GFC_REAL_16_IS_FLOAT128 */
|
||||
|
||||
#define TINY SUFFIX(0x1.p-16400) /* ~= 1.28e-4937 */
|
||||
#define COSD_SMALL SUFFIX(0x1.p-51) /* ~= 4.441e-16 */
|
||||
#define KIND 16
|
||||
#define TINY 0x1.p-16400 /* ~= 1.28e-4937 */
|
||||
#undef SIND_SMALL /* not precise */
|
||||
#define COSD30 SUFFIX(8.66025403784438646763723170752936183e-01)
|
||||
#define PIO180H SUFFIX(1.74532925199433197605003442731685936e-02)
|
||||
#define PIO180L SUFFIX(-2.39912634365882824665106671063098954e-17)
|
||||
|
||||
#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 */
|
||||
|
||||
#else
|
||||
/* 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
|
||||
|
||||
#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.
|
||||
|
||||
Literal values:
|
||||
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}.
|
||||
|
||||
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.
|
||||
ISFINITE(x)
|
||||
Whether x is a regular number or zero (not inf or NaN).
|
||||
|
||||
COSD_SMALL [optional]
|
||||
Value such that x <= COSD_SMALL implies COSD(x) = 1 to within the
|
||||
D2R(x)
|
||||
Convert x from radians to degrees.
|
||||
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue