suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use wrappers for trig functions in complex variants

Browse Source 
Using wrappers applies various "sconfig.h"-configured fixups.
This commit is contained in:
Matthew Flatt 2019-06-28 21:48:10 -06:00
parent 2847d1d22a
commit 82d40d1509
4 changed files with 30 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/collects/compiler/private/xform.rkt
View File

@ -907,7 +907,8 @@
__get_errno_ptr ; QNX preprocesses errno to __get_errno_ptr __get_errno_ptr ; QNX preprocesses errno to __get_errno_ptr
__getreent ; Cygwin __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 isinf fpclass signbit _signbit _fpclass __fpclassify __fpclassifyf __fpclassifyl
_isnan __isfinited __isnanl __isnan __signbit __signbitf __signbitd __signbitl __signbitf128 _isnan __isfinited __isnanl __isnan __signbit __signbitf __signbitd __signbitl __signbitf128
__isinff __isinfl isnanf isinff __isinfd __isnanf __isnand __isinf __isinff128 __isinff __isinfl isnanf isinff __isinfd __isnanf __isnand __isinf __isinff128

14
racket/src/racket/src/complex.c
View File

@ -445,15 +445,15 @@ Scheme_Object *scheme_complex_atan(const Scheme_Object *c)
i = (IS_NEG(y) ? HALF_PI : (-HALF_PI)); i = (IS_NEG(y) ? HALF_PI : (-HALF_PI));
} else if (x == 1.0) { } else if (x == 1.0) {
double k = ay + RHO; double k = ay + RHO;
r = log(sqrt(sqrt((y * y) + 4.0)) / sqrt(k)); r = scheme_double_log(sqrt(sqrt((y * y) + 4.0)) / sqrt(k));
i = (HALF_PI + atan(k/2.0)) / (IS_NEG(y) ? 2.0 : -2.0); i = (HALF_PI + scheme_double_atan(k/2.0)) / (IS_NEG(y) ? 2.0 : -2.0);
} else { } else {
double mx = 1.0 - x; double mx = 1.0 - x;
double k = ay + RHO; double k = ay + RHO;
k = k * k; k = k * k;
r = log(((4.0 * x) / ((mx * mx) + k)) + 1.0) / 4.0; r = scheme_double_log(((4.0 * x) / ((mx * mx) + k)) + 1.0) / 4.0;
i = atan2(2.0 * y, (mx * (1.0 + x)) - k) / -2.0; i = scheme_double_atan2(2.0 * y, (mx * (1.0 + x)) - k) / -2.0;
} }
if (negate) { if (negate) {
@ -506,15 +506,15 @@ Scheme_Object *scheme_complex_asin_or_acos(const Scheme_Object *z, int get_asin)
if (get_asin) { if (get_asin) {
if (SCHEME_COMPLEXP(z)) { if (SCHEME_COMPLEXP(z)) {
r = scheme_real_to_double(_scheme_complex_real_part(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 { } else {
r = scheme_real_to_double((Scheme_Object *)z); 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)); i = asinh((a*d)-(b*c));
} else { } else {
r = 2.0 * atan2(a, c); r = 2.0 * scheme_double_atan2(a, c);
i = asinh((b*c) - (a*d)); i = asinh((b*c) - (a*d));
} }

14
racket/src/racket/src/number.c
View File

@ -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) #define OVER_ONE_MAG_USES_COMPLEX(d) (d > 1.0) || (d < -1.0)
#ifdef TRIG_ZERO_NEEDS_SIGN_CHECK #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_TAN, tan)
MK_SCH_TRIG(SCH_SIN, sin) MK_SCH_TRIG(SCH_SIN, sin)
MK_SCH_TRIG(SCH_ASIN, asin) MK_SCH_TRIG(SCH_ASIN, asin)
@ -2924,7 +2924,7 @@ MK_SCH_TRIG(SCH_ASIN, asin)
#else #else
# ifdef SIN_COS_NEED_DEOPTIMIZE # ifdef SIN_COS_NEED_DEOPTIMIZE
# pragma optimize("g", off) # 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_SIN, sin)
MK_SCH_TRIG(SCH_COS, cos) MK_SCH_TRIG(SCH_COS, cos)
MK_SCH_TRIG(SCH_TAN, tan) MK_SCH_TRIG(SCH_TAN, tan)
@ -2937,7 +2937,7 @@ MK_SCH_TRIG(SCH_TAN, tan)
# define SCH_ASIN asin # define SCH_ASIN asin
#endif #endif
static double SCH_ATAN(double v) XFORM_NONGCING static double SCH_ATAN(double v)
{ {
#ifdef TRIG_ZERO_NEEDS_SIGN_CHECK #ifdef TRIG_ZERO_NEEDS_SIGN_CHECK
if (v == 0.0) { if (v == 0.0) {
@ -2948,7 +2948,7 @@ static double SCH_ATAN(double v)
return 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 #ifdef ATAN2_DOESNT_WORK_WITH_INFINITIES
if (MZ_IS_INFINITY(v) && MZ_IS_INFINITY(v2)) { 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); return atan2(v, v2);
} }
#ifdef LOG_ZERO_ISNT_NEG_INF #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); } static double SCH_LOG(double d) { if (d == 0.0) return scheme_minus_infinity_val; else return log(d); }
#else #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_atan(double x) { return SCH_ATAN(x); }
double scheme_double_log(double x) { return SCH_LOG(x); } double scheme_double_log(double x) { return SCH_LOG(x); }
double scheme_double_exp(double x) { return exp(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 #ifdef MZ_LONG_DOUBLE
long_double scheme_long_double_sin(long_double x) { return long_double_sin(x); } 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 #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 /* libm's pow() implementation seems to sometimes rely on
extended precision in pow(), so reset the control 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 # define sch_powl protected_powl
# endif # endif
#else #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 */ /* Explciitly handle all cases described by C99 */
if (x == 1.0) if (x == 1.0)

27
racket/src/racket/src/schpriv.h
View File

@ -2523,19 +2523,20 @@ intptr_t scheme_rand(Scheme_Random_State *rs);
/***** flonums *****/ /***** flonums *****/
double scheme_double_truncate(double x); XFORM_NONGCING double scheme_double_truncate(double x);
double scheme_double_round(double x); XFORM_NONGCING double scheme_double_round(double x);
double scheme_double_floor(double x); XFORM_NONGCING double scheme_double_floor(double x);
double scheme_double_ceiling(double x); XFORM_NONGCING double scheme_double_ceiling(double x);
double scheme_double_sin(double x); XFORM_NONGCING double scheme_double_sin(double x);
double scheme_double_cos(double x); XFORM_NONGCING double scheme_double_cos(double x);
double scheme_double_tan(double x); XFORM_NONGCING double scheme_double_tan(double x);
double scheme_double_asin(double x); XFORM_NONGCING double scheme_double_asin(double x);
double scheme_double_acos(double x); XFORM_NONGCING double scheme_double_acos(double x);
double scheme_double_atan(double x); XFORM_NONGCING double scheme_double_atan(double x);
double scheme_double_log(double x); XFORM_NONGCING double scheme_double_atan2(double v, double v2);
double scheme_double_exp(double x); XFORM_NONGCING double scheme_double_log(double x);
double scheme_double_expt(double x, double y); XFORM_NONGCING double scheme_double_exp(double x);
XFORM_NONGCING double scheme_double_expt(double x, double y);
/***** extflonums *****/ /***** extflonums *****/
#ifdef MZ_LONG_DOUBLE #ifdef MZ_LONG_DOUBLE