From 63690d6dc4617f2140f229a142728d1784efd0b5 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Sun, 19 May 2013 11:12:43 -0400 Subject: [PATCH] Free-er form FILTER-LVAR The DUMMY argument can now be in any argument position. Use that in CUT-TO-WIDTH instead of ((lambda (...) ...) ...) hack. --- src/compiler/ir1util.lisp | 21 ++++++++++++++------- src/compiler/srctran.lisp | 4 +--- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 478be97..d0df903 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -322,9 +322,9 @@ ;;;; ;;; 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) @@ -358,11 +358,18 @@ ;; 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)) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index a976fa5..545c4d6 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2866,9 +2866,7 @@ (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) -- 1.7.10.4