diff --git a/compiler/tn.lisp b/compiler/tn.lisp
index 2c3b1b76b86d8b830088262e3cb277d6436eed46..9e2fee84803e2535a2a93c295281e87b87e36155 100644
--- a/compiler/tn.lisp
+++ b/compiler/tn.lisp
@@ -77,41 +77,34 @@
   (declare (type primitive-type type))
   (let* ((component (component-info *compile-component*))
 	 (res (make-tn (incf (ir2-component-global-tn-counter component))
-		       :normal type nil))
-	 (costs (tn-costs res)))
-    (dolist (scn (primitive-type-scs type))
-      (setf (svref costs scn) 0))
+		       :normal type nil)))
     (push-in tn-next res (ir2-component-normal-tns component))
     res))
 
 
-;;; Make-Environment-TN  --  Interface
+;;; Make-Restricted-TN  --  Interface
 ;;;
-;;;    Like Make-Normal-TN, but give it a :Environment kind and note it in the
-;;; specified Environment.
+;;;    Create a packed TN restricted to the SC with number SCN.
 ;;;
-(defun make-environment-tn (type env)
-  (declare (type primitive-type type) (type environment env))
-  (let ((res (make-normal-tn type)))
-    (setf (tn-kind res) :environment)
-    (push res (ir2-environment-live-tns (environment-info env)))
+(defun make-restricted-tn (scn)
+  (declare (type sc-number scn))
+  (let* ((component (component-info *compile-component*))
+	 (res (make-tn (incf (ir2-component-global-tn-counter component))
+		       :normal nil (svref *sc-numbers* scn))))
+    (push-in tn-next res (ir2-component-restricted-tns component))
     res))
 
 
-;;; Make-Restricted-TN  --  Interface
+;;; MAKE-REPRESENTATION-TN  --  Interface
 ;;;
-;;;    Create a packed TN restricted to some subset of the SCs normally allowed
-;;; by Type.  SCs is a list of the legal SC numbers.
+;;;    Create a normal packed TN with representation indicated by SCN.
 ;;;
-(defun make-restricted-tn (type scs)
-  (declare (type primitive-type type) (type list scs))
+(defun make-representation-tn (scn)
+  (declare (type sc-number scn))
   (let* ((component (component-info *compile-component*))
 	 (res (make-tn (incf (ir2-component-global-tn-counter component))
-		       :normal type nil))
-	 (costs (tn-costs res)))
-    (dolist (scn scs)
-      (setf (svref costs scn) 0))
-    (push-in tn-next res (ir2-component-restricted-tns component))
+		       :normal nil (svref *sc-numbers* scn))))
+    (push-in tn-next res (ir2-component-normal-tns component))
     res))
 
 
@@ -119,31 +112,41 @@
 ;;;
 ;;;    Create a TN wired to a particular location in an SC.  We set the Offset
 ;;; and FSC to record where it goes, and then put it on the current component's
-;;; Wired-TNs list.  Type is used to determine the move/coerce operations.
+;;; Wired-TNs list.
 ;;;
-(defun make-wired-tn (type scn offset)
-  (declare (type primitive-type type) (type sc-number scn)
-	   (type unsigned-byte offset))
+(defun make-wired-tn (scn offset)
+  (declare (type sc-number scn) (type unsigned-byte offset))
   (let* ((component (component-info *compile-component*))
 	 (res (make-tn (incf (ir2-component-global-tn-counter component))
-		       :normal type (svref *sc-numbers* scn))))
+		       :normal nil (svref *sc-numbers* scn))))
     (setf (tn-offset res) offset)
     (push-in tn-next res (ir2-component-wired-tns component))
     res))
 
 
-;;; Make-Wired-Environment-TN  --  Interface
+;;; Environment-Live-TN  --  Interface
 ;;;
-;;;    Like Make-Wired-TN, but give it a :Environment kind and note it in the
-;;; specified Environment.
+;;;    Make TN be live throughout environment.  TN must be referenced only in
+;;; Env.  Return TN.
 ;;;
-(defun make-wired-environment-tn (type scn offset env)
-  (declare (type primitive-type type) (type sc-number scn)
-	   (type unsigned-byte offset) (type environment env))
-  (let ((res (make-wired-tn type scn offset)))
-    (setf (tn-kind res) :environment)
-    (push res (ir2-environment-live-tns (environment-info env)))
-    res))
+(defun environment-live-tn (tn env)
+  (declare (type tn tn) (type environment env))
+  (assert (eq (tn-kind tn) :normal))
+  (setf (tn-kind tn) :environment)
+  (push tn (ir2-environment-live-tns (environment-info env)))
+  tn)
+
+
+;;; Component-Live-TN  --  Interface
+;;;
+;;;    Make TN be live throughout the current component.  Return TN.
+;;;
+(defun component-live-tn (tn)
+  (declare (type tn tn))
+  (assert (eq (tn-kind tn) :normal))
+  (setf (tn-kind tn) :component)
+  (push tn (ir2-component-component-tns (component-info *compile-component*)))
+  tn)
 
 
 ;;; Make-Constant-TN  --  Interface
@@ -262,6 +265,151 @@
 
 ;;;; Random utilities:
 
+
+;;; Emit-Move-Template  --  Internal
+;;;
+;;;    Emit a move-like template determined at run-time, with X as the argument
+;;; and Y as the result.  Useful for move, coerce and type-check templates.  If
+;;; supplied, then insert before VOP, otherwise insert at then end of the
+;;; block.  Returns the last VOP inserted.
+;;;
+(defun emit-move-template (node block template x y &optional before)
+  (declare (type node node) (type ir2-block block)
+	   (type template template) (type tn x y))
+  (let ((arg (reference-tn x nil))
+	(result (reference-tn y t)))
+    (multiple-value-bind
+	(first last)
+	(funcall (template-emit-function template) node block template arg
+		 result)
+      (insert-vop-sequence first last block before)
+      last)))
+
+
+;;; EMIT-LOAD-TEMPLATE  --  Internal
+;;;
+;;;    Like EMIT-MOVE-TEMPLATE, except that we pass in Info args too.
+;;;
+(defun emit-load-template (node block template x y info &optional before)
+  (declare (type node node) (type ir2-block block)
+	   (type template template) (type tn x y))
+  (let ((arg (reference-tn x nil))
+	(result (reference-tn y t)))
+    (multiple-value-bind
+	(first last)
+	(funcall (template-emit-function template) node block template arg
+		 result info)
+      (insert-vop-sequence first last block before)
+      last)))
+
+
+;;; EMIT-MOVE-ARG-TEMPLATE  --  Internal
+;;;
+;;;    Like EMIT-MOVE-TEMPLATE, except that the VOP takes two args.
+;;;
+(defun emit-move-arg-template (node block template x f y &optional before)
+  (declare (type node node) (type ir2-block block)
+	   (type template template) (type tn x f y))
+  (let ((x-ref (reference-tn x nil))
+	(f-ref (reference-tn f nil))
+	(y-ref (reference-tn y t)))
+    (setf (tn-ref-across x-ref) f-ref)
+    (multiple-value-bind
+	(first last)
+	(funcall (template-emit-function template) node block template x-ref
+		 y-ref)
+      (insert-vop-sequence first last block before)
+      last)))
+
+
+;;; EMIT-CONTEXT-TEMPLATE  --  Internal
+;;;
+;;;    Like EMIT-MOVE-TEMPLATE, except that the VOP takes no args.
+;;;
+(defun emit-context-template (node block template y &optional before)
+  (declare (type node node) (type ir2-block block)
+	   (type template template) (type tn y))
+  (let ((y-ref (reference-tn y t)))
+    (multiple-value-bind
+	(first last)
+	(funcall (template-emit-function template) node block template nil
+		 y-ref)
+      (insert-vop-sequence first last block before)
+      last)))
+
+
+;;; Block-Label  --  Interface
+;;;
+;;;    Return the label marking the start of Block, assigning one if necessary.
+;;;
+(defun block-label (block)
+  (declare (type cblock block))
+  (let ((2block (block-info block)))
+    (or (ir2-block-%label 2block)
+	(setf (ir2-block-%label 2block) (gen-label)))))
+
+
+;;; Drop-Thru-P  --  Interface
+;;;
+;;;    Return true if Block is emitted immediately after the block ended by
+;;; Node.
+;;;
+(defun drop-thru-p (node block)
+  (declare (type node node) (type cblock block))
+  (let ((next-block (ir2-block-next (block-info (node-block node)))))
+    (assert (eq node (block-last (node-block node))))
+    (eq next-block (block-info block))))
+
+
+;;; Insert-VOP-Sequence  --  Interface
+;;;
+;;;    Link a list of VOPs from First to Last into Block, Before the specified
+;;; VOP.  If Before is NIL, insert at the end.
+;;;
+(defun insert-vop-sequence (first last block before)
+  (declare (type vop first last) (type ir2-block block)
+	   (type (or vop null) before))
+  (if before
+      (let ((prev (vop-prev before)))
+	(setf (vop-prev first) prev)
+	(if prev
+	    (setf (vop-next prev) first)
+	    (setf (ir2-block-start-vop block) first))
+	(setf (vop-next last) before)
+	(setf (vop-prev before) last))
+      (let ((current (ir2-block-last-vop block)))
+	(setf (vop-prev first) current)
+	(setf (ir2-block-last-vop block) last)
+	(if current
+	    (setf (vop-next current) first)
+	    (setf (ir2-block-start-vop block) first))))
+  (undefined-value))
+
+
+;;; DELETE-VOP  --  Interface
+;;;
+;;;    Delete all of the TN-Refs associated with VOP and remove VOP from the
+;;; IR2.
+;;;
+(defun delete-vop (vop)
+  (declare (type vop vop))
+  (do ((ref (vop-refs vop) (tn-ref-next-ref ref)))
+      ((null ref))
+    (delete-tn-ref ref))
+
+  (let ((prev (vop-prev vop))
+	(next (vop-next vop))
+	(block (vop-block vop)))
+    (if prev
+	(setf (vop-next prev) next)
+	(setf (ir2-block-start-vop block) next))
+    (if next
+	(setf (vop-prev next) prev)
+	(setf (ir2-block-last-vop block) prev)))
+
+  (undefined-value))
+
+
 ;;; Make-N-TNs  --  Interface
 ;;;
 ;;;    Return a list of N normal TNs of the specified primitive type.
@@ -300,29 +448,36 @@
 
 ;;; Force-TN-To-Stack  --  Interface
 ;;;
-;;;    Force TN not to be allocated in a register by clearing the cost for each
-;;; SC that has a Save-SC.
+;;;    Force TN to be allocated in a SC that doesn't need to be saved: an
+;;; unbounded non-save-p SC.  We don't actually make it a real "restricted" TN,
+;;; but since we change the SC to an unbounded one, we should always succeed in
+;;; packing it in that SC.
 ;;;
 (defun force-tn-to-stack (tn)
   (declare (type tn tn))
-  (let ((costs (tn-costs tn)))
-    (dotimes (i sc-number-limit)
-      (when (svref *save-scs* i)
-	(setf (svref costs i) nil))))
+  (let ((sc (tn-sc tn)))
+    (unless (and (not (sc-save-p sc))
+		 (eq (sb-kind (sc-sb sc)) :unbounded))
+      (dolist (alt (sc-alternate-scs sc)
+		   (error "SC ~S has no :unbounded :save-p NIL alternate SC."
+			  (sc-name sc)))
+	(when (and (not (sc-save-p alt))
+		   (eq (sb-kind (sc-sb alt)) :unbounded))
+	  (setf (tn-sc tn) alt)
+	  (return)))))
   (undefined-value))
 
 
 ;;; TN-Environment  --  Interface
 ;;;
-;;;    Return some IR2-Environment that TN is referenced in.  TN must have at
-;;; least one reference (either read or write.)  Note that some TNs are
-;;; referenced in multiple environments.
+;;;    Return some Environment that TN is referenced in.  TN must have at least
+;;; one reference (either read or write.)  Note that some TNs are referenced in
+;;; multiple environments.
 ;;;
 (defun tn-environment (tn)
   (declare (type tn tn))
   (let ((ref (or (tn-reads tn) (tn-writes tn))))
     (assert ref)
-    (environment-info
-     (lambda-environment
-      (block-lambda
-       (ir2-block-block (vop-block (tn-ref-vop ref))))))))
+    (lambda-environment
+     (block-lambda
+      (ir2-block-block (vop-block (tn-ref-vop ref)))))))