[Git][cmucl/cmucl][rtoy-setexception-inexact] 2 commits: Use setexception to raise the inexact exception for sinh.

[Raymond Toy]

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl


Commits:
e90e91d4 by Raymond Toy at 2015-12-23T19:43:17Z
Use setexception to raise the inexact exception for sinh.

- - - - -
d448ca78 by Raymond Toy at 2015-12-23T19:49:21Z
Use setexception to raise the inexact exception for cos.

- - - - -


3 changed files:

- src/lisp/e_sinh.c
- src/lisp/k_cos.c
- tests/fdlibm.lisp


Changes:

=====================================
src/lisp/e_sinh.c
=====================================
--- a/src/lisp/e_sinh.c
+++ b/src/lisp/e_sinh.c
@@ -67,8 +67,14 @@ static double one = 1.0, shuge = 1.0e307;
 	if (jx<0) h = -h;
     /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */
 	if (ix < 0x40360000) {		/* |x|<22 */
-	    if (ix<0x3e300000) 		/* |x|<2**-28 */
-		if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */
+	    if (ix<0x3e300000) {		/* |x|<2**-28 */
+		/* sinh(tiny) = tiny with inexact */
+		if (x != 0) {
+		    fdlibm_setexception(x, FDLIBM_INEXACT);
+		}
+
+		return x;		
+	    }
 	    t = fdlibm_expm1(fabs(x));
 	    if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one));
 	    return h*(t+t/(t+one));


=====================================
src/lisp/k_cos.c
=====================================
--- a/src/lisp/k_cos.c
+++ b/src/lisp/k_cos.c
@@ -75,7 +75,12 @@ C6  = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */
         ux.d = x;
 	ix = ux.i[HIWORD]&0x7fffffff;	/* ix = |x|'s high word*/
 	if(ix<0x3e400000) {			/* if x < 2**27 */
-	    if(((int)x)==0) return one;		/* generate inexact */
+            /* return 1 with inexact unless x == 0 */
+            if (x != 0) {
+                fdlibm_setexception(x, FDLIBM_INEXACT);
+            }
+
+            return one;
 	}
 	z  = x*x;
 	r  = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6)))));


=====================================
tests/fdlibm.lisp
=====================================
--- a/tests/fdlibm.lisp
+++ b/tests/fdlibm.lisp
@@ -68,8 +68,19 @@
 		  (kernel:%sinh ext:double-float-negative-infinity)))
   ;; Test NaN
   (kernel::with-float-traps-masked (:invalid)
-    (assert-true (ext:float-nan-p (kernel:%sinh *qnan*)))))
-
+    (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))))
+  ;; sinh(x) = x for |x| < 2^-28.  Should signal inexact unless x = 0.
+  (let ((x (scale-float 1d0 -29))
+	(x0 0d0))
+    (with-inexact-exception-enabled
+	;; This must not throw an inexact exception because the result
+	;; is exact when the arg is 0.
+	(assert-eql 0d0 (kernel:%sinh x0)))
+    (with-inexact-exception-enabled
+	;; This must throw an inexact exception for non-zero x even
+	;; though the result is exactly x.
+	(assert-error 'floating-point-inexact
+		      (kernel:%sinh x)))))
 
 (define-test %tanh.exceptions
   (:tag :fdlibm)
@@ -597,3 +608,17 @@
 	(assert-error 'floating-point-inexact
 		      (kernel:%asin x)))))
 
+(define-test %cos.exceptions
+    (:tag :fdlibm)
+  ;; cos(x) = 1 for |x| < 2^-27.  Signal inexact unless x = 0
+  (let ((x (scale-float 1d0 -28))
+	(x0 0d0))
+    (with-inexact-exception-enabled
+	;; This must not throw an inexact exception because the result
+	;; is exact when the arg is 0.
+	(assert-eql 1d0 (kernel:%cos x0)))
+    (with-inexact-exception-enabled
+	;; This must throw an inexact exception for non-zero x even
+	;; though the result is exactly x.
+	(assert-error 'floating-point-inexact
+		      (kernel:%cos x)))))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/b4c91767d6281cb4a6f976cee84cf17e876ccc6b...d448ca78228ea8b9173a4b42d24d16c8e9a4ef55
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20151224/bc69df24/attachment-0001.html>