repair for x86_64 struct return case

mats/foreign.ms

@@ -3716,6 +3716,28 @@
           (let ([v (cb_send cb)])
             (and (= v 112.25)
                  (loop (sub1 i))))]))))
+
+  (let ()
+    (define-ftype intfloat (struct
+                             [i int]
+                             [f float]))
+    (define-ftype callback (function (int float) (& intfloat)))
+    (define intfloat_sum_built
+      (foreign-procedure "intfloat_sum_built"
+                         ((* callback)) double))
+    (let ([cb (make-ftype-pointer
+               callback
+               (lambda (r i f)
+                 (ftype-set! intfloat (i) r i)
+                 (ftype-set! intfloat (f) r f)))])
+      (and (equal? (intfloat_sum_built cb)
+                   110.0)
+           (begin
+             (unlock-object
+              (foreign-callable-code-object
+               (ftype-pointer-address cb)))
+             #t))))
+
   )
 
 (mat collect-safe

mats/foreign4.c

@@ -447,3 +447,16 @@ static double _f4_sum_struct_uniondoubledouble_double (struct_uniondoubledouble_
 }
 static struct_uniondoubledouble_double init_struct_uniondoubledouble_double = { { 99.0 }, -12.5};
 GEN(struct_uniondoubledouble_double, init_struct_uniondoubledouble_double, _f4_sum_struct_uniondoubledouble_double)
+
+typedef struct {
+  int i;
+  float f;
+} intfloat;
+typedef intfloat (*intfloat_build_t)(int i, float f);
+
+static double intfloat_sum(intfloat n) {
+  return n.f + n.i;
+}
+EXPORT double intfloat_sum_built(intfloat_build_t proc) {
+  return intfloat_sum(proc(10, 100.0));
+}

release_notes/release_notes.stex

@@ -3021,6 +3021,14 @@ A bug that affects compilation on 32-bit ARM systems has been fixed. The bug was
 when an offset to a floating-point field or array element was unaligned or too large to
 fit into the 12-bit encoding used for immediate offsets.
 
+\subsection{Fix x86\_64 foreign callables with in-register struct results (10.4.0)}
+
+A bug that affects compilation for foreign callables on x86\_64
+systems has been fixed. The bug was triggered when a callable returns
+a \scheme{struct} that is small enough to fit into return registers,
+and when arguments to the callable include floating-point values. In
+that case, arguments were not delivered correctly to the callable.
+
 \subsection{Generic \protect\scheme{+} misoptimized with \protect\scheme{+nan.0} and non-real arguments (10.4.0)}
 
 A bug in the source optimizer (cp0) treated flonum NaN as a bottom value

s/x86_64.ss

@@ -3088,8 +3088,8 @@ incoming           |   incoming return address | one quad
                    |                           |
                    |    incoming stack args    |
            sp+192: |                           |
-                   +---------------------------+ <- 16-byte boundary
-                   |   incoming return address | one quad
+incoming           +---------------------------+ <- 16-byte boundary
+      sp-> sp+184: |   incoming return address | one quad
                    +---------------------------+
            sp+176: |  pad word / active state  | one quad
                    +---------------------------+
@@ -3406,7 +3406,8 @@ incoming           |   incoming return address | one quad
                      [adjust-active? (if-feature pthreads (memq 'adjust-active conv*) #f)]
                      [synthesize-first? (and result-classes
                                              (result-fits-in-registers? result-classes))]
-                     [locs (do-stack (if synthesize-first? (cdr arg-type*) arg-type*) adjust-active?)])
+                     [save-arg-type* (if synthesize-first? (cdr arg-type*) arg-type*)]
+                     [locs (do-stack save-arg-type* adjust-active?)])
                 (let-values ([(get-result result-regs result-fp-regs) (do-result result-type result-classes adjust-active?)])
                   (values
                    (lambda ()
@@ -3431,7 +3432,7 @@ incoming           |   incoming return address | one quad
                            (set! ,(%mref ,%sp ,%zero 32 fp) ,%fp7)
                            (set! ,(%mref ,%sp ,%zero 40 fp) ,%fp8)
                            (set! ,%sp ,(%inline - ,%sp (immediate 8)))
-                           ,(save-arg-regs arg-type*))
+                           ,(save-arg-regs save-arg-type*))
                          (%seq
                            (set! ,%sp ,(%inline - ,%sp (immediate 136)))
                            ,(%inline push ,%rbx)
@@ -3440,7 +3441,7 @@ incoming           |   incoming return address | one quad
                            ,(%inline push ,%r13)
                            ,(%inline push ,%r14)
                            ,(%inline push ,%r15)
-                           ,(save-arg-regs arg-type*)))
+                           ,(save-arg-regs save-arg-type*)))
                       ,(if-feature pthreads
                          ((lambda (e)
                             (if adjust-active?