Skip to content
Snippets Groups Projects
Commit b361921d authored by dtc's avatar dtc
Browse files

Fix float-trapping-nan-p which was returning T for quiet NaN and Nil

of trapping NaN.
parent e7e01cb1
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment