0.8.3.54:

        * Fix type derivers for %DPB and %DEPOSIT-FIELD: SIGNED-BYTE
          representation requires extra sign bit. (reported by Paul
          Dietz)

diff --git a/NEWS b/NEWS
index ce1611e..4b33b2d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2053,6 +2053,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
     ** unsigned addition of a 32-bit constant with the high bit set no
        longer causes an internal compiler error on the x86.
     ** LOGBITP accepts a non-negative bignum as its INDEX argument.
+    ** compiler incorrectly derived types of DPB and DEPOSIT-FIELD
+       with negative last argument.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index f675b2e..e2cb897 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2346,53 +2346,32 @@
              (specifier-type 'unsigned-byte)))
        *universal-type*)))
 
-(defoptimizer (%dpb derive-type) ((newbyte size posn int))
+(defun %deposit-field-derive-type-aux (size posn int)
   (let ((size (continuation-type size))
        (posn (continuation-type posn))
        (int (continuation-type int)))
-    (if (and (numeric-type-p size)
-            (csubtypep size (specifier-type 'integer))
-            (numeric-type-p posn)
-            (csubtypep posn (specifier-type 'integer))
-            (numeric-type-p int)
-            (csubtypep int (specifier-type 'integer)))
-       (let ((size-high (numeric-type-high size))
-             (posn-high (numeric-type-high posn))
-             (high (numeric-type-high int))
-             (low (numeric-type-low int)))
-         (if (and size-high posn-high high low
-                  (<= (+ size-high posn-high) sb!vm:n-word-bits))
-             (specifier-type
-              (list (if (minusp low) 'signed-byte 'unsigned-byte)
-                    (max (integer-length high)
-                         (integer-length low)
-                         (+ size-high posn-high))))
-             *universal-type*))
-       *universal-type*)))
+    (when (and (numeric-type-p size)
+               (numeric-type-p posn)
+               (numeric-type-p int))
+      (let ((size-high (numeric-type-high size))
+            (posn-high (numeric-type-high posn))
+            (high (numeric-type-high int))
+            (low (numeric-type-low int)))
+        (when (and size-high posn-high high low
+                   (<= (+ size-high posn-high) sb!vm:n-word-bits))
+          (let ((raw-bit-count (max (integer-length high)
+                                    (integer-length low)
+                                    (+ size-high posn-high))))
+            (specifier-type
+             (if (minusp low)
+                 `(signed-byte ,(1+ raw-bit-count))
+                 `(unsigned-byte ,raw-bit-count)))))))))
+
+(defoptimizer (%dpb derive-type) ((newbyte size posn int))
+  (%deposit-field-derive-type-aux size posn int))
 
 (defoptimizer (%deposit-field derive-type) ((newbyte size posn int))
-  (let ((size (continuation-type size))
-       (posn (continuation-type posn))
-       (int (continuation-type int)))
-    (if (and (numeric-type-p size)
-            (csubtypep size (specifier-type 'integer))
-            (numeric-type-p posn)
-            (csubtypep posn (specifier-type 'integer))
-            (numeric-type-p int)
-            (csubtypep int (specifier-type 'integer)))
-       (let ((size-high (numeric-type-high size))
-             (posn-high (numeric-type-high posn))
-             (high (numeric-type-high int))
-             (low (numeric-type-low int)))
-         (if (and size-high posn-high high low
-                  (<= (+ size-high posn-high) sb!vm:n-word-bits))
-             (specifier-type
-              (list (if (minusp low) 'signed-byte 'unsigned-byte)
-                    (max (integer-length high)
-                         (integer-length low)
-                         (+ size-high posn-high))))
-             *universal-type*))
-       *universal-type*)))
+  (%deposit-field-derive-type-aux size posn int))
 
 (deftransform %ldb ((size posn int)
                    (fixnum fixnum integer)

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index 563f369..3452abe 100644 (file)
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -137,3 +137,11 @@
             (65 (ash most-negative-fixnum 36) t)))
   (destructuring-bind (index int result) x
     (assert (eq (eval `(logbitp ,index ,int)) result))))
+
+;;; off-by-1 type inference error for %DPB and %DEPOSIT-FIELD:
+(let ((f (compile nil '(lambda (b)
+                        (integer-length (dpb b (byte 4 28) -1005))))))
+  (assert (= (funcall f 1230070) 32)))
+(let ((f (compile nil '(lambda (b)
+                        (integer-length (deposit-field b (byte 4 28) -1005))))))
+  (assert (= (funcall f 1230070) 32)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 698941d..54ac710 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.53"
+"0.8.3.54"