Free-er form FILTER-LVAR
authorPaul Khuong <pvk@pvk.ca>
Sun, 19 May 2013 15:12:43 +0000 (11:12 -0400)
committerPaul Khuong <pvk@pvk.ca>
Sun, 19 May 2013 15:49:49 +0000 (11:49 -0400)
The DUMMY argument can now be in any argument position.  Use that
in CUT-TO-WIDTH instead of ((lambda (...) ...) ...) hack.

src/compiler/ir1util.lisp
src/compiler/srctran.lisp

index 478be97..d0df903 100644 (file)
 ;;;;
 
 ;;; 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))
 
index a976fa5..545c4d6 100644 (file)
                                    (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)