diff --git a/compiler/ltn.lisp b/compiler/ltn.lisp
index cac30393dc7da656c2d4564155563847669532a4..3514ab4a2242d098696fa27af9973e20aba7f7df 100644
--- a/compiler/ltn.lisp
+++ b/compiler/ltn.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ltn.lisp,v 1.26 1991/11/09 22:07:34 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ltn.lisp,v 1.27 1991/12/11 17:19:13 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -171,7 +171,8 @@
 ;;;
 (defun flush-full-call-tail-transfer (call)
   (declare (type basic-combination call))
-  (let ((tails (node-tail-p call)))
+  (let ((tails (and (node-tail-p call)
+		    (lambda-tail-set (node-home-lambda call)))))
     (when tails
       (cond ((eq (return-info-kind (tail-set-info tails)) :unknown)
 	     (node-ends-block call)
@@ -411,9 +412,11 @@
 
 ;;; LTN-Analyze-Local-Call  --  Internal
 ;;;
-;;;    Annotate the arguments as ordinary single-value continuations.  If a
-;;; tail call, swing the successor link to the start of the called function so
-;;; that the return can be deleted.
+;;;    Annotate the arguments as ordinary single-value continuations.  If the
+;;; call is a tail call, make sure that is linked directly to the bind node.
+;;; Usually it will be, but calls from XEPs and calls that might have needed a
+;;; cleanup after them won't have been swung over yet, since we weren't sure
+;;; they would really be TR until now.
 ;;;
 (defun ltn-analyze-local-call (call policy)
   (declare (type combination call)
@@ -425,12 +428,14 @@
       (annotate-ordinary-continuation arg policy)))
 
   (when (node-tail-p call)
-    (node-ends-block call)
-    (let ((block (node-block call)))
-      (unlink-blocks block (first (block-succ block)))
-      (link-blocks block
-		   (node-block (lambda-bind (combination-lambda call))))))
-
+    (let ((caller (node-home-lambda call))
+	  (callee (combination-lambda call)))
+      (assert (eq (lambda-tail-set caller)
+		  (lambda-tail-set (lambda-home callee))))
+      (node-ends-block call)
+      (let ((block (node-block call)))
+	(unlink-blocks block (first (block-succ block)))
+	(link-blocks block (node-block (lambda-bind callee))))))
   (undefined-value))