diff --git a/compiler/life.lisp b/compiler/life.lisp
index 0e6ae0c2edcbd19066f7c612753cd8843f90eed0..ae11b19de65973343458b770ea5ac8eaa6261918 100644
--- a/compiler/life.lisp
+++ b/compiler/life.lisp
@@ -123,8 +123,7 @@
 	  (let* ((tn (tn-ref-tn ref))
 		 (local (tn-local tn))
 		 (kind (tn-kind tn)))
-	    (unless (or (eq kind :constant)
-			(eq kind :environment))
+	    (when (eq kind :normal)
 	      (unless (eq local block)
 		(when (= ltn-num local-tn-limit)
 		  (return-from find-local-references vop))
@@ -497,34 +496,34 @@
 
 ;;; Convert-To-Environment-TN  --  Internal
 ;;;
-;;;    If TN isn't already a :Environment TN, then make it into one.  This
-;;; requires deleting the existing conflict info.
+;;;    Convert a :Normal TN to an :Environment TN.  This requires deleting the
+;;; existing conflict info.
 ;;;
 (defun convert-to-environment-tn (tn)
   (declare (type tn tn))
-  (ecase (tn-kind tn)
-    (:environment)
-    (:normal
-     (let ((confs (tn-global-conflicts tn)))
-       (if confs
-	   (do ((conf confs (global-conflicts-tn-next conf)))
-	       ((null conf))
-	     (let ((block (global-conflicts-block conf)))
-	       (unless (eq (global-conflicts-kind conf) :live)
-		 (let ((ltns (ir2-block-local-tns block))
-		       (num (global-conflicts-number conf)))
-		   (assert (not (eq (svref ltns num) :more)))
-		   (setf (svref ltns num) nil)))
-	       (deletef-in global-conflicts-next (ir2-block-global-tns block)
-			   conf)))
-	   (setf (svref (ir2-block-local-tns (tn-local tn))
-			(tn-local-number tn))
-		 nil))
-       (setf (tn-local tn) nil)
-       (setf (tn-local-number tn) nil)
-       (setf (tn-global-conflicts tn) nil)
-       (setf (tn-kind tn) :environment)
-       (push tn (ir2-environment-live-tns (tn-environment tn))))))
+  (assert (eq (tn-kind tn) :normal))
+  (let ((confs (tn-global-conflicts tn)))
+    (if confs
+	(do ((conf confs (global-conflicts-tn-next conf)))
+	    ((null conf))
+	  (let ((block (global-conflicts-block conf)))
+	    (unless (eq (global-conflicts-kind conf) :live)
+	      (let ((ltns (ir2-block-local-tns block))
+		    (num (global-conflicts-number conf)))
+		(assert (not (eq (svref ltns num) :more)))
+		(setf (svref ltns num) nil)))
+	    (deletef-in global-conflicts-next (ir2-block-global-tns block)
+			conf)))
+	(setf (svref (ir2-block-local-tns (tn-local tn))
+		     (tn-local-number tn))
+	      nil))
+    (setf (tn-local tn) nil)
+    (setf (tn-local-number tn) nil)
+    (setf (tn-global-conflicts tn) nil)
+    (setf (tn-kind tn) :environment)
+    (push tn (ir2-environment-live-tns
+	      (environment-info
+	       (tn-environment tn)))))
   (undefined-value))
 
 
@@ -558,7 +557,7 @@
       (let ((tn (tn-ref-tn r)))
 	(ecase (tn-kind tn)
 	  (:normal (setf (sbit live (tn-local-number tn)) 0))
-	  (:environment))))
+	  (:environment :component))))
     live))
 
 
@@ -643,8 +642,9 @@
 	      (setf (vop-save-set vop) ss)
 	      (when (eq save-p :force-to-stack)
 		(do-live-tns (tn ss block)
-		  (force-tn-to-stack tn)
-		  (convert-to-environment-tn tn))))))
+		  (when (eq (tn-kind tn) :normal)
+		    (force-tn-to-stack tn)
+		    (convert-to-environment-tn tn)))))))
 	
 	(do ((ref (vop-refs vop) (tn-ref-next-ref ref)))
 	    ((null ref))
@@ -756,10 +756,9 @@
     (do ((conf (tn-global-conflicts y) (global-conflicts-tn-next conf)))
 	((null conf)
 	 nil)
-      (when (eq (environment-info
-		 (lambda-environment
-		  (block-lambda
-		   (ir2-block-block (global-conflicts-block conf)))))
+      (when (eq (lambda-environment
+		 (block-lambda
+		  (ir2-block-block (global-conflicts-block conf))))
 		env)
 	(return t)))))
 
@@ -770,37 +769,41 @@
 ;;;
 (defun tns-conflict-environment-local (x y)
   (declare (type tn x y))
-  (eq (environment-info
-       (lambda-environment
-	(block-lambda
-	 (ir2-block-block (tn-local y)))))
+  (eq (lambda-environment
+       (block-lambda
+	(ir2-block-block (tn-local y))))
       (tn-environment x)))
 
 
 ;;; TNs-Conflict  --  Interface
 ;;;
-;;;    Return true if the lifetimes of X and Y overlap at any point.
+;;;    Return true if X and Y are distinct and the lifetimes of X and Y overlap
+;;; at any point.
 ;;;
 (defun tns-conflict (x y)
   (declare (type tn x y))
-  (cond ((eq (tn-kind x) :environment)
-	 (cond ((tn-global-conflicts y)
-		(tns-conflict-environment-global x y))
-	       ((eq (tn-kind y) :environment)
-		(eq (tn-environment x) (tn-environment y)))
-	       (t
-		(tns-conflict-environment-local x y))))
-	((eq (tn-kind y) :environment)
-	 (if (tn-global-conflicts x)
-	     (tns-conflict-environment-global y x)
-	     (tns-conflict-environment-local y x)))
-	((tn-global-conflicts x)
-	 (if (tn-global-conflicts y)
-	     (tns-conflict-global-global x y)
-	     (tns-conflict-local-global y x)))
-	((tn-global-conflicts y)
-	 (tns-conflict-local-global x y))
-	(t
-	 (and (eq (tn-local x) (tn-local y))
-	      (not (zerop (sbit (tn-local-conflicts x)
-				(tn-local-number y))))))))
+  (let ((x-kind (tn-kind x))
+	(y-kind (tn-kind y)))
+    (cond ((eq x y) nil)
+	  ((eq x-kind :environment)
+	   (cond ((tn-global-conflicts y)
+		  (tns-conflict-environment-global x y))
+		 ((eq (tn-kind y) :environment)
+		  (eq (tn-environment x) (tn-environment y)))
+		 (t
+		  (tns-conflict-environment-local x y))))
+	  ((eq y-kind :environment)
+	   (if (tn-global-conflicts x)
+	       (tns-conflict-environment-global y x)
+	       (tns-conflict-environment-local y x)))
+	  ((or (eq x-kind :component) (eq y-kind :component)) t)
+	  ((tn-global-conflicts x)
+	   (if (tn-global-conflicts y)
+	       (tns-conflict-global-global x y)
+	       (tns-conflict-local-global y x)))
+	  ((tn-global-conflicts y)
+	   (tns-conflict-local-global x y))
+	  (t
+	   (and (eq (tn-local x) (tn-local y))
+		(not (zerop (sbit (tn-local-conflicts x)
+				  (tn-local-number y)))))))))