X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=d1d9e68360b8abad9a2f08078c08231878200666;hb=3dd90b64c37103d9c86d32b6c36277a6cea4098a;hp=b8b00544c4cddf5b1c632beafdbe0a706ac3234e;hpb=5fb561a1daba0b6dbd76f7347d4b0fa4b02494a6;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index b8b0054..d1d9e68 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -758,6 +758,14 @@
 
   (values))
 
+(defun xep-tail-combination-p (node)
+  (and (combination-p node)
+       (let* ((lvar (combination-lvar node))
+              (dest (when (lvar-p lvar) (lvar-dest lvar)))
+              (lambda (when (return-p dest) (return-lambda dest))))
+         (and (lambda-p lambda)
+              (eq :external (lambda-kind lambda))))))
+
 ;;; If NODE doesn't return (i.e. return type is NIL), then terminate
 ;;; the block there, and link it to the component tail.
 ;;;
@@ -783,7 +791,10 @@
     (declare (ignore lvar))
     (unless (or (and (eq node (block-last block)) (eq succ tail))
                 (block-delete-p block))
-      (when (eq (node-derived-type node) *empty-type*)
+      ;; Even if the combination will never return, don't terminate if this
+      ;; is the tail call of a XEP: doing that would inhibit TCO.
+      (when (and (eq (node-derived-type node) *empty-type*)
+                 (not (xep-tail-combination-p node)))
         (cond (ir1-converting-not-optimizing-p
                (cond
                  ((block-last block)
@@ -849,14 +860,18 @@
              ((nil :maybe-inline) (policy call (zerop space))))
            (defined-fun-p leaf)
            (defined-fun-inline-expansion leaf)
-           (let ((fun (defined-fun-functional leaf)))
-             (or (not fun)
-                 (and (eq inlinep :inline) (functional-kind fun))))
            (inline-expansion-ok call))
-      (flet (;; FIXME: Is this what the old CMU CL internal documentation
-             ;; called semi-inlining? A more descriptive name would
-             ;; be nice. -- WHN 2002-01-07
-             (frob ()
+      ;; Inline: if the function has already been converted at another call
+      ;; site in this component, we point this REF to the functional. If not,
+      ;; we convert the expansion.
+      ;;
+      ;; For :INLINE case local call analysis will copy the expansion later,
+      ;; but for :MAYBE-INLINE and NIL cases we only get one copy of the
+      ;; expansion per component.
+      ;;
+      ;; FIXME: We also convert in :INLINE & FUNCTIONAL-KIND case below. What
+      ;; is it for?
+      (flet ((frob ()
                (let* ((name (leaf-source-name leaf))
                       (res (ir1-convert-inline-expansion
                             name
@@ -864,18 +879,23 @@
                             leaf
                             inlinep
                             (info :function :info name))))
-                 ;; allow backward references to this function from
-                 ;; following top level forms
-                 (setf (defined-fun-functional leaf) res)
+                 ;; Allow backward references to this function from following
+                 ;; forms. (Reused only if policy matches.)
+                 (push res (defined-fun-functionals leaf))
                  (change-ref-leaf ref res))))
-        (if ir1-converting-not-optimizing-p
-            (frob)
-            (with-ir1-environment-from-node call
-              (frob)
-              (locall-analyze-component *current-component*))))
-
-      (values (ref-leaf (lvar-uses (basic-combination-fun call)))
-              nil))
+        (let ((fun (defined-fun-functional leaf)))
+          (if (or (not fun)
+                  (and (eq inlinep :inline) (functional-kind fun)))
+              ;; Convert.
+              (if ir1-converting-not-optimizing-p
+                  (frob)
+                  (with-ir1-environment-from-node call
+                    (frob)
+                    (locall-analyze-component *current-component*)))
+              ;; If we've already converted, change ref to the converted
+              ;; functional.
+              (change-ref-leaf ref fun))))
+      (values (ref-leaf ref) nil))
      (t
       (let ((info (info :function :info (leaf-source-name leaf))))
         (if info