0.8.3.39:

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

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 74f5a20..789d7e1 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -500,7 +500,7 @@
        ((continuation-block cont)
         (block-home-lambda-or-null (continuation-block cont)))
        (t
-        (bug "confused about home lambda for ~S"))))
+        (bug "confused about home lambda for ~S" cont))))
 
 ;;; Return the LAMBDA that is CONT's home.
 (declaim (ftype (sfunction (continuation) clambda)
@@ -544,7 +544,7 @@
 ;;; beginning of the current value, rather than replacing it entirely.
 (defun make-lexenv (&key (default *lexenv*)
                         funs vars blocks tags
-                         type-restrictions weakend-type-restrictions
+                         type-restrictions
                         (lambda (lexenv-lambda default))
                         (cleanup (lexenv-cleanup default))
                         (policy (lexenv-policy default)))
@@ -559,7 +559,6 @@
      (frob blocks lexenv-blocks)
      (frob tags lexenv-tags)
      (frob type-restrictions lexenv-type-restrictions)
-     (frob weakend-type-restrictions lexenv-weakend-type-restrictions)
      lambda cleanup policy)))
 
 ;;; Makes a LEXENV, suitable for using in a MACROLET introduced
@@ -587,7 +586,6 @@
      nil
      nil
      (lexenv-type-restrictions lexenv) ; XXX
-     (lexenv-weakend-type-restrictions lexenv)
      nil
      nil
      (lexenv-policy lexenv))))
@@ -862,8 +860,9 @@
                (return-block (and return (node-block return))))
          (unless (leaf-ever-used clambda)
            (let ((*compiler-error-context* bind))
-             (compiler-notify "deleting unused function~:[.~;~:*~%  ~S~]"
-                              (leaf-debug-name clambda))))
+             (compiler-notify 'code-deletion-note
+                              :format-control "deleting unused function~:[.~;~:*~%  ~S~]"
+                              :format-arguments (list (leaf-debug-name clambda)))))
           (unless (block-delete-p bind-block)
             (unlink-blocks (component-head component) bind-block))
          (when (and return-block (not (block-delete-p return-block)))
@@ -1081,9 +1080,12 @@
     (when last
       (let ((cont (node-cont last)))
         (delete-continuation-use last)
-        (if (eq (continuation-kind cont) :unused)
-            (delete-continuation cont)
-            (reoptimize-continuation cont)))))
+        (acond ((eq (continuation-kind cont) :unused)
+                (delete-continuation cont))
+               ((and (null (find-uses cont))
+                     (continuation-dest cont))
+                (mark-for-deletion (node-block it)))
+               ((reoptimize-continuation cont))))))
 
   (dolist (b (block-pred block))
     (unlink-blocks b block)
@@ -1143,7 +1145,7 @@
       (cast
        (flush-dest (cast-value node))))
 
-       (delete-continuation (node-prev node)))
+    (delete-continuation (node-prev node)))
 
   (remove-from-dfo block)
   (values))
@@ -1242,7 +1244,9 @@
                                          0)))
            (unless (return-p node)
              (let ((*compiler-error-context* node))
-               (compiler-notify "deleting unreachable code")))
+               (compiler-notify 'code-deletion-note
+                                :format-control "deleting unreachable code"
+                                :format-arguments nil)))
            (return))))))
   (values))
 
@@ -1602,6 +1606,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)))
 \f
 ;;;; careful call