From 49c69bcd41790587cbcb0411c5c3497ee84f4343 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 12 Sep 2003 15:23:07 +0000 Subject: [PATCH] 0.8.3.56: 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 | 2 ++ package-data-list.lisp-expr | 2 +- src/code/deftypes-for-target.lisp | 8 ++++++++ src/compiler/srctran.lisp | 36 ++++++++++++------------------------ tests/arith.pure.lisp | 8 ++++++++ version.lisp-expr | 2 +- 6 files changed, 32 insertions(+), 26 deletions(-) diff --git a/NEWS b/NEWS index 4b33b2d..76d2609 100644 --- 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 diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 7a0aac2..6588f96 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -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" diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp index 0559ce2..4e657c9 100644 --- a/src/code/deftypes-for-target.lisp +++ b/src/code/deftypes-for-target.lisp @@ -46,6 +46,14 @@ (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) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 518d88b..f6caaae 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2137,27 +2137,19 @@ ;; 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. @@ -2172,11 +2164,9 @@ (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) @@ -2215,11 +2205,9 @@ (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 @@ -2327,7 +2315,7 @@ (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*))) @@ -2342,7 +2330,7 @@ (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*))) @@ -2375,7 +2363,7 @@ (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)) diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index 3452abe..841f6ef 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -145,3 +145,11 @@ (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))) diff --git a/version.lisp-expr b/version.lisp-expr index 9476597..73ebf15 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.3.55" +"0.8.3.56" -- 1.7.10.4