diff --git a/compiler/mips/float.lisp b/compiler/mips/float.lisp
index 4d3f665be47de073ae8d2967b5004e8d6797b565..39c12c648036efa8acfde62d73ca6eaabf26761d 100644
--- a/compiler/mips/float.lisp
+++ b/compiler/mips/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.1 1990/07/02 16:33:56 ram Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.2 1990/07/03 17:30:11 ram Exp $
 ;;;
 ;;;    This file contains floating point support for the MIPS.
 ;;;
@@ -104,6 +104,29 @@
   (frob move-to-double double-reg t vm:double-float-value-slot))
 
 
+(macrolet ((frob (name sc stack-sc format double-p)
+	     `(progn
+		(define-vop (,name)
+		  (:args (x :scs (,sc))
+			 (nfp :scs (any-reg)
+			      :load-if (not (sc-is y ,sc))))
+		  (:results (y))
+		  (:generator ,(if double-p 2 1)
+		    (sc-case y
+		      (,sc
+		       (unless (location= x y)
+			 (inst move ,format y x)))
+		      (,stack-sc
+		       (let ((offset (* (tn-offset y) vm:word-bytes)))
+			 (inst swc1 x nfp offset)
+			 ,@(when double-p
+			     '((inst swc1-odd x nfp
+				     (+ offset vm:word-bytes)))))))))
+		(define-move-vop ,name :move-argument (,sc) (,sc)))))
+  (frob move-single-float-argument single-reg single-stack :single nil)
+  (frob move-double-float-argument double-reg double-stack :double t))
+
+
 (define-move-vop move-argument :move-argument
   (single-reg double-reg) (descriptor-reg))