diff --git a/code/float.lisp b/code/float.lisp index d19a364de5c54a3a63b545934654640046b76617..0950bfff104421fc5d9f93cfedb3e0ba15cb8d33 100644 --- a/code/float.lisp +++ b/code/float.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.16 1997/06/26 19:19:51 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.17 1998/02/19 03:49:48 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -82,15 +82,14 @@ ;;;; Float parameters: -(progn - (defconstant least-positive-single-float (single-from-bits 0 0 1)) - (defconstant least-positive-short-float least-positive-single-float) - (defconstant least-negative-single-float (single-from-bits 1 0 1)) - (defconstant least-negative-short-float least-negative-single-float) - (defconstant least-positive-double-float (double-from-bits 0 0 1)) - (defconstant least-positive-long-float least-positive-double-float) - (defconstant least-negative-double-float (double-from-bits 1 0 1)) - (defconstant least-negative-long-float least-negative-double-float)) +(defconstant least-positive-single-float (single-from-bits 0 0 1)) +(defconstant least-positive-short-float least-positive-single-float) +(defconstant least-negative-single-float (single-from-bits 1 0 1)) +(defconstant least-negative-short-float least-negative-single-float) +(defconstant least-positive-double-float (double-from-bits 0 0 1)) +(defconstant least-positive-long-float least-positive-double-float) +(defconstant least-negative-double-float (double-from-bits 1 0 1)) +(defconstant least-negative-long-float least-negative-double-float) (defconstant least-positive-normalized-single-float (single-from-bits 0 vm:single-float-normal-exponent-min 0)) @@ -183,6 +182,7 @@ ((double-float) (let ((hi (double-float-high-bits x)) (lo (double-float-low-bits x))) + (declare (ignorable lo)) (and (> (ldb vm:double-float-exponent-byte hi) vm:double-float-normal-exponent-max) ,double))))))) @@ -199,12 +199,10 @@ (frob float-trapping-nan-p "Return true if the float X is a trapping NaN (Not a Number)." - (not (zerop (logand (ldb vm:single-float-significand-byte bits) - vm:single-float-trapping-nan-bit))) - (progn - lo; ignore - (not (zerop (logand (ldb vm:double-float-significand-byte hi) - vm:double-float-trapping-nan-bit)))))) + (zerop (logand (ldb vm:single-float-significand-byte bits) + vm:single-float-trapping-nan-bit)) + (zerop (logand (ldb vm:double-float-significand-byte hi) + vm:double-float-trapping-nan-bit)))) ;;; FLOAT-PRECISION -- Public diff --git a/code/irrat.lisp b/code/irrat.lisp index 302846463197af3c43a8f377d5c6a23f365fbde7..f9536ffe08de1e277a38f84756e0fed40d87b5d0 100644 --- a/code/irrat.lisp +++ b/code/irrat.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.25 1997/12/15 06:46:54 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.26 1998/02/19 03:49:49 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -750,7 +750,7 @@ For the special cases, the following values are used: 0 -infinity " (declare (type double-float x)) - (cond ((float-trapping-nan-p x) + (cond ((float-nan-p x) x) ((float-infinity-p x) #.ext:double-float-positive-infinity) @@ -802,7 +802,7 @@ and Y are coerced to single-float." ;; signal would have been raised. (with-float-traps-masked (:underflow :overflow) (setf rho (+ (square x) (square y))) - (cond ((and (or (float-trapping-nan-p rho) + (cond ((and (or (float-nan-p rho) (float-infinity-p rho)) (or (float-infinity-p (abs x)) (float-infinity-p (abs y)))) @@ -836,7 +836,7 @@ Z may be any number, but the result is always a complex." (nu 0d0)) (declare (double-float x y eta nu)) - (if (not (float-trapping-nan-p x)) + (if (not (float-nan-p x)) (setf rho (+ (scalb (abs x) (- k)) (sqrt rho)))) (cond ((oddp k)