0.8.5.5:

[sbcl.git] / src / compiler / locall.lisp

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 661896a..3239cd3 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -234,22 +234,21 @@
 ;;; do LET conversion here.
 (defun locall-analyze-fun-1 (fun)
   (declare (type functional fun))
-  (let ((refs (leaf-refs fun))
-       (first-time t))
+  (let ((refs (leaf-refs fun)))
     (dolist (ref refs)
       (let* ((lvar (node-lvar ref))
             (dest (when lvar (lvar-dest lvar))))
-       (cond ((and (basic-combination-p dest)
-                   (eq (basic-combination-fun dest) lvar)
-                   (eq (lvar-uses lvar) ref))
+        (unless (node-to-be-deleted-p ref)
+          (cond ((and (basic-combination-p dest)
+                      (eq (basic-combination-fun dest) lvar)
+                      (eq (lvar-uses lvar) ref))
 
-              (convert-call-if-possible ref dest)
+                 (convert-call-if-possible ref dest)
 
-              (unless (eq (basic-combination-kind dest) :local)
-                (reference-entry-point ref)))
-             (t
-              (reference-entry-point ref))))
-      (setq first-time nil)))
+                 (unless (eq (basic-combination-kind dest) :local)
+                   (reference-entry-point ref)))
+                (t
+                 (reference-entry-point ref)))))))
 
   (values))
 
@@ -393,8 +392,7 @@
         (original-fun (ref-leaf ref)))
     (aver (functional-p original-fun))
     (unless (or (member (basic-combination-kind call) '(:local :error))
-               (block-delete-p block)
-               (eq (functional-kind (block-home-lambda block)) :deleted)
+                (node-to-be-deleted-p call)
                (member (functional-kind original-fun)
                        '(:toplevel-xep :deleted))
                (not (or (eq (component-kind component) :initial)
@@ -440,22 +438,23 @@
 (defun convert-mv-call (ref call fun)
   (declare (type ref ref) (type mv-combination call) (type functional fun))
   (when (and (looks-like-an-mv-bind fun)
-            (not (functional-entry-fun fun))
             (singleton-p (leaf-refs fun))
             (singleton-p (basic-combination-args call)))
     (let* ((*current-component* (node-component ref))
            (ep (optional-dispatch-entry-point-fun
                 fun (optional-dispatch-max-args fun))))
-      (aver (= (optional-dispatch-min-args fun) 0))
-      (setf (basic-combination-kind call) :local)
-      (pushnew ep (lambda-calls-or-closes (node-home-lambda call)))
-      (merge-tail-sets call ep)
-      (change-ref-leaf ref ep)
+      (when (null (leaf-refs ep))
+        (aver (= (optional-dispatch-min-args fun) 0))
+        (aver (not (functional-entry-fun fun)))
+        (setf (basic-combination-kind call) :local)
+        (pushnew ep (lambda-calls-or-closes (node-home-lambda call)))
+        (merge-tail-sets call ep)
+        (change-ref-leaf ref ep)
 
-      (assert-lvar-type
-       (first (basic-combination-args call))
-       (make-short-values-type (mapcar #'leaf-type (lambda-vars ep)))
-       (lexenv-policy (node-lexenv call)))))
+        (assert-lvar-type
+         (first (basic-combination-args call))
+         (make-short-values-type (mapcar #'leaf-type (lambda-vars ep)))
+         (lexenv-policy (node-lexenv call))))))
   (values))
 
 ;;; Attempt to convert a call to a lambda. If the number of args is
@@ -1032,9 +1031,7 @@
          (when (and (basic-combination-p dest)
                     (eq (basic-combination-fun dest) ref-lvar)
                     (eq (basic-combination-kind dest) :local)
-                    (not (block-delete-p (node-block dest)))
-                     (neq (functional-kind (node-home-lambda dest))
-                          :deleted)
+                     (not (node-to-be-deleted-p dest))
                     (cond ((ok-initial-convert-p clambda) t)
                           (t
                            (reoptimize-lvar ref-lvar)
@@ -1123,7 +1120,7 @@
     (let ((outside-non-tail-call nil)
          (outside-call nil))
       (when (and (dolist (ref (leaf-refs clambda) t)
-                  (let ((dest (lvar-dest (node-lvar ref))))
+                  (let ((dest (node-dest ref)))
                     (when (or (not dest)
                                (block-delete-p (node-block dest)))
                        (return nil))