Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
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).
  • Loading branch information
Alexey Dejneka committed Apr 10, 2005
1 parent 70c5793 commit d8fba21
Show file tree
Hide file tree
Showing 5 changed files with 50 additions and 25 deletions.
4 changes: 4 additions & 0 deletions NEWS
Expand Up @@ -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
Expand All @@ -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
Expand Down
5 changes: 4 additions & 1 deletion src/compiler/alpha/array.lisp
Expand Up @@ -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
Expand Down
22 changes: 12 additions & 10 deletions src/compiler/checkgen.lisp
Expand Up @@ -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
Expand Down
42 changes: 29 additions & 13 deletions tests/compiler.pure.lisp
Expand Up @@ -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))
Expand Down Expand Up @@ -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)))
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit d8fba21

Please sign in to comment.