cmucl-cvs December 2015

cmucl-cvs@common-lisp.net

1 participants
44 discussions

[Git][cmucl/cmucl][rtoy-setexception-inexact] Use setexception to raise the inexact exception for tanh.
by Raymond Toy 24 Dec '15

24 Dec '15

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl Commits: b9e3a511 by Raymond Toy at 2015-12-24T09:29:08Z Use setexception to raise the inexact exception for tanh. Note that original code didn't actually signal inexact probably because the compiler constant-folded one - tiny to one. - - - - - 2 changed files: - src/lisp/s_tanh.c - tests/fdlibm.lisp Changes: ===================================== src/lisp/s_tanh.c ===================================== --- a/src/lisp/s_tanh.c +++ b/src/lisp/s_tanh.c @@ -78,7 +78,9 @@ static double one=1.0, two=2.0, tiny = 1.0e-300; } /* |x| > 22, return +-1 */ } else { - z = one - tiny; /* raised inexact flag */ + /* Always raise inexact flag */ + fdlibm_setexception(x, FDLIBM_INEXACT); + z = one - tiny; } return (jx>=0)? z: -z; } ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -88,7 +88,14 @@ (assert-error 'floating-point-invalid-operation (kernel:%tanh *snan*)) (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))) + (assert-true (ext:float-nan-p (kernel:%tanh *snan*)))) + ;; tanh(x) = +/- 1 for |x| > 22, raising inexact, always. + (let ((x 22.1d0)) + (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:%tanh x))))) (define-test %acosh.exceptions (:tag :fdlibm) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/b9e3a5113c1c08e5785fc3686…

1 0

[Git][cmucl/cmucl][rtoy-setexception-inexact] Use setexception to raise the inexact exception for %log1p.
by Raymond Toy 24 Dec '15

24 Dec '15

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl Commits: 91ff3607 by Raymond Toy at 2015-12-24T09:23:06Z Use setexception to raise the inexact exception for %log1p. - - - - - 2 changed files: - src/lisp/s_log1p.c - tests/fdlibm.lisp 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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/91ff36070092df5d879081a43…

1 0

[Git][cmucl/cmucl][rtoy-setexception-inexact] Use setexception to raise the inexact exception for %expm1.
by Raymond Toy 24 Dec '15

24 Dec '15

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl Commits: 89097cd0 by Raymond Toy at 2015-12-24T09:15:27Z Use setexception to raise the inexact exception for %expm1. - - - - - 2 changed files: - src/lisp/s_expm1.c - tests/fdlibm.lisp Changes: ===================================== src/lisp/s_expm1.c ===================================== --- a/src/lisp/s_expm1.c +++ b/src/lisp/s_expm1.c @@ -160,8 +160,8 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */ } if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */ - if(x+tiny<0.0) /* raise inexact */ - return tiny-one; /* return -1 */ + fdlibm_setexception(x, FDLIBM_INEXACT); + return tiny - one; } } ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -163,7 +163,12 @@ (kernel:%expm1 709.8d0)) ) (kernel::with-float-traps-masked (:invalid) - (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) + (assert-true (ext::float-nan-p (kernel:%expm1 *snan*)))) + ;; expm1(x) = -1 for x < -56*log(2), signaling inexact + (let ((x (* -57 (log 2d0)))) + (with-inexact-exception-enabled + (assert-error 'floating-point-inexact + (kernel:%expm1 x))))) (define-test %log1p.exceptions (:tag :fdlibm) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/89097cd0d602d233c8deddd44…

1 0

[Git][cmucl/cmucl][rtoy-setexception-inexact] 3 commits: Use setexception to raise the inexact exception for sin.
by Raymond Toy 24 Dec '15

24 Dec '15

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl Commits: 71bdff74 by Raymond Toy at 2015-12-24T08:54:03Z Use setexception to raise the inexact exception for sin. - - - - - a31150c5 by Raymond Toy at 2015-12-24T08:59:29Z Use setexception to raise the inexact exception for tan. - - - - - ae70cdd3 by Raymond Toy at 2015-12-24T09:06:54Z Use setexception to raise the inexact exception for atan. - - - - - 4 changed files: - src/lisp/k_sin.c - src/lisp/k_tan.c - src/lisp/s_atan.c - tests/fdlibm.lisp Changes: ===================================== src/lisp/k_sin.c ===================================== --- a/src/lisp/k_sin.c +++ b/src/lisp/k_sin.c @@ -67,8 +67,14 @@ S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */ ux.d = x; ix = ux.i[HIWORD]&0x7fffffff; /* high word of x */ - if(ix<0x3e400000) /* |x| < 2**-27 */ - {if((int)x==0) return x;} /* generate inexact */ + if(ix<0x3e400000) { /* |x| < 2**-27 */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; + } z = x*x; v = z*x; r = S2+z*(S3+z*(S4+z*(S5+z*S6))); ===================================== src/lisp/k_tan.c ===================================== --- a/src/lisp/k_tan.c +++ b/src/lisp/k_tan.c @@ -78,31 +78,34 @@ __kernel_tan(double x, double y, int iy) { hx = ux.i[HIWORD]; /* high word of x */ ix = hx & 0x7fffffff; /* high word of |x| */ if (ix < 0x3e300000) { /* x < 2**-28 */ - if ((int) x == 0) { /* generate inexact */ - if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0) - return one / fabs(x); - else { - if (iy == 1) - return x; - else { /* compute -1 / (x+y) carefully */ - double a, t; + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } - z = w = x + y; - uz.d = z; - uz.i[LOWORD] = 0; - z = ux.d; + if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0) + return one / fabs(x); + else { + if (iy == 1) + return x; + else { /* compute -1 / (x+y) carefully */ + double a, t; + + z = w = x + y; + uz.d = z; + uz.i[LOWORD] = 0; + z = ux.d; - v = y - (z - x); - t = a = -one / w; - uz.d = t; - uz.i[LOWORD] = 0; - t = uz.d; + v = y - (z - x); + t = a = -one / w; + uz.d = t; + uz.i[LOWORD] = 0; + t = uz.d; - s = one + t * z; - return t + a * (s + t * v); - } - } + s = one + t * z; + return t + a * (s + t * v); } + } } if (ix >= 0x3FE59428) { /* |x| >= 0.6744 */ if (hx < 0) { ===================================== src/lisp/s_atan.c ===================================== --- a/src/lisp/s_atan.c +++ b/src/lisp/s_atan.c @@ -104,7 +104,12 @@ huge = 1.0e300; else return -atanhi[3]-atanlo[3]; } if (ix < 0x3fdc0000) { /* |x| < 0.4375 */ if (ix < 0x3e200000) { /* |x| < 2^-29 */ - if(huge+x>one) return x; /* raise inexact */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; } id = -1; } else { ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -258,7 +258,19 @@ (kernel:%atan *snan*)) (assert-true (ext:float-nan-p (kernel:%atan *qnan*))) (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%atan *snan*))))) + (assert-true (ext:float-nan-p (kernel:%atan *snan*)))) + ;; atan(x) = x for |x| < 2^-29, signaling inexact. + (let ((x (scale-float 1d0 -30)) + (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:%atan 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:%atan x))))) (define-test %log10.exceptions (:tag :fdlibm) @@ -622,3 +634,34 @@ ;; though the result is exactly x. (assert-error 'floating-point-inexact (kernel:%cos x))))) + +(define-test %sin.exceptions + (:tag :fdlibm) + ;; sin(x) = x 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 0d0 (kernel:%sin 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:%sin x))))) + +(define-test %tan.exceptions + (:tag :fdlibm) + ;; tan(x) = x for |x| < 2^-28. 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:%tan 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:%tan x))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/d448ca78228ea8b9173a4b42…

1 0

[Git][cmucl/cmucl][rtoy-setexception-inexact] 2 commits: Use setexception to raise the inexact exception for sinh.
by Raymond Toy 23 Dec '15

23 Dec '15

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/b4c91767d6281cb4a6f976ce…

1 0

[Git][cmucl/cmucl][rtoy-setexception-inexact] 3 commits: Use setexception to raise the inexact exception for asin.
by Raymond Toy 23 Dec '15

23 Dec '15

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl Commits: e655d017 by Raymond Toy at 2015-12-23T14:30:10Z Use setexception to raise the inexact exception for asin. o Add tests for this o Use setexception for inexact in e_asin.c. - - - - - 8b36c06e by Raymond Toy at 2015-12-23T15:48:58Z Group the inexact exception test with the exceptions tests. - - - - - b4c91767 by Raymond Toy at 2015-12-23T15:55:19Z Use setexception to raise the inexact exception for exp. o Add tests for this o Use setexception for inexact in e_exp.c. - - - - - 3 changed files: - src/lisp/e_asin.c - src/lisp/e_exp.c - tests/fdlibm.lisp 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))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0d53bc7f4a6713baf3b60149…

