Update of /cvsroot/sbcl/sbcl/src/compiler
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv15706/src/compiler
220.127.116.11: fix bug 354: XEPs in backtraces, properly this time
* Don't terminate the block in MAYBE-TERMINATE-BLOCK even if the node
is a call to a function that never returns if it is also the tail
end of a XEP -- this allows TCO to deal with the XEP.
* More stale bugs:
** 143 -- cannot replicate, interrupt handling has been robustified
and partially redesigned since than, so confidence that this is
really gone is reasonably high.
** 238 -- has gotten fixed at some point.
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.132
retrieving revision 1.133
diff -u -d -r1.132 -r1.133
--- ir1opt.lisp 3 Nov 2008 18:09:38 -0000 1.132
+++ ir1opt.lisp 21 Dec 2008 09:51:02 -0000 1.133
@@ -758,6 +758,14 @@
+(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))
- (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)))