Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
-
63ee590e
by Raymond Toy at 2024-05-10T18:53:05+00:00
-
f661bac3
by Raymond Toy at 2024-05-10T18:53:09+00:00
3 changed files:
Changes:
| ... | ... | @@ -1800,12 +1800,10 @@ Z may be any number, but the result is always a complex." |
| 1800 | 1800 | (declare (optimize (speed 3) (space 0)
|
| 1801 | 1801 | (inhibit-warnings 3)))
|
| 1802 | 1802 | (cond ((> (abs x)
|
| 1803 | - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0)
|
|
| 1804 | - ;; This is more accurate under linux.
|
|
| 1805 | - #+(or linux hpux) #.(/ (+ (%log 2.0d0)
|
|
| 1806 | - (%log most-positive-double-float)) 4d0))
|
|
| 1803 | + ;; Don't need double-double accuracy here.
|
|
| 1804 | + #.(/ (%asinh most-positive-double-float) 4d0))
|
|
| 1807 | 1805 | (complex (float-sign x)
|
| 1808 | - (float-sign y)))
|
|
| 1806 | + (float-sign y 0w0)))
|
|
| 1809 | 1807 | (t
|
| 1810 | 1808 | (let* ((tv (dd-%tan y))
|
| 1811 | 1809 | (beta (+ 1.0d0 (* tv tv)))
|
| ... | ... | @@ -1521,12 +1521,12 @@ Z may be any number, but the result is always a complex." |
| 1521 | 1521 | ;; space 0 to get maybe-inline functions inlined
|
| 1522 | 1522 | (declare (optimize (speed 3) (space 0)))
|
| 1523 | 1523 | (cond ((> (abs x)
|
| 1524 | - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0)
|
|
| 1525 | - ;; This is more accurate under linux.
|
|
| 1526 | - #+(or linux hpux) #.(/ (+ (%log 2.0d0)
|
|
| 1527 | - (%log most-positive-double-float)) 4d0))
|
|
| 1524 | + (/ (%asinh most-positive-double-float) 4d0))
|
|
| 1525 | + ;; Kahan says the answer is
|
|
| 1526 | + ;;
|
|
| 1527 | + ;; copysign(1, x) + i*copysign(0, y)
|
|
| 1528 | 1528 | (coerce-to-complex-type (float-sign x)
|
| 1529 | - (float-sign y) z))
|
|
| 1529 | + (float-sign y 0d0) z))
|
|
| 1530 | 1530 | (t
|
| 1531 | 1531 | (let* ((tv (%tan y))
|
| 1532 | 1532 | (beta (+ 1.0d0 (* tv tv)))
|
| ... | ... | @@ -231,3 +231,17 @@ |
| 231 | 231 | (let ((z (sqrt (complex minf (- nan)))))
|
| 232 | 232 | (assert-true (ext:float-nan-p (realpart z)))
|
| 233 | 233 | (assert-eql minf (imagpart z))))))
|
| 234 | + |
|
| 235 | +;; See bug #314
|
|
| 236 | +(define-test tanh-large
|
|
| 237 | + (:tag :issues)
|
|
| 238 | + (assert-eql (complex 1d0 -0d0)
|
|
| 239 | + (tanh #c(200d0 -200d0)))
|
|
| 240 | + (assert-eql (complex 1d0 +0d0)
|
|
| 241 | + (tanh #c(200d0 +200d0)))
|
|
| 242 | + (assert-eql (complex 1w0 -0w0)
|
|
| 243 | + (tanh #c(200w0 -200w0)))
|
|
| 244 | + (assert-eql (complex 1w0 +0w0)
|
|
| 245 | + (tanh #c(200w0 200w0))))
|
|
| 246 | +
|
|
| 247 | + |