0.8.19.23:

        Optimize float/fixnum comparisons, primarily for the benefit
        of McCLIM. If the fixnum's value is in a range where it's
        guaranteed to have an exact float representation, coerce it to
        a float and do a float comparison. Otherwise fall back to the
        old behaviour of rationalizing the float.

diff --git a/NEWS b/NEWS
index e3ea60c..d105bd7 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
     CLOS classes has had redundant type checks removed.
   * optimization: added declarations to speed up operations that access
     the internal character database (for example STRING-UPCASE)
+  * optimization: comparison operations between floats and sufficiently small
+    fixnums no longer create extra rationals
   * fixed some bugs related to Unicode integration:
     ** portions of multibyte characters at the end of buffers for
        character-based file input are correctly transferred to the

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index c0440f3..2b26643 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -819,6 +819,15 @@ the first."
      (declare (type real number result))
      (if (< (car nlist) result) (setq result (car nlist)))))
 
+(defconstant most-positive-exactly-single-float-fixnum
+  (min #xffffff most-positive-fixnum))
+(defconstant most-negative-exactly-single-float-fixnum
+  (max #x-ffffff most-negative-fixnum))
+(defconstant most-positive-exactly-double-float-fixnum
+  (min #x1fffffffffffff most-positive-fixnum))
+(defconstant most-negative-exactly-double-float-fixnum
+  (max #x-1fffffffffffff most-negative-fixnum))
+
 (eval-when (:compile-toplevel :execute)
 
 ;;; The INFINITE-X-FINITE-Y and INFINITE-Y-FINITE-X args tell us how
@@ -838,6 +847,40 @@ the first."
     #!+long-float
     ((long-float (foreach single-float double-float))
      (,op x (coerce y 'long-float)))
+    ((fixnum (foreach single-float double-float))
+     (if (float-infinity-p y)
+         ,infinite-y-finite-x
+         ;; If the fixnum has an exact float representation, do a
+         ;; float comparison. Otherwise do the slow float -> ratio
+         ;; conversion.
+        (multiple-value-bind (lo hi)
+            (case '(dispatch-type y)
+              ('single-float
+               (values most-negative-exactly-single-float-fixnum
+                       most-positive-exactly-single-float-fixnum))
+              ('double-float
+               (values most-negative-exactly-double-float-fixnum
+                       most-positive-exactly-double-float-fixnum)))
+          (if (<= lo y hi)
+              (,op (coerce x '(dispatch-type y)) y)
+              (,op x (rational y))))))
+    (((foreach single-float double-float) fixnum)
+     (if (eql y 0)
+         (,op x (coerce 0 '(dispatch-type x)))
+         (if (float-infinity-p x)
+             ,infinite-x-finite-y
+             ;; Likewise
+            (multiple-value-bind (lo hi)
+                (case '(dispatch-type x)
+                  ('single-float
+                   (values most-negative-exactly-single-float-fixnum
+                           most-positive-exactly-single-float-fixnum))
+                  ('double-float
+                   (values most-negative-exactly-double-float-fixnum
+                           most-positive-exactly-double-float-fixnum)))
+              (if (<= lo y hi)
+                  (,op x (coerce y '(dispatch-type x)))
+                  (,op (rational x) y))))))
     (((foreach single-float double-float) double-float)
      (,op (coerce x 'double-float) y))
     ((double-float single-float)

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index 2b1266d..25981fc 100644 (file)
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -224,3 +224,37 @@
   (frob /)
   (frob floor)
   (frob ceiling))
+
+;; Check that the logic in SB-KERNEL::BASIC-COMPARE for doing fixnum/float
+;; comparisons without rationalizing the floats still gives the right anwers
+;; in the edge cases (had a fencepost error).
+(macrolet ((test (range type sign)
+            `(let (ints
+                   floats
+                   (start (- ,(find-symbol (format nil
+                                                   "MOST-~A-EXACTLY-~A-FIXNUM"
+                                                   sign type)
+                                           :sb-kernel)
+                             ,range)))
+               (dotimes (i (1+ (* ,range 2)))
+                 (let* ((x (+ start i))
+                        (y (coerce x ',type)))
+                   (push x ints)
+                   (push y floats)))
+               (dolist (i ints)
+                 (dolist (f floats)
+                   (dolist (op '(< <= = >= >))
+                     (unless (eq (funcall op i f)
+                                 (funcall op i (rationalize f)))
+                       (error "(not (eq (~a ~a ~f) (~a ~a ~a)))~%"
+                              op i f
+                              op i (rationalize f)))
+                     (unless (eq (funcall op f i)
+                                 (funcall op (rationalize f) i))
+                       (error "(not (eq (~a ~f ~a) (~a ~a ~a)))~%"
+                              op f i
+                              op (rationalize f) i))))))))
+  (test 32 double-float negative)
+  (test 32 double-float positive)
+  (test 32 single-float negative)
+  (test 32 single-float positive))

diff --git a/version.lisp-expr b/version.lisp-expr
index 1c85a50..c55cc11 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.19.22"
+"0.8.19.23"