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.
** LOGBITP accepts a non-negative bignum as its INDEX argument.
** compiler incorrectly derived types of DPB and DEPOSIT-FIELD
with negative last argument.
** 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
planned incompatible changes in 0.8.x:
* (not done yet, but planned:) When the profiling interface settles
"INDEX" "LOAD/STORE-INDEX"
"SIGNED-BYTE-WITH-A-BITE-OUT"
"UNSIGNED-BYTE-WITH-A-BITE-OUT"
"INDEX" "LOAD/STORE-INDEX"
"SIGNED-BYTE-WITH-A-BITE-OUT"
"UNSIGNED-BYTE-WITH-A-BITE-OUT"
+ "SFUNCTION" "UNSIGNED-BYTE*"
;; ..and type predicates
"INSTANCEP"
"DOUBLE-FLOAT-P"
;; ..and type predicates
"INSTANCEP"
"DOUBLE-FLOAT-P"
(t
(error "bad size specified for UNSIGNED-BYTE type specifier: ~S" s))))
(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)
(sb!xc:deftype bit () '(integer 0 1))
(sb!xc:deftype compiled-function () 'function)
;; They must both be positive.
(cond ((or (null x-len) (null y-len))
(specifier-type 'unsigned-byte))
;; 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)))
- (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))
;; X is positive, but Y might be negative.
(cond ((null x-len)
(specifier-type 'unsigned-byte))
- ((zerop x-len)
- (specifier-type '(integer 0 0)))
- (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))
;; 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.
;; 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.
(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)
((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.
(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
((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))
(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*)))
(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))
(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 'unsigned-byte)))
*universal-type*)))
(specifier-type
(if (minusp low)
`(signed-byte ,(1+ raw-bit-count))
(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))
(defoptimizer (%dpb derive-type) ((newbyte size posn int))
(%deposit-field-derive-type-aux size posn int))
(let ((f (compile nil '(lambda (b)
(integer-length (deposit-field 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)))
+
+;;; 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)))
;;; 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".)
;;; 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".)