From 51a50f19caf4a20eea3eda73af0f2d5daddc90a3 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sat, 19 May 2007 01:35:46 +0000
Subject: [PATCH] Trac ticket #10

For large numbers we did not check for odd-valued results that needed
to be rounded to even.
---
 code/float.lisp | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/code/float.lisp b/code/float.lisp
index cf2cc867b..cb126c284 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.35 2007/03/27 16:57:43 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.36 2007/05/19 01:35:46 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1200,6 +1200,7 @@ rounding modes & do ieee round-to-integer.
 	     (integer-decode-float number)
 	   (let* ((shifted (ash bits exp))
 		  (rounded (if (and (minusp exp)
+				    (oddp shifted)
 				    (not (zerop (logand bits
 							(ash 1 (- -1 exp))))))
 			       (1+ shifted)
@@ -1210,16 +1211,17 @@ rounding modes & do ieee round-to-integer.
     #+double-double
     ((double-double-float)
      (multiple-value-bind (bits exp)
-	     (integer-decode-float number)
-	   (let* ((shifted (ash bits exp))
-		  (rounded (if (and (minusp exp)
-				    (not (zerop (logand bits
-							(ash 1 (- -1 exp))))))
-			       (1+ shifted)
-			       shifted)))
-	     (if (minusp number)
-		 (- rounded)
-		 rounded))))))
+	 (integer-decode-float number)
+       (let* ((shifted (ash bits exp))
+	      (rounded (if (and (minusp exp)
+				(oddp shifted)
+				(not (zerop (logand bits
+						    (ash 1 (- -1 exp))))))
+			   (1+ shifted)
+			   shifted)))
+	 (if (minusp number)
+	     (- rounded)
+	     rounded))))))
 
 (declaim (maybe-inline %unary-ftruncate/single-float
 		       %unary-ftruncate/double-float))
-- 
GitLab