X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=90de78490e006e173b817606b0d9188aba8ca568;hb=ae1efb49d01b7f887b4e6bed741a01a28124c643;hp=02797be11963c63bbbefc3f79d6f5475db4d458d;hpb=ff57884e206ac28660af6af34315bc9b81697f57;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 02797be..90de784 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1070,18 +1070,20 @@
 ;;; We mark the START as has having no next and remove the last node
 ;;; from its CONT's uses. We also flush the DEST for all continuations
 ;;; whose values are received by nodes in the block.
-(defun delete-block (block)
+(defun delete-block (block &optional silent)
   (declare (type cblock block))
   (aver (block-component block))      ; else block is already deleted!
-  (note-block-deletion block)
+  (unless silent
+    (note-block-deletion block))
   (setf (block-delete-p block) t)
 
-  (let* ((last (block-last block))
-	 (cont (node-cont last)))
-    (delete-continuation-use last)
-    (if (eq (continuation-kind cont) :unused)
-	(delete-continuation cont)
-	(reoptimize-continuation cont)))
+  (let ((last (block-last block)))
+    (when last
+      (let ((cont (node-cont last)))
+        (delete-continuation-use last)
+        (if (eq (continuation-kind cont) :unused)
+            (delete-continuation cont)
+            (reoptimize-continuation cont)))))
 
   (dolist (b (block-pred block))
     (unlink-blocks b block)
@@ -1095,7 +1097,7 @@
   (dolist (b (block-succ block))
     (unlink-blocks block b))
 
-  (do-nodes (node cont block)
+  (do-nodes-carefully (node cont block)
     (typecase node
       (ref (delete-ref node))
       (cif
@@ -1106,42 +1108,42 @@
       ;; careful that this LET has not already been partially deleted.
       (basic-combination
        (when (and (eq (basic-combination-kind node) :local)
-		  ;; Guards COMBINATION-LAMBDA agains the REF being deleted.
-		  (continuation-use (basic-combination-fun node)))
-	 (let ((fun (combination-lambda node)))
-	   ;; If our REF was the second-to-last ref, and has been
-	   ;; deleted, then FUN may be a LET for some other
-	   ;; combination.
-	   (when (and (functional-letlike-p fun)
-		      (eq (let-combination fun) node))
-	     (delete-lambda fun))))
+                  ;; Guards COMBINATION-LAMBDA agains the REF being deleted.
+                  (continuation-use (basic-combination-fun node)))
+         (let ((fun (combination-lambda node)))
+           ;; If our REF was the second-to-last ref, and has been
+           ;; deleted, then FUN may be a LET for some other
+           ;; combination.
+           (when (and (functional-letlike-p fun)
+                      (eq (let-combination fun) node))
+             (delete-lambda fun))))
        (flush-dest (basic-combination-fun node))
        (dolist (arg (basic-combination-args node))
-	 (when arg (flush-dest arg))))
+         (when arg (flush-dest arg))))
       (bind
        (let ((lambda (bind-lambda node)))
-	 (unless (eq (functional-kind lambda) :deleted)
-	   (delete-lambda lambda))))
+         (unless (eq (functional-kind lambda) :deleted)
+           (delete-lambda lambda))))
       (exit
        (let ((value (exit-value node))
-	     (entry (exit-entry node)))
-	 (when value
-	   (flush-dest value))
-	 (when entry
-	   (setf (entry-exits entry)
-		 (delete node (entry-exits entry))))))
+             (entry (exit-entry node)))
+         (when value
+           (flush-dest value))
+         (when entry
+           (setf (entry-exits entry)
+                 (delete node (entry-exits entry))))))
       (creturn
        (flush-dest (return-result node))
        (delete-return node))
       (cset
        (flush-dest (set-value node))
        (let ((var (set-var node)))
-	 (setf (basic-var-sets var)
-	       (delete node (basic-var-sets var)))))
+         (setf (basic-var-sets var)
+               (delete node (basic-var-sets var)))))
       (cast
        (flush-dest (cast-value node))))
 
-    (delete-continuation (node-prev node)))
+       (delete-continuation (node-prev node)))
 
   (remove-from-dfo block)
   (values))
@@ -1600,6 +1602,20 @@
 			      *inline-expansion-limit*))
 	   nil)
 	  (t t))))
+
+;;; Make sure that FUNCTIONAL is not let-converted or deleted.
+(defun assure-functional-live-p (functional)
+  (declare (type functional functional))
+  (when (and (or
+              ;; looks LET-converted
+              (functional-somewhat-letlike-p functional)
+              ;; It's possible for a LET-converted function to end up
+              ;; deleted later. In that case, for the purposes of this
+              ;; analysis, it is LET-converted: LET-converted functionals
+              ;; are too badly trashed to expand them inline, and deleted
+              ;; LET-converted functionals are even worse.
+              (eql (functional-kind functional) :deleted)))
+    (throw 'locall-already-let-converted functional)))
 
 ;;;; careful call