diff --git a/LOG b/LOG
index 527b7c683e..23e4ab8efe 100644
--- a/LOG
+++ b/LOG
@@ -370,3 +370,8 @@
     alloc.c, gc.c, scheme.c
 - fixed a few comments to refer to scheme.c rather than main.c
     externs.h, globals.h, thread.c
+- for 64-bit Windows systems, now copying foreign-procedure
+  double-precision floating-point register arguments to integer
+  registers as required for varargs functions. Windows does not
+  support single-precision floating-point arguments as varargs.
+    foreign.ms, np-languages.ss, x86_64.ss
diff --git a/s/np-languages.ss b/s/np-languages.ss
index 3ff0948b9a..405d12a166 100644
--- a/s/np-languages.ss
+++ b/s/np-languages.ss
@@ -540,6 +540,7 @@
   (declare-primitive -/eq value #f)
   (declare-primitive asmlibcall value #f)
   (declare-primitive fstpl value #f) ; x86 only
+  (declare-primitive get-double value #t) ; x86_64
   (declare-primitive get-tc value #f) ; threaded version only
   (declare-primitive lea1 value #t)
   (declare-primitive lea2 value #t)
diff --git a/s/x86_64.ss b/s/x86_64.ss
index 7aa144241e..75595851d5 100644
--- a/s/x86_64.ss
+++ b/s/x86_64.ss
@@ -794,6 +794,11 @@
     [(op (x ur) (y ur) (z imm32))
      `(asm ,info ,(asm-fl-load op (info-loadfl-flreg info)) ,x ,y ,z)])
 
+  (define-instruction value (get-double)
+    [(op (z ur))
+     `(set! ,(make-live-info) ,z
+        (asm ,info ,(asm-get-double (info-loadfl-flreg info))))])
+
   (define-instruction effect (flt)
     [(op (x mem ur) (y ur)) `(asm ,info ,asm-flt ,x ,y)])
 
@@ -979,7 +984,7 @@
                      ; threaded version specific
                      asm-get-tc
                      ; machine dependent exports
-                     asm-sext-rax->rdx asm-store-single->double asm-kill)
+                     asm-sext-rax->rdx asm-store-single->double asm-kill asm-get-double)
 
   (define ax-register?
     (case-lambda
@@ -1781,6 +1786,11 @@
             [(load-single) (emit sse.movss src (cons 'reg flreg) code*)]
             [(load-double) (emit sse.movsd src (cons 'reg flreg) code*)])))))
 
+  (define asm-get-double
+    (lambda (flreg)
+      (lambda (code* dst)
+        (emit sse.movd (cons 'reg flreg) (cons 'reg dst) code*))))
+
   (define asm-flt
     (lambda (code* src flonumreg)
       (Trivit (src)
@@ -2420,6 +2430,12 @@
                   (lambda (fpreg)
                     (lambda (x) ; requires var
                       `(inline ,(make-info-loadfl fpreg) ,%load-double ,x ,%zero ,(%constant flonum-data-disp))))]
+                 [load-double-reg2
+                  (lambda (fpreg ireg)
+                    (lambda (x) ; requires var
+                      (%seq
+                       (inline ,(make-info-loadfl fpreg) ,%load-double ,x ,%zero ,(%constant flonum-data-disp))
+                       (set! ,ireg (inline ,(make-info-loadfl fpreg) ,%get-double)))))]
                  [load-single-reg
                   (lambda (fpreg)
                     (lambda (x) ; requires var
@@ -2445,9 +2461,10 @@
                             (nanopass-case (Ltype Type) (car types)
                               [(fp-double-float)
                                (if (< i 4)
-                                   (loop (cdr types)
-                                     (cons (load-double-reg (vector-ref vfp i)) locs)
-                                     regs (fx+ i 1) isp)
+                                   (let ([reg (vector-ref vint i)])
+                                     (loop (cdr types)
+                                       (cons (load-double-reg2 (vector-ref vfp i) reg) locs)
+                                       (cons reg regs) (fx+ i 1) isp))
                                    (loop (cdr types)
                                      (cons (load-double-stack isp) locs)
                                      regs i (fx+ isp 8)))]