From 258101b2bc45125f6bd72dc2a1cf56e6baab821b Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Tue, 19 Aug 2014 21:31:04 -0700 Subject: [PATCH] Make sure floating-point exceptions are signaled. The compiler sometimes constant folds operations so that floating-point exceptions are not signaled. However, lisp and other applications (maxima) currently expects these exceptions to be signaled. Make this happen by using feraiseexcept to force these signals when they are enabled. If feraiseexcept does not raise an exception (because it is masked), we return the appropriate value. Only a few files have been updated to support this. More work needed. * src/lisp/setexception.c: * New file. This is used by the routines to signal an appropriate exception or return the appropriate value. Uses feraiseexcept to do this, which should be available on all supported platforms. * src/lisp/GNUmakefile: * Add setexception.c to list of files to compile and link into lisp. * src/lisp/e_cosh.c: * Update to use the new routine.to signal exceptions. * src/lisp/e_sinh.c: * Update to use the new routine.to signal exceptions. * tests/trig.lisp: * Add tests to make sure exceptions are thrown for cosh and sinh. * Add tests to make sure that the correct value is returned when the floating point exception is masked. --- src/lisp/GNUmakefile | 3 ++- src/lisp/e_cosh.c | 12 ++++++--- src/lisp/e_sinh.c | 10 ++++++-- src/lisp/fdlibm.h | 8 ++++++ src/lisp/setexception.c | 55 +++++++++++++++++++++++++++++++++++++++++ tests/trig.lisp | 54 ++++++++++++++++++++++++++++++++++++---- 6 files changed, 131 insertions(+), 11 deletions(-) create mode 100644 src/lisp/setexception.c diff --git a/src/lisp/GNUmakefile b/src/lisp/GNUmakefile index 55a0b5b87..c557d3be4 100644 --- a/src/lisp/GNUmakefile +++ b/src/lisp/GNUmakefile @@ -11,7 +11,8 @@ FDLIBM = k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \ e_cosh.c e_sinh.c s_tanh.c \ e_acosh.c s_asinh.c e_atanh.c \ e_atan2.c \ - e_rem_pio2.c k_rem_pio2.c + e_rem_pio2.c k_rem_pio2.c \ + setexception.c SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ vars.c parse.c interrupt.c search.c validate.c globals.c \ diff --git a/src/lisp/e_cosh.c b/src/lisp/e_cosh.c index 1d2ac3078..dc13feeca 100644 --- a/src/lisp/e_cosh.c +++ b/src/lisp/e_cosh.c @@ -58,8 +58,14 @@ static double one = 1.0, half=0.5, huge = 1.0e307; ix &= 0x7fffffff; /* x is INF or NaN */ - if(ix>=0x7ff00000) return x*x; - + if(ix>=0x7ff00000) { + if (ix == 0x7ff00000 && (ux.i[LOWORD] == 0)) { + return fdlibm_setexception(fabs(x), FDLIBM_OVERFLOW); + } else { + return fdlibm_setexception(x, FDLIBM_INVALID); + } + } + /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */ if(ix<0x3fd62e43) { t = fdlibm_expm1(fabs(x)); @@ -91,5 +97,5 @@ static double one = 1.0, half=0.5, huge = 1.0e307; } /* |x| > overflowthresold, cosh(x) overflow */ - return fabs(x)*huge; + return fdlibm_setexception(fabs(x), FDLIBM_OVERFLOW);; } diff --git a/src/lisp/e_sinh.c b/src/lisp/e_sinh.c index 76b3418d0..9d7aec89a 100644 --- a/src/lisp/e_sinh.c +++ b/src/lisp/e_sinh.c @@ -55,7 +55,13 @@ static double one = 1.0, shuge = 1.0e307; ix = jx&0x7fffffff; /* x is INF or NaN */ - if(ix>=0x7ff00000) return x+x; + if(ix>=0x7ff00000) { + if (ix == 0x7ff00000 && (ux.i[LOWORD] == 0)) { + return fdlibm_setexception(x, FDLIBM_OVERFLOW); + } else { + return fdlibm_setexception(x, FDLIBM_INVALID); + } + }; h = 0.5; if (jx<0) h = -h; @@ -84,5 +90,5 @@ static double one = 1.0, shuge = 1.0e307; } /* |x| > overflowthresold, sinh(x) overflow */ - return x*shuge; + return fdlibm_setexception(x, FDLIBM_OVERFLOW);; } diff --git a/src/lisp/fdlibm.h b/src/lisp/fdlibm.h index 9d256646c..abd6e80d7 100644 --- a/src/lisp/fdlibm.h +++ b/src/lisp/fdlibm.h @@ -57,5 +57,13 @@ extern double fdlibm_atan(double x); extern double __ieee754_exp(double x); extern double __ieee754_log(double x); +enum FDLIBM_EXCEPTION { + FDLIBM_DIVIDE_BY_ZERO, + FDLIBM_UNDERFLOW, + FDLIBM_OVERFLOW, + FDLIBM_INVALID +}; + +extern double fdlibm_setexception(double x, enum FDLIBM_EXCEPTION); #endif diff --git a/src/lisp/setexception.c b/src/lisp/setexception.c new file mode 100644 index 000000000..a0f568c05 --- /dev/null +++ b/src/lisp/setexception.c @@ -0,0 +1,55 @@ +#include <fenv.h> +#include <math.h> +#include <stdio.h> + +#include "fdlibm.h" + +/* + * Signal the floating-point exception of the given |type|, based on + * the value of |x|. + */ + +double +fdlibm_setexception(double x, enum FDLIBM_EXCEPTION type) +{ + double ret; + + switch (type) { + case 0: + /* Division by zero. Use the sign of x to get the correct + * signed infinity + */ + feraiseexcept(FE_DIVBYZERO); + + ret = copysign(INFINITY, x); + break; + case 1: + /* Underflow. Use the sign of x to get a signed zero. */ + feraiseexcept(FE_UNDERFLOW); + ret = copysign(0.0, x); + break; + case 2: + /* overflow */ + feraiseexcept(FE_OVERFLOW); + ret = copysign(INFINITY, x); + break; + case 3: + { + /* invalid */ + feraiseexcept(FE_INVALID); + /* + * FIXME: Of the many NaN values that we have, what NaN + * should we return? + */ + union { int i[2]; double d; } ux; + ux.i[HIWORD] = 0x7ff00000; + ux.i[LOWORD] = 0xdeadbeef; + + ret = ux.d; + + break; + } + } + + return ret; +} diff --git a/tests/trig.lisp b/tests/trig.lisp index 4f1584869..18c919908 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -792,12 +792,56 @@ (assert-true (check-signs #'atanh #c(2d0 0d0) tr ti)) (assert-true (check-signs #'atanh #c(2w0 0w0) tr ti)))) -(define-test cosh.overflow - (:tag :cosh) +;; Test that fdlibm routines signals exceptions as expected. + +(defparameter *nan* + (kernel::with-float-traps-masked (:invalid) + (* 0 ext:double-float-positive-infinity)) + "Some randon MaN value") + +(define-test cosh.exceptions + (:tag :fdlibm) (assert-error 'floating-point-overflow - (cosh 1000d0))) + (cosh 1000d0)) + (assert-error 'floating-point-overflow + (cosh -1000d0)) + (assert-error 'floating-point-invalid-operation + (cosh *nan*)) + ;; Same, but with overflow's masked + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (cosh 1000d0)) + (assert-equal ext:double-float-positive-infinity + (cosh -1000d0)) + (assert-equal ext:double-float-positive-infinity + (cosh ext:double-float-positive-infinity)) + (assert-equal ext:double-float-positive-infinity + (cosh ext:double-float-negative-infinity))) + ;; Test NaN + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (cosh *nan*))))) (define-test sinh.overflow - (:tag :sinh) + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (sinh 1000d0)) (assert-error 'floating-point-overflow - (sinh 1000d0))) \ No newline at end of file + (sinh -1000d0)) + (assert-error 'floating-point-invalid-operation + (sinh *nan*)) + ;; Same, but with overflow's masked + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (sinh 1000d0)) + (assert-equal ext:double-float-negative-infinity + (sinh -1000d0)) + (assert-equal ext:double-float-positive-infinity + (sinh ext:double-float-positive-infinity)) + (assert-equal ext:double-float-negative-infinity + (sinh ext:double-float-negative-infinity))) + ;; Test NaN + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (sinh *nan*))))) + + + -- GitLab