From: Alexey Dejneka Date: Sun, 10 Apr 2005 04:54:22 +0000 (+0000) Subject: 0.8.21.30: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d8fba216f4fd8b41dd0f7f3964559e4041ece631;p=sbcl.git 0.8.21.30: * Fix misc.548: weakening of (VALUES (MEMBER A B C) &OPTIONAL) produces (VALUES &OPTIONAL SYMBOL) with different number of required/optional parameters. * Fix DATA-VECTOR-SET-C/SIMPLE-BIT-VECTOR on Alpha-32: srl-sll does not clean up upper bit (found by regression tests). --- diff --git a/NEWS b/NEWS index a11e227..041ea38 100644 --- a/NEWS +++ b/NEWS @@ -36,6 +36,8 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21: * optimization: type testing for non-vector arrays should be faster. * fixed TRACE :ENCAPSULATE NIL, added support for :ENCAPSULATE NIL on x86-64 + * bug fix: setting 31st element of a bit vector to zero did not work + on Alpha-32. * fixed some bugs related to Unicode integration: ** the restarts for recovering from input and output encoding errors only appear when there is in fact such an error to @@ -55,6 +57,8 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21: ** accessing double-floats stored on the stack now works on x86-64. ** debugger internals could sometimes create invalid lispobjs, resulting in GC crashes. + ** MISC.548: type check weakening can convert required type into + optional. changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20: * incompatible change: thread support for non-NPTL systems has diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index 1c19682..d2c11d5 100644 --- a/src/compiler/alpha/array.lisp +++ b/src/compiler/alpha/array.lisp @@ -252,7 +252,10 @@ (unless (and (sc-is value immediate) (= (tn-value value) ,(1- (ash 1 bits)))) - (cond ((= extra ,(1- elements-per-word)) + (cond #+#.(cl:if + (cl:= sb-vm:n-word-bits sb-vm:n-machine-word-bits) + '(and) '(or)) + ((= extra ,(1- elements-per-word)) (inst sll old ,bits old) (inst srl old ,bits old)) (t diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 3fd81d5..ddad0b6 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -262,16 +262,18 @@ ((lvar-single-value-p lvar) ;; exactly one value is consumed (principal-lvar-single-valuify lvar) - (let ((creq (car (args-type-required ctype)))) - (multiple-value-setq (ctype atype) - (if creq - (values creq (car (args-type-required atype))) - (values (car (args-type-optional ctype)) - (car (args-type-optional atype))))) - (maybe-negate-check value - (list ctype) (list atype) - force-hairy - n-required))) + (flet ((get-type (type) + (acond ((args-type-required type) + (car it)) + ((args-type-optional type) + (car it)) + (t (bug "type ~S is too hairy" type))))) + (multiple-value-bind (ctype atype) + (values (get-type ctype) (get-type atype)) + (maybe-negate-check value + (list ctype) (list atype) + force-hairy + n-required)))) ((and (mv-combination-p dest) (eq (mv-combination-kind dest) :local)) ;; we know the number of consumed values diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 514ec6f..4bc68b9 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1678,19 +1678,24 @@ ;;; Bug reported by Timmy Douglas: overflow in bit vector setter with ;;; constant index and value. -(let* ((n (* 2 sb-vm::n-word-bits)) - (array1 (make-array n :element-type 'bit)) - (array2 (make-array n :element-type 'bit))) - (dotimes (i n) - (dotimes (v 2) - (let ((f (compile nil `(lambda (a) - (declare (type (simple-array bit (,n)) a)) - (setf (bit a ,i) ,v))))) - (fill array1 (- 1 v)) - (fill array2 (- 1 v)) - (funcall f array1) - (setf (aref array2 i) v) - (assert (equal array1 array2)))))) +(loop for n-bits = 1 then (* n-bits 2) + for type = `(unsigned-byte ,n-bits) + and v-max = (1- (ash 1 n-bits)) + while (<= n-bits sb-vm:n-word-bits) + do + (let* ((n (* 2 (1+ (- sb-vm::n-word-bits n-bits)))) + (array1 (make-array n :element-type type)) + (array2 (make-array n :element-type type))) + (dotimes (i n) + (dolist (v (list 0 v-max)) + (let ((f (compile nil `(lambda (a) + (declare (type (simple-array ,type (,n)) a)) + (setf (aref a ,i) ,v))))) + (fill array1 (- v-max v)) + (fill array2 (- v-max v)) + (funcall f array1) + (setf (aref array2 i) v) + (assert (every #'= array1 array2))))))) (let ((fn (compile nil '(lambda (x) (declare (type bit x)) @@ -1752,3 +1757,14 @@ (or p1 (the (eql t) p2)))) nil t) t)) + +;;; MISC.548: type check weakening converts required type into +;;; optional +(assert (eql t + (funcall + (compile + nil + '(lambda (p1) + (declare (optimize (speed 2) (safety 1) (debug 3) (space 2))) + (atom (the (member f assoc-if write-line t w) p1)))) + t))) diff --git a/version.lisp-expr b/version.lisp-expr index e1dbf71..a795dd1 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.21.29" +"0.8.21.30"