Skip to content
Snippets Groups Projects
Commit bb5d5804 authored by ram's avatar ram
Browse files

Updated for new TAIL-SET semantics.

Added an assertion that when we see a tail local call, the caller
and callee tail sets had better be the same.
parent b117084c
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -171,7 +171,8 @@
;;; ;;;
(defun flush-full-call-tail-transfer (call) (defun flush-full-call-tail-transfer (call)
(declare (type basic-combination 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 (when tails
(cond ((eq (return-info-kind (tail-set-info tails)) :unknown) (cond ((eq (return-info-kind (tail-set-info tails)) :unknown)
(node-ends-block call) (node-ends-block call)
...@@ -411,9 +412,11 @@ ...@@ -411,9 +412,11 @@
;;; LTN-Analyze-Local-Call -- Internal ;;; LTN-Analyze-Local-Call -- Internal
;;; ;;;
;;; Annotate the arguments as ordinary single-value continuations. If a ;;; Annotate the arguments as ordinary single-value continuations. If the
;;; tail call, swing the successor link to the start of the called function so ;;; call is a tail call, make sure that is linked directly to the bind node.
;;; that the return can be deleted. ;;; 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) (defun ltn-analyze-local-call (call policy)
(declare (type combination call) (declare (type combination call)
...@@ -425,12 +428,14 @@ ...@@ -425,12 +428,14 @@
(annotate-ordinary-continuation arg policy))) (annotate-ordinary-continuation arg policy)))
(when (node-tail-p call) (when (node-tail-p call)
(node-ends-block call) (let ((caller (node-home-lambda call))
(let ((block (node-block call))) (callee (combination-lambda call)))
(unlink-blocks block (first (block-succ block))) (assert (eq (lambda-tail-set caller)
(link-blocks block (lambda-tail-set (lambda-home callee))))
(node-block (lambda-bind (combination-lambda call)))))) (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)) (undefined-value))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment