Changeset 5670

Timestamp:

Jan 2, 2007, 5:59:19 AM (18 years ago)

Author:

Gary Byers

Message:

Don't assume that fixnums can be accurately coerced to floats when comparing
fixnums and floats; do the logical equvalent of calling RATIONAL on the float
instead.

File:

• trunk/ccl/level-0/l0-numbers.lisp (modified) (1 diff)

trunk/ccl/level-0/l0-numbers.lisp

@@ -424 +424 @@
 
 
-;; gary's more better idea
 (defun fixnum-dfloat-compare (int dfloat)
-  (declare (double-float dfloat))
+  (declare (double-float dfloat) (fixnum int))
   (if (and (eq int 0)(= dfloat 0.0d0))
     0
-    (with-stack-double-floats ((tem int))
-      (if (= tem dfloat)
-        0
-        (if (< tem dfloat) -1 1)))))
+    ;; Whatever we do here should have the effect
+    ;; of comparing the integer to the result of calling
+    ;; RATIONAL on the float.  We could probably
+    ;; skip the call to RATIONAL in more cases,
+    ;; but at least check the obvious ones here
+    ;; (e.g. different signs)
+    (multiple-value-bind (mantissa exponent sign)
+        (integer-decode-double-float dfloat)
+      (declare (type (integer -1 1) sign)
+               (fixnum exponent))
+      (cond ((zerop int)
+             (- sign))
+            ((and (< int 0) (eql sign 1)) -1)
+            ((and (> int 0) (eql sign -1)) 1)
+            (t
+             ;; See RATIONAL.  Can probably avoid this if
+             ;; magnitudes are clearly dissimilar.
+             (if (= sign -1) (setq mantissa (- mantissa)))
+             (let* ((rat (if (< exponent 0)
+                           (/ mantissa (ash 1 (the fixnum (- exponent))))
+                           (ash mantissa exponent))))
+               (if (< int rat)
+                 -1
+                 (if (eq int rat)
+                   0
+                   1))))))))
 
 
 
 (defun fixnum-sfloat-compare (int sfloat)
-  (declare (short-float sfloat))
+  (declare (short-float sfloat) (fixnum int))
   (if (and (eq int 0)(= sfloat 0.0s0))
     0
-    #+ppc32-target
-    (ppc32::with-stack-short-floats ((tem int))
-      (if (= tem sfloat)
-        0
-        (if (< tem sfloat) -1 1)))
-    #+64-bit-target
-    (let* ((tem (%int-to-sfloat int)))
-      (declare (single-float tem))
-      (if (= tem sfloat)
-        0
-        (if (< tem sfloat) -1 1)))))
+    ;; Whatever we do here should have the effect
+    ;; of comparing the integer to the result of calling
+    ;; RATIONAL on the float.  We could probably
+    ;; skip the call to RATIONAL in more cases,
+    ;; but at least check the obvious ones here
+    ;; (e.g. different signs)
+    (multiple-value-bind (mantissa exponent sign)
+        (integer-decode-short-float sfloat)
+      (declare (type (integer -1 1) sign)
+               (fixnum exponent))
+      (cond ((zerop int)
+             (- sign))
+            ((and (< int 0) (eql sign 1)) -1)
+            ((and (> int 0) (eql sign -1)) 1)
+            (t
+             ;; See RATIONAL.  Can probably avoid this if
+             ;; magnitudes are clearly dissimilar.
+             (if (= sign -1) (setq mantissa (- mantissa)))
+             (let* ((rat (if (< exponent 0)
+                           (/ mantissa (ash 1 (the fixnum (- exponent))))
+                           (ash mantissa exponent))))
+               (if (< int rat)
+                 -1
+                 (if (eq int rat)
+                   0
+                   1))))))))