0.8.3.61:

	Fix for compiler "cannot convert to SINGLE-FLOAT: <largenum>" in
	type inference, as reported PFD sbcl-devel 2003-09-13:
	... a slight rewrite to the SIGNED-ZERO-OP methods in
		src/compiler/srctran.lisp
	... not correct in the presence of one integer and one float argument,
		as coercion could still occur.  Break me if you can.

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index f6caaae..95dfbab 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -225,6 +225,21 @@
 ;;;; numeric-type has everything we want to know. Reason 2 wins for
 ;;;; now.
 
+;;; Support operations that mimic real arithmetic comparison
+;;; operators, but imposing a total order on the floating points such
+;;; that negative zeros are strictly less than positive zeros.
+(macrolet ((def (name op)
+            `(defun ,name (x y)
+               (declare (real x y))
+               (if (and (floatp x) (floatp y) (zerop x) (zerop y))
+                   (,op (float-sign x) (float-sign y))
+                   (,op x y)))))
+  (def signed-zero->= >=)
+  (def signed-zero-> >)
+  (def signed-zero-= =)
+  (def signed-zero-< <)
+  (def signed-zero-<= <=))
+
 ;;; The basic interval type. It can handle open and closed intervals.
 ;;; A bound is open if it is a list containing a number, just like
 ;;; Lisp says. NIL means unbounded.
@@ -324,16 +339,8 @@
   (make-interval :low (type-bound-number (interval-low x))
                 :high (type-bound-number (interval-high x))))
 
-(defun signed-zero->= (x y)
-  (declare (real x y))
-  (or (> x y)
-      (and (= x y)
-          (>= (float-sign (float x))
-              (float-sign (float y))))))
-
 ;;; For an interval X, if X >= POINT, return '+. If X <= POINT, return
 ;;; '-. Otherwise return NIL.
-#+nil
 (defun interval-range-info (x &optional (point 0))
   (declare (type interval x))
   (let ((lo (interval-low x))
@@ -344,20 +351,6 @@
           '-)
          (t
           nil))))
-(defun interval-range-info (x &optional (point 0))
-  (declare (type interval x))
-  (labels ((signed->= (x y)
-            (if (and (zerop x) (zerop y) (floatp x) (floatp y))
-                (>= (float-sign x) (float-sign y))
-                (>= x y))))
-    (let ((lo (interval-low x))
-         (hi (interval-high x)))
-      (cond ((and lo (signed->= (type-bound-number lo) point))
-            '+)
-           ((and hi (signed->= point (type-bound-number hi)))
-            '-)
-           (t
-            nil)))))
 
 ;;; Test to see whether the interval X is bounded. HOW determines the
 ;;; test, and should be either ABOVE, BELOW, or BOTH.
@@ -371,32 +364,6 @@
     (both
      (and (interval-low x) (interval-high x)))))
 
-;;; signed zero comparison functions. Use these functions if we need
-;;; to distinguish between signed zeroes.
-(defun signed-zero-< (x y)
-  (declare (real x y))
-  (or (< x y)
-      (and (= x y)
-          (< (float-sign (float x))
-             (float-sign (float y))))))
-(defun signed-zero-> (x y)
-  (declare (real x y))
-  (or (> x y)
-      (and (= x y)
-          (> (float-sign (float x))
-             (float-sign (float y))))))
-(defun signed-zero-= (x y)
-  (declare (real x y))
-  (and (= x y)
-       (= (float-sign (float x))
-         (float-sign (float y)))))
-(defun signed-zero-<= (x y)
-  (declare (real x y))
-  (or (< x y)
-      (and (= x y)
-          (<= (float-sign (float x))
-              (float-sign (float y))))))
-
 ;;; See whether the interval X contains the number P, taking into
 ;;; account that the interval might not be closed.
 (defun interval-contains-p (p x)

diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index 9fe1951..c7c564c 100644 (file)
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -83,6 +83,19 @@
         (signum (logior c b)))
     (logior a -1))))
 
+(defun #:foo (b c)
+  (declare (type (integer -23228343 2) b)
+          (type (integer -115581022 512244512) c)
+          (optimize (speed 3) (safety 1) (debug 1)))
+  (* (* (logorc2 3 (deposit-field 4667947 (byte 14 26) b))
+       (deposit-field b (byte 25 27) -30424886))
+     (dpb b (byte 23 29) c)))
+
+(defun #:foo (x y)
+  (declare (type (integer -1 1000000000000000000000000) x y)
+          (optimize speed))
+  (* x (* y x)))
+
 ;;; bug 282
 ;;;
 ;;; Verify type checking policy in full calls: the callee is supposed

diff --git a/version.lisp-expr b/version.lisp-expr
index 3fa0939..c97385c 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.3.60"
+"0.8.3.61"