Date: Friday, September 2, 2011 @ 22:19:03 Author: rtoy Path: /project/cmucl/cvsroot/src
Modified: code/float.lisp general-info/release-20c.txt
Fix rounding for large numbers.
Bug was pointed by Christophe in private email. Fix is based on his suggested solution. Some examples that should work now:
(round 100000000002.9d0) -> 100000000003
(round (+ most-positive-fixnum 1.5w0)) -> 536870912
------------------------------+ code/float.lisp | 67 ++++++++++++++++++++++------------------- general-info/release-20c.txt | 2 + 2 files changed, 38 insertions(+), 31 deletions(-)
Index: src/code/float.lisp diff -u src/code/float.lisp:1.48 src/code/float.lisp:1.49 --- src/code/float.lisp:1.48 Tue Apr 20 10:57:44 2010 +++ src/code/float.lisp Fri Sep 2 22:19:03 2011 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/float.lisp,v 1.48 2010/04/20 17:57:44 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/float.lisp,v 1.49 2011/09/03 05:19:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1257,40 +1257,45 @@ ;;; represented by an integer.] ;;; (defun %unary-round (number) - (number-dispatch ((number real)) - ((integer) number) - ((ratio) (values (round (numerator number) (denominator number)))) - (((foreach single-float double-float #+long-float long-float)) - (if (< (float most-negative-fixnum number) - number - (float most-positive-fixnum number)) - (truly-the fixnum (%unary-round number)) - (multiple-value-bind (bits exp) - (integer-decode-float number) + (flet ((round-integer (bits exp sign) (let* ((shifted (ash bits exp)) - (rounded (if (and (minusp exp) - (oddp shifted) - (not (zerop (logand bits - (ash 1 (- -1 exp)))))) + (roundup-p + ;; Round if the are fraction bits (exp is + ;; negative). + (when (minusp exp) + (let ((fraction (ldb (byte (- exp) 0) bits)) + (half (ash 1 (- -1 exp)))) + ;; If the fraction is less than half, then no + ;; rounding. Otherwise, round up if the + ;; fraction is greater than half or the + ;; integer part is odd (for round-to-even). + (cond ((> fraction half) t) + ((< fraction half) nil) + ((oddp shifted) + t))))) + (rounded (if roundup-p (1+ shifted) shifted))) - (if (minusp number) + + (if (minusp sign) (- rounded) - rounded))))) - #+double-double - ((double-double-float) - (multiple-value-bind (bits exp) - (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)))))) + rounded)))) + (number-dispatch ((number real)) + ((integer) number) + ((ratio) (values (round (numerator number) (denominator number)))) + (((foreach single-float double-float #+long-float long-float)) + (if (< (float most-negative-fixnum number) + number + (float most-positive-fixnum number)) + (truly-the fixnum (%unary-round number)) + (multiple-value-bind (bits exp sign) + (integer-decode-float number) + (round-integer bits exp sign)))) + #+double-double + ((double-double-float) + (multiple-value-bind (bits exp sign) + (integer-decode-float number) + (round-integer bits exp sign)))))) (declaim (maybe-inline %unary-ftruncate/single-float %unary-ftruncate/double-float)) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.31 src/general-info/release-20c.txt:1.32 --- src/general-info/release-20c.txt:1.31 Wed Aug 31 21:39:55 2011 +++ src/general-info/release-20c.txt Fri Sep 2 22:19:03 2011 @@ -141,6 +141,8 @@ - Make stack overflow checking actually work on Mac OS X. The implementation had the :stack-checking feature, but it didn't actually prevent stack overflows from crashing lisp. + - Fix rounding of numbers larger than a fixnum. (See Trac #10 for + a related issue.)
* Trac Tickets: