X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Firrat.lisp;h=b821b7ac469b609cb33c352c17d5832251b0eab2;hb=e8e3ccee2ad4acb6ee1774d91648b68254868483;hp=e308197514bab84ec8f83ef5905b36103ef64dd3;hpb=b0a51fec91a2196e95824165dcdb049ff6e3834b;p=sbcl.git diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index e308197..b821b7a 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -118,7 +118,10 @@ #!+sb-doc "Return BASE raised to the POWER." (if (zerop power) - (1+ (* base power)) + (let ((result (1+ (* base power)))) + (if (and (floatp result) (float-nan-p result)) + (float 1 result) + result)) (labels (;; determine if the double float is an integer. ;; 0 - not an integer ;; 1 - an odd int @@ -879,25 +882,25 @@ (declare (optimize (speed 3))) (cond ((or (> x theta) (> (abs y) theta)) - ;; To avoid overflow... - (setf eta (float-sign y half-pi)) - ;; nu is real part of 1/(x + iy). This is x/(x^2+y^2), + ;; To avoid overflow... + (setf nu (float-sign y half-pi)) + ;; ETA is real part of 1/(x + iy). This is x/(x^2+y^2), ;; which can cause overflow. Arrange this computation so ;; that it won't overflow. - (setf nu (let* ((x-bigger (> x (abs y))) - (r (if x-bigger (/ y x) (/ x y))) - (d (+ 1.0d0 (* r r)))) - (if x-bigger - (/ (/ x) d) - (/ (/ r y) d))))) + (setf eta (let* ((x-bigger (> x (abs y))) + (r (if x-bigger (/ y x) (/ x y))) + (d (+ 1.0d0 (* r r)))) + (if x-bigger + (/ (/ x) d) + (/ (/ r y) d))))) ((= x 1.0d0) ;; Should this be changed so that if y is zero, eta is set ;; to +infinity instead of approx 176? In any case ;; tanh(176) is 1.0d0 within working precision. (let ((t1 (+ 4d0 (square y))) (t2 (+ (abs y) rho))) - (setf eta (log (/ (sqrt (sqrt t1))) - (sqrt t2))) + (setf eta (log (/ (sqrt (sqrt t1)) + (sqrt t2)))) (setf nu (* 0.5d0 (float-sign y (+ half-pi (atan (* 0.5d0 t2))))))))