X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=d1d9e68360b8abad9a2f08078c08231878200666;hb=395c461b58f0cd484c21913c1e075593c206b5c1;hp=9fe8589584077802ed2f9dfdeff9ae46151c9ed1;hpb=ed72064bbc8203d70526388e90d6858c28a6db25;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 9fe8589..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)
@@ -868,9 +879,9 @@
                             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))))
         (let ((fun (defined-fun-functional leaf)))
           (if (or (not fun)
@@ -881,7 +892,8 @@
                   (with-ir1-environment-from-node call
                     (frob)
                     (locall-analyze-component *current-component*)))
-              ;; If we've already converted, change ref to the converted functional.
+              ;; If we've already converted, change ref to the converted
+              ;; functional.
               (change-ref-leaf ref fun))))
       (values (ref-leaf ref) nil))
      (t