From d30da16eea1fe05d17d337c5f392f12736199dc0 Mon Sep 17 00:00:00 2001
From: Paul Khuong <pvk@pvk.ca>
Date: Thu, 27 Jun 2013 22:03:24 -0400
Subject: [PATCH] Defer some sanity checks to after testing for value refence
 to inline functions

 The functional corresponding to an inline function can be marked as dead when
 there remains references in for-value contexts.  Detect such references before
 making sure the function is still live.

 Reported with a reduced test case by Teemu Likonen to sbcl-devel on 2013-06-24.
---
 src/compiler/ir2tran.lisp |   62 ++++++++++++++++++++++++---------------------
 tests/compiler.pure.lisp  |    9 +++++++
 2 files changed, 42 insertions(+), 29 deletions(-)

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index a1ac4dc..275d2dc 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -250,35 +250,39 @@
            (type ir2-block ir2-block)
            (type functional functional)
            (type tn res))
-  (aver (not (eql (functional-kind functional) :deleted)))
-  (unless (leaf-info functional)
-    (setf (leaf-info functional)
-          (make-entry-info :name (functional-debug-name functional))))
-  (let ((closure (etypecase functional
-                   (clambda
-                    (assertions-on-ir2-converted-clambda functional)
-                    (physenv-closure (get-lambda-physenv functional)))
-                   (functional
-                    (aver (eq (functional-kind functional) :toplevel-xep))
-                    nil)))
-        global-var)
-    (cond (closure
-           (let* ((physenv (node-physenv ref))
-                  (tn (find-in-physenv functional physenv)))
-             (emit-move ref ir2-block tn res)))
-          ;; we're about to emit a reference to a "closure" that's actually
-          ;; an inlinable global function.
-          ((and (global-var-p (setf global-var
-                                    (functional-inline-expanded functional)))
-                (eq :global-function (global-var-kind global-var)))
-           (ir2-convert-global-var ref ir2-block global-var res))
-          (t
-           ;; if we're here, we should have either a toplevel-xep (some
-           ;; global scope function in a different component) or an external
-           ;; reference to the "closure"'s body.
-           (aver (memq (functional-kind functional) '(:external :toplevel-xep)))
-           (let ((entry (make-load-time-constant-tn :entry functional)))
-             (emit-move ref ir2-block entry res)))))
+  (flet ((prepare ()
+           (aver (not (eql (functional-kind functional) :deleted)))
+           (unless (leaf-info functional)
+             (setf (leaf-info functional)
+                   (make-entry-info :name
+                                    (functional-debug-name functional))))))
+    (let ((closure (etypecase functional
+                     (clambda
+                      (assertions-on-ir2-converted-clambda functional)
+                      (physenv-closure (get-lambda-physenv functional)))
+                     (functional
+                      (aver (eq (functional-kind functional) :toplevel-xep))
+                      nil)))
+          global-var)
+      (cond (closure
+             (prepare)
+             (let* ((physenv (node-physenv ref))
+                    (tn (find-in-physenv functional physenv)))
+               (emit-move ref ir2-block tn res)))
+            ;; we're about to emit a reference to a "closure" that's actually
+            ;; an inlinable global function.
+            ((and (global-var-p (setf global-var
+                                      (functional-inline-expanded functional)))
+                  (eq :global-function (global-var-kind global-var)))
+             (ir2-convert-global-var ref ir2-block global-var res))
+            (t
+             ;; if we're here, we should have either a toplevel-xep (some
+             ;; global scope function in a different component) or an external
+             ;; reference to the "closure"'s body.
+             (prepare)
+             (aver (memq (functional-kind functional) '(:external :toplevel-xep)))
+             (let ((entry (make-load-time-constant-tn :entry functional)))
+               (emit-move ref ir2-block entry res))))))
   (values))
 
 (defun closure-initial-value (what this-env current-fp)
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 48ccbb1..8f8d4c3 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4647,3 +4647,12 @@
                                       ,(sb-c::primitive-type-or-lose
                                         'fixnum))))
                 collect info))))))
+
+(with-test (:name :maybe-inline-ref-to-dead-lambda)
+  (compile nil `(lambda (string)
+                  (declare (optimize speed (space 0)))
+                  (cond ((every #'digit-char-p string)
+                         nil)
+                        ((some (lambda (c)
+                                 (digit-char-p c))
+                               string))))))
-- 
1.7.10.4