X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffloat.lisp;h=a3a0114a7f752f74f4a94239572b150d64baef9a;hb=cd5a858174d892f876699373dc3ea389cf2c4d40;hp=c8aee59d79ac71a4e7c3d0ddaa6a22022e01a571;hpb=89b82a03269446741ab4b7bba8656d6e37502fe9;p=sbcl.git

diff --git a/src/code/float.lisp b/src/code/float.lisp
index c8aee59..a3a0114 100644
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -170,7 +170,7 @@
 (defun float-radix (x)
   #!+sb-doc
   "Return (as an integer) the radix b of its floating-point argument."
-  (declare (ignore x))
+  (declare (ignore x) (type float x))
   2)
 
 ;;;; INTEGER-DECODE-FLOAT and DECODE-FLOAT
@@ -630,7 +630,7 @@
   (frob %long-float long-float))
 
 ;;; Convert a ratio to a float. We avoid any rounding error by doing an
-;;; integer division. Accuracy is important to preserve read/print
+;;; integer division. Accuracy is important to preserve print-read
 ;;; consistency, since this is ultimately how the reader reads a float. We
 ;;; scale the numerator by a power of two until the division results in the
 ;;; desired number of fraction bits, then do round-to-nearest.
@@ -753,10 +753,13 @@
 ;;; *not* return the second value of truncate, so it must be computed by the
 ;;; caller if needed.
 ;;;
-;;; In the float case, we pick off small arguments so that compiler can use
-;;; special-case operations. We use an exclusive test, since (due to round-off
-;;; error), (float most-positive-fixnum) may be greater than
-;;; most-positive-fixnum.
+;;; In the float case, we pick off small arguments so that compiler
+;;; can use special-case operations. We use an exclusive test, since
+;;; (due to round-off error), (float most-positive-fixnum) is likely
+;;; to be equal to (1+ most-positive-fixnum).  An exclusive test is
+;;; good enough, because most-positive-fixnum will be one less than a
+;;; power of two, and that power of two will be exactly representable
+;;; as a float (at least until we get 128-bit fixnums).
 (defun %unary-truncate (number)
   (number-dispatch ((number real))
     ((integer) number)
@@ -775,9 +778,9 @@
 ;;; Specialized versions for floats.
 (macrolet ((def (type name)
              `(defun ,name (number)
-                (if (< ,(coerce most-negative-fixnum type)
+                (if (< ,(coerce sb!xc:most-negative-fixnum type)
                        number
-                       ,(coerce most-positive-fixnum type))
+                       ,(coerce sb!xc:most-positive-fixnum type))
                     (truly-the fixnum (,name number))
                     ;; General -- slow -- case.
                     (multiple-value-bind (bits exp) (integer-decode-float number)
@@ -807,12 +810,13 @@
          (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)
+                  (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))))
                                shifted)))
              (if (minusp number)
                  (- rounded)