1 0

[Git][cmucl/cmucl][rtoy-setexception-inexact] 2 commits: Add inexact exception test for asinh.
by Raymond Toy 23 Dec '15

23 Dec '15

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl Commits: 507f6d9e by Raymond Toy at 2015-12-22T21:35:14Z Add inexact exception test for asinh. - - - - - 0d53bc7f by Raymond Toy at 2015-12-23T14:24:49Z Merge branch 'master' into rtoy-setexception-inexact - - - - - 1 changed file: - tests/fdlibm.lisp Changes: ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -14,6 +14,15 @@ (kernel:make-double-float #x7ff00000 1) "A randon signaling MaN value") +(defmacro with-inexact-exception-enabled (&body body) + (let ((old-modes (gensym "OLD-MODES-"))) + `(let ((,old-modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:inexact)) + ,@body) + (apply 'ext:set-floating-point-modes ,old-modes))))) + (define-test %cosh.exceptions (:tag :fdlibm) (assert-error 'floating-point-overflow @@ -285,10 +294,20 @@ (:tag :fdlibm) (assert-eql -0d0 (asinh -0d0)) (assert-eql 0d0 (asinh 0d0)) - (let ((x (scale-float 1d0 -29))) + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) ;; asinh(x) = x for x < 2^-28 (assert-eql x (asinh x)) - (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)))) (let ((x (scale-float 1d0 -28))) ;; Case 2 > |x| >= 2^-28 (assert-eql 3.725290298461914d-9 (asinh x)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/a53d7ef42da5bf984ae51dc4…

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-setexception-inexact
by Raymond Toy 23 Dec '15

23 Dec '15

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

1 0

[Git][cmucl/cmucl][master] Add inexact exception test for asinh.
by Raymond Toy 22 Dec '15

22 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 507f6d9e by Raymond Toy at 2015-12-22T21:35:14Z Add inexact exception test for asinh. - - - - - 1 changed file: - tests/fdlibm.lisp Changes: ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -14,6 +14,15 @@ (kernel:make-double-float #x7ff00000 1) "A randon signaling MaN value") +(defmacro with-inexact-exception-enabled (&body body) + (let ((old-modes (gensym "OLD-MODES-"))) + `(let ((,old-modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:inexact)) + ,@body) + (apply 'ext:set-floating-point-modes ,old-modes))))) + (define-test %cosh.exceptions (:tag :fdlibm) (assert-error 'floating-point-overflow @@ -285,10 +294,20 @@ (:tag :fdlibm) (assert-eql -0d0 (asinh -0d0)) (assert-eql 0d0 (asinh 0d0)) - (let ((x (scale-float 1d0 -29))) + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) ;; asinh(x) = x for x < 2^-28 (assert-eql x (asinh x)) - (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)))) (let ((x (scale-float 1d0 -28))) ;; Case 2 > |x| >= 2^-28 (assert-eql 3.725290298461914d-9 (asinh x)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/507f6d9e658dd231fb22b8402…

1 0

[Git][cmucl/cmucl][master] Add tanh tests.
by Raymond Toy 20 Dec '15

20 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4b556124 by Raymond Toy at 2015-12-20T12:38:54Z Add tanh tests. - - - - - 1 changed file: - tests/fdlibm.lisp Changes: ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -515,3 +515,26 @@ (assert-error 'floating-point-overflow (sinh (- x)))) (assert-error 'floating-point-overflow (sinh 1000d0)) (assert-error 'floating-point-overflow (sinh -1000d0))) + +(define-test tanh-basic-tests + (:tag :fdlibm) + ;; case |x| < 2^-55 + (let ((x (scale-float 1d0 -56))) + (assert-eql x (tanh x)) + (assert-eql (- x) (tanh (- x)))) + ;; tanh(log(2)) = 3/5, case |x| < 1 + (let ((x (log 2d0)) + (y (float 3/5 1d0))) + (assert-eql y (tanh x)) + (assert-eql (- y) (tanh (- x)))) + ;; tanh(2*log(2)) = 15/17, case |x| < 22 + (let ((x (* 2 (log 2d0))) + (y (float 15/17 1d0))) + (assert-eql y (tanh x)) + (assert-eql (- y) (tanh (- x)))) + ;; tanh(100) = 1, case |x| > 22 + (assert-eql 1d0 (tanh 100d0)) + (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 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4b5561248417690e415cf6152…

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs December 2015