diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp
index 2125511aea5f133444062da61f18987b32ba0da7..fd19073d60611559173fd5e039214299daf9fe1b 100644
--- a/compiler/ir1opt.lisp
+++ b/compiler/ir1opt.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/ir1opt.lisp,v 1.45 1992/06/03 19:57:43 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.46 1992/06/04 17:48:53 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -19,7 +19,7 @@
 ;;;
 ;;; Written by Rob MacLachlan
 ;;;
-(in-package 'c)
+(in-package :c)
 
 
 ;;;; Interface for obtaining results of constant folding:
@@ -457,29 +457,26 @@
 ;;;
 ;;;    This function is called on RETURN nodes that have their REOPTIMIZE flag
 ;;; set.  It iterates over the uses of the RESULT, looking for interesting
-;;; stuff to update the TAIL-SET:
-;;;  -- If a use is a tail local call, then we check that the called function
-;;;     has the tail set Tails.  If we encounter any different tail set, we
-;;;     return true.  If NODE-TAIL-P is not set, we also call
-;;;     CONVERT-TAIL-LOCAL-CALL, which changes the succesor of the call to be
-;;;     the called function and checks if the call can become an assignment.
-;;;  -- If a use isn't a local call, then we union its type together with the
-;;;     types of other such uses.  We assign to the RETURN-RESULT-TYPE the
-;;;     intersection of this type with the RESULT's asserted type.  We can make
-;;;     this intersection now (potentially before type checking) because this
-;;;     assertion on the result will eventually be checked (if appropriate.)
-;;;
-(defun find-result-type (node tails)
+;;; stuff to update the TAIL-SET.  If a use isn't a local call, then we union
+;;; its type together with the types of other such uses.  We assign to the
+;;; RETURN-RESULT-TYPE the intersection of this type with the RESULT's asserted
+;;; type.  We can make this intersection now (potentially before type checking)
+;;; because this assertion on the result will eventually be checked (if
+;;; appropriate.)
+;;;
+;;;    We call MAYBE-CONVERT-TAIL-LOCAL-CALL on each local non-MV combination,
+;;; which may change the succesor of the call to be the called function, and if
+;;; so, checks if the call can become an assignment.
+;;;
+(defun find-result-type (node)
   (declare (type creturn node))
-  (let ((result (return-result node))
-	(retry nil))
+  (let ((result (return-result node)))
     (collect ((use-union *empty-type* values-type-union))
       (do-uses (use result)
 	(cond ((and (basic-combination-p use)
-		    (eq (basic-combination-kind use) :local)
-		    (immediately-used-p result use))
-	       (when (merge-tail-sets use tails)
-		 (setq retry t))
+		    (eq (basic-combination-kind use) :local))
+	       (assert (eq (lambda-tail-set (node-home-lambda use))
+			   (lambda-tail-set (combination-lambda use))))
 	       (when (combination-p use)
 		 (maybe-convert-tail-local-call use)))
 	      (t
@@ -487,30 +484,8 @@
       (let ((int (values-type-intersection
 		  (continuation-asserted-type result)
 		  (use-union))))
-	(setf (return-result-type node) int)))
-    retry))
-
-
-;;; Merge-Tail-Sets  --  Internal
-;;;
-;;;    This function handles merging the tail sets if Call is a call to a
-;;; function with a different TAIL-SET than Ret-Set.  We return true if we do
-;;; anything.
-;;;
-;;;     It is assumed that Call sends its value to a RETURN node.  We
-;;; destructively modify the set for the returning function to represent both,
-;;; and then change all the functions in callee's set to reference the first.
-;;;
-(defun merge-tail-sets (call ret-set)
-  (declare (type basic-combination call) (type tail-set ret-set))
-  (let ((fun-set (lambda-tail-set (combination-lambda call))))
-    (unless (eq ret-set fun-set)
-      (let ((funs (tail-set-functions fun-set)))
-	(dolist (fun funs)
-	  (setf (lambda-tail-set fun) ret-set))
-	(setf (tail-set-functions ret-set)
-	      (nconc (tail-set-functions ret-set) funs)))
-      t)))
+	(setf (return-result-type node) int))))
+  (undefined-value))
 
 
 ;;; IR1-Optimize-Return  --  Internal
@@ -521,17 +496,6 @@
 ;;; up to date.  We iterate over the returns for all the functions in the tail
 ;;; set, reanalyzing them all (not treating Node specially.)
 ;;;
-;;;    During this iteration, we may discover new functions that should be
-;;; added to the tail set.  If this happens, we restart the iteration over the
-;;; TAIL-SET-FUNCTIONS.  Note that this really doesn't duplicate much work, as
-;;; we clear the NODE-REOPTIMIZE flags in the return nodes as we go, thus we
-;;; don't call FIND-RESULT-TYPE on any given return more than once.
-;;;
-;;;    Restarting the iteration doesn't disturb the computation of the result
-;;; type RES, since we will just be adding more types to the union.  (or when
-;;; we iterate over a return multiple times, unioning in the same type more
-;;; than once.)
-;;;
 ;;;    When we are done, we check if the new type is different from the old
 ;;; TAIL-SET-TYPE.  If so, we set the type and also reoptimize all the
 ;;; continuations for references to functions in the tail set.  This will
@@ -540,19 +504,16 @@
 ;;;
 (defun ir1-optimize-return (node)
   (declare (type creturn node))
-  (let ((tails (lambda-tail-set (return-lambda node))))
+  (let* ((tails (lambda-tail-set (return-lambda node)))
+	 (funs (tail-set-functions tails)))
     (collect ((res *empty-type* values-type-union))
-      (loop
-	(block RETRY
-	  (let ((funs (tail-set-functions tails)))
-	    (dolist (fun funs)
-	      (let ((return (lambda-return fun)))
-		(when return
-		  (when (node-reoptimize return)
-		    (setf (node-reoptimize node) nil)
-		    (when (find-result-type return tails) (return-from RETRY)))
-		  (res (return-result-type return))))))
-	  (return)))
+      (dolist (fun funs)
+	(let ((return (lambda-return fun)))
+	  (when return
+	    (when (node-reoptimize return)
+	      (setf (node-reoptimize node) nil)
+	      (find-result-type return))
+	    (res (return-result-type return)))))
       
       (when (type/= (res) (tail-set-type tails))
 	(setf (tail-set-type tails) (res))
@@ -655,7 +616,8 @@
 ;;; -- If the exit node and its Entry have the same home lambda then we know
 ;;;    the exit is local, and can delete the exit.  We change uses of the
 ;;;    Exit-Value to be uses of the original continuation, then unlink the
-;;;    node.
+;;;    node.  If the exit is to a TR context, then we must do MERGE-TAIL-SETS
+;;;    on any local calls which delivered their value to this exit.
 ;;; -- If there is no value (as in a GO), then we skip the value semantics.
 ;;;
 ;;; This function is also called by environment analysis, since it wants all
@@ -672,7 +634,15 @@
       (prog1
 	  (unlink-node node)
 	(when value
-	  (substitute-continuation-uses cont value))))))
+	  (collect ((merges))
+	    (when (return-p (continuation-dest cont))
+	      (do-uses (use value)
+		(when (and (basic-combination-p use)
+			   (eq (basic-combination-kind use) :local))
+		  (merges use))))
+	    (substitute-continuation-uses cont value)
+	    (dolist (merge (merges))
+	      (merge-tail-sets merge))))))))
 
 
 ;;;; Combination IR1 optimization: