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