diff --git a/compiler/vmdef.lisp b/compiler/vmdef.lisp
index 1cea78cb64fec11f327f226df68e4339581992ee..a23f70af9ff1b67b756d86471a37966663404fe3 100644
--- a/compiler/vmdef.lisp
+++ b/compiler/vmdef.lisp
@@ -476,7 +476,8 @@
   (variant () :type list)
   (variant-vars () :type list)
   ;;
-  ;; Variable bound to the Vop-Node when in the generator body.
+  ;; Variables bound to the VOP and Vop-Node when in the generator body.
+  (vop-var (gensym) :type symbol)
   (node-var nil :type (or symbol null))
   ;;
   ;; A list of the names of the codegen-info arguments to this VOP.
@@ -952,8 +953,9 @@
 ;;;
 (defun make-generator-function (parse)
   (declare (type vop-parse parse))
-  (let ((n-vop (gensym)) (n-info (gensym)) (n-variant (gensym))
-	(operands (vop-parse-operands parse)))
+  (let ((n-vop (vop-parse-vop-var parse))
+	(operands (vop-parse-operands parse))
+	(n-info (gensym)) (n-variant (gensym)))
     (collect ((binds))
       (dolist (op operands)
 	(ecase (operand-parse-kind op)
@@ -1160,6 +1162,8 @@
 	       (make-list (length vars) :initial-element nil))))
       (:variant-cost
        (setf (vop-parse-cost parse) (vop-spec-arg spec 'unsigned-byte)))
+      (:vop-var
+       (setf (vop-parse-vop-var parse) (vop-spec-arg spec 'symbol)))
       (:node-var
        (setf (vop-parse-node-var parse) (vop-spec-arg spec 'symbol)))
       (:note
@@ -1633,6 +1637,11 @@
       form returns NIL, then emission of this VOP is prohibited even when
       all other restrictions are met.
 
+  :VOP-Var Name
+  :Node-Var Name
+      In the generator, bind the specified variable to the VOP or the Node that
+      generated this VOP.
+
   :Save-P {NIL | T | :Compute-Only | :Force-To-Stack}
       Indicates how a VOP wants live registers saved."
   
@@ -1894,6 +1903,58 @@
        ((null ,block-var) ,result)
      ,@forms)))
 
+
+;;; DO-LIVE-TNS  --  Interface
+;;;
+(defmacro do-live-tns ((tn-var live block &optional result) &body body)
+  "DO-LIVE-TNS (TN-Var Live Block [Result]) Form*
+  Iterate over all the TNs live at some point, with the live set represented by
+  a local conflicts bit-vector and the IR2-Block containing the location.
+  :More TNs are ignored, but :More TNs never appear in save-sets."
+  (let ((n-conf (gensym))
+	(n-bod (gensym))
+	(i (gensym))
+	(ltns (gensym)))
+      (once-only ((n-live live)
+		  (n-block block))
+	`(block nil
+	   (flet ((,n-bod (,tn-var) ,@body))
+	     ;;
+	     ;; Do environment-live TNs.
+	     (dolist (,tn-var (ir2-environment-live-tns
+			       (environment-info
+				(ir2-block-environment ,n-block))))
+	       (,n-bod ,tn-var))
+	     ;;
+	     ;; Do TNs always-live in this block.
+	     (do ((,n-conf (ir2-block-global-tns ,n-block)
+			   (global-conflicts-next ,n-conf)))
+		 ((null ,n-conf))
+	       (when (eq (global-conflicts-kind ,n-conf) :always-live)
+		 (,n-bod (global-conflicts-tn ,n-conf))))
+	     ;;
+	     ;; Do TNs locally live in the designated live set.
+	     (let ((,ltns (ir2-block-local-tns ,n-block)))
+	       (dotimes (,i (ir2-block-local-tn-count ,n-block) ,result)
+		 (unless (zerop (sbit ,n-live ,i))
+		   (let ((,tn-var (svref ,ltns ,i)))
+		     (unless (eq ,tn-var :more)
+		       (,n-bod ,tn-var)))))))))))
+
+
+;;; DO-ENVIRONMENT-IR2-BLOCKS  --  Interface
+;;;
+(defmacro do-environment-ir2-blocks ((block-var env &optional result)
+				     &body body)
+  "DO-ENVIRONMENT-IR2-BLOCKS (Block-Var Env [Result]) Form*
+  Iterate over all the IR2 blocks in the environment Env, in emit order."
+  (once-only ((n-env env))
+    `(do ((,block-var (block-info (node-block (lambda-bind fun)))
+		      (ir2-block-next ,block-var)))
+	((not (eq (ir2-block-environment ,block-var) ,n-env))
+	 ,result)
+       ,@body)))
+
 
 ;;;; Utilities for defining miscops: