This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp".
The branch, master has been updated via 258101b2bc45125f6bd72dc2a1cf56e6baab821b (commit) from c5f98ef90641ec6912e35730b215eaf751841539 (commit)
Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below.
- Log ----------------------------------------------------------------- commit 258101b2bc45125f6bd72dc2a1cf56e6baab821b Author: Raymond Toy toy.raymond@gmail.com Date: Tue Aug 19 21:31:04 2014 -0700
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.
diff --git a/src/lisp/GNUmakefile b/src/lisp/GNUmakefile index 55a0b5b..c557d3b 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 1d2ac30..dc13fee 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 76b3418..9d7aec8 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 9d25664..abd6e80 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 0000000..a0f568c --- /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 4f15848..18c9199 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*))))) + + +
-----------------------------------------------------------------------
Summary of changes: 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
hooks/post-receive