diff --git a/compiler/alpha/float.lisp b/compiler/alpha/float.lisp
index e0e715538fda03564efc7399d6909e53e4488ede..b816c11cc20388e0206adbaaa97303fb9c92f060 100644
--- a/compiler/alpha/float.lisp
+++ b/compiler/alpha/float.lisp
@@ -6,7 +6,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.7 1998/01/26 18:15:33 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.8 1998/03/04 15:00:30 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -282,65 +282,88 @@
 ;;;
 ;;; Move from a descriptor to a complex float register
 ;;;
-(macrolet ((frob (name sc double-p real-value imag-value)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (descriptor-reg)))
-		  (:results (y :scs (,sc)))
-		  (:note "pointer to complex float coercion")
-		  (:generator 2
-		    (let ((real-tn ,(if double-p
-					'(complex-double-reg-real-tn y)
-					'(complex-single-reg-real-tn y))))
-		      (inst ,(if double-p 'ldt 'lds) real-tn
-			    (- (* ,real-value vm:word-bytes)
-			       vm:other-pointer-type)
-			    x))
-		    (let ((imag-tn ,(if double-p
-					'(complex-double-reg-imag-tn y)
-					'(complex-single-reg-imag-tn y))))
-		      (inst ,(if double-p 'ldt 'lds) imag-tn
-			    (- (* ,imag-value vm:word-bytes)
-			       vm:other-pointer-type)
-			    x))))
-		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
-	  (frob move-to-complex-single complex-single-reg nil
-		complex-single-float-real-slot complex-single-float-imag-slot)
-	  (frob move-to-complex-double complex-double-reg t
-		complex-double-float-real-slot complex-double-float-imag-slot))
+(define-vop (move-to-complex-single)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-single-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (let ((real-tn (complex-single-reg-real-tn y)))
+      (inst lds real-tn (- (* complex-single-float-real-slot vm:word-bytes)
+			   vm:other-pointer-type)
+	    x))
+    (let ((imag-tn (complex-single-reg-imag-tn y)))
+      (inst lds imag-tn (- (* complex-single-float-imag-slot vm:word-bytes)
+			   vm:other-pointer-type)
+	    x))))
+(define-move-vop move-to-complex-single :move
+  (descriptor-reg) (complex-single-reg)))))
+
+(define-vop (move-to-complex-double)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-double-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (let ((real-tn (complex-double-reg-real-tn y)))
+      (inst ldt real-tn (- (* complex-double-float-real-slot vm:word-bytes)
+			   vm:other-pointer-type)
+	    x))
+    (let ((imag-tn (complex-double-reg-imag-tn y)))
+      (inst ldt imag-tn (- (* complex-double-float-imag-slot vm:word-bytes)
+			   vm:other-pointer-type)
+	    x))))
+(define-move-vop move-to-complex-double :move
+  (descriptor-reg) (complex-double-reg)))))
+
 ;;;
 ;;; Complex float move-argument vop
 ;;;
-(macrolet ((frob (name sc stack-sc double-p)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (,sc) :target y)
-			 (nfp :scs (any-reg)
-			      :load-if (not (sc-is y ,sc))))
-		  (:results (y))
-		  (:note "complex float argument move")
-		  (:generator ,(if double-p 2 1)
-		    (sc-case y
-		      (,sc
-		       (unless (location= x y)
-			 (let ((x-real (complex-double-reg-real-tn x))
-			       (y-real (complex-double-reg-real-tn y)))
-			   (inst fmove x-real y-real))
-			 (let ((x-imag (complex-double-reg-imag-tn x))
-			       (y-imag (complex-double-reg-imag-tn y)))
-			   (inst fmove x-imag y-imag))))
-		      (,stack-sc
-		       (let ((offset (* (tn-offset y) vm:word-bytes)))
-			 (let ((real-tn (complex-double-reg-real-tn x)))
-			   (inst ,(if double-p 'stt 'sts) real-tn offset nfp))
-			 (let ((imag-tn (complex-double-reg-imag-tn x)))
-			   (inst ,(if double-p 'stt 'sts) imag-tn offset nfp)))))))
-		(define-move-vop ,name :move-argument
-		  (,sc descriptor-reg) (,sc)))))
-  (frob move-complex-single-float-argument
-	complex-single-reg complex-single-stack nil)
-  (frob move-complex-double-float-argument
-	complex-double-reg complex-double-stack t))
+(define-vop (move-complex-single-float-argument)
+  (:args (x :scs (complex-single-reg) :target y)
+	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
+  (:results (y))
+  (:note "complex single float argument move")
+  (:generator 1
+    (sc-case y
+      (complex-single-reg
+       (unless (location= x y)
+	 (let ((x-real (complex-single-reg-real-tn x))
+	       (y-real (complex-single-reg-real-tn y)))
+	   (inst fmove x-real y-real))
+	 (let ((x-imag (complex-single-reg-imag-tn x))
+	       (y-imag (complex-single-reg-imag-tn y)))
+	   (inst fmove x-imag y-imag))))
+      (complex-single-stack
+       (let ((offset (* (tn-offset y) vm:word-bytes)))
+	 (let ((real-tn (complex-single-reg-real-tn x)))
+	   (inst sts real-tn offset nfp))
+	 (let ((imag-tn (complex-single-reg-imag-tn x)))
+	   (inst sts imag-tn (+ offset world-bytes) nfp)))))))
+(define-move-vop move-complex-single-float-argument :move-argument
+  (complex-single-reg descriptor-reg) (complex-single-reg)))))
+
+(define-vop (move-complex-double-float-argument)
+  (:args (x :scs (complex-double-reg) :target y)
+	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
+  (:results (y))
+  (:note "complex double float argument move")
+  (:generator 2
+    (sc-case y
+      (complex-double-reg
+       (unless (location= x y)
+	 (let ((x-real (complex-double-reg-real-tn x))
+	       (y-real (complex-double-reg-real-tn y)))
+	   (inst fmove x-real y-real))
+	 (let ((x-imag (complex-double-reg-imag-tn x))
+	       (y-imag (complex-double-reg-imag-tn y)))
+	   (inst fmove x-imag y-imag))))
+      (complex-double-stack
+       (let ((offset (* (tn-offset y) vm:word-bytes)))
+	 (let ((real-tn (complex-double-reg-real-tn x)))
+	   (inst stt real-tn offset nfp))
+	 (let ((imag-tn (complex-double-reg-imag-tn x)))
+	   (inst stt imag-tn (+ offset (* 2 word-bytes)) nfp)))))))
+(define-move-vop move-complex-double-float-argument :move-argument
+  (complex-double-reg descriptor-reg) (complex-double-reg)))))
 
 ) ; progn complex-float
 
diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp
index 95dd5b5e4e4bf8b01f87f2977fbb18bb56ccf5c5..09616ae2aebba886eb6ed0ae48bd68de203e9678 100644
--- a/compiler/sparc/float.lisp
+++ b/compiler/sparc/float.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.16 1998/03/03 16:35:30 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.17 1998/03/04 15:00:28 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -270,68 +270,86 @@
 ;;;
 ;;; Move from a descriptor to a complex float register
 ;;;
