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

Commits:

3 changed files:

Changes:

  • src/lisp/e_asin.c
    --- a/src/lisp/e_asin.c
    +++ b/src/lisp/e_asin.c
    @@ -89,7 +89,12 @@ qS4 =  7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
     	    return fdlibm_setexception(x, FDLIBM_INVALID);
     	} else if (ix<0x3fe00000) {	/* |x|<0.5 */
     	    if(ix<0x3e400000) {		/* if |x| < 2**-27 */
    -		if(huge+x>one) return x;/* return x with inexact if x!=0*/
    +                /* return x inexact except 0 */
    +                if (x != 0) {
    +                    fdlibm_setexception(x, FDLIBM_INEXACT);
    +                }
    +
    +                return x;
     	    } else 
     		t = x*x;
     		p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
    

  • src/lisp/e_exp.c
    --- a/src/lisp/e_exp.c
    +++ b/src/lisp/e_exp.c
    @@ -161,7 +161,12 @@ P5   =  4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */
     	    x  = hi - lo;
     	} 
     	else if(hx < 0x3e300000)  {	/* when |x|<2**-28 */
    -	    if(huge+x>one) return one+x;/* trigger inexact */
    +            /* return x inexact except 0 */
    +            if (x != 0) {
    +                fdlibm_setexception(x, FDLIBM_INEXACT);
    +            }
    +
    +            return one + x;
     	}
     	else k = 0;
     
    

  • tests/fdlibm.lisp
    --- a/tests/fdlibm.lisp
    +++ b/tests/fdlibm.lisp
    @@ -106,7 +106,18 @@
         (assert-error ext:double-float-negative-infinity
     		  (kernel:%asinh ext:double-float-negative-infinity)))
       (kernel::with-float-traps-masked (:invalid)
    -    (assert-true (ext:float-nan-p (kernel:%asinh *snan*)))))
    +    (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))
    +  (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 (asinh 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
    +		      (asinh x)))))
     
     (define-test %atanh.exceptions
       (:tag :fdlibm)
    @@ -176,7 +187,19 @@
     	   (ext:set-floating-point-modes :traps '(:underflow))
     	   (assert-error 'floating-point-underflow
     			 (kernel:%exp -1000d0)))
    -      (apply #'ext:set-floating-point-modes modes))))
    +      (apply #'ext:set-floating-point-modes modes)))
    +  (let ((x (scale-float 1d0 -29))
    +	(x0 0d0))
    +    ;; exp(x) = x, |x| < 2^-28, with inexact exception unlees x = 0
    +    (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:%exp 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:%exp x)))))
     
     (define-test %log.exception
       (:tag :fdlibm)
    @@ -298,16 +321,7 @@
     	(x0 0d0))
         ;; asinh(x) = x for x < 2^-28
         (assert-eql x (asinh x))
    -    (assert-eql (- x) (asinh (- x)))
    -    (with-inexact-exception-enabled
    -	;; This must not throw an inexact exception because the result
    -	;; is exact when the arg is 0.
    -	(assert-eql 0d0 (asinh 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
    -		      (asinh x))))
    +    (assert-eql (- x) (asinh (- x))))
       (let ((x (scale-float 1d0 -28)))
         ;; Case 2 > |x| >= 2^-28
         (assert-eql 3.725290298461914d-9 (asinh x))
    @@ -556,4 +570,30 @@
       (assert-eql -1d0 (tanh -100d0))
       ;; tanh(1d300), no overflow
       (assert-eql 1d0 (tanh most-positive-double-float))
    -  (assert-eql -1d0 (tanh (- most-positive-double-float))))
    \ No newline at end of file
    +  (assert-eql -1d0 (tanh (- most-positive-double-float))))
    +
    +(define-test %asin-basic-tests
    +    (:tag :fdlibm)
    +  (let ((x (scale-float 1d0 -28))
    +	(x0 0d0))
    +    ;; asin(x) = x for |x| < 2^-27, with inexact exception if x is not 0.
    +    (assert-eql x (kernel:%asin x))
    +    (assert-eql (- x) (kernel:%asin (- x)))))
    +
    +(define-test %asin-exception
    +    (:tag :fdlibm)
    +  (let ((x (scale-float 1d0 -28))
    +	(x0 0d0))
    +    ;; asin(x) = x for |x| < 2^-27, with inexact exception if x is not 0.
    +    (assert-eql x (kernel:%asin x))
    +    (assert-eql (- x) (kernel:%asin (- x)))
    +    (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:%asin 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:%asin x)))))
    +