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)

diff --git a/src/code/float.lisp b/src/code/float.lisp
index 88ffb37..483a6cf 100644 (file)
--- 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 d1a5bc4..e2aed69 100644 (file)
--- 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)))