From e9fad2f02c77c984c92040261d81dd0b42274bd0 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 2 Jun 1992 18:48:09 +0000
Subject: [PATCH] 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.

---
 compiler/locall.lisp | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/compiler/locall.lisp b/compiler/locall.lisp
index 8da5230bc..72ded33b9 100644
--- a/compiler/locall.lisp
+++ b/compiler/locall.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/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 @@
 ;;; must be restored to normal calls which transfer to Next-Block (Fun's
 ;;; 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)
   (dolist (called (lambda-calls fun))
     (dolist (ref (leaf-refs called))
       (let ((this-call (continuation-dest (node-cont ref))))
 	(when (and (node-tail-p this-call)
 		   (eq (node-home-lambda this-call) fun))
-	  (assert (member (functional-kind called) '(nil :cleanup :optional)))
 	  (setf (node-tail-p this-call) nil)
-	  (let ((block (node-block this-call)))
-	    (unlink-blocks block (first (block-succ block)))
-	    (link-blocks block next-block)
-	    (delete-continuation-use this-call)
-	    (add-continuation-use this-call (node-cont call)))))))
+	  (ecase (functional-kind called)
+	    ((nil :cleanup :optional)
+	     (let ((block (node-block this-call)))
+	       (unlink-blocks block (first (block-succ block)))
+	       (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))
 
 
@@ -921,8 +928,8 @@
 		  (unless (node-tail-p dest)
 		    (when (or non-tail (eq home fun)) (return nil))
 		    (setq non-tail dest)))))
+	(setf (functional-kind fun) :assignment)
 	(let-convert fun (or non-tail
 			     (continuation-dest
 			      (node-cont (first (leaf-refs fun))))))
-	(setf (functional-kind fun) :assignment)
 	t))))
-- 
GitLab