From e1b493ee19525651837595763538c78be495c17a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 29 Mar 2008 12:48:59 +0000 Subject: [PATCH] add __isinfl as rcognized non-GCing primitive for xform, and streamline infinity tests while we're at it svn: r9109 --- collects/compiler/private/xform.ss | 3 ++- src/mzscheme/src/number.c | 22 ++++++++-------------- src/mzscheme/src/numstr.c | 3 +-- src/mzscheme/src/schpriv.h | 6 ++++++ 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/collects/compiler/private/xform.ss b/collects/compiler/private/xform.ss index f812091385..f60b3e85cd 100644 --- a/collects/compiler/private/xform.ss +++ b/collects/compiler/private/xform.ss @@ -835,7 +835,8 @@ ;; So we can ignore them: strlen cos sin exp pow log sqrt atan2 - isnan isinf fpclass _fpclass _isnan __isfinited __isnanl __isinfl isnanf isinff + isnan isinf fpclass _fpclass _isnan __isfinited __isnanl + __isinff __isinfl isnanf isinff floor ceil round fmod fabs __maskrune _errno __errno isalpha isdigit isspace tolower toupper fread fwrite socket fcntl setsockopt connect send recv close diff --git a/src/mzscheme/src/number.c b/src/mzscheme/src/number.c index c204a1501e..64afeb2b6e 100644 --- a/src/mzscheme/src/number.c +++ b/src/mzscheme/src/number.c @@ -657,15 +657,13 @@ int scheme_minus_zero_p(double d) #ifdef MZ_USE_SINGLE_FLOATS static int rational_flt_p(float f) { return !(MZ_IS_NAN(f) - || MZ_IS_POS_INFINITY(f) - || MZ_IS_NEG_INFINITY(f)); + || MZ_IS_INFINITY(f)); } #endif static int rational_dbl_p(double f) { return !(MZ_IS_NAN(f) - || MZ_IS_POS_INFINITY(f) - || MZ_IS_NEG_INFINITY(f)); + || MZ_IS_INFINITY(f)); } #ifdef DEFEAT_FP_COMP_OPTIMIZATION @@ -777,8 +775,7 @@ int scheme_is_integer(const Scheme_Object *o) if (MZ_IS_NAN(d)) return 0; # endif - if (MZ_IS_POS_INFINITY(d) - || MZ_IS_NEG_INFINITY(d)) + if (MZ_IS_INFINITY(d)) return 0; if (floor(d) == d) return 1; @@ -933,7 +930,7 @@ scheme_odd_p (int argc, Scheme_Object *argv[]) if (scheme_is_integer(v)) { double d = SCHEME_FLOAT_VAL(v); - if (MZ_IS_POS_INFINITY(d) || MZ_IS_NEG_INFINITY(d)) + if (MZ_IS_INFINITY(d)) return scheme_true; return (fmod(d, 2.0) == 0.0) ? scheme_false : scheme_true; } @@ -955,7 +952,7 @@ even_p (int argc, Scheme_Object *argv[]) if (scheme_is_integer(v)) { double d = SCHEME_FLOAT_VAL(v); - if (MZ_IS_POS_INFINITY(d) || MZ_IS_NEG_INFINITY(d)) + if (MZ_IS_INFINITY(d)) return scheme_true; return (fmod(d, 2.0) == 0.0) ? scheme_true : scheme_false; } @@ -1351,8 +1348,7 @@ static Scheme_Object *get_frac(char *name, int low_p, double d = SCHEME_FLOAT_VAL(n); if (MZ_IS_NAN(d) - || MZ_IS_POS_INFINITY(d) - || MZ_IS_NEG_INFINITY(d)) { + || MZ_IS_INFINITY(d)) { scheme_wrong_type(name, "rational number", 0, argc, argv); ESCAPED_BEFORE_HERE; } @@ -1700,8 +1696,7 @@ atan_prim (int argc, Scheme_Object *argv[]) } #ifdef ATAN2_DOESNT_WORK_WITH_INFINITIES - if ((MZ_IS_POS_INFINITY(v) || MZ_IS_NEG_INFINITY(v)) - && (MZ_IS_POS_INFINITY(v2) || MZ_IS_NEG_INFINITY(v2))) { + if (MZ_IS_INFINITY(v) && MZ_IS_INFINITY(v2)) { v = MZ_IS_POS_INFINITY(v) ? 1.0 : -1.0; v2 = MZ_IS_POS_INFINITY(v2) ? 1.0 : -1.0; } @@ -2028,8 +2023,7 @@ scheme_expt(int argc, Scheme_Object *argv[]) d2 = SCHEME_FLOAT_VAL(e); if ((d2 == 0.0) - || MZ_IS_POS_INFINITY(d2) - || MZ_IS_NEG_INFINITY(d2) + || MZ_IS_INFINITY(d2) || MZ_IS_NAN(d2)) norm = 1; } diff --git a/src/mzscheme/src/numstr.c b/src/mzscheme/src/numstr.c index 01df3e03ac..8bd14ff63e 100644 --- a/src/mzscheme/src/numstr.c +++ b/src/mzscheme/src/numstr.c @@ -1595,8 +1595,7 @@ char *scheme_number_to_string(int radix, Scheme_Object *obj) int scheme_check_double(const char *where, double d, const char *dest) { - if (MZ_IS_POS_INFINITY(d) - || MZ_IS_NEG_INFINITY(d) + if (MZ_IS_INFINITY(d) || MZ_IS_NAN(d)) { if (where) scheme_raise_exn(MZEXN_FAIL_CONTRACT, diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 9e022f8b5f..48629abc17 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1493,6 +1493,7 @@ extern int scheme_is_nan(double); # define MZ_IS_NAN(d) isnan(d) # else # ifdef USE_CARBON_FP_PREDS +# define MZ_IS_INFINITY(d) (!__isfinited(d)) # define MZ_IS_POS_INFINITY(d) (!__isfinited(d) && (d > 0)) # define MZ_IS_NEG_INFINITY(d) (!__isfinited(d) && (d < 0)) # define MZ_IS_NAN(d) __isnand(d) @@ -1504,6 +1505,7 @@ extern int scheme_is_nan(double); # define MZ_IS_NAN(d) _isnan(d) # else /* USE_IEEE_FP_PREDS */ +# define MZ_IS_INFINITY(d) (isinf(d)) # define MZ_IS_POS_INFINITY(d) (isinf(d) && (d > 0)) # define MZ_IS_NEG_INFINITY(d) (isinf(d) && (d < 0)) # define MZ_IS_NAN(d) isnan(d) @@ -1514,6 +1516,10 @@ extern int scheme_is_nan(double); # endif #endif +#ifndef MZ_IS_INFINITY +# define MZ_IS_INFINITY(d) (MZ_IS_POS_INFINITY(d) || MZ_IS_NEG_INFINITY(d)) +#endif + #define IZI_REAL_PART(n) (((Scheme_Complex *)(n))->r) extern double scheme_infinity_val, scheme_minus_infinity_val;