From 46602bb31b943b1793da732781586c032333c907 Mon Sep 17 00:00:00 2001
From: Paul Khuong <pvk@pvk.ca>
Date: Tue, 21 May 2013 19:49:19 -0400
Subject: [PATCH] Evaluate global inline functions via their fdefinition

 * When inlinable global functions are evaluated for value, emit
   code to refer to their fdefinition, rather than to a bogus
   entry point.

 * Make sure we only generate code to refer to XEPs and fail early
   otherwise, rather than after backpatching.

 * Fixes lp#1035721.
---
 NEWS                       |    2 ++
 src/compiler/ir2tran.lisp  |   57 +++++++++++++++++++++++++++-----------------
 tests/compiler.impure.lisp |   15 ++++++++++++
 3 files changed, 52 insertions(+), 22 deletions(-)

diff --git a/NEWS b/NEWS
index 5825cd5..0411d55 100644
--- a/NEWS
+++ b/NEWS
@@ -71,6 +71,8 @@ changes relative to sbcl-1.1.7:
   * bug fix: Type mismatch for the value of conditional expressions are
     correctly reported when detected at compile-time, instead of complaining
     about a constant NIL (similar for non-EQ-comparable catch tags).
+  * bug fix: Referring to INLINE global functions as values should not result
+    in a compilation failure. (lp#1035721)
   * optimization: faster ISQRT on fixnums and small bignums
   * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
   * optimization: On x86-64, the number of multi-byte NOP instructions used
diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index 24bccb7..b10661d 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -157,29 +157,32 @@
       (functional
        (ir2-convert-closure node block leaf res))
       (global-var
-       (let ((unsafe (policy node (zerop safety)))
-             (name (leaf-source-name leaf)))
-         (ecase (global-var-kind leaf)
-           ((:special :unknown)
-            (aver (symbolp name))
-            (let ((name-tn (emit-constant name)))
-              (if (or unsafe (info :variable :always-bound name))
-                  (vop fast-symbol-value node block name-tn res)
-                  (vop symbol-value node block name-tn res))))
-           (:global
-            (aver (symbolp name))
-            (let ((name-tn (emit-constant name)))
-              (if (or unsafe (info :variable :always-bound name))
-                  (vop fast-symbol-global-value node block name-tn res)
-                  (vop symbol-global-value node block name-tn res))))
-           (:global-function
-            (let ((fdefn-tn (make-load-time-constant-tn :fdefinition name)))
-              (if unsafe
-                  (vop fdefn-fun node block fdefn-tn res)
-                  (vop safe-fdefn-fun node block fdefn-tn res))))))))
+       (ir2-convert-global-var node block leaf res)))
     (move-lvar-result node block locs lvar))
   (values))
 
+(defun ir2-convert-global-var (node block leaf res)
+  (let ((unsafe (policy node (zerop safety)))
+        (name (leaf-source-name leaf)))
+    (ecase (global-var-kind leaf)
+      ((:special :unknown)
+       (aver (symbolp name))
+       (let ((name-tn (emit-constant name)))
+         (if (or unsafe (info :variable :always-bound name))
+             (vop fast-symbol-value node block name-tn res)
+             (vop symbol-value node block name-tn res))))
+      (:global
+       (aver (symbolp name))
+       (let ((name-tn (emit-constant name)))
+         (if (or unsafe (info :variable :always-bound name))
+             (vop fast-symbol-global-value node block name-tn res)
+             (vop symbol-global-value node block name-tn res))))
+      (:global-function
+       (let ((fdefn-tn (make-load-time-constant-tn :fdefinition name)))
+         (if unsafe
+             (vop fdefn-fun node block fdefn-tn res)
+             (vop safe-fdefn-fun node block fdefn-tn res)))))))
+
 ;;; some sanity checks for a CLAMBDA passed to IR2-CONVERT-CLOSURE
 (defun assertions-on-ir2-converted-clambda (clambda)
   ;; This assertion was sort of an experiment. It would be nice and
@@ -244,13 +247,23 @@
                     (physenv-closure (get-lambda-physenv functional)))
                    (functional
                     (aver (eq (functional-kind functional) :toplevel-xep))
-                    nil))))
-
+                    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)))))
   (values))
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 080d5c8..29eb6c3 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2403,4 +2403,19 @@
   (compile nil `(lambda (x)
                   (norm-1177703 (vec-1177703 x)))))
 
+(declaim (inline call-1035721))
+(defun call-1035721 (function)
+  (lambda (x)
+    (funcall function x)))
+
+(declaim (inline identity-1035721))
+(defun identity-1035721 (x)
+  x)
+
+(test-util:with-test (:name :bug-1035721)
+  (compile nil `(lambda ()
+                  (list
+                   (call-1035721 #'identity-1035721)
+                   (lambda (x)
+                     (identity-1035721 x))))))
 ;;; success
-- 
1.7.10.4