From 8e58835f0324d5937a3bdf387899702131a18b26 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Thu, 25 Aug 2005 21:25:09 +0000
Subject: [PATCH] o Fix a bug in %unary-ftruncate/single-float and  
 %unary-ftruncate/double-float where the test for infinity and NaN   was
 wrong. o When given NaN, these functions should return a quiet  
 (non-signaling) NaN instead of returning the signaling NaN.  This   fixes the
 FRUNCATE/FFLOOR/FCEILING tests in ieeefp-tests.

---
 code/float.lisp | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/code/float.lisp b/code/float.lisp
index 1078c2816..cfae17915 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.30 2004/06/18 18:18:12 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.31 2005/08/25 21:25:09 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1092,9 +1092,15 @@ rounding modes & do ieee round-to-integer.
     ;; For everything else, some of the bits in frac are
     ;; fractional.  Figure which ones they are and set them to
     ;; zero.
-    (cond ((= exp vm:single-float-normal-exponent-max)
-	   ;; Infinity or NaN.
-	   x)
+    ;;
+    (cond ((> exp vm:single-float-normal-exponent-max)
+	   ;; Infinity or NaN.  Convert NaN to quiet NaN.
+	   (let ((signif (ldb vm:single-float-significand-byte bits)))
+	     (if (zerop signif)
+		 ;; Infinity
+		 x
+		 ;; NaN.  Convert to quiet Nan
+		 (make-single-float (logior bits vm:single-float-trapping-nan-bit)))))
 	  ((<= biased 0)
 	   ;; Number is less than 1.  IEEE 754 says it should have the
 	   ;; same sign.  Make it so.
@@ -1123,8 +1129,15 @@ rounding modes & do ieee round-to-integer.
 			    (- exp vm:double-float-bias))))
     (declare (type (signed-byte 32) hi)
 	     (type (unsigned-byte 32) lo))
-    (cond ((= exp vm:double-float-normal-exponent-max)
-	   x)
+    (cond ((> exp vm:double-float-normal-exponent-max)
+	   ;; Infinity or NaN.  Convert NaN to quiet NaN.
+	   (if (and (zerop (ldb vm:double-float-significand-byte hi))
+		    (zerop lo))
+	       ;; Infinity
+	       x
+	       ;; NaN.  Convert to quiet NaN
+	       (make-double-float (logior hi vm:double-float-trapping-nan-bit)
+				  lo)))
 	  ((<= biased 0)
 	   ;; Number is less than 1.  IEEE 754 says it should have the
 	   ;; same sign.  Make it so.
-- 
GitLab