X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=0e9ba01c102a9ccafa5c652119b8ad920a0a5ec3;hb=f73c1f391342c797b8daebe4e8c27e5923341b6d;hp=a4bf8fa1209da25a019cbc14f99bb6444560d4ac;hpb=11f02398a1a9ccbde847c82fd233e8378e45c29c;p=sbcl.git

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index a4bf8fa..0e9ba01 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -281,7 +281,7 @@
 	(return))
       (let ((kind (functional-kind functional)))
 	(cond ((or (functional-somewhat-letlike-p functional)
-		   (eql kind :deleted))
+		   (memq kind '(:deleted :zombie)))
 	       (values)) ; nothing to do
 	      ((and (null (leaf-refs functional)) (eq kind nil)
 		    (not (functional-entry-fun functional)))
@@ -438,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
@@ -952,11 +953,17 @@
 ;;; new references to it.
 (defun let-convert (fun call)
   (declare (type clambda fun) (type basic-combination call))
-  (let ((next-block (if (node-tail-p call)
-			nil
-			(insert-let-body fun call))))
+  (let* ((next-block (insert-let-body fun call))
+         (next-block (if (node-tail-p call)
+                         nil
+                         next-block)))
     (move-return-stuff fun call next-block)
-    (merge-lets fun call)))
+    (merge-lets fun call)
+    (setf (node-tail-p call) nil)
+    ;; If CALL has a derive type NIL, it means that "its return" is
+    ;; unreachable, but the next BIND is still reachable; in order to
+    ;; not confuse MAYBE-TERMINATE-BLOCK...
+    (setf (node-derived-type call) *wild-type*)))
 
 ;;; Reoptimize all of CALL's args and its result.
 (defun reoptimize-call (call)
@@ -1031,6 +1038,7 @@
 		     (eq (basic-combination-fun dest) ref-lvar)
 		     (eq (basic-combination-kind dest) :local)
                      (not (node-to-be-deleted-p dest))
+                     (not (block-delete-p (lambda-block clambda)))
 		     (cond ((ok-initial-convert-p clambda) t)
 			   (t
 			    (reoptimize-lvar ref-lvar)
@@ -1070,7 +1078,8 @@
 ;;; tail-convert. The second is the value of M-C-T-A.
 (defun maybe-convert-tail-local-call (call)
   (declare (type combination call))
-  (let ((return (lvar-dest (node-lvar call))))
+  (let ((return (lvar-dest (node-lvar call)))
+        (fun (combination-lambda call)))
     (aver (return-p return))
     (when (and (not (node-tail-p call)) ; otherwise already converted
                ;; this is a tail call
@@ -1081,10 +1090,10 @@
                ;; non-tail so that we can use known return inside the
                ;; component.
 	       (not (eq (functional-kind (node-home-lambda call))
-			:external)))
+			:external))
+               (not (block-delete-p (lambda-block fun))))
       (node-ends-block call)
-      (let ((block (node-block call))
-	    (fun (combination-lambda call)))
+      (let ((block (node-block call)))
 	(setf (node-tail-p call) t)
 	(unlink-blocks block (first (block-succ block)))
 	(link-blocks block (lambda-block fun))