From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 16 Aug 2004 19:51:28 +0000 (+0000)
Subject: 0.8.13.66:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b54a8ae1b85ba81082053646a7dd84fc97b56110;p=sbcl.git

0.8.13.66:
	Fix a couple of thinkos in LOGFOO-DERIVE-TYPE-AUX
	... LOGAND is bounded by either argument, if unsigned;
	... LOGXOR is negative if precisely one argument is.
---

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index e4084c3..8f1739f 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2136,14 +2136,18 @@
     (return-from logand-derive-type-aux x))
   (multiple-value-bind (x-len x-pos x-neg) (integer-type-length x)
     (declare (ignore x-pos))
-    (multiple-value-bind (y-len y-pos y-neg) (integer-type-length  y)
+    (multiple-value-bind (y-len y-pos y-neg) (integer-type-length y)
       (declare (ignore y-pos))
       (if (not x-neg)
 	  ;; X must be positive.
 	  (if (not y-neg)
 	      ;; They must both be positive.
-	      (cond ((or (null x-len) (null y-len))
+	      (cond ((and (null x-len) (null y-len))
 		     (specifier-type 'unsigned-byte))
+		    ((null x-len)
+		     (specifier-type `(unsigned-byte* ,y-len)))
+		    ((null y-len)
+		     (specifier-type `(unsigned-byte* ,x-len)))
 		    (t
 		     (specifier-type `(unsigned-byte* ,(min x-len y-len)))))
 	      ;; X is positive, but Y might be negative.
@@ -2218,7 +2222,7 @@
 					      (max x-len y-len)
 					      '*))))
        ((or (and (not x-pos) (not y-neg))
-	    (and (not y-neg) (not y-pos)))
+	    (and (not y-pos) (not x-neg)))
 	;; Either X is negative and Y is positive or vice-versa. The
 	;; result will be negative.
 	(specifier-type `(integer ,(if (and x-len y-len)
@@ -2240,7 +2244,6 @@
   (deffrob logior)
   (deffrob logxor))
 
-;;; FIXME: could actually do stuff with SAME-LEAF
 (defoptimizer (logeqv derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
 			     (lognot-derive-type-aux 
@@ -2256,7 +2259,6 @@
 			     (lognot-derive-type-aux
 			      (logior-derive-type-aux x y same-leaf)))
 		       #'lognor))
-;;; FIXME: use SAME-LEAF instead of ignoring it.
 (defoptimizer (logandc1 derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
 			     (if same-leaf
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index ae0fe96..0799a59 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1413,3 +1413,21 @@
   (frob nil (defgeneric #:foo (x &optional y z)))
   (frob nil (defgeneric #:foo (x &key y z)))
   (frob t (defun #:foo (x) (flet ((foo (x &optional y &key z) (list x y z))) (foo x x :z x)))))
+
+;;; this was a bug in the LOGXOR type deriver.  The top form gave a
+;;; note, because the system failed to derive the fact that the return
+;;; from LOGXOR was small and negative, though the bottom one worked.
+(handler-bind ((sb-ext:compiler-note #'error))
+  (compile nil '(lambda ()
+		 (declare (optimize speed (safety 0)))
+		 (lambda (x y)
+		   (declare (type (integer 3 6) x)
+			    (type (integer -6 -3) y))
+		   (+ (logxor x y) most-positive-fixnum)))))
+(handler-bind ((sb-ext:compiler-note #'error))
+  (compile nil '(lambda ()
+		 (declare (optimize speed (safety 0)))
+		 (lambda (x y)
+		   (declare (type (integer 3 6) y)
+			    (type (integer -6 -3) x))
+		   (+ (logxor x y) most-positive-fixnum)))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 08a2b06..9893852 100644
--- 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.13.65"
+"0.8.13.66"