diff --git a/compiler/represent.lisp b/compiler/represent.lisp
index 1c47ae43be6b889aec876bb800383e36045df266..1c44f2c9cda0629dbfa76bb33ec9076cddb877e9 100644
--- a/compiler/represent.lisp
+++ b/compiler/represent.lisp
@@ -31,31 +31,46 @@
 ;;; 3] True if the operand is a more operand, false otherwise.
 ;;; 4] The costs for this operand.
 ;;; 5] The load-scs vector for this operand (NIL if more-p.)
+;;; 6] True if the costs or SCs in the VOP-INFO are inconsistent with the
+;;;    currently record ones.
 ;;;
 (defun get-operand-info (ref)
   (declare (type tn-ref ref))
   (let* ((arg-p (not (tn-ref-write-p ref)))
 	 (vop (tn-ref-vop ref))
 	 (info (vop-info vop)))
-    (flet ((frob (refs costs restr load more-cost)
+    (flet ((frob (refs costs load more-cost)
 	     (do ((refs refs (tn-ref-across refs))
 		  (costs costs (cdr costs))
 		  (load load (cdr load))
-		  (n 0 (1+ i)))
+		  (n 0 (1+ n)))
 		 ((null costs)
 		  (assert more-cost)
 		  (values arg-p
-			  (+ n (position-in #'tn-ref-across ref refs))
+			  (+ n (position-in #'tn-ref-across ref refs) 1)
 			  t
 			  more-cost
+			  nil
 			  nil))
 	       (when (eq refs ref)
-		 (return
-		  (values arg-p
-			  n
-			  nil
-			  (car costs)
-			  (car load)))))))
+		 (let ((parse (vop-parse-or-lose (vop-info-name info))))
+		   (multiple-value-bind
+		       (ccosts cscs)
+		       (compute-loading-costs
+			(elt (if arg-p
+				 (vop-parse-args parse)
+				 (vop-parse-results parse))
+			     n)
+			arg-p)
+		     
+		     (return
+		      (values arg-p
+			      (1+ n)
+			      nil
+			      (car costs)
+			      (car load)
+			      (not (and (equalp ccosts (car costs))
+					(equalp cscs (car load))))))))))))
       (if arg-p
 	  (frob (vop-args vop) (vop-info-arg-costs info)
 	        (vop-info-arg-load-scs info)
@@ -87,14 +102,13 @@
 (defun bad-costs-error (ref)
   (declare (type tn-ref ref))
   (let* ((tn (tn-ref-tn ref))
-	 (vop (tn-ref-vop ref))
 	 (ptype (tn-primitive-type tn)))
-    (multiple-value-bind (arg-p pos more-p costs load-scs)
+    (multiple-value-bind (arg-p pos more-p costs load-scs incon)
 			 (get-operand-info ref)
       (collect ((losers))
-	(dolist (sc (primitive-type-scs ptype))
-	  (unless (svref costs (sc-number sc))
-	    (losers sc)))
+	(dolist (scn (primitive-type-scs ptype))
+	  (unless (svref costs scn)
+	    (losers (svref *sc-numbers* scn))))
 
 	(unless (losers)
 	  (error "Representation selection flamed out for no obvious reason.~@
@@ -103,47 +117,88 @@
 	(error "~S is not valid as the ~:R ~:[result~;argument~] to the~@
 	        ~S VOP, since the TN's primitive type ~S allows SCs:~%  ~S~@
 		~:[which cannot be coerced or loaded into the allowed SCs:~
-		~%  ~S~;~]"
+		~%  ~S~;~]~:[~;~@
+		Current cost info inconsistent with that in effect at compile ~
+		time.  Recompile.~%Compilation order may be incorrect.~]"
 	       tn pos arg-p
-	       (template-name info)
+	       (template-name (vop-info (tn-ref-vop ref)))
 	       (primitive-type-name ptype)
-	       (mapcar #'sc-name losers)
+	       (mapcar #'sc-name (losers))
 	       more-p
-	       (mapcar #'sc-name (listify-restrictions load-scs)))))))
+	       (mapcar #'sc-name (listify-restrictions load-scs))
+	       incon)))))
 
 
 ;;; BAD-MOVE-ARG-ERROR  --  Internal
 ;;;
 (defun bad-move-arg-error (val pass)
   (declare (type tn val pass))
-  (error "No :MOVE-ARGUMENT VOP defined to move ~S (SC ~S) to
+  (error "No :MOVE-ARGUMENT VOP defined to move ~S (SC ~S) to ~
           ~S (SC ~S.)"
 	 val (sc-name (tn-sc val))
 	 pass (sc-name (tn-sc pass))))
 
+
+;;;; VM Consistency Checking:
+;;;
+;;;    We do some checking of the consistency of the VM definition at load
+;;; time.
+
+;;; CHECK-MOVE-FUNCTION-CONSISTENCY  --  Interface
+;;;
+(defun check-move-function-consistency ()
+  (dotimes (i sc-number-limit)
+    (let ((sc (svref *sc-numbers* i)))
+      (when sc
+	(let ((moves (sc-load-functions sc)))
+	  (dolist (const (sc-constant-scs sc))
+	    (unless (svref moves (sc-number const))
+	      (error "No move function defined to load SC ~S from constant ~
+	              SC ~S."
+		     (sc-name sc) (sc-name const))))
+
+	  (dolist (alt (sc-alternate-scs sc))
+	    (unless (svref moves (sc-number alt))
+	      (error "No move function defined to load SC ~S from alternate ~
+	              SC ~S."
+		     (sc-name sc) (sc-name alt)))
+	    (unless (svref (sc-load-functions alt) i)
+	      (error "No move function defined to save SC ~S to alternate ~
+	              SC ~S."
+		     (sc-name sc) (sc-name alt)))))))))
+;;;
+(check-move-function-consistency)
+
 
 ;;; SELECT-TN-REPRESENTATION  --  Internal
 ;;;
 ;;;    Return the best representation for a normal TN.  SCs is a list of the SC
 ;;; numbers of the SCs to select from.  Costs is a scratch vector.
 ;;;
+;;;     What we do is sum the costs for each reference to TN in each of the
+;;; SCs, and then return the SC having the lowest cost.  We ignore references
+;;; by the MOVE VOP, since counting them would spuriously encourage descriptor
+;;; representations.  We won't actually need to coerce to descriptor and back,
+;;; since we will replace the MOVE with a specialized move VOP.
+;;;
 (defun select-tn-representation (tn scs costs)
   (declare (type tn tn) (type sc-vector costs))
   (dolist (scn scs)
     (setf (svref costs scn) 0))
   
   (macrolet ((scan-refs (refs ops-slot costs-slot more-costs-slot)
-			`(do ((ref ,refs (tn-ref-next ref)))
-			     ((null ref))
-			   (let* ((vop (tn-ref-vop ref))
-				  (info (vop-info vop)))
-			     (do ((cost (,costs-slot info) (cdr cost))
-				  (op (,ops-slot vop) (tn-ref-across op)))
-				 ((null cost)
-				  (add-costs (,more-costs-slot info)))
-			       (when (eq op ref)
-				 (add-costs (car cost))
-				 (return))))))
+	       `(do ((ref ,refs (tn-ref-next ref)))
+		    ((null ref))
+		  (let* ((vop (tn-ref-vop ref))
+			 (info (vop-info vop)))
+		    (unless (eq (vop-info-name info) 'move)
+		      (do ((cost (,costs-slot info) (cdr cost))
+			   (op (,ops-slot vop) (tn-ref-across op)))
+			  ((null cost)
+			   (add-costs (,more-costs-slot info)))
+			(when (eq op ref)
+			  (add-costs (car cost))
+			  (return)))))))
 	     (add-costs (cost)
 	       `(let ((cost ,cost))
 		  (dolist (scn scs)
@@ -163,7 +218,7 @@
       (let ((cost (svref costs scn)))
 	(when (< cost min)
 	  (setq min cost)
-	  (setq min-scs scn))))
+	  (setq min-scn scn))))
     
     (svref *sc-numbers* min-scn)))
 
@@ -171,24 +226,24 @@
 ;;; NOTE-NUMBER-STACK-TN  --  Internal
 ;;;
 ;;;    Prepare for the possibility of a TN being allocated on the number stack
-;;; by allocating a number-FP in all functions that TN is referenced in and in
+;;; by setting NUMBER-STACK-P in all functions that TN is referenced in and in
 ;;; all the functions in their tail sets.  Refs is a TN-Refs list of references
 ;;; to the TN.
 ;;;
 (defun note-number-stack-tn (refs)
   (declare (type (or tn-ref null) refs))
+  
   (do ((ref refs (tn-ref-next refs)))
       ((null ref))
     (let* ((lambda (block-lambda
 		    (ir2-block-block
-		     (vop-block (tn-ref-fop ref)))))
+		     (vop-block (tn-ref-vop ref)))))
 	   (tails (lambda-tail-set lambda)))
       (flet ((frob (fun)
-	       (let ((env (lambda-environment lambda))
-		     (2env (environment-info env)))
-		 (unless (ir2-environment-number-fp 2env)
-		   (setf (ir2-environment-number-fp 2env)
-			 (make-number-fp-tn env))))))
+	       (setf (ir2-environment-number-stack-p
+		      (environment-info
+		       (lambda-environment fun)))
+		     t)))
 	(frob lambda)
 	(when tails
 	  (dolist (fun (tail-set-functions tails))
@@ -197,31 +252,6 @@
   (undefined-value))
 
 
-;;; ALLOCATE-OLD-NUMBER-FP-TNS  --  Internal
-;;;
-;;;    Allocate Old-Number-FP and Old-Number-FP-Pass TNs for all functions in
-;;; tail sets that have locations which might be allocated on the number stack.
-;;;
-(defun allocate-old-number-fp-tns (component)
-  (dolist (fun (component-lambdas component))
-    (let* ((env (lambda-environment fun))
-	   (2env (environment-info env)))
-      (unless (ir2-environment-old-number-fp 2env)
-	(let ((tails (lambda-tail-set fun)))
-	  (when tails
-	    (let ((info (tail-set-info tails)))
-	      (when (eq (return-info-kind info) :fixed)
-		(dolist (loc (return-info-locations ))
-		  (when (sc-number-stack-p (tn-sc loc))
-		    (setf (ir2-environment-old-number-fp 2env)
-			  (make-normal-tn *any-primitive-type*))
-		    (setf (ir2-environment-old-number-fp-pass 2env)
-			  (make-normal-tn *any-primitive-type*))
-		    (return))))))))))
-
-  (undefined-value))
-
-
 ;;; EMIT-COERCE-VOP  --  Internal
 ;;;
 ;;;    Emit a coercion VOP for Op or die trying.  SCS is the operand's LOAD-SCS
@@ -234,6 +264,9 @@
 ;;; SC.  If we find such a VOP, then we make a TN having the load SC as the
 ;;; representation.
 ;;;
+;;;    If the TN is an unused result TN, then we don't actually emit the move;
+;;; we just change to the right kind of TN.
+;;;
 (defun emit-coerce-vop (op scs)
   (declare (type tn-ref op) (type sc-vector scs))
   (let* ((op-tn (tn-ref-tn op))
@@ -252,9 +285,12 @@
 	  (when res
 	    (let ((temp (make-representation-tn i)))
 	      (change-tn-ref-tn op temp)
-	      (if write-p 
-		  (emit-move-template node block res temp op-tn vop)
-		  (emit-move-template node block res op-tn temp vop)))
+	      (cond
+	       ((not write-p)
+		(emit-move-template node block res op-tn temp vop))
+	       ((null (tn-reads op-tn)))
+	       (t
+		(emit-move-template node block res temp op-tn (vop-next vop)))))
 	    (return)))))))
 
 
@@ -277,6 +313,50 @@
       (scan (vop-results vop) (vop-info-result-load-scs info)))))
 
 
+;;; EMIT-ARG-MOVES  --  Internal
+;;;
+(defun emit-arg-moves (vop)
+  (let* ((info (vop-info vop))
+	 (node (vop-node vop))
+	 (block (vop-block vop))
+	 (how (vop-info-move-args info))
+	 (args (vop-args vop))
+	 (fp-tn (tn-ref-tn args))
+	 (nfp-tn (if (eq how :local-call)
+		     (tn-ref-tn (tn-ref-across args))
+		     nil))
+	 (pass-locs (first (vop-codegen-info vop))))
+    (do ((val (do ((arg args (tn-ref-across arg))
+		   (req (template-arg-types info) (cdr req)))
+		  ((null req) arg))
+	      (tn-ref-across val))
+	 (pass pass-locs (cdr pass)))
+	((null val)
+	 (assert (null pass)))
+      (let* ((val-tn (tn-ref-tn val))
+	     (pass-tn (first pass))
+	     (pass-sc (tn-sc pass-tn))
+	     (res (svref (sc-move-arg-vops pass-sc)
+			 (sc-number (tn-sc val-tn)))))
+	(unless res
+	  (bad-move-arg-error val-tn pass-tn))
+
+	(let ((this-fp
+	       (cond ((not (sc-number-stack-p pass-sc)) fp-tn)
+		     (nfp-tn)
+		     (t
+		      (assert (eq how :known-return))
+		      (setq nfp-tn
+			    (make-representation-tn
+			     (first (primitive-type-scs
+				     *any-primitive-type*))))
+		      (emit-context-template node block nfp-tn vop)
+		      nfp-tn))))
+	(emit-move-arg-template node block res val-tn this-fp pass-tn vop)))))
+
+  (undefined-value))
+
+
 ;;; EMIT-MOVES-AND-COERCIONS  --  Internal
 ;;;
 ;;;    Scan the IR2 looking for move operations that need to be replaced with
@@ -290,39 +370,21 @@
     (let ((info (vop-info vop))
 	  (node (vop-node vop))
 	  (block (vop-block vop)))
-      (case (vop-info-name info)
-	(move-arguments
-	 (let* ((info-args (vop-codegen-info vop))
-		(fp-tn (first info-args))
-		(nfp-tn (second info-args))
-		(pass-locs (third (info-args))))
-	   (do ((val (vop-args vop) (tn-ref-across val))
-		(pass pass-locs (cdr pass-loc)))
-	       ((null val))
-	     (let* ((val-tn (tn-ref-tn val))
-		    (pass-tn (first pass))
-		    (pass-sc (tn-sc pass-tn))
-		    (res (svref (sc-move-arg-vops pass-sc)
-				(sc-number (tn-sc val-tn)))))
-	       (unless res
-		 (bad-move-arg-error val-tn pass-tn))
-	       (emit-move-arg-template node block res val-tn
-				       (if (sc-number-stack-p pass-sc)
-					   nfp-tn fp-tn)
-				       pass-tn
-				       vop)))))
-	(move
-	 (let ((x (tn-ref-tn (vop-args op)))
+      (cond
+       ((eq (vop-info-name info) 'move)
+	(let* ((x (tn-ref-tn (vop-args vop)))
 	       (y (tn-ref-tn (vop-results vop)))
 	       (res (svref (sc-move-vops (tn-sc y))
 			   (sc-number (tn-sc x)))))
-	   (cond (res
-		  (emit-move-template node block res x y vop)
-		  (delete-vop vop))
-		 (t
-		  (coerce-vop-operands vop)))))
-	(t
-	 (coerce-vop-operands vop))))))
+	  (cond (res
+		 (emit-move-template node block res x y vop)
+		 (delete-vop vop))
+		(t
+		 (coerce-vop-operands vop)))))
+       ((vop-info-move-args info)
+	(emit-arg-moves vop))
+       (t
+	(coerce-vop-operands vop))))))
 
 
 ;;; SELECT-REPRESENTATIONS  --  Interface
@@ -334,20 +396,25 @@
 ;;; return values on the number stack.  Finally, we scan the IR2 looking for
 ;;; places that we need to insert coercions and representation-specific moves.
 ;;;
+;;;    We ignore TNs that already have a SC (representation is predetermined.)
+;;;
 (defun select-representations (component)
-  (let ((costs (make-array sc-number-limit)))
-    (do ((tn (ir2-component-normal-tns (component-info component))
-	     (tn-next tn)))
+  (let ((costs (make-array sc-number-limit))
+	(2comp (component-info component)))
+    (do ((tn (ir2-component-normal-tns 2comp) (tn-next tn)))
 	((null tn))
-      (let* ((scs (primitive-type-scs (tn-primitive-type tn)))
-	     (sc (if (rest scs)
-		     (select-tn-representation tn scs costs)
-		     (svref *sc-numbers* (first scs)))))
-	(setf (tn-sc tn) sc)
-	(when (sc-number-stack-p tn)
-	  (note-number-stack-tn tn)))))
-
-  (allocate-old-number-fp-tns component)
+      (unless (tn-sc tn)
+	(let* ((scs (primitive-type-scs (tn-primitive-type tn)))
+	       (sc (if (rest scs)
+		       (select-tn-representation tn scs costs)
+		       (svref *sc-numbers* (first scs)))))
+	  (assert sc)
+	  (setf (tn-sc tn) sc)
+	  (when (sc-number-stack-p sc)
+	    (unless (ir2-component-nfp 2comp)
+	      (setf (ir2-component-nfp 2comp) (make-nfp-tn)))
+	    (note-number-stack-tn (tn-reads tn))
+	    (note-number-stack-tn (tn-writes tn)))))))
 
   (do-ir2-blocks (block component)
     (emit-moves-and-coercions block))