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

In UNCONVERT-TAIL-CALLS, don't unconvert the tail calls for the assignment we

are currently converting.  In MAYBE-CONVERT-TO-ASSIGNMENT, moved assignment of
functional-kind to before the LET-CONVERT so that we can know when we are
converting an assignment.
parent 930d1e01
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/locall.lisp,v 1.29 1992/04/27 19:47:24 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/locall.lisp,v 1.30 1992/06/02 18:48:09 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -710,19 +710,26 @@ ...@@ -710,19 +710,26 @@
;;; must be restored to normal calls which transfer to Next-Block (Fun's ;;; must be restored to normal calls which transfer to Next-Block (Fun's
;;; return point.) ;;; return point.)
;;; ;;;
;;; The called function might be an assignment in the case where we are
;;; currently converting that function. In steady-state, assignments never
;;; appear in the lambda-calls.
;;;
(defun unconvert-tail-calls (fun call next-block) (defun unconvert-tail-calls (fun call next-block)
(dolist (called (lambda-calls fun)) (dolist (called (lambda-calls fun))
(dolist (ref (leaf-refs called)) (dolist (ref (leaf-refs called))
(let ((this-call (continuation-dest (node-cont ref)))) (let ((this-call (continuation-dest (node-cont ref))))
(when (and (node-tail-p this-call) (when (and (node-tail-p this-call)
(eq (node-home-lambda this-call) fun)) (eq (node-home-lambda this-call) fun))
(assert (member (functional-kind called) '(nil :cleanup :optional)))
(setf (node-tail-p this-call) nil) (setf (node-tail-p this-call) nil)
(let ((block (node-block this-call))) (ecase (functional-kind called)
(unlink-blocks block (first (block-succ block))) ((nil :cleanup :optional)
(link-blocks block next-block) (let ((block (node-block this-call)))
(delete-continuation-use this-call) (unlink-blocks block (first (block-succ block)))
(add-continuation-use this-call (node-cont call))))))) (link-blocks block next-block)
(delete-continuation-use this-call)
(add-continuation-use this-call (node-cont call))))
(:assignment
(assert (eq called fun))))))))
(undefined-value)) (undefined-value))
...@@ -921,8 +928,8 @@ ...@@ -921,8 +928,8 @@
(unless (node-tail-p dest) (unless (node-tail-p dest)
(when (or non-tail (eq home fun)) (return nil)) (when (or non-tail (eq home fun)) (return nil))
(setq non-tail dest))))) (setq non-tail dest)))))
(setf (functional-kind fun) :assignment)
(let-convert fun (or non-tail (let-convert fun (or non-tail
(continuation-dest (continuation-dest
(node-cont (first (leaf-refs fun)))))) (node-cont (first (leaf-refs fun))))))
(setf (functional-kind fun) :assignment)
t)))) t))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment