[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-08-17-ga206017
Raymond Toy
rtoy at common-lisp.net
Fri Aug 22 03:41:23 UTC 2014
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 a206017de697d0bd41545b300669138d5d5533ff (commit)
via 7758900b5e12172d7b0306e67a9dc045e7c33643 (commit)
from 81ebae1c1af846d41fd128703b2357e83736d90d (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 a206017de697d0bd41545b300669138d5d5533ff
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Aug 21 20:41:10 2014 -0700
Make expm1 signal errors using fdlibm_setexception. Update tests to
handle signaling and quite NaN
* src/lisp/s_expm1.c:
* Use fdlibm_setexception
* tests/trig.lisp:
* Add additional tests to existing testsuite to distinguish
signaling and quiet NaN. The functions should signal on quiet
NaN.
* Add tests for expm1.
diff --git a/src/lisp/s_expm1.c b/src/lisp/s_expm1.c
index 7431885..4e9bae8 100644
--- a/src/lisp/s_expm1.c
+++ b/src/lisp/s_expm1.c
@@ -150,10 +150,14 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */
if(hx >= 0x40862E42) { /* if |x|>=709.78... */
if(hx>=0x7ff00000) {
if(((hx&0xfffff)|ux.i[LOWORD])!=0)
- return x+x; /* NaN */
- else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */
+ return fdlibm_setexception(x, FDLIBM_INVALID); /* NaN */
+ else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */
}
- if(x > o_threshold) return huge*huge; /* overflow */
+ if(x > o_threshold) {
+ /* overflow */
+ return fdlibm_setexception(x, FDLIBM_OVERFLOW);
+ }
+
}
if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */
if(x+tiny<0.0) /* raise inexact */
diff --git a/tests/trig.lisp b/tests/trig.lisp
index 62ac377..07cd6bd 100644
--- a/tests/trig.lisp
+++ b/tests/trig.lisp
@@ -794,10 +794,14 @@
;; Test that fdlibm routines signals exceptions as expected.
-(defparameter *nan*
+(defparameter *qnan*
(kernel::with-float-traps-masked (:invalid)
(* 0 ext:double-float-positive-infinity))
- "Some randon MaN value")
+ "Some randon quiet MaN value")
+
+(defparameter *snan*
+ (kernel:make-double-float #x7ff00000 1)
+ "A randon signaling MaN value")
(define-test cosh.exceptions
(:tag :fdlibm)
@@ -806,7 +810,9 @@
(assert-error 'floating-point-overflow
(kernel:%cosh -1000d0))
(assert-error 'floating-point-invalid-operation
- (kernel:%cosh *nan*))
+ (kernel:%cosh *snan*))
+ (assert-true (ext:float-nan-p (kernel:%cosh *qnan*)))
+
;; Same, but with overflow's masked
(kernel::with-float-traps-masked (:overflow)
(assert-equal ext:double-float-positive-infinity
@@ -819,7 +825,7 @@
(kernel:%cosh ext:double-float-negative-infinity)))
;; Test NaN
(kernel::with-float-traps-masked (:invalid)
- (assert-true (ext:float-nan-p (kernel:%cosh *nan*)))))
+ (assert-true (ext:float-nan-p (kernel:%cosh *snan*)))))
(define-test sinh.exceptions
(:tag :fdlibm)
@@ -828,7 +834,8 @@
(assert-error 'floating-point-overflow
(kernel:%sinh -1000d0))
(assert-error 'floating-point-invalid-operation
- (kernel:%sinh *nan*))
+ (kernel:%sinh *snan*))
+ (assert-true (ext:float-nan-p (kernel:%sinh *qnan*)))
;; Same, but with overflow's masked
(kernel::with-float-traps-masked (:overflow)
(assert-equal ext:double-float-positive-infinity
@@ -841,12 +848,16 @@
(kernel:%sinh ext:double-float-negative-infinity)))
;; Test NaN
(kernel::with-float-traps-masked (:invalid)
- (assert-true (ext:float-nan-p (kernel:%sinh *nan*)))))
+ (assert-true (ext:float-nan-p (kernel:%sinh *qnan*)))))
(define-test tanh.exceptions
(:tag :fdlibm)
- (assert-true (ext:float-nan-p (kernel:%tanh *nan*))))
+ (assert-true (ext:float-nan-p (kernel:%tanh *qnan*)))
+ (assert-error 'floating-point-invalid-operation
+ (kernel:%tanh *snan*))
+ (kernel::with-float-traps-masked (:invalid)
+ (assert-true (ext:float-nan-p (kernel:%tanh *snan*)))))
(define-test acosh.exceptions
(:tag :fdlibm)
@@ -860,3 +871,19 @@
(kernel::with-float-traps-masked (:invalid)
(assert-true (ext:float-nan-p (kernel:%acosh 0d0)))))
+(define-test expm1.exceptions
+ (:tag :fdlibm)
+ (assert-error 'floating-point-overflow
+ (kernel:%expm1 709.8d0))
+ (assert-equal 'ext:double-float-positive-infinity
+ (kernel:%expm1 ext:double-float-positive-infinity))
+ (assert-error 'floating-point-invalid-operation
+ (kernel:%expm1 *snan*))
+ (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*)))
+ (kernel::with-float-traps-masked (:overflow)
+ (assert-true ext:double-float-positive-infinity
+ (kernel:%expm1 709.8d0))
+ (assert-true ext:double-float-positive-infinity
+ (kernel:%expm1 ext:double-float-positive-infinity)))
+ (kernel::with-float-traps-masked (:invalid)
+ (assert-true (ext::float-nan-p (kernel:%expm1 *snan*)))))
commit 7758900b5e12172d7b0306e67a9dc045e7c33643
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Aug 21 20:32:32 2014 -0700
Handle invalid correctly.
If the argument is a quiet NaN, then we don't want to signal an
invalid operation. For all other floats, we do want to signal
that. Add function isQNaN to detect quiet NaN.
diff --git a/src/lisp/setexception.c b/src/lisp/setexception.c
index a0f568c..a77a9d8 100644
--- a/src/lisp/setexception.c
+++ b/src/lisp/setexception.c
@@ -5,6 +5,37 @@
#include "fdlibm.h"
/*
+ * Test if the given number is a quiet NaN
+ */
+
+int
+isQNaN(double x)
+{
+ int hx;
+ union { int i[2]; double d; } ux;
+
+ ux.d = x;
+ hx = ux.i[HIWORD] & 0x7fffffff;
+
+ if (hx >= 0x7ff00000) {
+ /*
+ * We have some kind of infinity or NaN. Get the (top)
+ * mantissa bits. We have a quiet NaN if the most significant
+ * bit is 1. The other bits of the mantissa don't matter. We
+ * also don't distinguish this from the quiet NaN
+ * floating-point indefinite which only has the most
+ * significant bit set. These are all considered NaNs for our
+ * purposes.
+ */
+ hx &= 0xfffff;
+
+ return hx & 0x80000;
+ }
+
+ return 0;
+}
+
+/*
* Signal the floating-point exception of the given |type|, based on
* the value of |x|.
*/
@@ -36,13 +67,21 @@ fdlibm_setexception(double x, enum FDLIBM_EXCEPTION type)
case 3:
{
/* invalid */
- feraiseexcept(FE_INVALID);
+
+ if (!isQNaN(x)) {
+ /*
+ * If it's not a quiet NaN, we want to signal an invalid
+ * operation. Otherwise, we silently return a NaN.
+ */
+ 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[HIWORD] = 0x7ff80000;
ux.i[LOWORD] = 0xdeadbeef;
ret = ux.d;
-----------------------------------------------------------------------
Summary of changes:
src/lisp/s_expm1.c | 10 +++++++---
src/lisp/setexception.c | 43 +++++++++++++++++++++++++++++++++++++++++--
tests/trig.lisp | 41 ++++++++++++++++++++++++++++++++++-------
3 files changed, 82 insertions(+), 12 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-commit
mailing list