[Sbcl-commits] master: Defer some sanity checks to after testing for value refence to inline functions

[Paul K. <pk...@us...>]

The branch "master" has been updated in SBCL:
       via  d30da16eea1fe05d17d337c5f392f12736199dc0 (commit)
      from  b8846766dd1ecb2b6c3dce848f2aae0b3b11a6ea (commit)

- Log -----------------------------------------------------------------
commit d30da16eea1fe05d17d337c5f392f12736199dc0
Author: Paul Khuong <pv...@pv...>
Date:   Thu Jun 27 22:03:24 2013 -0400

    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))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL