Place Win64 ABI shadow store in c_stack_link

The Win64 ABI requires the caller to reserve a fixed 32 bytes of stack
space prior to the call for the function to spill the four argument
registers into (if it chooses).

There are three ways C functions are called by OCaml programs. Under
Windows, two of them were needlessly wasting space reserving this twice
and the third was not reserving it at all.

This implementation capitalises on the fact that OCaml 5 no longer uses
the C stack for OCaml code and so adds the shadow store to the
c_stack_link struct. When in OCaml code, the C stack is therefore left
in exactly the required state to call a C function, which removes the
need for the stack pointer computations from the backend.
Simultaneously, this also fixes a bug, as the shadow store previously
was not being reserved at all when calling noalloc C functions.

5 files changed, 30 insertions, 25 deletions

diff --git a/Changes b/Changes
index 95a1dbd8d1..5f8cba6893 100644
--- a/Changes
+++ b/Changes
@@ -620,7 +620,12 @@ Working version
    Hugo Heuzard)
 
 - #11846: Mark rbx as destroyed at C call for Win64 (mingw-w64 and Cygwin64).
-  (David Allsopp, review by KC Sivaramakrishnan)
+  Reserve the shadow store for the ABI in the c_stack_link struct instead of
+  explictly when calling C functions. This simultaneously reduces the number of
+  stack pointer manipulations and also fixes a bug when calling noalloc
+  functions where the shadow store was not being reserved.
+  (David Allsopp, report by Vesa Karvonen, review by Xavier Leroy and
+   KC Sivaramakrishnan)
 
 - #11850: When stopping before the `emit` phase (using `-stop-after`), an empty
   temporary assembly file is no longer left in the file system.
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index e2da778605..39fa014ce7 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -537,13 +537,8 @@ let emit_instr env fallthrough i =
       end
   | Lop(Iextcall { func; alloc; stack_ofs }) ->
       add_used_symbol func;
-      let base_stack_size =
-        if Arch.win64 then
-          32 (* Windows x64 rcx+rdx+r8+r9 shadow stack *)
-        else
-          0 in
-      if stack_ofs > base_stack_size then begin
-        I.lea (mem64 QWORD base_stack_size RSP) r13;
+      if stack_ofs > 0 then begin
+        I.lea (mem64 QWORD 0 RSP) r13;
         I.lea (mem64 QWORD stack_ofs RSP) r12;
         load_symbol_addr func rax;
         emit_call "caml_c_call_stack_args";
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index 8a46c05f48..cd50cba52b 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -235,7 +235,7 @@ let win64_float_external_arguments =
 let win64_loc_external_arguments arg =
   let loc = Array.make (Array.length arg) Reg.dummy in
   let reg = ref 0
-  and ofs = ref 32 in
+  and ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i) with
     | Val | Int | Addr as ty ->
diff --git a/runtime/amd64.S b/runtime/amd64.S
index e9bb38b423..8dc9f81ec6 100644
--- a/runtime/amd64.S
+++ b/runtime/amd64.S
@@ -144,9 +144,17 @@
 #define Handler_parent          24
 
 /* struct c_stack_link */
+#if defined(SYS_mingw64) || defined (SYS_cygwin)
+#define Cstack_stack            32
+#define Cstack_sp               40
+#define Cstack_prev             48
+#define SIZEOF_C_STACK_LINK     56
+#else
 #define Cstack_stack             0
 #define Cstack_sp                8
 #define Cstack_prev             16
+#define SIZEOF_C_STACK_LINK     24
+#endif
 
 /******************************************************************************/
 /* DWARF */
@@ -369,20 +377,7 @@
 
 #endif
 
-#if defined(SYS_mingw64) || defined (SYS_cygwin)
-   /* Calls from OCaml to C must reserve 32 bytes of extra stack space */
-#  define PREPARE_FOR_C_CALL subq $32, %rsp; CFI_ADJUST(32)
-#  define CLEANUP_AFTER_C_CALL addq $32, %rsp; CFI_ADJUST(-32)
-   /* Stack probing mustn't be larger than the page size */
-#  define STACK_PROBE_SIZE 4096
-#else
-#  define PREPARE_FOR_C_CALL
-#  define CLEANUP_AFTER_C_CALL
-#  define STACK_PROBE_SIZE 4096
-#endif
-
-#define C_call(target) \
-  PREPARE_FOR_C_CALL; CHECK_STACK_ALIGNMENT; call target; CLEANUP_AFTER_C_CALL
+#define C_call(target) CHECK_STACK_ALIGNMENT; call target
 
 /******************************************************************************/
 /* Registers holding arguments of C functions. */
@@ -635,6 +630,9 @@ CFI_STARTPROC
     /* Make the alloc ptr available to the C code */
         movq    %r15, Caml_state(young_ptr)
     /* Copy arguments from OCaml to C stack */
+#if defined(SYS_mingw64) || defined (SYS_cygwin)
+        addq    $32, %rsp
+#endif
 LBL(105):
         subq    $8, %r12
         cmpq    %r13,%r12
@@ -642,6 +640,9 @@ LBL(105):
         push    (%r12); CFI_ADJUST(8)
         jmp     LBL(105)
 LBL(106):
+#if defined(SYS_mingw64) || defined (SYS_cygwin)
+        subq    $32, %rsp
+#endif
     /* Call the function (address in %rax) */
         C_call  (*%rax)
     /* Pop arguments back off the stack */
@@ -680,7 +681,7 @@ LBL(caml_start_program):
     /* Load young_ptr into %r15 */
         movq    Caml_state(young_ptr), %r15
     /* Build struct c_stack_link on the C stack */
-        subq    $24 /* sizeof struct c_stack_link */, %rsp; CFI_ADJUST(24)
+        subq    $SIZEOF_C_STACK_LINK, %rsp; CFI_ADJUST(SIZEOF_C_STACK_LINK)
         movq    $0, Cstack_stack(%rsp)
         movq    $0, Cstack_sp(%rsp)
         movq    Caml_state(c_stack), %r10
@@ -737,7 +738,7 @@ LBL(108):
     /* Pop the struct c_stack_link */
         movq    Cstack_prev(%rsp), %r10
         movq    %r10, Caml_state(c_stack)
-        addq    $24, %rsp; CFI_ADJUST(-24)
+        addq    $SIZEOF_C_STACK_LINK, %rsp; CFI_ADJUST(-SIZEOF_C_STACK_LINK)
     /* Restore callee-save registers. */
         POP_CALLEE_SAVE_REGS
     /* Return to caller. */
diff --git a/runtime/caml/fiber.h b/runtime/caml/fiber.h
index 133a3ba0df..1883c6dd68 100644
--- a/runtime/caml/fiber.h
+++ b/runtime/caml/fiber.h
@@ -98,6 +98,10 @@ CAML_STATIC_ASSERT(sizeof(struct stack_info) ==
  * stack is reallocated, this linked list is walked to update the OCaml stack
  * pointers. It is also used for DWARF backtraces. */
 struct c_stack_link {
+#if defined(_WIN32) || defined(__CYGWIN__)
+  /* Win64 ABI shadow store for argument registers */
+  void* shadow_store[4];
+#endif
   /* The reference to the OCaml stack */
   struct stack_info* stack;
   /* OCaml return address */