X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=f98462107ddd01d20e806a8d96ad77d63edeef93;hb=54da325f13fb41669869aea688ae195426c0e231;hp=7f44b64f3178c987f5d212e03804aa33cf2a6417;hpb=aae2706b8a22e913bb354531687797450446ea81;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 7f44b64..f984621 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -522,17 +522,19 @@
 ;;; Delete any nodes in BLOCK whose value is unused and which have no
 ;;; side effects. We can delete sets of lexical variables when the set
 ;;; variable has no references.
-(defun flush-dead-code (block)
+(defun flush-dead-code (block &aux victim)
   (declare (type cblock block))
   (setf (block-flush-p block) nil)
   (do-nodes-backwards (node lvar block :restart-p t)
     (unless lvar
       (typecase node
         (ref
+         (setf victim node)
          (delete-ref node)
          (unlink-node node))
         (combination
          (when (flushable-combination-p node)
+           (setf victim node)
            (flush-combination node)))
         (mv-combination
          (when (eq (basic-combination-kind node) :local)
@@ -541,27 +543,31 @@
                      (when (or (leaf-refs var)
                                (lambda-var-sets var))
                        (return nil)))
+               (setf victim node)
                (flush-dest (first (basic-combination-args node)))
                (delete-let fun)))))
         (exit
          (let ((value (exit-value node)))
            (when value
+             (setf victim node)
              (flush-dest value)
              (setf (exit-value node) nil))))
         (cset
          (let ((var (set-var node)))
            (when (and (lambda-var-p var)
                       (null (leaf-refs var)))
+             (setf victim node)
              (flush-dest (set-value node))
              (setf (basic-var-sets var)
                    (delq node (basic-var-sets var)))
              (unlink-node node))))
         (cast
          (unless (cast-type-check node)
+           (setf victim node)
            (flush-dest (cast-value node))
            (unlink-node node))))))
 
-  (values))
+  victim)
 
 ;;;; local call return type propagation