- cmucl-cvs - mailman3.common-lisp.net

[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 24 Dec '15

24 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 23 Dec '15

23 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

[Git][cmucl/cmucl][master] 2 commits: Add log tests.
by Raymond Toy 20 Dec '15

20 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 106b9498 by Raymond Toy at 2015-12-20T12:18:26Z Add log tests. - - - - - d1ef807a by Raymond Toy at 2015-12-20T12:33:05Z Add sinh tests. - - - - - 1 changed file: - tests/fdlibm.lisp Changes: ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -403,3 +403,115 @@ (assert-error 'floating-point-overflow (exp 1000d0)) ;; exp(-1000) underflow (assert-eql 0d0 (exp -1000d0))) + +(define-test log-basic-tests + (:tag :fdlibm) + (assert-eql 0d0 (log 1d0)) + (assert-eql 1d0 (log (exp 1d0))) + (assert-eql -1d0 (log (exp -1d0))) + (assert-eql 0.5d0 (log (sqrt (exp 1d0)))) + (assert-eql -0.5d0 (log (sqrt (exp -1d0)))) + ;; Test a denormal arg + (assert-eql -709.08956571282410d0 (log (scale-float 1d0 -1023))) + ;; Largest double value + (assert-eql 709.7827128933840d0 (log most-positive-double-float)) + ;; Tests case 0 < f < 2^-20, k = 0 + ;; log(1+2^-21) + (assert-eql 4.7683704451632344d-7 (log (+ 1 (scale-float 1d0 -21)))) + ;; Tests case 0 < f < 2^-20, k = 1 + ;; log(2 + 2^-20) + (assert-eql 0.6931476573969898d0 (log (+ 2(scale-float 1d0 -20)))) + (assert-eql 1.3862943611198906d0 (log 4d0)) + ;; Tests main path, i > 0, k = 0 + (assert-eql 0.3220828910287846d0 + (log (kernel:make-double-float (+ #x3ff00000 #x6147a) 0))) + ;; Tests main path, i > 0, k = 1 + (assert-eql 0.35065625373947773d0 + (log (kernel:make-double-float (+ #x3ff00000 #x6b851) 0))) + ;; Tests main path, i > 0, k = -1 + (assert-eql -0.3710642895311607d0 + (log (kernel:make-double-float (+ #x3fe00000 #x6147a) 0))) + ;; Tests main path, i < 0, k = 0 + (assert-eql 0.3220821999597803d0 + (log (kernel:make-double-float (+ #x3ff00000 #x61479) 0))) + ;; Tests main path, i < 0, k = 1 + (assert-eql 1.0152293805197257d0 + (log (kernel:make-double-float (+ #x40000000 #x61479) 0))) + ;; Tests main path, i < 0, k = -1 + (assert-eql -0.37106498060016496d0 + (log (kernel:make-double-float (+ #x3fe00000 #x61479) 0)))) + +(define-test log-consistency + (:tag :fdlibm) + ;; |log(x) + log(1/x)| < 1.77635684e-15, x = 1.2^k, 0 <= k < 2000 + ;; The threshold is experimentally determined + (let ((x 1d0) + (max-value -1d0)) + (declare (double-float max-value) + (type (double-float 1d0) x)) + (dotimes (k 2000) + (let ((y (abs (+ (log x) (log (/ x)))))) + (setf max-value (max max-value y)) + (setf x (* x 1.4d0)))) + (assert-true (< max-value 1.77635684d-15))) + ;; |exp(log(x)) - x|/x < 5.6766649d-14, x = 1.4^k, 0 <= k < 2000 + (let ((x 1d0) + (max-error 0d0)) + (declare (double-float max-error) + (type (double-float 1d0) x)) + (dotimes (k 2000) + (let ((y (abs (/ (- (exp (log x)) x) x)))) + (setf max-error (max max-error y)) + (setf x (* x 1.4d0)))) + (assert-true (< max-error 5.6766649d-14))) + ;; |exp(log(x)) - x|/x < 5.68410245d-14, x = 1.4^(-k), 0 <= k < 2000 + (let ((x 1d0) + (max-error 0d0)) + (declare (double-float max-error) + (type (double-float (0d0)) x)) + (dotimes (k 2000) + (let ((y (abs (/ (- (exp (log x)) x) x)))) + (setf max-error (max max-error y)) + (setf x (/ x 1.4d0)))) + (assert-true (< max-error 5.68410245d-14)))) + +(define-test sinh-basic-tests + (:tag :fdlibm) + (assert-eql +0d0 (sinh 0d0)) + (assert-eql -0d0 (sinh -0d0)) + ;; sinh(x) = x, |x| < 2^-28 + (let ((x (scale-float 1d0 -29))) + (assert-eql x (sinh x)) + (assert-eql (- x) (sinh (- x)))) + ;; case |x| < 1 + (assert-eql 0.5210953054937474d0 (sinh 0.5d0)) + (assert-eql -0.5210953054937474d0 (sinh -0.5d0)) + ;; sinh(10*log(2)) = 1048575/2048, case |x| < 22 + (let ((x (* 10 (log 2d0))) + (y (float 1048575/2048 1d0))) + (assert-eql y (sinh x)) + (assert-eql (- y) (sinh (- x)))) + ;; sinh(10), case |x| < 22 + (let ((y 11013.232874703393d0)) + (assert-eql y (sinh 10d0)) + (assert-eql (- y) (sinh -10d0))) + ;; sinh(32*log(2)), case |x| in [22, log(maxdouble)] + (let ((x (* 32 (log 2d0))) + (y 2.1474836479999983d9)) + (assert-eql y (sinh x)) + (assert-eql (- y) (sinh (- x)))) + ;; sinh(100), case |x| in [22, log(maxdouble)] + (let ((y 1.3440585709080678d43)) + (assert-eql y (sinh 100d0)) + (assert-eql (- y) (sinh -100d0))) + ;; sinh(710....), no overflow, case |x| in [log(maxdouble), overflowthreshold] + (let ((x 710.4758600739439d0) + (y 1.7976931348621744d308)) + (assert-eql y (sinh x)) + (assert-eql (- y) (sinh (- x)))) + ;; sinh(710.475860073944), overflow, case |x| > ovfthreshold] + (let ((x 710.475860073944d0)) + (assert-error 'floating-point-overflow (sinh x)) + (assert-error 'floating-point-overflow (sinh (- x)))) + (assert-error 'floating-point-overflow (sinh 1000d0)) + (assert-error 'floating-point-overflow (sinh -1000d0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/4c29796b2ba54474fff55a48…

1 0

[Git][cmucl/cmucl][master] Add exp tests.
by Raymond Toy 19 Dec '15

19 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4c29796b by Raymond Toy at 2015-12-19T10:29:09Z Add exp tests. - - - - - 1 changed file: - tests/fdlibm.lisp Changes: ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -362,3 +362,44 @@ (let ((x 710.4758600739439d0)) (assert-eql 1.7976931348621744d308 (cosh x)) (assert-eql 1.7976931348621744d308 (cosh (- x))))) + +(define-test exp-basic-tests + (:tag :fdlibm) + ;; No overflow and no underflow + (let ((x 709.7822265625d0)) + (assert-eql 1.7968190737295725d308 (exp x)) + (assert-eql 5.565390609552841d-309 (exp (- x)))) + ;; exp(7.09782712893383973096e+02), no overflow + (assert-eql 1.7976931348622732d308 (exp 7.09782712893383973096d+02)) + ;; exp(-7.45133219101941108420e+02), no underflow + (assert-eql 4.9406564584124654d-324 (exp -7.45133219101941108420d+02)) + ;; Overflow + (assert-error 'floating-point-overflow (exp 709.7827128933841d0)) + ;; Case |x| < 2^-28 + (let ((x (scale-float 1d0 -29))) + (assert-eql (+ 1 x) (exp x)) + (assert-eql (- 1 x) (exp (- x)))) + ;; exp(0.5), case log(2)/2 < |x| < 3/2*log(2) + (let ((x 0.5d0)) + (assert-eql 1.6487212707001282d0 (exp x)) + (assert-eql 0.6065306597126334d0 (exp (- x)))) + ;; exp(2), case |x| > 3/2*log(2) + (let ((x 2d0)) + (assert-eql 7.38905609893065d0 (exp x)) + (assert-eql 0.1353352832366127d0 (exp (- x)))) + ;; exp(2^-1022), case k < -1021 + (assert-eql 1d0 (exp (scale-float 1d0 -1022))) + ;; exp(2^-1021), case k >= -1021 + (assert-eql 1d0 (exp (scale-float 1d0 -1021))) + ;; exp(7.09782712893383973096e+02), no overflow + (assert-eql 1.7976931348622732d308 (exp 7.09782712893383973096d+02)) + ;; overflow + (assert-error 'floating-point-overflow (exp 709.7827128933841d0)) + ;; exp(-7.45133219101941108420e+02), no underflow + (assert-eql 4.9406564584124654d-324 (exp -745.1332191019411d0)) + ;; exp(-745.1332191019412), underflows + (assert-eql 0d0 (exp -745.1332191019412d0)) + ;; exp(1000) overflow + (assert-error 'floating-point-overflow (exp 1000d0)) + ;; exp(-1000) underflow + (assert-eql 0d0 (exp -1000d0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4c29796b2ba54474fff55a484…

1 0

[Git][cmucl/cmucl][master] Add cosh tests.
by Raymond Toy 19 Dec '15

19 Dec '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: aeff3c51 by Raymond Toy at 2015-12-19T09:55:25Z Add cosh tests. - - - - - 1 changed file: - tests/fdlibm.lisp Changes: ===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -332,4 +332,33 @@ ;; There's no guarantee that atanh(3/4) = log(7)2 in floating ;; point, but it's true in this case with fdlibm (assert-eql (/ (log 7d0) 2) (atanh x)))) - \ No newline at end of file + +(define-test cosh-basic-tests + (:tag :fdlibm) + ;; cosh(2^-55) = 1, tiny x case + (let ((x (scale-float 1d0 -55))) + (assert-eql 1d0 (cosh x)) + (assert-eql 1d0 (cosh (- x)))) + ;; cosh(2^-55) = 1, tiny x case + (let ((x (scale-float 1d0 -56))) + (assert-eql 1d0 (cosh x)) + (assert-eql 1d0 (cosh (- x)))) + ;; cosh(log(2)/4) = (sqrt(2) + 1)/2^(5/4), case |x| < log(2)/2 + (let ((x (/ (log 2d0) 4))) + ;; This depends on (/ (log 2d0) 4) producing the value we really + ;; want as the arg. + (assert-eql 1.0150517651282178d0 (cosh x)) + (assert-eql 1.0150517651282178d0 (cosh (- x)))) + ;; cosh(10*log(2)) = 1048577/2048, case log(2)/2 < |x| < 22 + (let ((x (* 10 (log 2d0))) + (y (float 1048577/2048 1d0))) + (assert-eql y (cosh x)) + (assert-eql y (cosh (- x)))) + ;; cosh(32*log(2)), case 22 <= |x| < log(maxdouble) + (let ((x (* 32 (log 2d0)))) + (assert-eql 2.1474836479999983d9 (cosh x)) + (assert-eql 2.1474836479999983d9 (cosh (- x)))) + ;; cosh(710.4758600739439), case log(maxdouble) <= |x| <= overflowthreshold + (let ((x 710.4758600739439d0)) + (assert-eql 1.7976931348621744d308 (cosh x)) + (assert-eql 1.7976931348621744d308 (cosh (- x))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/aeff3c51eb1c62e21b4ca9a86…

1 0