-(macrolet ((frob (name sc double-p real-value imag-value)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (descriptor-reg)))
-		  (:results (y :scs (,sc)))
-		  (:note "pointer to complex float coercion")
-		  (:generator 2
-		    (let ((real-tn ,(if double-p 
-					'(complex-double-reg-real-tn y)
-					'(complex-single-reg-real-tn y))))
-		      (inst ,(if double-p 'lddf 'ldf) real-tn x
-			    (- (* ,real-value vm:word-bytes)
-			       vm:other-pointer-type)))
-		    (let ((imag-tn ,(if double-p
-					'(complex-double-reg-imag-tn y)
-					'(complex-single-reg-imag-tn y))))
-		      (inst ,(if double-p 'lddf 'ldf) imag-tn x
-			    (- (* ,imag-value vm:word-bytes)
-			       vm:other-pointer-type)))))
-		(define-move-vop ,name :move (descriptor-reg) (,sc)))))
-	  (frob move-to-complex-single complex-single-reg nil
-		complex-single-float-real-slot complex-single-float-imag-slot)
-	  (frob move-to-complex-double complex-double-reg t
-		complex-double-float-real-slot complex-double-float-imag-slot))
+(define-vop (move-to-complex-single)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-single-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (let ((real-tn (complex-single-reg-real-tn y)))
+      (inst ldf real-tn x (- (* complex-single-float-real-slot word-bytes)
+			     other-pointer-type)))
+    (let ((imag-tn (complex-single-reg-imag-tn y)))
+      (inst ldf imag-tn x (- (* complex-single-float-imag-slot word-bytes)
+			     other-pointer-type)))))
+(define-move-vop move-to-complex-single :move
+  (descriptor-reg) (complex-single-reg))
+
+(define-vop (move-to-complex-double)
+  (:args (x :scs (descriptor-reg)))
+  (:results (y :scs (complex-double-reg)))
+  (:note "pointer to complex float coercion")
+  (:generator 2
+    (let ((real-tn (complex-double-reg-real-tn y)))
+      (inst lddf real-tn x (- (* complex-double-float-real-slot word-bytes)
+			      other-pointer-type)))
+    (let ((imag-tn (complex-double-reg-imag-tn y)))
+      (inst lddf imag-tn x (- (* complex-double-float-imag-slot word-bytes)
+			      other-pointer-type)))))
+(define-move-vop move-to-complex-double :move
+  (descriptor-reg) (complex-double-reg))
 
 ;;;
 ;;; Complex float move-argument vop
 ;;;
-(macrolet ((frob (name sc stack-sc double-p)
-	     `(progn
-		(define-vop (,name)
-		  (:args (x :scs (,sc) :target y)
-			 (nfp :scs (any-reg)
-			      :load-if (not (sc-is y ,sc))))
-		  (:results (y))
-		  (:note "float argument move")
-		  (:generator ,(if double-p 2 1)
-		    (sc-case y
-		      (,sc
-		       (unless (location= x y)
-			 (let ((x-real (complex-double-reg-real-tn x))
-			       (y-real (complex-double-reg-real-tn y)))
-			   (inst fmovs y-real x-real)
-			   ,@(when double-p
-			       '((inst fmovs-odd y-real x-real))))
-			 (let ((x-imag (complex-double-reg-imag-tn x))
-			       (y-imag (complex-double-reg-imag-tn y)))
-			   (inst fmovs y-imag x-imag)
-			   ,@(when double-p
-			       '((inst fmovs-odd y-imag x-imag))))))
-		      (,stack-sc
-		       (let ((offset (* (tn-offset y) vm:word-bytes)))
-			 (let ((real-tn (complex-double-reg-real-tn x)))
-			   (inst ,(if double-p 'stdf 'stf) real-tn nfp offset))
-			 (let ((imag-tn (complex-double-reg-imag-tn x)))
-			   (inst ,(if double-p 'stdf 'stf) imag-tn nfp offset)))))))
-		(define-move-vop ,name :move-argument
-		  (,sc descriptor-reg) (,sc)))))
-  (frob move-complex-single-float-argument
-	complex-single-reg complex-single-stack nil)
-  (frob move-complex-double-float-argument
-	complex-double-reg complex-double-stack t))
+(define-vop (move-complex-single-float-argument)
+  (:args (x :scs (complex-single-reg) :target y)
+	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
+  (:results (y))
+  (:note "complex single-float argument move")
+  (:generator 1
+    (sc-case y
+      (complex-single-reg
+       (unless (location= x y)
+	 (let ((x-real (complex-single-reg-real-tn x))
+	       (y-real (complex-single-reg-real-tn y)))
+	   (inst fmovs y-real x-real))
+	 (let ((x-imag (complex-single-reg-imag-tn x))
+	       (y-imag (complex-single-reg-imag-tn y)))
+	   (inst fmovs y-imag x-imag))))
+      (complex-single-stack
+       (let ((offset (* (tn-offset y) word-bytes)))
+	 (let ((real-tn (complex-double-reg-real-tn x)))
+	   (inst stf real-tn nfp offset))
+	 (let ((imag-tn (complex-double-reg-imag-tn x)))
+	   (inst stf imag-tn nfp (+ offset word-bytes))))))))
+(define-move-vop move-complex-single-float-argument :move-argument
+  (complex-single-reg descriptor-reg) (complex-single-reg)))))
+
+(define-vop (move-complex-double-float-argument)
+  (:args (x :scs (complex-double-reg) :target y)
+	 (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg))))
+  (:results (y))
+  (:note "complex double-float argument move")
+  (:generator 2
+    (sc-case y
+      (complex-double-reg
+       (unless (location= x y)
+	 (let ((x-real (complex-double-reg-real-tn x))
+	       (y-real (complex-double-reg-real-tn y)))
+	   (inst fmovs y-real x-real)
+	   (inst fmovs-odd y-real x-real))
+	 (let ((x-imag (complex-double-reg-imag-tn x))
+	       (y-imag (complex-double-reg-imag-tn y)))
+	   (inst fmovs y-imag x-imag)
+	   (inst fmovs-odd y-imag x-imag))))
+      (complex-double-stack
+       (let ((offset (* (tn-offset y) word-bytes)))
+	 (let ((real-tn (complex-double-reg-real-tn x)))
+	   (inst stdf real-tn nfp offset))
+	 (let ((imag-tn (complex-double-reg-imag-tn x)))
+	   (inst stdf imag-tn nfp (+ offset (* 2 word-bytes)))))))))
+(define-move-vop move-complex-double-float-argument :move-argument
+  (complex-double-reg descriptor-reg) (complex-double-reg)))))
 
 ) ; progn complex-float