;;;;
;;; Filter values of LVAR through FORM, which must be an ordinary/mv
-;;; call. First argument must be 'DUMMY, which will be replaced with
-;;; LVAR. In case of an ordinary call the function should not have
-;;; return type NIL. We create a new "filtered" lvar.
+;;; call. Exactly one argument must be 'DUMMY, which will be replaced
+;;; with LVAR. In case of an ordinary call the function should not
+;;; have return type NIL. We create a new "filtered" lvar.
;;;
;;; TODO: remove preconditions.
(defun filter-lvar (lvar form)
;; Replace 'DUMMY with the LVAR. (We can find 'DUMMY because
;; no LET conversion has been done yet.) The [mv-]combination
;; code from the call in the form will be the use of the new
- ;; check lvar. We substitute for the first argument of
- ;; this node.
+ ;; check lvar. We substitute exactly one argument.
(let* ((node (lvar-use filtered-lvar))
- (args (basic-combination-args node))
- (victim (principal-lvar (first args))))
+ victim)
+ (dolist (arg (basic-combination-args node) (aver victim))
+ (let* ((arg (principal-lvar arg))
+ (use (lvar-use arg))
+ leaf)
+ (when (and (ref-p use)
+ (constant-p (setf leaf (ref-leaf use)))
+ (eql (constant-value leaf) 'dummy))
+ (aver (not victim))
+ (setf victim arg))))
(aver (eq (constant-value (ref-leaf (lvar-use victim)))
'dummy))
(csubtypep (lvar-type lvar) type))
(filter-lvar lvar
(if signedp
- `((lambda (x)
- (mask-signed-field ,width x))
- 'dummy)
+ `(mask-signed-field ,width 'dummy)
`(logand 'dummy ,(ldb (byte width 0) -1))))
(setf (block-reoptimize (node-block node)) t)
(reoptimize-component (node-component node) :maybe)