diff options
| author | Alexey Dejneka <adejneka@comail.ru> | 2005-04-10 04:54:22 +0000 |
|---|---|---|
| committer | Alexey Dejneka <adejneka@comail.ru> | 2005-04-10 04:54:22 +0000 |
| commit | d8fba216f4fd8b41dd0f7f3964559e4041ece631 (patch) | |
| tree | 07013604ee2d94b6f29e73364940664a85968d9d /src | |
| parent | 70c579379283da66f97906a0d62c8a5fc34e4dab (diff) | |
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).
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/alpha/array.lisp | 5 | ||||
| -rw-r--r-- | src/compiler/checkgen.lisp | 22 |
2 files changed, 16 insertions, 11 deletions
diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index 1c1968289..d2c11d538 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 3fd81d57a..ddad0b614 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 |