From 82d40d150908a2019584e7025e8936bceef9643b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 28 Jun 2019 21:48:10 -0600 Subject: [PATCH] use wrappers for trig functions in complex variants Using wrappers applies various "sconfig.h"-configured fixups. --- racket/collects/compiler/private/xform.rkt | 3 ++- racket/src/racket/src/complex.c | 14 +++++------ racket/src/racket/src/number.c | 14 +++++------ racket/src/racket/src/schpriv.h | 27 +++++++++++----------- 4 files changed, 30 insertions(+), 28 deletions(-) diff --git a/racket/collects/compiler/private/xform.rkt b/racket/collects/compiler/private/xform.rkt index 10be0b53dc..36db405a74 100644 --- a/racket/collects/compiler/private/xform.rkt +++ b/racket/collects/compiler/private/xform.rkt @@ -907,7 +907,8 @@ __get_errno_ptr ; QNX preprocesses errno to __get_errno_ptr __getreent ; Cygwin - strlen cos cosl sin sinl exp expl pow powl log logl sqrt sqrtl atan2 atan2l frexp + strlen cos cosl sin sinl tan tanl exp expl pow powl log logl sqrt sqrtl frexp + asin acos asinl acosl atan atanl atan2 atan2l isnan isinf fpclass signbit _signbit _fpclass __fpclassify __fpclassifyf __fpclassifyl _isnan __isfinited __isnanl __isnan __signbit __signbitf __signbitd __signbitl __signbitf128 __isinff __isinfl isnanf isinff __isinfd __isnanf __isnand __isinf __isinff128 diff --git a/racket/src/racket/src/complex.c b/racket/src/racket/src/complex.c index b132008a4f..9f27d2ff7b 100644 --- a/racket/src/racket/src/complex.c +++ b/racket/src/racket/src/complex.c @@ -445,15 +445,15 @@ Scheme_Object *scheme_complex_atan(const Scheme_Object *c) i = (IS_NEG(y) ? HALF_PI : (-HALF_PI)); } else if (x == 1.0) { double k = ay + RHO; - r = log(sqrt(sqrt((y * y) + 4.0)) / sqrt(k)); - i = (HALF_PI + atan(k/2.0)) / (IS_NEG(y) ? 2.0 : -2.0); + r = scheme_double_log(sqrt(sqrt((y * y) + 4.0)) / sqrt(k)); + i = (HALF_PI + scheme_double_atan(k/2.0)) / (IS_NEG(y) ? 2.0 : -2.0); } else { double mx = 1.0 - x; double k = ay + RHO; k = k * k; - r = log(((4.0 * x) / ((mx * mx) + k)) + 1.0) / 4.0; - i = atan2(2.0 * y, (mx * (1.0 + x)) - k) / -2.0; + r = scheme_double_log(((4.0 * x) / ((mx * mx) + k)) + 1.0) / 4.0; + i = scheme_double_atan2(2.0 * y, (mx * (1.0 + x)) - k) / -2.0; } if (negate) { @@ -506,15 +506,15 @@ Scheme_Object *scheme_complex_asin_or_acos(const Scheme_Object *z, int get_asin) if (get_asin) { if (SCHEME_COMPLEXP(z)) { r = scheme_real_to_double(_scheme_complex_real_part(z)); - r = atan2(r, (a*c)-(b*d)); + r = scheme_double_atan2(r, (a*c)-(b*d)); } else { r = scheme_real_to_double((Scheme_Object *)z); - r = atan2(r, 0.0); /* void +nan.0 from (a*c)-(b*d) */ + r = scheme_double_atan2(r, 0.0); /* void +nan.0 from (a*c)-(b*d) */ } i = asinh((a*d)-(b*c)); } else { - r = 2.0 * atan2(a, c); + r = 2.0 * scheme_double_atan2(a, c); i = asinh((b*c) - (a*d)); } diff --git a/racket/src/racket/src/number.c b/racket/src/racket/src/number.c index 82880bb000..0897c14555 100644 --- a/racket/src/racket/src/number.c +++ b/racket/src/racket/src/number.c @@ -2916,7 +2916,7 @@ static Scheme_Object *complex_atan(Scheme_Object *c) #define OVER_ONE_MAG_USES_COMPLEX(d) (d > 1.0) || (d < -1.0) #ifdef TRIG_ZERO_NEEDS_SIGN_CHECK -#define MK_SCH_TRIG(SCH_TRIG, c_trig) static double SCH_TRIG(double d) { if (d == 0.0) return d; else return c_trig(d); } +#define MK_SCH_TRIG(SCH_TRIG, c_trig) XFORM_NONGCING static double SCH_TRIG(double d) { if (d == 0.0) return d; else return c_trig(d); } MK_SCH_TRIG(SCH_TAN, tan) MK_SCH_TRIG(SCH_SIN, sin) MK_SCH_TRIG(SCH_ASIN, asin) @@ -2924,7 +2924,7 @@ MK_SCH_TRIG(SCH_ASIN, asin) #else # ifdef SIN_COS_NEED_DEOPTIMIZE # pragma optimize("g", off) -# define MK_SCH_TRIG(SCH_TRIG, c_trig) static double SCH_TRIG(double d) { return c_trig(d); } +# define MK_SCH_TRIG(SCH_TRIG, c_trig) XFORM_NONGCING static double SCH_TRIG(double d) { return c_trig(d); } MK_SCH_TRIG(SCH_SIN, sin) MK_SCH_TRIG(SCH_COS, cos) MK_SCH_TRIG(SCH_TAN, tan) @@ -2937,7 +2937,7 @@ MK_SCH_TRIG(SCH_TAN, tan) # define SCH_ASIN asin #endif -static double SCH_ATAN(double v) +XFORM_NONGCING static double SCH_ATAN(double v) { #ifdef TRIG_ZERO_NEEDS_SIGN_CHECK if (v == 0.0) { @@ -2948,7 +2948,7 @@ static double SCH_ATAN(double v) return v; } -static double SCH_ATAN2(double v, double v2) +XFORM_NONGCING static double SCH_ATAN2(double v, double v2) { #ifdef ATAN2_DOESNT_WORK_WITH_INFINITIES if (MZ_IS_INFINITY(v) && MZ_IS_INFINITY(v2)) { @@ -2965,7 +2965,6 @@ static double SCH_ATAN2(double v, double v2) return atan2(v, v2); } - #ifdef LOG_ZERO_ISNT_NEG_INF static double SCH_LOG(double d) { if (d == 0.0) return scheme_minus_infinity_val; else return log(d); } #else @@ -2981,6 +2980,7 @@ double scheme_double_acos(double x) { return acos(x); } double scheme_double_atan(double x) { return SCH_ATAN(x); } double scheme_double_log(double x) { return SCH_LOG(x); } double scheme_double_exp(double x) { return exp(x); } +double scheme_double_atan2(double v, double v2) { return SCH_ATAN2(v, v2); } #ifdef MZ_LONG_DOUBLE long_double scheme_long_double_sin(long_double x) { return long_double_sin(x); } @@ -3351,7 +3351,7 @@ static Scheme_Object *fixnum_expt(intptr_t x, intptr_t y) } #ifdef ASM_DBLPREC_CONTROL_87 -static double protected_pow(double x, double y) +XFORM_NONGCING static double protected_pow(double x, double y) { /* libm's pow() implementation seems to sometimes rely on extended precision in pow(), so reset the control @@ -3390,7 +3390,7 @@ static long_double protected_powl(long_double x, long_double y) # define sch_powl protected_powl # endif #else -static double sch_pow(double x, double y) +XFORM_NONGCING static double sch_pow(double x, double y) { /* Explciitly handle all cases described by C99 */ if (x == 1.0) diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 759bfcb47b..4f9c730330 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -2523,19 +2523,20 @@ intptr_t scheme_rand(Scheme_Random_State *rs); /***** flonums *****/ -double scheme_double_truncate(double x); -double scheme_double_round(double x); -double scheme_double_floor(double x); -double scheme_double_ceiling(double x); -double scheme_double_sin(double x); -double scheme_double_cos(double x); -double scheme_double_tan(double x); -double scheme_double_asin(double x); -double scheme_double_acos(double x); -double scheme_double_atan(double x); -double scheme_double_log(double x); -double scheme_double_exp(double x); -double scheme_double_expt(double x, double y); +XFORM_NONGCING double scheme_double_truncate(double x); +XFORM_NONGCING double scheme_double_round(double x); +XFORM_NONGCING double scheme_double_floor(double x); +XFORM_NONGCING double scheme_double_ceiling(double x); +XFORM_NONGCING double scheme_double_sin(double x); +XFORM_NONGCING double scheme_double_cos(double x); +XFORM_NONGCING double scheme_double_tan(double x); +XFORM_NONGCING double scheme_double_asin(double x); +XFORM_NONGCING double scheme_double_acos(double x); +XFORM_NONGCING double scheme_double_atan(double x); +XFORM_NONGCING double scheme_double_atan2(double v, double v2); +XFORM_NONGCING double scheme_double_log(double x); +XFORM_NONGCING double scheme_double_exp(double x); +XFORM_NONGCING double scheme_double_expt(double x, double y); /***** extflonums *****/ #ifdef MZ_LONG_DOUBLE