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

Commits:

2 changed files:

Changes:

  • src/lisp/s_log1p.c
    --- a/src/lisp/s_log1p.c
    +++ b/src/lisp/s_log1p.c
    @@ -123,9 +123,14 @@ static double zero = 0.0;
                     }
     	    }
     	    if(ax<0x3e200000) {			/* |x| < 2**-29 */
    -		if(two54+x>zero			/* raise inexact */
    -	            &&ax<0x3c900000) 		/* |x| < 2**-54 */
    +		if (ax < 0x3c900000) {  /* |x| < 2**-54 */
    +		    /* return x inexact except 0 */
    +		    if (x != 0) {
    +			fdlibm_setexception(x, FDLIBM_INEXACT);
    +		    }
    +
     		    return x;
    +		}
     		else
     		    return x - x*x*0.5;
     	    }
    

  • tests/fdlibm.lisp
    --- a/tests/fdlibm.lisp
    +++ b/tests/fdlibm.lisp
    @@ -181,7 +181,19 @@
         (assert-equal ext:double-float-negative-infinity
     		  (kernel:%log1p -1d0)))
       (kernel::with-float-traps-masked (:invalid)
    -    (assert-true (ext:float-nan-p (kernel:%log1p *snan*)))))
    +    (assert-true (ext:float-nan-p (kernel:%log1p *snan*))))
    +  ;; log1p(x) = x for |x| < 2^-54, signaling inexact except for x = 0.
    +  (let ((x (scale-float 1d0 -55))
    +	(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:%log1p 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:%log1p x)))))
     
     (define-test %exp.exceptions
       (:tag :fdlibm)