0.8.3.56:
authorChristophe Rhodes <csr21@cam.ac.uk>
Fri, 12 Sep 2003 15:23:07 +0000 (15:23 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Fri, 12 Sep 2003 15:23:07 +0000 (15:23 +0000)
Fix (BYTE 0 0)
... again, in the %LDB-and-friends DERIVE-TYPE methods, but this
time the failure seemed more justifiable, because...
... (UNSIGNED-BYTE 0) is quite naturally interpreted as
(INTEGER 0 0), and that's what we wrote, but ...
... ANSI saith "s---a positive integer".  Ugh.  So ...
... implement SB!INT:UNSIGNED-BYTE* that does the right thing,
and use it to simplify derive-type logic.

NEWS
package-data-list.lisp-expr
src/code/deftypes-for-target.lisp
src/compiler/srctran.lisp
tests/arith.pure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 4b33b2d..76d2609 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2055,6 +2055,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
     ** LOGBITP accepts a non-negative bignum as its INDEX argument.
     ** compiler incorrectly derived types of DPB and DEPOSIT-FIELD
        with negative last argument.
+    ** byte specifiers with zero size and position no longer cause
+       an error during type derivation.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
index 7a0aac2..6588f96 100644 (file)
@@ -784,7 +784,7 @@ retained, possibly temporariliy, because it might be used internally."
              "INDEX" "LOAD/STORE-INDEX"
             "SIGNED-BYTE-WITH-A-BITE-OUT"
             "UNSIGNED-BYTE-WITH-A-BITE-OUT"
-             "SFUNCTION"
+             "SFUNCTION" "UNSIGNED-BYTE*"
              ;; ..and type predicates
              "INSTANCEP"
              "DOUBLE-FLOAT-P"
index 0559ce2..4e657c9 100644 (file)
        (t
         (error "bad size specified for UNSIGNED-BYTE type specifier: ~S" s))))
 
+;;; ANSI got UNSIGNED-BYTE wrong, prohibiting (UNSIGNED-BYTE 0).
+;;; Since this is actually a substantial impediment to clarity...
+(sb!xc:deftype unsigned-byte* (&optional s)
+  (cond
+    ((eq s '*) '(integer 0))
+    ((zerop s) '(integer 0 0))
+    (t `(unsigned-byte ,s))))
+
 (sb!xc:deftype bit () '(integer 0 1))
 
 (sb!xc:deftype compiled-function () 'function)
index 518d88b..f6caaae 100644 (file)
              ;; They must both be positive.
              (cond ((or (null x-len) (null y-len))
                     (specifier-type 'unsigned-byte))
-                   ((or (zerop x-len) (zerop y-len))
-                    (specifier-type '(integer 0 0)))
                    (t
-                    (specifier-type `(unsigned-byte ,(min x-len y-len)))))
+                    (specifier-type `(unsigned-byte* ,(min x-len y-len)))))
              ;; X is positive, but Y might be negative.
              (cond ((null x-len)
                     (specifier-type 'unsigned-byte))
-                   ((zerop x-len)
-                    (specifier-type '(integer 0 0)))
                    (t
-                    (specifier-type `(unsigned-byte ,x-len)))))
+                    (specifier-type `(unsigned-byte* ,x-len)))))
          ;; X might be negative.
          (if (not y-neg)
              ;; Y must be positive.
              (cond ((null y-len)
                     (specifier-type 'unsigned-byte))
-                   ((zerop y-len)
-                    (specifier-type '(integer 0 0)))
-                   (t
-                    (specifier-type
-                     `(unsigned-byte ,y-len))))
+                   (t (specifier-type `(unsigned-byte* ,y-len))))
              ;; Either might be negative.
              (if (and x-len y-len)
                  ;; The result is bounded.
       (cond
        ((and (not x-neg) (not y-neg))
        ;; Both are positive.
-       (if (and x-len y-len (zerop x-len) (zerop y-len))
-           (specifier-type '(integer 0 0))
-           (specifier-type `(unsigned-byte ,(if (and x-len y-len)
-                                            (max x-len y-len)
-                                            '*)))))
+       (specifier-type `(unsigned-byte* ,(if (and x-len y-len)
+                                             (max x-len y-len)
+                                             '*))))
        ((not x-pos)
        ;; X must be negative.
        (if (not y-pos)
            (and (not x-pos) (not y-pos)))
        ;; Either both are negative or both are positive. The result
        ;; will be positive, and as long as the longer.
-       (if (and x-len y-len (zerop x-len) (zerop y-len))
-           (specifier-type '(integer 0 0))
-           (specifier-type `(unsigned-byte ,(if (and x-len y-len)
-                                            (max x-len y-len)
-                                            '*)))))
+       (specifier-type `(unsigned-byte* ,(if (and x-len y-len)
+                                             (max x-len y-len)
+                                             '*))))
        ((or (and (not x-pos) (not y-neg))
            (and (not y-neg) (not y-pos)))
        ;; Either X is negative and Y is positive of vice-versa. The
             (csubtypep size (specifier-type 'integer)))
        (let ((size-high (numeric-type-high size)))
          (if (and size-high (<= size-high sb!vm:n-word-bits))
-             (specifier-type `(unsigned-byte ,size-high))
+             (specifier-type `(unsigned-byte* ,size-high))
              (specifier-type 'unsigned-byte)))
        *universal-type*)))
 
              (posn-high (numeric-type-high posn)))
          (if (and size-high posn-high
                   (<= (+ size-high posn-high) sb!vm:n-word-bits))
-             (specifier-type `(unsigned-byte ,(+ size-high posn-high)))
+             (specifier-type `(unsigned-byte* ,(+ size-high posn-high)))
              (specifier-type 'unsigned-byte)))
        *universal-type*)))
 
             (specifier-type
              (if (minusp low)
                  `(signed-byte ,(1+ raw-bit-count))
-                 `(unsigned-byte ,raw-bit-count)))))))))
+                 `(unsigned-byte* ,raw-bit-count)))))))))
 
 (defoptimizer (%dpb derive-type) ((newbyte size posn int))
   (%deposit-field-derive-type-aux size posn int))
index 3452abe..841f6ef 100644 (file)
 (let ((f (compile nil '(lambda (b)
                         (integer-length (deposit-field b (byte 4 28) -1005))))))
   (assert (= (funcall f 1230070) 32)))
+
+;;; type inference leading to an internal compiler error:
+(let ((f (compile nil '(lambda (x)
+                       (declare (type fixnum x))
+                       (ldb (byte 0 0) x)))))
+  (assert (= (funcall f 1) 0))
+  (assert (= (funcall f most-positive-fixnum) 0))
+  (assert (= (funcall f -1) 0)))
index 9476597..73ebf15 100644 (file)
@@ -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.55"
+"0.8.3.56"