Set up frame pointer correctly prior to tail calling caml_c_call.

This repairs operation when the compiler is built with --enable-frame-pointers
and either Effect.Unhandled or Effect.Continuation_already_resumed needs to
be raised.

Changes

@@ -382,6 +382,10 @@ Working version
   optional arguments and default values in the Closure backend
   (Alain Frisch, review by Vincent Laviron)
 
+- #12486: Fix delivery of unhandled effect exceptions on amd64 with
+  --enable-frame-pointers
+  (Miod Vallat, report by Jan Midtgaard, review by Gabriel Scherer)
+
 OCaml 5.1.0 (14 September 2023)
 -------------------------------
 

runtime/amd64.S

@@ -1137,6 +1137,7 @@ LBL(112):
         movq    Caml_state(current_stack), %rsi
         SWITCH_OCAML_STACKS
     /* No parent stack. Raise Effect.Unhandled. */
+        ENTER_FUNCTION
 #if defined(WITH_THREAD_SANITIZER)
         /* We must let the TSan runtime know that we switched back to the
            original performer stack. For that, we perform the necessary calls
@@ -1215,7 +1216,8 @@ CFI_STARTPROC
         UPDATE_BASE_POINTER(%rcx)
         SWITCH_OCAML_STACKS
         jmp     *(%rbx)
-2:      TSAN_ENTER_FUNCTION(0) /* Necessary to include the caller of caml_resume
+2:      ENTER_FUNCTION
+        TSAN_ENTER_FUNCTION(0) /* Necessary to include the caller of caml_resume
                                   in the TSan backtrace */
         LEA_VAR(caml_raise_continuation_already_resumed, %rax)
         jmp LBL(caml_c_call)

testsuite/tests/effects/unhandled_effects.ml

@@ -0,0 +1,36 @@
+(* TEST
+ set OCAMLRUNPARAM = "s32";
+ native;
+*)
+
+(* This test verifies that stack frames are correct when raising unhandled
+   effect exceptions. This used not to be the case on some platforms,
+   causing assertions when the garbage collector would fire.
+
+   By using a very small initial heap (s32), this test guarantees the GC
+   will get triggered.
+
+   Refer to https://github.com/ocaml/ocaml/issues/12486 for more
+   information.
+*)
+
+open Effect
+
+type _ t += Yield : unit t
+
+let rec burn l =
+  if List.hd l > 12 then ()
+  else
+    burn (l @ l |> List.map (fun x -> x + 1))
+
+let foo l =
+  burn l;
+  perform Yield
+
+let bar i = foo [i]
+
+let () =
+  for _ = 1 to 10_000 do
+    try bar 8
+    with Unhandled _ -> ()
+  done