diff --git a/compiler/old-rt/char.lisp b/compiler/old-rt/char.lisp
index d74ebde85b2331b0e3889054b72f5aa52abd0e2a..4254d0f70fcbb2b1a5782a6bfadae152a62614d0 100644
--- a/compiler/old-rt/char.lisp
+++ b/compiler/old-rt/char.lisp
@@ -13,53 +13,71 @@
 ;;;
 (in-package 'c)
 
+
+;;;; Moves and coercions:
+
+;;; Move untagged string-char values.
+;;;
 (define-vop (string-char-move)
   (:args (x :target y
 	    :scs (string-char-reg)
-	    :load nil))
+	    :load-if (not (location= x y))))
   (:results (y :scs (string-char-reg)
-	       :load nil))
-  (:temporary (:scs (string-char-reg) :type string-char
-	       :from :argument  :to :result)
-	      temp)
+	       :load-if (not (location= x y))))
   (:effects)
   (:affected)
   (:generator 0
-    (sc-case x ((string-char-reg string-char-stack immediate-string-char
-				 descriptor-reg any-reg stack)))
-    (sc-case y ((string-char-reg string-char-stack
-				 descriptor-reg any-reg stack)))
-
-    (let* ((x-char (sc-is x string-char-reg string-char-stack
-			  immediate-string-char))
-	   (y-char (sc-is y string-char-reg string-char-stack))
-	   (same-rep (if x-char y-char (not y-char)))
-	   (src (if (sc-is x stack string-char-stack immediate-string-char)
-		    temp x))
-	   (dest (if (sc-is y stack string-char-stack) temp y)))
-
-      (unless (and same-rep (location= x y))
-
-	(unless (eq x src)
-	  (sc-case x
-	    ((string-char-stack stack)
-	     (load-stack-tn src x))
-	    (immediate-string-char
-	     (loadi src (char-code (tn-value x))))))
-
-	(if same-rep
-	    (unless (location= src dest)
-	      (inst lr dest src))
-	    (if x-char
-		(inst oiu dest src (ash system:%string-char-type
-					clc::type-shift-16))
-		(inst nilz dest src system:%character-code-mask)))
-
-	(unless (eq y dest)
-	  (store-stack-tn y dest)))))) 
-
-(primitive-type-vop string-char-move (:coerce-to-t :coerce-from-t :move)
-  string-char)
+    (unless (location= x y)
+      (inst lr y x))))
+;;;
+(define-move-vop string-char-move :move (string-char-reg) (string-char-reg))
+
+
+;;; Move untagged string-char arguments/return-values.
+;;;
+(define-vop (move-string-char-argument)
+  (:args (x :target y
+	    :scs (string-char-reg))
+	 (fp :scs (descriptor-reg)
+	     :load-if (not (sc-is y string-char-reg))))
+  (:results (y))
+  (:generator 0
+    (sc-case y
+      (string-char-reg
+       (unless (location= x y)
+	 (inst lr y x)))
+      (string-char-stack
+       (storew x fp (tn-offset y))))))
+;;;
+(define-move-vop move-string-char-argument :move-argument
+  (string-char-reg) (string-char-reg))
+
+
+;;; Move a tagged string char to an untagged representation.
+;;;
+(define-vop (move-to-string-char)
+  (:args (x :scs (any-reg descriptor-reg)))
+  (:results (y :scs (string-char-reg)))
+  (:generator 1
+    (inst nilz y x system:%character-code-mask)))
+;;;
+(define-move-vop move-to-string-char :move
+  (any-reg descriptor-reg) (string-char-reg))
+
+
+;;; Move an untagged string char to a tagged representation.
+;;;
+(define-vop (move-from-string-char)
+  (:args (x :scs (string-char-reg)))
+  (:results (y :scs (any-reg descriptor-reg)))
+  (:generator 1
+    (inst oiu y x (ash system:%string-char-type clc::type-shift-16))))
+;;;
+(define-move-vop move-from-string-char :move
+  (string-char-reg) (any-reg descriptor-reg))
+
+
+;;;; Other operations:
 
 (define-vop (char-code)
   (:args (ch :scs (string-char-reg) :target res))
@@ -74,7 +92,6 @@
 (define-vop (code-char)
   (:args (code :scs (any-reg descriptor-reg) :target res))
   (:results (res :scs (string-char-reg)))
-  (:result-types string-char)
   (:translate code-char)
   (:policy :fast-safe)
   (:generator 0
diff --git a/compiler/old-rt/move.lisp b/compiler/old-rt/move.lisp
index d6063dcfdd8e4f0093b87418db2e23974a8e4177..8796ab2db72ccb1857beb10abfebb68df6489feb 100644
--- a/compiler/old-rt/move.lisp
+++ b/compiler/old-rt/move.lisp
@@ -14,83 +14,62 @@
 ;;;
 (in-package 'c)
 
-;;; Load-Constant-TN  --  Internal
-;;;
-;;;    Load the Constant or immediate constant TN X into Y.  Temp is a
-;;; descriptor register temp or NIL, if none is available.  Temp must be
-;;; supplied if Y may be in memory.  Node is for souce context.
-;;;
-(defun load-constant-tn (x y temp node)
-  (declare (type tn x y) (type (or tn null temp)) (type node node))
-  (assemble node
-    (sc-case x
-      ((short-immediate unsigned-immediate immediate random-immediate
-			immediate-string-char)
-       (let ((val (tn-value x))
-	     (dest (sc-case y
-		     ((any-reg descriptor-reg string-char-reg) y)
-		     (stack temp))))
-	 (etypecase val
-	   (integer
-	    (loadi dest val))
-	   (null
-	    (inst cau dest zero-tn clc::nil-16))
-	   ((member t)
-	    (inst cau dest zero-tn clc::t-16))
-	   (string-char
-	    (let ((code (char-code val)))
-	      (loadi dest code)
-	      (unless (sc-is y string-char-reg)
-		(inst oiu dest dest (ash system:%string-char-type
-					 clc::type-shift-16))))))
-	 (unless (eq dest y)
-	   (store-stack-tn y temp))))
-      (constant
-       (sc-case y
-	 ((any-reg descriptor-reg)
-	  (load-slot y env-tn (tn-offset x)))
-	 (stack
-	  (load-slot temp env-tn (tn-offset x))
-	  (store-stack-tn y temp)))))))
+
+;;;; Move functions:
+
+(define-move-function (load-immediate 1) (node x y)
+  ((short-immediate unsigned-immediate immediate random-immediate)
+   (any-reg descriptor-reg))
+  (let ((val (tn-value x)))
+    (etypecase val
+      (integer
+       (loadi y val))
+      (null
+       (inst cau y zero-tn clc::nil-16))
+      ((member t)
+       (inst cau y zero-tn clc::t-16)))))
+
+(define-move-function (load-string-char 1) (node x y)
+  ((immediate-string-char) (string-char-reg))
+  (loadi y (char-code (tn-value x))))
+
+(define-move-function (load-tagged-string-char 2) (node x y)
+  ((immediate-string-char) (any-reg descriptor-reg))
+  (loadi y (char-code (tn-value x)))
+  (inst oiu y y (ash system:%string-char-type clc::type-shift-16)))
+
+(define-move-function (load-constant 5) (node x y)
+  ((constant) (any-reg descriptor-reg))
+  (load-slot y env-tn (tn-offset x)))
+
+(define-move-function (load-stack 5) (node x y)
+  ((stack) (any-reg descriptor-reg)
+   (string-char-stack) (string-char-reg))
+  (load-stack-tn y x))
+
+(define-move-function (store-stack 5) (node x y)
+  ((any-reg descriptor-reg) (stack)
+   (string-char-reg) (string-char-stack))
+  (store-stack-tn y x))
 
 
-;;;; The Move VOP:
-;;;
+;;;; Move and Move-Argument VOPs:
+
+
 ;;;    The Move VOP is used for doing arbitrary moves when there is no
 ;;; type-specific move/coerce operation.
-
-;;; We need a register to do a memory-memory move.
 ;;;
 (define-vop (move)
   (:args (x :target y
 	    :scs (any-reg descriptor-reg)
-	    :load nil))
+	    :load-if (not (location= x y))))
   (:results (y :scs (any-reg descriptor-reg)
-	       :load nil))
-  (:temporary (:scs (descriptor-reg)
-	       :from :argument  :to :result)
-	      temp)
-  (:node-var node)
+	       :load-if (not (location= x y))))
   (:effects)
   (:affected)
   (:generator 0
     (unless (location= x y)
-      (sc-case x
-	((any-reg descriptor-reg)
-	 (sc-case y
-	   ((any-reg descriptor-reg)
-	    (inst lr y x))
-	   (stack
-	    (store-stack-tn y x))))
-	(stack
-	 (sc-case y
-	   ((any-reg descriptor-reg)
-	    (load-stack-tn y x))
-	   (stack
-	    (load-stack-tn temp x)
-	    (store-stack-tn y temp))))
-	(t
-	 (unassemble (load-constant-tn x y temp node)))))))
+      (inst lr y x))))
 
 
 ;;; Make Move the check VOP for T so that type check generation doesn't think
@@ -99,84 +78,23 @@
 ;;;
 (primitive-type-vop move (:check) t)
 
-
-;;;; ILLEGAL-MOVE
 
-;;; This VOP is emitted when we attempt to do a move between incompatible
-;;; primitive types.  We signal an error, and ignore the result (which is
-;;; specified only to terminate its lifetime.)
+;;;    The Move-Argument VOP is used for moving descriptor values into another
+;;; frame for argument or known value passing.
 ;;;
-(define-vop (illegal-move three-arg-miscop)
-  (:args (x :scs (any-reg descriptor-reg) :target a1)
-	 (y-type :scs (any-reg descriptor-reg) :target a2))
-  (:variant-vars)
-  (:ignore r a3 nl0 nl1 misc-pc)
-  (:generator 666
-    (loadi a0 clc::error-object-not-type)
-    (unless (location= x a1)
-      (inst lr a1 x))
-    (unless (location= y-type a2)
-      (inst lr a2 y-type))
-    (inst miscop 'clc::error2)
-    (note-this-location vop :internal-error)))
-
-
-;;;; Operand loading and saving:
-;;;
-;;;    These are the VOPs used for loading or saving Load-TNs.  They cannot
-;;; allocate any temporaries since packing has already been done by the time
-;;; that these VOPs are emitted.  It can be assumed that the loaded (saved) TN
-;;; is free before (after) the load (save) (so may be used as a temporary.)
-;;;
-
-(define-vop (load-operand)
-  (:args (x))
-  (:results (y))
-  (:node-var node)
-  (:generator 5
-    (sc-case x
-      (stack
-       (sc-case y
-	 ((any-reg descriptor-reg)
-	  (load-stack-tn y x))
-	 (string-char-reg
-	  (load-stack-tn y x)
-	  (inst nilz y y system:%character-code-mask))))
-      (string-char-stack
-       (sc-case y
-	 (string-char-reg
-	  (load-stack-tn y x))))
-      (t
-       (unassemble (load-constant-tn x y nil node))))))
-
-(define-vop (store-operand)
-  (:args (x))
+(define-vop (move-argument)
+  (:args (x :target y
+	    :scs (any-reg descriptor-reg))
+	 (fp :scs (descriptor-reg)
+	     :load-if (not (sc-is y any-reg descriptor-reg))))
   (:results (y))
-  (:generator 5
+  (:generator 0
     (sc-case y
+      ((any-reg descriptor-reg)
+       (unless (location= x y)
+	 (inst lr y x)))
       (stack
-       (sc-case x
-	 ((any-reg descriptor-reg)
-	  (store-stack-tn y x))
-	 (string-char-reg
-	  (inst oiu x x (ash system:%string-char-type clc::type-shift-16))
-	  (store-stack-tn y x))))
-      (string-char-stack
-       (sc-case x
-	 (string-char-reg
-	  (store-stack-tn y x)))))))
-
-
-;;;; Register saving and restoring VOPs.
-
-(define-vop (save-reg)
-  (:args (reg))
-  (:results (stack))
-  (:generator 5
-    (store-stack-tn stack reg)))
-
-(define-vop (restore-reg)
-  (:args (stack))
-  (:results (reg))
-  (:generator 5
-    (load-stack-tn reg stack)))
+       (storew x fp (tn-offset y))))))
+;;;
+(define-move-vop move-argument :move-argument
+  (any-reg descriptor-reg) (any-reg descriptor-reg))