From 8754394dc238f6932935bf46490b2206c2a33344 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 4 Sep 2011 20:27:17 +0100 Subject: [PATCH] fix rounding of floats big enough to be bignums Wow, so broken: the attempt to confuse while pretending to do round-to-even goes back decades to original CMUCL sources. Rewrite the bignum branch with a more careful and clear version that is obviously correct. Optimizers might want to elide some of the computation on appropriate platforms: on 32-bit platforms, all single floats outside the fixnum range are integral, while on 64-bit platforms all single and double floats outside the fixnum range are integral. (This could be implemented by comparing most-fooative-fixnum with fooble-float-significand-byte) --- src/code/float.lisp | 15 ++++++++------- tests/float.pure.lisp | 8 ++++++++ 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/src/code/float.lisp b/src/code/float.lisp index 88ffb3784..483a6cfd9 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -810,13 +810,14 @@ (truly-the fixnum (%unary-round number)) (multiple-value-bind (bits exp) (integer-decode-float number) (let* ((shifted (ash bits exp)) - (rounded (if (and (minusp exp) - (oddp shifted) - (eql (logand bits - (lognot (ash -1 (- exp)))) - (ash 1 (- -1 exp)))) - (1+ shifted) - shifted))) + (rounded (if (minusp exp) + (let ((fractional-bits (logand bits (lognot (ash -1 (- exp))))) + (0.5bits (ash 1 (- -1 exp)))) + (cond + ((> fractional-bits 0.5bits) (1+ shifted)) + ((< fractional-bits 0.5bits) shifted) + (t (if (oddp shifted) (1+ shifted) shifted))))) + )) (if (minusp number) (- rounded) rounded))))))) diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp index d1a5bc4a3..e2aed69c3 100644 --- a/tests/float.pure.lisp +++ b/tests/float.pure.lisp @@ -373,3 +373,11 @@ (+ (float int 0e0) x0)))) (declare (notinline test-cvtsi2ss)) (assert (zerop (imagpart (test-cvtsi2ss 4))))))) + +(with-test (:name :round-to-bignum) + (assert (= (round 1073741822.3d0) 1073741822)) + (assert (= (round 1073741822.5d0) 1073741822)) + (assert (= (round 1073741822.7d0) 1073741823)) + (assert (= (round 1073741823.3d0) 1073741823)) + (assert (= (round 1073741823.5d0) 1073741824)) + (assert (= (round 1073741823.7d0) 1073741824))) -- 2.11.4.GIT