From edd7618ff77f759f24da0a138d4c24cce4a8a724 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Thu, 4 Jan 2024 16:59:30 +0000
Subject: [PATCH 01/11] Locals x effects

---
 otherlibs/systhreads/st_stubs.c               | 10 ++--
 runtime/amd64.S                               | 41 +++++++++++++++
 runtime/caml/config.h                         |  4 +-
 runtime/caml/domain_state.tbl                 |  5 +-
 runtime/caml/fiber.h                          | 11 +++-
 runtime/caml/gc.h                             |  1 -
 runtime/caml/memory.h                         | 11 +++-
 runtime/caml/roots.h                          |  3 +-
 runtime/domain.c                              |  1 -
 runtime/fiber.c                               | 41 ++++++++++-----
 runtime/major_gc.c                            |  3 +-
 runtime/memory.c                              | 51 ++++++++++++-------
 runtime/minor_gc.c                            |  5 +-
 runtime/roots.c                               |  3 +-
 runtime/shared_heap.c                         |  4 +-
 testsuite/tests/typing-local/effects.ml       | 35 +++++++++++++
 .../tests/typing-local/effects.reference      |  1 +
 17 files changed, 175 insertions(+), 55 deletions(-)
 create mode 100644 testsuite/tests/typing-local/effects.ml
 create mode 100644 testsuite/tests/typing-local/effects.reference

diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
index 84db67b7548..79960e56ded 100644
--- a/otherlibs/systhreads/st_stubs.c
+++ b/otherlibs/systhreads/st_stubs.c
@@ -123,6 +123,7 @@ struct caml_thread_struct {
      safely be shared between all threads on the same domain. */
   struct caml__roots_block *local_roots; /* saved value of local_roots */
   struct caml_local_arenas *local_arenas;
+  intnat local_sp;
   int backtrace_pos;           /* saved value of Caml_state->backtrace_pos */
   backtrace_slot * backtrace_buffer;
     /* saved value of Caml_state->backtrace_buffer */
@@ -262,8 +263,7 @@ static void caml_thread_scan_roots(
       if (th != active) {
         if (th->current_stack != NULL)
           caml_do_local_roots(action, fflags, fdata,
-                              th->local_roots, th->current_stack, th->gc_regs,
-                              th->local_arenas);
+                              th->local_roots, th->current_stack, th->gc_regs);
       }
       th = th->next;
     } while (th != active);
@@ -290,7 +290,8 @@ static void save_runtime_state(void)
   th->exn_handler = Caml_state->exn_handler;
   th->async_exn_handler = Caml_state->async_exn_handler;
   th->local_roots = Caml_state->local_roots;
-  th->local_arenas = caml_get_local_arenas(Caml_state);
+  th->local_arenas = caml_get_local_arenas_and_save_local_sp(th->current_stack);
+  th->local_sp = Caml_state->local_sp;
   th->backtrace_pos = Caml_state->backtrace_pos;
   th->backtrace_buffer = Caml_state->backtrace_buffer;
   th->backtrace_last_exn = Caml_state->backtrace_last_exn;
@@ -318,7 +319,7 @@ static void restore_runtime_state(caml_thread_t th)
   Caml_state->exn_handler = th->exn_handler;
   Caml_state->async_exn_handler = th->async_exn_handler;
   Caml_state->local_roots = th->local_roots;
-  caml_set_local_arenas(Caml_state, th->local_arenas);
+  caml_set_local_arenas(th->local_arenas, th->local_sp);
   Caml_state->backtrace_pos = th->backtrace_pos;
   Caml_state->backtrace_buffer = th->backtrace_buffer;
   caml_modify_generational_global_root
@@ -435,6 +436,7 @@ static caml_thread_t caml_thread_new_info(void)
   th->c_stack = NULL;
   th->local_roots = NULL;
   th->local_arenas = NULL;
+  th->local_sp = 0;
   th->backtrace_pos = 0;
   th->backtrace_buffer = NULL;
   th->backtrace_last_exn = Val_unit;
diff --git a/runtime/amd64.S b/runtime/amd64.S
index 108f1243fe5..10b39abf7b6 100644
--- a/runtime/amd64.S
+++ b/runtime/amd64.S
@@ -144,6 +144,9 @@
 #define Stack_sp                 0
 #define Stack_exception          8
 #define Stack_handler            16
+#define Stack_local_sp           64
+#define Stack_local_top          72
+#define Stack_local_limit        80
 
 /* struct stack_handler */
 #define Handler_value(REG)       0(REG)
@@ -247,6 +250,10 @@
     /* Fill in Caml_state->current_stack->sp */            \
         movq    Caml_state(current_stack), %r10;           \
         movq    %rsp, Stack_sp(%r10);                      \
+    /* No need to update Stack_local_sp: if the runtime    \
+       needs this value, it will copy it out of            \
+       Caml_state first (see                               \
+       caml_get_local_arenas_and_update_local_sp). */      \
     /* Fill in Caml_state->c_stack */                      \
         movq    Caml_state(c_stack), %r11;                 \
         movq    %rsp, Cstack_sp(%r11);                     \
@@ -311,6 +318,10 @@
         movq    %rsp, Stack_sp(%rsi);                     \
         movq    Caml_state(exn_handler), %r12;            \
         movq    %r12, Stack_exception(%rsi);              \
+    /* Save any local allocations state from Caml_state   \
+       which the OCaml code might have changed. */        \
+        movq    Caml_state(local_sp), %r12;               \
+        movq    %r12, Stack_local_sp(%rsi);               \
     /* switch stacks */                                   \
         movq    %r10, Caml_state(current_stack);          \
         movq    Stack_sp(%r10), %rsp;                     \
@@ -318,6 +329,14 @@
     /* restore exn_handler for new stack */               \
         movq    Stack_exception(%r10), %r12;              \
         movq    %r12, Caml_state(exn_handler);            \
+    /* Restore all local allocations state, since this    \
+       is now a different stack */                        \
+        movq    Stack_local_sp(%r10), %r12;               \
+        movq    %r12, Caml_state(local_sp);               \
+        movq    Stack_local_top(%r10), %r12;              \
+        movq    %r12, Caml_state(local_top);              \
+        movq    Stack_local_limit(%r10), %r12;            \
+        movq    %r12, Caml_state(local_limit);            \
         LEAVE_FUNCTION
 
 /* Updates the oldest saved frame pointer in the target fiber.
@@ -929,6 +948,9 @@ LBL(108):
         addq    $16, %r10
     /* Update alloc ptr */
         movq    %r15, Caml_state(young_ptr)
+    /* No need to update Stack_local_sp: if the runtime needs this value, it
+       will copy it out of Caml_state first (see
+       caml_get_local_arenas_and_update_local_sp). */
     /* Return to C stack. */
         movq    Caml_state(current_stack), %r11
         movq    %r10, Stack_sp(%r11)
@@ -1315,11 +1337,21 @@ CFI_STARTPROC
         movq    Caml_state(exn_handler), %r10
         movq    %rsp, Stack_sp(%rcx)
         movq    %r10, Stack_exception(%rcx)
+    /* Save local allocations state that the OCaml code might have modified */
+        movq    Caml_state(local_sp), %r10
+        movq    %r10, Stack_local_sp(%rcx)
     /* Load new stack pointer and set parent */
         movq    Stack_handler(%rax), %r11
         movq    %rcx, Handler_parent(%r11)
         movq    %rax, Caml_state(current_stack)
         movq    Stack_sp(%rax), %r11
+    /* Load all local allocations state for the new stack */
+        movq    Stack_local_sp(%rax), %r10
+        movq    %r10, Caml_state(local_sp)
+        movq    Stack_local_top(%rax), %r10
+        movq    %r10, Caml_state(local_top)
+        movq    Stack_local_limit(%rax), %r10
+        movq    %r10, Caml_state(local_limit)
     /* Create an exception handler on the target stack
        after 16byte DWARF & gc_regs block (which is unused here) */
         subq    $32, %r11
@@ -1348,11 +1380,20 @@ LBL(frame_runstack):
         leaq    32(%rsp), %r11 /* SP with exn handler popped */
         movq    Handler_value(%r11), %rbx
 1:      movq    Caml_state(current_stack), C_ARG_1 /* arg to caml_free_stack */
+    /* The old (currently the current) stack is about to be freed, so
+       there is nothing to do in terms of local allocations state. */
     /* restore parent stack and exn_handler into Caml_state */
         movq    Handler_parent(%r11), %r10
         movq    Stack_exception(%r10), %r11
         movq    %r10, Caml_state(current_stack)
         movq    %r11, Caml_state(exn_handler)
+    /* Restore all local allocations state for the new stack */
+        movq    Stack_local_sp(%r10), %r11
+        movq    %r11, Caml_state(local_sp)
+        movq    Stack_local_top(%r10), %r11
+        movq    %r11, Caml_state(local_top)
+        movq    Stack_local_limit(%r10), %r11
+        movq    %r11, Caml_state(local_limit)
     /* free old stack by switching directly to c_stack; is a no-alloc call */
         movq    Stack_sp(%r10), %r13 /* saved across C call */
         CFI_RESTORE_STATE
diff --git a/runtime/caml/config.h b/runtime/caml/config.h
index fc368d3359e..b34f9c09d21 100644
--- a/runtime/caml/config.h
+++ b/runtime/caml/config.h
@@ -209,9 +209,9 @@ typedef uint64_t uintnat;
 /* Number of words used in the control structure at the start of a stack
    (see fiber.h) */
 #ifdef ARCH_SIXTYFOUR
-#define Stack_ctx_words (6 + 1)
+#define Stack_ctx_words (10 + 1)
 #else
-#define Stack_ctx_words (6 + 2)
+#define Stack_ctx_words (10 + 2)
 #endif
 
 /* Default maximum size of the stack (words). */
diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl
index c9f3d025f16..f02bc73a4d0 100644
--- a/runtime/caml/domain_state.tbl
+++ b/runtime/caml/domain_state.tbl
@@ -46,8 +46,9 @@ DOMAIN_STATE(void*, exn_handler)
 DOMAIN_STATE(char*, async_exn_handler)
 /* Async exception pointer that points into the current stack */
 
-/* Local allocations */
-DOMAIN_STATE(struct caml_local_arenas*, local_arenas)
+/* Local allocations
+   These are kept directly in here to avoid a second indirection on the
+   fast path of a local allocation inline in OCaml code. */
 DOMAIN_STATE(intnat, local_sp)
 DOMAIN_STATE(void*, local_top)
 DOMAIN_STATE(intnat, local_limit)
diff --git a/runtime/caml/fiber.h b/runtime/caml/fiber.h
index bd4ad85b4e1..acfd1f8225f 100644
--- a/runtime/caml/fiber.h
+++ b/runtime/caml/fiber.h
@@ -59,6 +59,14 @@ struct stack_info {
   size_t size; /* only used when USE_MMAP_MAP_STACK is defined */
   uintnat magic;
   int64_t id;
+
+  /* Local allocations.
+     Note: [local_arenas] should always be read via
+     [get_local_arenas_and_save_local_sp]. */
+  struct caml_local_arenas* local_arenas;
+  intnat local_sp;
+  void* local_top;
+  intnat local_limit;
 };
 
 #define Stack_base(stk) ((value*)(stk + 1))
@@ -252,8 +260,7 @@ CAMLextern struct stack_info* caml_alloc_main_stack (uintnat init_wsize);
 
 void caml_scan_stack(
   scanning_action f, scanning_action_flags fflags, void* fdata,
-  struct stack_info* stack, value* v_gc_regs,
-  struct caml_local_arenas* locals);
+  struct stack_info* stack, value* v_gc_regs);
 
 struct stack_info* caml_alloc_stack_noexc(mlsize_t wosize, value hval,
                                           value hexn, value heff, int64_t id);
diff --git a/runtime/caml/gc.h b/runtime/caml/gc.h
index 1af26350a81..8bb83102070 100644
--- a/runtime/caml/gc.h
+++ b/runtime/caml/gc.h
@@ -54,7 +54,6 @@ struct caml_local_arena {
 };
 typedef struct caml_local_arenas {
   int count;
-  intnat saved_sp;
   intnat next_length;
   struct caml_local_arena arenas[Max_local_arenas];
 } caml_local_arenas;
diff --git a/runtime/caml/memory.h b/runtime/caml/memory.h
index 7c3359b7e86..45b148893a4 100644
--- a/runtime/caml/memory.h
+++ b/runtime/caml/memory.h
@@ -224,8 +224,15 @@ enum caml_alloc_small_flags {
 #define Alloc_small(result, wosize, tag, GC) \
   Alloc_small_with_reserved(result, wosize, tag, GC, (uintnat)0)
 
-CAMLextern caml_local_arenas* caml_get_local_arenas(caml_domain_state*);
-CAMLextern void caml_set_local_arenas(caml_domain_state*, caml_local_arenas* s);
+// Retrieve the local arenas for the given stack.
+// If the stack is the current stack, the copy of [local_sp] at the
+// root of [Caml_state] is saved in the current [stack_info]
+// structure, as it may have been updated by OCaml code.
+CAMLextern caml_local_arenas* caml_get_local_arenas_and_save_local_sp(
+  struct stack_info*);
+
+// Update the local arenas in [Caml_state].
+CAMLextern void caml_set_local_arenas(caml_local_arenas* s, uintnat local_sp);
 
 #endif /* CAML_INTERNALS */
 
diff --git a/runtime/caml/roots.h b/runtime/caml/roots.h
index dac89c76cb9..5435a145592 100644
--- a/runtime/caml/roots.h
+++ b/runtime/caml/roots.h
@@ -42,8 +42,7 @@ CAMLextern void caml_do_local_roots(
   void* data,
   struct caml__roots_block* local_roots,
   struct stack_info *current_stack,
-  value * v_gc_regs,
-  struct caml_local_arenas* locals);
+  value * v_gc_regs);
 
 #endif /* CAML_INTERNALS */
 
diff --git a/runtime/domain.c b/runtime/domain.c
index 1a57defb07c..21a55db032d 100644
--- a/runtime/domain.c
+++ b/runtime/domain.c
@@ -736,7 +736,6 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   domain_state->backtrace_active = 0;
   caml_register_generational_global_root(&domain_state->backtrace_last_exn);
 
-  domain_state->local_arenas = NULL;
   domain_state->local_sp = 0;
   domain_state->local_top = NULL;
   domain_state->local_limit = 0;
diff --git a/runtime/fiber.c b/runtime/fiber.c
index 72e8cd9b07d..b7471eeff2b 100644
--- a/runtime/fiber.c
+++ b/runtime/fiber.c
@@ -276,6 +276,10 @@ alloc_size_class_stack_noexc(mlsize_t wosize, int cache_bucket, value hval,
   stack->sp = (value*)hand;
   stack->exception_ptr = NULL;
   stack->id = id;
+  stack->local_arenas = NULL;
+  stack->local_sp = 0;
+  stack->local_top = NULL;
+  stack->local_limit = 0;
 #ifdef DEBUG
   stack->magic = 42;
 #endif
@@ -394,7 +398,7 @@ static int visit(scanning_action f, void* fdata,
 }
 
 static void scan_local_allocations(scanning_action f, void* fdata,
-                                   caml_local_arenas* loc)
+                                   caml_local_arenas* loc, uintnat local_sp)
 {
   int arena_ix;
   intnat sp;
@@ -404,7 +408,7 @@ static void scan_local_allocations(scanning_action f, void* fdata,
 
   if (loc == NULL) return;
   CAMLassert(loc->count > 0);
-  sp = loc->saved_sp;
+  sp = local_sp;
   arena_ix = loc->count - 1;
   arena = loc->arenas[arena_ix];
 #ifdef DEBUG
@@ -552,16 +556,19 @@ Caml_inline void scan_stack_frames(
 
 void caml_scan_stack(
   scanning_action f, scanning_action_flags fflags, void* fdata,
-  struct stack_info* stack, value* gc_regs,
-  struct caml_local_arenas* locals)
+  struct stack_info* stack, value* gc_regs)
 {
   while (stack != NULL) {
+    caml_local_arenas* locals = caml_get_local_arenas_and_save_local_sp(stack);
+
     scan_stack_frames(f, fflags, fdata, stack, gc_regs, locals);
 
     f(fdata, Stack_handle_value(stack), &Stack_handle_value(stack));
     f(fdata, Stack_handle_exception(stack), &Stack_handle_exception(stack));
     f(fdata, Stack_handle_effect(stack), &Stack_handle_effect(stack));
 
+    scan_local_allocations(f, fdata, locals, stack->local_sp);
+
     stack = Stack_parent(stack);
   }
 }
@@ -640,8 +647,7 @@ CAMLprim value caml_ensure_stack_capacity(value required_space)
 
 void caml_scan_stack(
   scanning_action f, scanning_action_flags fflags, void* fdata,
-  struct stack_info* stack, value* v_gc_regs,
-  struct caml_local_arenas* unused)
+  struct stack_info* stack, value* v_gc_regs)
 {
   value *low, *high, *sp;
 
@@ -674,12 +680,15 @@ CAMLexport void caml_do_local_roots (
   scanning_action f, scanning_action_flags fflags, void* fdata,
   struct caml__roots_block *local_roots,
   struct stack_info *current_stack,
-  value * v_gc_regs,
-  struct caml_local_arenas* locals)
+  value * v_gc_regs)
 {
   struct caml__roots_block *lr;
   int i, j;
   value* sp;
+#ifdef NATIVE_CODE
+  caml_local_arenas* locals =
+    caml_get_local_arenas_and_save_local_sp(current_stack);
+#endif
 
   for (lr = local_roots; lr != NULL; lr = lr->next) {
     for (i = 0; i < lr->ntables; i++){
@@ -695,11 +704,9 @@ CAMLexport void caml_do_local_roots (
       }
     }
   }
-  caml_scan_stack(f, fflags, fdata, current_stack, v_gc_regs, locals);
-#ifdef NATIVE_CODE
-  scan_local_allocations(f, fdata, locals);
-#else
-  CAMLassert(locals == NULL);
+  caml_scan_stack(f, fflags, fdata, current_stack, v_gc_regs);
+#ifndef NATIVE_CODE
+  CAMLassert(current_stack->local_arenas == NULL);
 #endif
 }
 
@@ -850,6 +857,12 @@ int caml_try_realloc_stack(asize_t required_space)
          stack_used * sizeof(value));
   new_stack->sp = Stack_high(new_stack) - stack_used;
   Stack_parent(new_stack) = Stack_parent(old_stack);
+
+  new_stack->local_arenas = caml_get_local_arenas_and_save_local_sp(old_stack);
+  new_stack->local_sp = old_stack->local_sp;
+  new_stack->local_top = old_stack->local_top;
+  new_stack->local_limit = old_stack->local_limit;
+
 #ifdef NATIVE_CODE
   /* There's no need to do another pass rewriting from
      Caml_state->async_exn_handler because every asynchronous exception trap
@@ -891,6 +904,8 @@ int caml_try_realloc_stack(asize_t required_space)
     }
   }
 
+  // XXX mshinwell: should free local arenas when stacks are finished with,
+  // but not at this point!
   caml_free_stack(old_stack);
   Caml_state->current_stack = new_stack;
   return 1;
diff --git a/runtime/major_gc.c b/runtime/major_gc.c
index e8726641761..632a467c9ee 100644
--- a/runtime/major_gc.c
+++ b/runtime/major_gc.c
@@ -1122,6 +1122,7 @@ Caml_noinline static intnat do_some_marking(struct mark_stack* stk,
     }
 
     value_ptr scan_end = me.end;
+    CAMLassert(scan_end != NULL);
     if (scan_end - me.start > budget) {
       intnat scan_len = budget < 0 ? 0 : budget;
       scan_end = me.start + scan_len;
@@ -1238,7 +1239,7 @@ void caml_darken_cont(value cont)
         value stk = Field(cont, 0);
         if (Ptr_val(stk) != NULL)
           caml_scan_stack(&caml_darken, darken_scanning_flags, Caml_state,
-                          Ptr_val(stk), 0, NULL);
+                          Ptr_val(stk), 0);
         atomic_store_release(Hp_atomic_val(cont),
                              With_status_hd(hd, caml_global_heap_state.MARKED));
       }
diff --git a/runtime/memory.c b/runtime/memory.c
index 6cf49f0a921..3adde1fbb6b 100644
--- a/runtime/memory.c
+++ b/runtime/memory.c
@@ -420,7 +420,9 @@ CAMLprim value caml_atomic_fetch_add (value ref, value incr)
 CAMLexport int caml_is_stack (value v)
 {
   int i;
-  struct caml_local_arenas* loc = Caml_state->local_arenas;
+  // We elide a call to caml_get_local_arenas_and_save_local_sp here
+  // for speed, since we never read the local sp.
+  struct caml_local_arenas* loc = Caml_state->current_stack->local_arenas;
   if (!Is_block(v)) return 0;
   if (Color_hd(Hd_val(v)) != NOT_MARKABLE) return 0;
   if (loc == NULL) return 0;
@@ -453,32 +455,46 @@ CAMLexport void caml_modify_local (value obj, intnat i, value val)
   }
 }
 
-CAMLexport caml_local_arenas* caml_get_local_arenas(caml_domain_state* dom)
+CAMLexport caml_local_arenas* caml_get_local_arenas_and_save_local_sp(
+  struct stack_info* stack)
 {
-  caml_local_arenas* s = dom->local_arenas;
-  if (s != NULL)
-    s->saved_sp = dom->local_sp;
+  caml_local_arenas* s = stack->local_arenas;
+
+  // OCaml code may have updated [Caml_state->local_sp], so sync it to
+  // the [stack_info] structure, in the case where we are working with
+  // the current stack.
+  // CR mshinwell: should we be using stack->id for the comparison?
+  if (stack == Caml_state->current_stack && s != NULL) {
+    Caml_state->current_stack->local_sp = Caml_state->local_sp;
+  }
+
   return s;
 }
 
-CAMLexport void caml_set_local_arenas(caml_domain_state* dom, caml_local_arenas* s)
+CAMLexport void caml_set_local_arenas(caml_local_arenas* s, uintnat local_sp)
 {
-  dom->local_arenas = s;
+  Caml_state->current_stack->local_arenas = s;
   if (s != NULL) {
     struct caml_local_arena a = s->arenas[s->count - 1];
-    dom->local_sp = s->saved_sp;
-    dom->local_top = (void*)(a.base + a.length);
-    dom->local_limit = - a.length;
+    Caml_state->current_stack->local_sp = local_sp;
+    Caml_state->current_stack->local_top = (void*)(a.base + a.length);
+    Caml_state->current_stack->local_limit = - a.length;
   } else {
-    dom->local_sp = 0;
-    dom->local_top = NULL;
-    dom->local_limit = 0;
+    Caml_state->current_stack->local_sp = 0;
+    Caml_state->current_stack->local_top = NULL;
+    Caml_state->current_stack->local_limit = 0;
   }
+
+  // Sync changes to the root of [Caml_state], ready for OCaml code.
+  Caml_state->local_sp = Caml_state->current_stack->local_sp;
+  Caml_state->local_top = Caml_state->current_stack->local_top;
+  Caml_state->local_limit = Caml_state->current_stack->local_limit;
 }
 
 void caml_local_realloc(void)
 {
-  caml_local_arenas* s = caml_get_local_arenas(Caml_state);
+  caml_local_arenas* s =
+    caml_get_local_arenas_and_save_local_sp(Caml_state->current_stack);
   intnat i;
   char* arena;
   caml_stat_block block;
@@ -486,7 +502,6 @@ void caml_local_realloc(void)
     s = caml_stat_alloc(sizeof(*s));
     s->count = 0;
     s->next_length = 0;
-    s->saved_sp = Caml_state->local_sp;
   }
   if (s->count == Max_local_arenas)
     caml_fatal_error("Local allocation stack overflow - exceeded Max_local_arenas");
@@ -500,7 +515,7 @@ void caml_local_realloc(void)
       s->next_length *= 4;
     }
     /* may need to loop, if a very large allocation was requested */
-  } while (s->saved_sp + s->next_length < 0);
+  } while (Caml_state->local_sp + s->next_length < 0);
 
   arena = caml_stat_alloc_aligned_noexc(s->next_length, 0, &block);
   if (arena == NULL)
@@ -510,7 +525,7 @@ void caml_local_realloc(void)
     *((header_t*)(arena + i)) = Debug_uninit_local;
   }
 #endif
-  for (i = s->saved_sp; i < 0; i += sizeof(value)) {
+  for (i = Caml_state->local_sp; i < 0; i += sizeof(value)) {
     *((header_t*)(arena + s->next_length + i)) = Local_uninit_hd;
   }
   caml_gc_message(0x08,
@@ -520,7 +535,7 @@ void caml_local_realloc(void)
   s->arenas[s->count-1].length = s->next_length;
   s->arenas[s->count-1].base = arena;
   s->arenas[s->count-1].alloc_block = block;
-  caml_set_local_arenas(Caml_state, s);
+  caml_set_local_arenas(s, Caml_state->local_sp);
   CAMLassert(Caml_state->local_limit <= Caml_state->local_sp);
 }
 
diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
index 33177aa8206..b4f2f80e27f 100644
--- a/runtime/minor_gc.c
+++ b/runtime/minor_gc.c
@@ -294,7 +294,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
       Field(result, 1) = Field(v, 1);
       if (stk != NULL) {
         caml_scan_stack(&oldify_one, oldify_scanning_flags, st,
-                        stk, 0, NULL);
+                        stk, 0);
       }
     }
     else
@@ -684,8 +684,7 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   CAML_EV_BEGIN(EV_MINOR_LOCAL_ROOTS);
   caml_do_local_roots(
     &oldify_one, oldify_scanning_flags, &st,
-    domain->local_roots, domain->current_stack, domain->gc_regs,
-    caml_get_local_arenas(domain));
+    domain->local_roots, domain->current_stack, domain->gc_regs);
 
   scan_roots_hook = atomic_load(&caml_scan_roots_hook);
   if (scan_roots_hook != NULL)
diff --git a/runtime/roots.c b/runtime/roots.c
index 3d98194bcb6..d76d6bea18e 100644
--- a/runtime/roots.c
+++ b/runtime/roots.c
@@ -39,8 +39,7 @@ void caml_do_roots (
 {
   scan_roots_hook hook;
   caml_do_local_roots(f, fflags, fdata,
-                      d->local_roots, d->current_stack, d->gc_regs,
-                      caml_get_local_arenas(d));
+                      d->local_roots, d->current_stack, d->gc_regs);
   hook = atomic_load(&caml_scan_roots_hook);
   if (hook != NULL) (*hook)(f, fflags, fdata, d);
   caml_final_do_roots(f, fflags, fdata, d, do_final_val);
diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c
index db0199723a5..33a709fd87a 100644
--- a/runtime/shared_heap.c
+++ b/runtime/shared_heap.c
@@ -821,7 +821,7 @@ static void verify_object(struct heap_verify_state* st, value v) {
   if (Tag_val(v) == Cont_tag) {
     struct stack_info* stk = Ptr_val(Field(v, 0));
     if (stk != NULL)
-      caml_scan_stack(verify_push, verify_scanning_flags, st, stk, 0, NULL);
+      caml_scan_stack(verify_push, verify_scanning_flags, st, stk, 0);
   } else if (Tag_val(v) < No_scan_tag) {
     int i = 0;
     if (Tag_val(v) == Closure_tag) {
@@ -921,7 +921,7 @@ static void compact_update_block(header_t* p)
   if (tag == Cont_tag) {
     value stk = Field(Val_hp(p), 0);
     if (Ptr_val(stk)) {
-      caml_scan_stack(&compact_update_value, 0, NULL, Ptr_val(stk), 0, NULL);
+      caml_scan_stack(&compact_update_value, 0, NULL, Ptr_val(stk), 0);
     }
   } else {
     uintnat offset = 0;
diff --git a/testsuite/tests/typing-local/effects.ml b/testsuite/tests/typing-local/effects.ml
new file mode 100644
index 00000000000..07943408d5e
--- /dev/null
+++ b/testsuite/tests/typing-local/effects.ml
@@ -0,0 +1,35 @@
+open Effect
+open Effect.Deep
+
+type _ Effect.t += Xchg: int -> int t
+
+external opaque : ('a[@local_opt]) -> ('a[@local_opt]) = "%opaque"
+
+let[@inline never] local_alloc x y =
+  Gc.compact ();
+  let in_minor = opaque (opaque x, opaque y) in
+  Gc.full_major ();
+  local_ (opaque (opaque in_minor, opaque in_minor))
+
+let comp1 () =
+  let p = local_alloc 1 2 in
+  perform (Xchg (fst (fst (opaque p))))
+    + (opaque (
+        let q = opaque (local_ (opaque 100, opaque 200)) in
+        fst q
+      ))
+    + perform (Xchg (snd (snd (opaque p))))
+
+let[@inline never] f () =
+    try_with comp1 ()
+    { effc = fun (type a) (eff: a t) ->
+        Gc.compact ();
+        match eff with
+        | Xchg n -> Some (fun (k: (a, _) continuation) ->
+            Gc.compact ();
+            let q = opaque (local_ (opaque 10, opaque 20)) in
+            continue k (n + fst q))
+        | _ -> None
+    }
+
+let () = Printf.printf "%d\n%!" (f ())
diff --git a/testsuite/tests/typing-local/effects.reference b/testsuite/tests/typing-local/effects.reference
new file mode 100644
index 00000000000..190a18037c6
--- /dev/null
+++ b/testsuite/tests/typing-local/effects.reference
@@ -0,0 +1 @@
+123

From 009bc259b5a158ae9cb67b7bae98dead92323e0a Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Tue, 9 Jan 2024 15:42:06 +0000
Subject: [PATCH 02/11] Change remaining testsuite CR ocaml 5 effects markers
 to CR ocaml 5 domains

---
 testsuite/tests/parallel/deadcont.ml         | 1 +
 testsuite/tests/parallel/mctest.ml           | 1 +
 testsuite/tests/parallel/test_issue_11094.ml | 2 +-
 3 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/testsuite/tests/parallel/deadcont.ml b/testsuite/tests/parallel/deadcont.ml
index f3726e263d1..ca5c10aea0d 100644
--- a/testsuite/tests/parallel/deadcont.ml
+++ b/testsuite/tests/parallel/deadcont.ml
@@ -1,4 +1,5 @@
 (* TEST
+ reason = "CR ocaml 5 domains: re-enable this test";
  skip;
  runtime5;
  { bytecode; }
diff --git a/testsuite/tests/parallel/mctest.ml b/testsuite/tests/parallel/mctest.ml
index 985bd647de5..4a755f89649 100644
--- a/testsuite/tests/parallel/mctest.ml
+++ b/testsuite/tests/parallel/mctest.ml
@@ -1,4 +1,5 @@
 (* TEST
+ reason = "CR ocaml 5 domains: re-enable this test";
  skip;
  runtime5;
  include unix;
diff --git a/testsuite/tests/parallel/test_issue_11094.ml b/testsuite/tests/parallel/test_issue_11094.ml
index 98cacc15ab3..9bb4f5cde21 100644
--- a/testsuite/tests/parallel/test_issue_11094.ml
+++ b/testsuite/tests/parallel/test_issue_11094.ml
@@ -1,5 +1,5 @@
 (* TEST
- reason = "CR ocaml 5 effects: re-enable this test";
+ reason = "CR ocaml 5 domains: re-enable this test";
  skip;
  runtime5;
  {

From 07eb4d502548ddb8831953bba75e4c442591bfb4 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Tue, 9 Jan 2024 16:11:43 +0000
Subject: [PATCH 03/11] Make effects tests only run on runtime5

---
 testsuite/tests/backtrace/backtrace_effects.ml        | 4 +++-
 testsuite/tests/backtrace/backtrace_effects_nested.ml | 3 +--
 testsuite/tests/callback/callback_effects_gc.ml       | 3 +--
 testsuite/tests/callback/nested_fiber.ml              | 9 +++++++--
 testsuite/tests/callback/stack_overflow.ml            | 9 +++++++--
 testsuite/tests/callback/test7.ml                     | 9 +++++++--
 testsuite/tests/effects/backtrace.ml                  | 4 +++-
 testsuite/tests/effects/cmphash.ml                    | 4 +++-
 testsuite/tests/effects/evenodd.ml                    | 4 +++-
 testsuite/tests/effects/issue479.ml                   | 4 ++--
 testsuite/tests/effects/manylive.ml                   | 4 +++-
 testsuite/tests/effects/marshal.ml                    | 5 +++--
 testsuite/tests/effects/overflow.ml                   | 4 +++-
 testsuite/tests/effects/partial.ml                    | 4 +++-
 testsuite/tests/effects/reperform.ml                  | 4 +++-
 testsuite/tests/effects/sched.ml                      | 4 +++-
 testsuite/tests/effects/shallow_state.ml              | 4 +++-
 testsuite/tests/effects/shallow_state_io.ml           | 4 +++-
 testsuite/tests/effects/test1.ml                      | 4 +++-
 testsuite/tests/effects/test10.ml                     | 4 +++-
 testsuite/tests/effects/test11.ml                     | 4 +++-
 testsuite/tests/effects/test2.ml                      | 4 +++-
 testsuite/tests/effects/test3.ml                      | 4 +++-
 testsuite/tests/effects/test4.ml                      | 4 +++-
 testsuite/tests/effects/test5.ml                      | 6 ++++--
 testsuite/tests/effects/test6.ml                      | 6 ++++--
 testsuite/tests/effects/test_lazy.ml                  | 4 +++-
 testsuite/tests/effects/unhandled_unlinked.ml         | 9 ++-------
 testsuite/tests/effects/used_cont.ml                  | 4 +++-
 testsuite/tests/frame-pointers/effects.ml             | 8 +-------
 testsuite/tests/frame-pointers/reperform.ml           | 7 +------
 testsuite/tests/frame-pointers/stack_realloc.ml       | 7 +------
 testsuite/tests/frame-pointers/stack_realloc2.ml      | 7 +------
 33 files changed, 99 insertions(+), 69 deletions(-)

diff --git a/testsuite/tests/backtrace/backtrace_effects.ml b/testsuite/tests/backtrace/backtrace_effects.ml
index 2060628fe38..c3c7868b32b 100644
--- a/testsuite/tests/backtrace/backtrace_effects.ml
+++ b/testsuite/tests/backtrace/backtrace_effects.ml
@@ -46,5 +46,7 @@ let _ = baz ()
  flags = "-g";
  ocamlrunparam += ",b=1";
  exit_status = "2";
- skip;
+ runtime5;
+ { bytecode; }
+ { native; }
 *)
diff --git a/testsuite/tests/backtrace/backtrace_effects_nested.ml b/testsuite/tests/backtrace/backtrace_effects_nested.ml
index be0e4ba944a..4f3341302cd 100644
--- a/testsuite/tests/backtrace/backtrace_effects_nested.ml
+++ b/testsuite/tests/backtrace/backtrace_effects_nested.ml
@@ -49,8 +49,7 @@ let () = f ()
 
 (* TEST
  flags = "-g";
- reason = "CR ocaml 5 effects: re-enable this test";
- skip;
+ runtime5;
  {
    bytecode;
  }{
diff --git a/testsuite/tests/callback/callback_effects_gc.ml b/testsuite/tests/callback/callback_effects_gc.ml
index 4213f818f8d..d873700c10a 100644
--- a/testsuite/tests/callback/callback_effects_gc.ml
+++ b/testsuite/tests/callback/callback_effects_gc.ml
@@ -1,7 +1,6 @@
 (* TEST
  ocamlrunparam += ",s=512";
- reason = "CR ocaml 5 effects: re-enable this test";
- skip;
+ runtime5;
  native;
 *)
 
diff --git a/testsuite/tests/callback/nested_fiber.ml b/testsuite/tests/callback/nested_fiber.ml
index bd6bd9cb248..07551c77271 100644
--- a/testsuite/tests/callback/nested_fiber.ml
+++ b/testsuite/tests/callback/nested_fiber.ml
@@ -1,7 +1,12 @@
 (* TEST
  modules = "nested_fiber_.c";
- reason = "CR ocaml 5 effects: re-enable this test";
- skip;
+ runtime5;
+ libunix;
+ {
+   bytecode;
+ }{
+   native;
+ }
 *)
 
 external caml_to_c : (unit -> 'a) -> 'a = "caml_to_c"
diff --git a/testsuite/tests/callback/stack_overflow.ml b/testsuite/tests/callback/stack_overflow.ml
index 108ac61560d..e8b58d10ea2 100644
--- a/testsuite/tests/callback/stack_overflow.ml
+++ b/testsuite/tests/callback/stack_overflow.ml
@@ -1,7 +1,12 @@
 (* TEST
  modules = "stack_overflow_.c";
- reason = "CR ocaml 5 effects: re-enable this test";
- skip;
+ runtime5;
+ libunix;
+ {
+   bytecode;
+ }{
+   native;
+ }
 *)
 
 external caml_to_c : (unit -> 'a) -> 'a = "caml_to_c"
diff --git a/testsuite/tests/callback/test7.ml b/testsuite/tests/callback/test7.ml
index 10f1179ffbc..58fad864e14 100644
--- a/testsuite/tests/callback/test7.ml
+++ b/testsuite/tests/callback/test7.ml
@@ -1,7 +1,12 @@
 (* TEST
  modules = "test7_.c";
- reason = "CR ocaml 5 effects: re-enable this test";
- skip;
+ runtime5;
+ libunix;
+ {
+   bytecode;
+ }{
+   native;
+ }
 *)
 
 (* Tests nested calls from C (main C) to OCaml (main OCaml) to C (caml_to_c) to
diff --git a/testsuite/tests/effects/backtrace.ml b/testsuite/tests/effects/backtrace.ml
index 1ce736038d0..e4fd22dddf3 100644
--- a/testsuite/tests/effects/backtrace.ml
+++ b/testsuite/tests/effects/backtrace.ml
@@ -58,5 +58,7 @@ let _ = main ()
 (* TEST
  flags = "-g";
  ocamlrunparam += ",b=1";
- skip;
+ runtime5;
+ { bytecode; }
+ { native; }
 *)
diff --git a/testsuite/tests/effects/cmphash.ml b/testsuite/tests/effects/cmphash.ml
index e0c7f4b5ee8..a06b6d492dc 100644
--- a/testsuite/tests/effects/cmphash.ml
+++ b/testsuite/tests/effects/cmphash.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/evenodd.ml b/testsuite/tests/effects/evenodd.ml
index 8913220b03c..0aeb12c647e 100644
--- a/testsuite/tests/effects/evenodd.ml
+++ b/testsuite/tests/effects/evenodd.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/issue479.ml b/testsuite/tests/effects/issue479.ml
index 264acbe8ab3..b00ddded79c 100644
--- a/testsuite/tests/effects/issue479.ml
+++ b/testsuite/tests/effects/issue479.ml
@@ -1,6 +1,6 @@
 (* TEST
- skip;
- toplevel;
+   runtime5;
+   toplevel;
 *)
 
 (* https://github.com/ocaml-multicore/ocaml-multicore/issues/479 *)
diff --git a/testsuite/tests/effects/manylive.ml b/testsuite/tests/effects/manylive.ml
index 3211eeb3951..b4aaf5b17b4 100644
--- a/testsuite/tests/effects/manylive.ml
+++ b/testsuite/tests/effects/manylive.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 let f x =
diff --git a/testsuite/tests/effects/marshal.ml b/testsuite/tests/effects/marshal.ml
index d061d425f10..2e401060435 100644
--- a/testsuite/tests/effects/marshal.ml
+++ b/testsuite/tests/effects/marshal.ml
@@ -1,6 +1,7 @@
 (* TEST
- reason = "CR ocaml 5 effects: re-enable this test";
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/overflow.ml b/testsuite/tests/effects/overflow.ml
index 301638edb30..97660f54188 100644
--- a/testsuite/tests/effects/overflow.ml
+++ b/testsuite/tests/effects/overflow.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/partial.ml b/testsuite/tests/effects/partial.ml
index dc297511055..843e739f328 100644
--- a/testsuite/tests/effects/partial.ml
+++ b/testsuite/tests/effects/partial.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/reperform.ml b/testsuite/tests/effects/reperform.ml
index 19ac1dae389..14e844893fc 100644
--- a/testsuite/tests/effects/reperform.ml
+++ b/testsuite/tests/effects/reperform.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/sched.ml b/testsuite/tests/effects/sched.ml
index 3cfd75910d1..6316816764d 100644
--- a/testsuite/tests/effects/sched.ml
+++ b/testsuite/tests/effects/sched.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/shallow_state.ml b/testsuite/tests/effects/shallow_state.ml
index ec60aa2d24f..2273263e308 100644
--- a/testsuite/tests/effects/shallow_state.ml
+++ b/testsuite/tests/effects/shallow_state.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/shallow_state_io.ml b/testsuite/tests/effects/shallow_state_io.ml
index 0f5890dbbc4..b288c3dd015 100644
--- a/testsuite/tests/effects/shallow_state_io.ml
+++ b/testsuite/tests/effects/shallow_state_io.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/test1.ml b/testsuite/tests/effects/test1.ml
index ae40884ba69..c3f5bd8c278 100644
--- a/testsuite/tests/effects/test1.ml
+++ b/testsuite/tests/effects/test1.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/test10.ml b/testsuite/tests/effects/test10.ml
index 6c30f45735b..b7435a83b07 100644
--- a/testsuite/tests/effects/test10.ml
+++ b/testsuite/tests/effects/test10.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/test11.ml b/testsuite/tests/effects/test11.ml
index 1b30abe953c..ab3895ace1f 100644
--- a/testsuite/tests/effects/test11.ml
+++ b/testsuite/tests/effects/test11.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 (* Tests RESUMETERM with extra_args != 0 in bytecode,
diff --git a/testsuite/tests/effects/test2.ml b/testsuite/tests/effects/test2.ml
index 11ca399ba72..a7884acecbd 100644
--- a/testsuite/tests/effects/test2.ml
+++ b/testsuite/tests/effects/test2.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Printf
diff --git a/testsuite/tests/effects/test3.ml b/testsuite/tests/effects/test3.ml
index 176d50ead9a..66597d88258 100644
--- a/testsuite/tests/effects/test3.ml
+++ b/testsuite/tests/effects/test3.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/test4.ml b/testsuite/tests/effects/test4.ml
index 17bc4f45abb..cff6918b089 100644
--- a/testsuite/tests/effects/test4.ml
+++ b/testsuite/tests/effects/test4.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/test5.ml b/testsuite/tests/effects/test5.ml
index e6f84ef3365..2f01025536b 100644
--- a/testsuite/tests/effects/test5.ml
+++ b/testsuite/tests/effects/test5.ml
@@ -1,6 +1,8 @@
 (* TEST
- skip;
-*)
+   runtime5;
+   { bytecode; }
+   { native; }
+ *)
 
 open Effect
 open Effect.Deep
diff --git a/testsuite/tests/effects/test6.ml b/testsuite/tests/effects/test6.ml
index 3d399d22cf8..7b54d3b720c 100644
--- a/testsuite/tests/effects/test6.ml
+++ b/testsuite/tests/effects/test6.ml
@@ -1,6 +1,8 @@
 (* TEST
- skip;
-*)
+   runtime5;
+   { bytecode; }
+   { native; }
+ *)
 
 open Effect
 open Effect.Deep
diff --git a/testsuite/tests/effects/test_lazy.ml b/testsuite/tests/effects/test_lazy.ml
index b1d2cce322f..dc9d7dc0999 100644
--- a/testsuite/tests/effects/test_lazy.ml
+++ b/testsuite/tests/effects/test_lazy.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/unhandled_unlinked.ml b/testsuite/tests/effects/unhandled_unlinked.ml
index a2738526308..f1296130826 100644
--- a/testsuite/tests/effects/unhandled_unlinked.ml
+++ b/testsuite/tests/effects/unhandled_unlinked.ml
@@ -1,12 +1,7 @@
 (* TEST
- {
-   exit_status = "2";
-   skip;
- }{
    runtime5;
-   reason = "CR ocaml 5 effects: re-enable this test";
-   skip;
- }
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/effects/used_cont.ml b/testsuite/tests/effects/used_cont.ml
index 0959d254407..ceda83ddf12 100644
--- a/testsuite/tests/effects/used_cont.ml
+++ b/testsuite/tests/effects/used_cont.ml
@@ -1,5 +1,7 @@
 (* TEST
- skip;
+   runtime5;
+   { bytecode; }
+   { native; }
 *)
 
 open Effect
diff --git a/testsuite/tests/frame-pointers/effects.ml b/testsuite/tests/frame-pointers/effects.ml
index 092f13e6764..3fb435732dc 100644
--- a/testsuite/tests/frame-pointers/effects.ml
+++ b/testsuite/tests/frame-pointers/effects.ml
@@ -1,15 +1,9 @@
 (* TEST
- {
-   runtime4;
-   skip;
- }{
-   reason = "CR ocaml 5 effects: re-enable this test";
-   skip;
+   runtime5;
    frame_pointers;
    readonly_files = "fp_backtrace.c";
    all_modules = "${readonly_files} effects.ml";
    native;
- }
 *)
 
 open Printf
diff --git a/testsuite/tests/frame-pointers/reperform.ml b/testsuite/tests/frame-pointers/reperform.ml
index d8262b457ee..f547d8a71f2 100644
--- a/testsuite/tests/frame-pointers/reperform.ml
+++ b/testsuite/tests/frame-pointers/reperform.ml
@@ -1,14 +1,9 @@
 (* TEST
- {
-   skip;
- }{
-   reason = "CR ocaml 5 effects: re-enable this test";
-   skip;
+   runtime5;
    frame_pointers;
    readonly_files = "fp_backtrace.c";
    all_modules = "${readonly_files} reperform.ml";
    native;
- }
 *)
 
 open Effect
diff --git a/testsuite/tests/frame-pointers/stack_realloc.ml b/testsuite/tests/frame-pointers/stack_realloc.ml
index 0aefe3e897e..925daab5030 100644
--- a/testsuite/tests/frame-pointers/stack_realloc.ml
+++ b/testsuite/tests/frame-pointers/stack_realloc.ml
@@ -1,14 +1,9 @@
 (* TEST
- {
-   skip;
- }{
-   reason = "CR ocaml 5 effects: re-enable this test";
-   skip;
+   runtime5;
    frame_pointers;
    readonly_files = "fp_backtrace.c stack_realloc_.c";
    all_modules = "${readonly_files} stack_realloc.ml";
    native;
- }
 *)
 
 open Effect
diff --git a/testsuite/tests/frame-pointers/stack_realloc2.ml b/testsuite/tests/frame-pointers/stack_realloc2.ml
index 10d0ddb8f94..c80ec56a231 100644
--- a/testsuite/tests/frame-pointers/stack_realloc2.ml
+++ b/testsuite/tests/frame-pointers/stack_realloc2.ml
@@ -1,14 +1,9 @@
 (* TEST
- {
-   skip;
- }{
-   reason = "CR ocaml 5 effects: re-enable this test";
-   skip;
+   runtime5;
    frame_pointers;
    readonly_files = "fp_backtrace.c stack_realloc_.c";
    all_modules = "${readonly_files} stack_realloc2.ml";
    native;
- }
 *)
 
 open Effect

From 512b4cad11f31d4f81cd2b158ee719fb892dc7b2 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Tue, 9 Jan 2024 16:25:49 +0000
Subject: [PATCH 04/11] backtrace_effects_nested

---
 .../backtrace/backtrace_effects_nested.flambda.reference      | 4 ++--
 testsuite/tests/backtrace/backtrace_effects_nested.reference  | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference b/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
index 2d5d343388f..a2195c3f23c 100644
--- a/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
+++ b/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
@@ -1,4 +1,4 @@
-Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 21, characters 2-11
+Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 23, characters 2-11
 Called from Stdlib__Effect.Deep.continue in file "effect.ml" (inlined), line 62, characters 4-65
-Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 29, characters 16-29
+Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 31, characters 16-29
 43
diff --git a/testsuite/tests/backtrace/backtrace_effects_nested.reference b/testsuite/tests/backtrace/backtrace_effects_nested.reference
index 20238eee031..cf61b75391d 100644
--- a/testsuite/tests/backtrace/backtrace_effects_nested.reference
+++ b/testsuite/tests/backtrace/backtrace_effects_nested.reference
@@ -1,3 +1,3 @@
-Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 21, characters 2-11
-Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 29, characters 16-29
+Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 23, characters 2-11
+Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 31, characters 16-29
 43

From 4e041cfa3a2cbd7080fc743b7b15ee6bf1ea4391 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Tue, 9 Jan 2024 16:30:38 +0000
Subject: [PATCH 05/11] Fix symbol separator in bytecode test

---
 testsuite/tests/effects/issue479.compilers.reference | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/testsuite/tests/effects/issue479.compilers.reference b/testsuite/tests/effects/issue479.compilers.reference
index 2e438f6ce75..88a6e2bfabc 100644
--- a/testsuite/tests/effects/issue479.compilers.reference
+++ b/testsuite/tests/effects/issue479.compilers.reference
@@ -9,5 +9,5 @@ val f : unit -> unit = <fun>
 Hold 1
 1
 Hold 2
-Exception: Stdlib.Effect.Continuation_already_resumed.
+Exception: Stdlib__Effect.Continuation_already_resumed.
 

From 836c794eb4eae2c9816288cd333561d48f5da8f2 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Wed, 10 Jan 2024 16:13:22 +0000
Subject: [PATCH 06/11] Test cases

---
 testsuite/tests/typing-local/effects.ml | 187 +++++++++++++++++++++++-
 1 file changed, 180 insertions(+), 7 deletions(-)

diff --git a/testsuite/tests/typing-local/effects.ml b/testsuite/tests/typing-local/effects.ml
index 07943408d5e..66671c2d7c5 100644
--- a/testsuite/tests/typing-local/effects.ml
+++ b/testsuite/tests/typing-local/effects.ml
@@ -5,14 +5,177 @@ type _ Effect.t += Xchg: int -> int t
 
 external opaque : ('a[@local_opt]) -> ('a[@local_opt]) = "%opaque"
 
-let[@inline never] local_alloc x y =
+let[@inline never] rand () = Random.int 42
+
+external local_stack_offset : unit -> int = "caml_local_stack_offset"
+let local_stack_offset () = local_stack_offset () / (Sys.word_size / 8)
+
+let initial_stack_offset = local_stack_offset ()
+
+let[@inline never] expect_local_stack_offset expected =
+  let now = local_stack_offset () in
+  if now <> initial_stack_offset + expected then (
+    Printf.eprintf "Callstack:\n%s\n"
+      (Printexc.get_callstack 100 |> Printexc.raw_backtrace_to_string);
+    failwith (Printf.sprintf "local stack offset mismatch (in words): \
+        initial = %d, now = %d, expected = %d"
+      initial_stack_offset now expected)
+  )
+
+(* -------------- Simple tests of the local stack offset ------------------- *)
+
+(* When a fiber stack is created, its accompanying local stack is empty,
+   even if the parent fiber stack's local stack is not. *)
+let[@inline never] f1 () =
+  let (_ : int * int) = opaque (local_ (rand (), rand ())) in
+  expect_local_stack_offset 3;
+  let result =
+    try_with (fun () ->
+        (* This is on a new fiber stack *)
+        expect_local_stack_offset 0;
+        42
+      )
+      ()
+      { effc = (fun (type a) (_eff: a t) -> None) }
+  in
+  assert (result = 42)
+
+(* When a fiber stack is created, local allocation from the corresponding
+   fiber does not touch the local stack of the parent. *)
+let[@inline never] f2 () =
+  let (_ : int * int) = opaque (local_ (rand (), rand ())) in
+  expect_local_stack_offset 3;
+  let result =
+    try_with (fun () ->
+        let (_ : int * int * int) =
+          opaque (local_ (rand (), rand (), rand ()))
+        in
+        expect_local_stack_offset 4;
+        42
+      )
+      ()
+      { effc = (fun (type a) (_eff: a t) -> None) }
+  in
+  (* The allocation of the triple should not have affected the local stack
+     offset here. *)
+  expect_local_stack_offset 3;
+  assert (result = 42)
+
+(* As for f2, but with the check for the parent's local stack in an
+   effect handler.  In addition we check that when the [perform] returns,
+   the fiber's local stack offset is unaffected. *)
+type _ Effect.t += Eff_f3 : unit -> unit t
+let[@inline never] f3 () =
+  let (_ : int * int) = opaque (local_ (rand (), rand ())) in
+  expect_local_stack_offset 3;
+  let result =
+    try_with (fun () ->
+        let (_ : int * int * int) =
+          opaque (local_ (rand (), rand (), rand ()))
+        in
+        expect_local_stack_offset 4;
+        perform (Eff_f3 ());
+        expect_local_stack_offset 4;
+        42
+      )
+      ()
+      { effc = (fun (type a) (eff: a t) ->
+          match eff with
+          | Eff_f3 () ->
+            (* This is like the check on the penultimate line of [f3] below *)
+            expect_local_stack_offset 3;
+            Some (fun (k: (a, _) continuation) ->
+              (* Ditto *)
+              expect_local_stack_offset 3;
+              continue k ())
+          | _ -> assert false)
+      }
+  in
+  (* The allocation of the triple should not have affected the local stack
+     offset here. *)
+  expect_local_stack_offset 3;
+  assert (result = 42)
+
+(* Like f3, except the effect handler raises an exception that is not caught
+   in the fiber's computation. *)
+type _ Effect.t += Eff_f4 : unit -> unit t
+exception Exn_f4
+let[@inline never] f4 () =
+  let (p : int * int) = opaque (local_ (rand (), rand ())) in
+  expect_local_stack_offset 3;
+  match
+    try_with (fun () ->
+        let (_ : int * int * int) =
+          opaque (local_ (rand (), rand (), rand ()))
+        in
+        expect_local_stack_offset 4;
+        perform (Eff_f4 ());
+        assert false
+      )
+      ()
+      { effc = (fun (type a) (eff: a t) ->
+          match eff with
+          | Eff_f4 () ->
+            expect_local_stack_offset 3;
+            Some (fun (k: (a, _) continuation) ->
+              (* Ditto *)
+              expect_local_stack_offset 3;
+              raise Exn_f4)
+          | _ -> assert false)
+      }
+  with
+  | exception Exn_f4 ->
+    expect_local_stack_offset 3;
+    (* Ensure that the region for [p] extends for long enough: *)
+    let (_ : int) = opaque (fst p) in
+    ()
+  | _ -> assert false
+
+(* Like f4, except that the exception is raised directly in the fiber's
+   computation. *)
+type _ Effect.t += Eff_f5 : unit -> unit t
+exception Exn_f5
+let[@inline never] f5 () =
+  let (p : int * int) = opaque (local_ (rand (), rand ())) in
+  expect_local_stack_offset 3;
+  match
+    try_with (fun () ->
+        let (_ : int * int * int) =
+          opaque (local_ (rand (), rand (), rand ()))
+        in
+        expect_local_stack_offset 4;
+        perform (Eff_f5 ());
+        expect_local_stack_offset 4;
+        raise Exn_f5
+      )
+      ()
+      { effc = (fun (type a) (eff: a t) ->
+          match eff with
+          | Eff_f5 () ->
+            expect_local_stack_offset 3;
+            Some (fun (k: (a, _) continuation) ->
+              (* Ditto *)
+              expect_local_stack_offset 3;
+              continue k ())
+          | _ -> assert false)
+      }
+  with
+  | exception Exn_f5 ->
+    expect_local_stack_offset 3;
+    let (_ : int) = opaque (fst p) in
+    ()
+  | _ -> assert false
+
+(* ------ Tests to make sure local allocations are scanned by the GC ------ *)
+
+let[@inline never] g1_local_alloc x y =
   Gc.compact ();
   let in_minor = opaque (opaque x, opaque y) in
-  Gc.full_major ();
+  Gc.full_major (); (* XXX *)
   local_ (opaque (opaque in_minor, opaque in_minor))
 
-let comp1 () =
-  let p = local_alloc 1 2 in
+let g1_comp () =
+  let p = g1_local_alloc 1 2 in
   perform (Xchg (fst (fst (opaque p))))
     + (opaque (
         let q = opaque (local_ (opaque 100, opaque 200)) in
@@ -20,8 +183,8 @@ let comp1 () =
       ))
     + perform (Xchg (snd (snd (opaque p))))
 
-let[@inline never] f () =
-    try_with comp1 ()
+let[@inline never] g1' () =
+    try_with g1_comp ()
     { effc = fun (type a) (eff: a t) ->
         Gc.compact ();
         match eff with
@@ -32,4 +195,14 @@ let[@inline never] f () =
         | _ -> None
     }
 
-let () = Printf.printf "%d\n%!" (f ())
+let g1 () = assert (g1' () = 123)
+
+(* ------------------------------------------------------------------------ *)
+
+let () =
+  print_endline "f1"; f1 ();
+  print_endline "f2"; f2 ();
+  print_endline "f3"; f3 ();
+  print_endline "f4"; f4 ();
+  print_endline "f5"; f5 ();
+  print_endline "g1"; g1 ()

From 18c956ffc0dee8086afbd12cf1d7dc8a47e3fb39 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Mon, 2 Dec 2024 16:09:56 +0000
Subject: [PATCH 07/11] Enable Effect module in the stdlib

---
 stdlib/stdlib.ml  | 3 ---
 stdlib/stdlib.mli | 3 ---
 2 files changed, 6 deletions(-)

diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
index 08a548368e4..6604f019fed 100644
--- a/stdlib/stdlib.ml
+++ b/stdlib/stdlib.ml
@@ -609,10 +609,7 @@ module Condition      = Condition
 module Digest         = Digest
 module Domain         = Domain
 module Dynarray       = Dynarray
-(* CR ocaml 5 effects:
-   BACKPORT
 module Effect         = Effect
-*)
 module Either         = Either
 module Ephemeron      = Ephemeron
 module Filename       = Filename
diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli
index de95b9047ff..141f3d1bc10 100644
--- a/stdlib/stdlib.mli
+++ b/stdlib/stdlib.mli
@@ -1411,14 +1411,11 @@ module Domain         = Domain
     "The Domain interface may change in incompatible ways in the future."
 ]
 module Dynarray       = Dynarray
-(* CR ocaml 5 effects:
-BACKPORT
 module Effect         = Effect
 [@@alert "-unstable"]
 [@@alert unstable
     "The Effect interface may change in incompatible ways in the future."
 ]
-*)
 module Either         = Either
 module Ephemeron      = Ephemeron
 module Filename       = Filename

From 3f8785747eefe75d94e355ffb652af8461af4124 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Mon, 2 Dec 2024 16:26:53 +0000
Subject: [PATCH 08/11] Test promotions and fixes

---
 .../backtrace_effects.byte.reference          |  12 +
 .../tests/backtrace/backtrace_effects.ml      |   4 +-
 .../backtrace/backtrace_effects.reference     |  19 +-
 ...backtrace_effects_nested.flambda.reference |   6 +-
 .../backtrace_effects_nested.reference        |   4 +-
 .../tests/basic/patmatch_for_multiple.ml      | 314 +++++++++---------
 testsuite/tests/effects/backtrace.reference   |  12 +-
 testsuite/tests/lib-extensions/modules.ml     |   9 +
 .../tests/match-side-effects/partiality.ml    |  90 ++---
 .../match-side-effects/test_contexts_code.ml  |  68 ++--
 .../ppx-empty-cases/test.compilers.reference  |  44 +--
 .../overwriting_proj_push_down_bug.ml         | 186 +++++------
 .../tests/unboxed-primitive-args/common.ml    |  12 +
 .../tests/unboxed-primitive-args/common.mli   |   1 +
 .../tests/unboxed-primitive-args/gen_test.ml  |  34 +-
 .../tests/unboxed-primitive-args/test.ml      |   5 +-
 .../unboxed-primitive-args/test_common.h      |   2 +
 17 files changed, 441 insertions(+), 381 deletions(-)
 create mode 100644 testsuite/tests/backtrace/backtrace_effects.byte.reference

diff --git a/testsuite/tests/backtrace/backtrace_effects.byte.reference b/testsuite/tests/backtrace/backtrace_effects.byte.reference
new file mode 100644
index 00000000000..786f0b18efb
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_effects.byte.reference
@@ -0,0 +1,12 @@
+(** get_callstack **)
+Raised by primitive operation at Backtrace_effects.bar in file "backtrace_effects.ml", line 20, characters 13-39
+Called from Backtrace_effects.foo in file "backtrace_effects.ml", line 27, characters 12-17
+Called from Backtrace_effects in file "backtrace_effects.ml", line 43, characters 8-14
+(** get_continuation_callstack **)
+Raised by primitive operation at Backtrace_effects.bar in file "backtrace_effects.ml", line 22, characters 4-13
+Called from Backtrace_effects.foo in file "backtrace_effects.ml", line 27, characters 12-17
+(** raise **)
+Fatal error: exception Stdlib.Exit
+Raised at Backtrace_effects.bar in file "backtrace_effects.ml", line 17, characters 4-14
+Re-raised at Backtrace_effects.baz.(fun) in file "backtrace_effects.ml", line 33, characters 21-28
+Called from Backtrace_effects in file "backtrace_effects.ml", line 43, characters 8-14
diff --git a/testsuite/tests/backtrace/backtrace_effects.ml b/testsuite/tests/backtrace/backtrace_effects.ml
index c3c7868b32b..c7534fd35f9 100644
--- a/testsuite/tests/backtrace/backtrace_effects.ml
+++ b/testsuite/tests/backtrace/backtrace_effects.ml
@@ -47,6 +47,8 @@ let _ = baz ()
  ocamlrunparam += ",b=1";
  exit_status = "2";
  runtime5;
- { bytecode; }
+ { reference = "${test_source_directory}/backtrace_effects.byte.reference";
+   bytecode;
+ }
  { native; }
 *)
diff --git a/testsuite/tests/backtrace/backtrace_effects.reference b/testsuite/tests/backtrace/backtrace_effects.reference
index 06acda2bc8b..6d9b15245d4 100644
--- a/testsuite/tests/backtrace/backtrace_effects.reference
+++ b/testsuite/tests/backtrace/backtrace_effects.reference
@@ -1,11 +1,16 @@
 (** get_callstack **)
-Raised by primitive operation at Backtrace_effects.bar in file "backtrace_effects.ml", line 18, characters 13-39
-Called from Backtrace_effects.foo in file "backtrace_effects.ml", line 25, characters 12-17
-Called from Backtrace_effects in file "backtrace_effects.ml", line 41, characters 8-14
+Raised by primitive operation at Backtrace_effects.bar in file "backtrace_effects.ml", line 20, characters 13-39
+Called from Backtrace_effects.foo in file "backtrace_effects.ml", line 27, characters 12-17
+Called from Stdlib__Effect.Deep.match_with in file "stdlib/effect.ml", line 88, characters 4-23
+Called from Backtrace_effects.baz in file "backtrace_effects.ml" (inlined), lines 31-41, characters 2-401
+Called from Backtrace_effects in file "backtrace_effects.ml", line 43, characters 8-14
 (** get_continuation_callstack **)
-Raised by primitive operation at Backtrace_effects.bar in file "backtrace_effects.ml", line 20, characters 4-13
-Called from Backtrace_effects.foo in file "backtrace_effects.ml", line 25, characters 12-17
+Raised by primitive operation at Backtrace_effects.bar in file "backtrace_effects.ml", line 22, characters 4-13
+Called from Backtrace_effects.foo in file "backtrace_effects.ml", line 27, characters 12-17
 (** raise **)
 Fatal error: exception Stdlib.Exit
-Raised at Backtrace_effects.baz.(fun) in file "backtrace_effects.ml", line 31, characters 21-28
-Called from Backtrace_effects in file "backtrace_effects.ml", line 41, characters 8-14
+Raised at Backtrace_effects.bar in file "backtrace_effects.ml", line 17, characters 4-14
+Re-raised at Backtrace_effects.baz.(fun) in file "backtrace_effects.ml", line 33, characters 21-28
+Called from Stdlib__Effect.Deep.match_with in file "stdlib/effect.ml", line 88, characters 4-23
+Called from Backtrace_effects.baz in file "backtrace_effects.ml" (inlined), lines 31-41, characters 2-401
+Called from Backtrace_effects in file "backtrace_effects.ml", line 43, characters 8-14
diff --git a/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference b/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
index a2195c3f23c..a146c826b4a 100644
--- a/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
+++ b/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
@@ -1,4 +1,4 @@
-Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 23, characters 2-11
-Called from Stdlib__Effect.Deep.continue in file "effect.ml" (inlined), line 62, characters 4-65
-Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 31, characters 16-29
+Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 24, characters 2-11
+Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 32, characters 16-29
+Called from Stdlib__Effect.Deep.try_with in file "stdlib/effect.ml", line 102, characters 4-23
 43
diff --git a/testsuite/tests/backtrace/backtrace_effects_nested.reference b/testsuite/tests/backtrace/backtrace_effects_nested.reference
index cf61b75391d..ccd9309a26f 100644
--- a/testsuite/tests/backtrace/backtrace_effects_nested.reference
+++ b/testsuite/tests/backtrace/backtrace_effects_nested.reference
@@ -1,3 +1,3 @@
-Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 23, characters 2-11
-Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 31, characters 16-29
+Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 24, characters 2-11
+Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 32, characters 16-29
 43
diff --git a/testsuite/tests/basic/patmatch_for_multiple.ml b/testsuite/tests/basic/patmatch_for_multiple.ml
index 570be1097d0..45fe8a07dc6 100644
--- a/testsuite/tests/basic/patmatch_for_multiple.ml
+++ b/testsuite/tests/basic/patmatch_for_multiple.ml
@@ -26,15 +26,15 @@ match (3, 2, 1) with
 | _ -> false
 ;;
 [%%expect{|
-(let (*match*/277 =[int] 3 *match*/278 =[int] 2 *match*/279 =[int] 1)
+(let (*match*/278 =[int] 3 *match*/279 =[int] 2 *match*/280 =[int] 1)
   (catch
     (catch
-      (catch (if (!= *match*/278 3) (exit 3) (exit 1)) with (3)
-        (if (!= *match*/277 1) (exit 2) (exit 1)))
+      (catch (if (!= *match*/279 3) (exit 3) (exit 1)) with (3)
+        (if (!= *match*/278 1) (exit 2) (exit 1)))
      with (2) 0)
    with (1) 1))
-(let (*match*/277 =[int] 3 *match*/278 =[int] 2 *match*/279 =[int] 1)
-  (catch (if (!= *match*/278 3) (if (!= *match*/277 1) 0 (exit 1)) (exit 1))
+(let (*match*/278 =[int] 3 *match*/279 =[int] 2 *match*/280 =[int] 1)
+  (catch (if (!= *match*/279 3) (if (!= *match*/278 1) 0 (exit 1)) (exit 1))
    with (1) 1))
 - : bool = false
 |}];;
@@ -47,32 +47,32 @@ match (3, 2, 1) with
 | _ -> false
 ;;
 [%%expect{|
-(let (*match*/282 =[int] 3 *match*/283 =[int] 2 *match*/284 =[int] 1)
+(let (*match*/283 =[int] 3 *match*/284 =[int] 2 *match*/285 =[int] 1)
   (catch
     (catch
       (catch
-        (if (!= *match*/283 3) (exit 6)
+        (if (!= *match*/284 3) (exit 6)
           (let
-            (x/286 =a[(consts ()) (non_consts ([0: [int], [int], [int]]))]
-               (makeblock 0 *match*/282 *match*/283 *match*/284))
-            (exit 4 x/286)))
+            (x/287 =a[(consts ()) (non_consts ([0: [int], [int], [int]]))]
+               (makeblock 0 *match*/283 *match*/284 *match*/285))
+            (exit 4 x/287)))
        with (6)
-        (if (!= *match*/282 1) (exit 5)
+        (if (!= *match*/283 1) (exit 5)
           (let
-            (x/285 =a[(consts ()) (non_consts ([0: [int], [int], [int]]))]
-               (makeblock 0 *match*/282 *match*/283 *match*/284))
-            (exit 4 x/285))))
+            (x/286 =a[(consts ()) (non_consts ([0: [int], [int], [int]]))]
+               (makeblock 0 *match*/283 *match*/284 *match*/285))
+            (exit 4 x/286))))
      with (5) 0)
-   with (4 x/280[(consts ()) (non_consts ([0: [int], [int], [int]]))])
-    (seq (ignore x/280) 1)))
-(let (*match*/282 =[int] 3 *match*/283 =[int] 2 *match*/284 =[int] 1)
+   with (4 x/281[(consts ()) (non_consts ([0: [int], [int], [int]]))])
+    (seq (ignore x/281) 1)))
+(let (*match*/283 =[int] 3 *match*/284 =[int] 2 *match*/285 =[int] 1)
   (catch
-    (if (!= *match*/283 3)
-      (if (!= *match*/282 1) 0
-        (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284)))
-      (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284)))
-   with (4 x/280[(consts ()) (non_consts ([0: [int], [int], [int]]))])
-    (seq (ignore x/280) 1)))
+    (if (!= *match*/284 3)
+      (if (!= *match*/283 1) 0
+        (exit 4 (makeblock 0 *match*/283 *match*/284 *match*/285)))
+      (exit 4 (makeblock 0 *match*/283 *match*/284 *match*/285)))
+   with (4 x/281[(consts ()) (non_consts ([0: [int], [int], [int]]))])
+    (seq (ignore x/281) 1)))
 - : bool = false
 |}];;
 
@@ -82,8 +82,8 @@ let _ = fun a b ->
   | ((true, _) as _g)
   | ((false, _) as _g) -> ()
 [%%expect{|
-(function {nlocal = 0} a/287[int] b/288 : int 0)
-(function {nlocal = 0} a/287[int] b/288 : int 0)
+(function {nlocal = 0} a/288[int] b/289 : int 0)
+(function {nlocal = 0} a/288[int] b/289 : int 0)
 - : bool -> 'a -> unit = <fun>
 |}];;
 
@@ -102,15 +102,15 @@ let _ = fun a b -> match a, b with
 | (false, _) as p -> p
 (* outside, trivial *)
 [%%expect {|
-(function {nlocal = 0} a/291[int] b/292
+(function {nlocal = 0} a/292[int] b/293
   [(consts ()) (non_consts ([0: [int], *]))](let
-                                              (p/293 =a[(consts ())
+                                              (p/294 =a[(consts ())
                                                         (non_consts (
                                                         [0: [int], *]))]
-                                                 (makeblock 0 a/291 b/292))
-                                              p/293))
-(function {nlocal = 0} a/291[int] b/292
-  [(consts ()) (non_consts ([0: [int], *]))](makeblock 0 a/291 b/292))
+                                                 (makeblock 0 a/292 b/293))
+                                              p/294))
+(function {nlocal = 0} a/292[int] b/293
+  [(consts ()) (non_consts ([0: [int], *]))](makeblock 0 a/292 b/293))
 - : bool -> 'a -> bool * 'a = <fun>
 |}]
 
@@ -119,15 +119,15 @@ let _ = fun a b -> match a, b with
 | ((false, _) as p) -> p
 (* inside, trivial *)
 [%%expect{|
-(function {nlocal = 0} a/295[int] b/296
+(function {nlocal = 0} a/296[int] b/297
   [(consts ()) (non_consts ([0: [int], *]))](let
-                                              (p/297 =a[(consts ())
+                                              (p/298 =a[(consts ())
                                                         (non_consts (
                                                         [0: [int], *]))]
-                                                 (makeblock 0 a/295 b/296))
-                                              p/297))
-(function {nlocal = 0} a/295[int] b/296
-  [(consts ()) (non_consts ([0: [int], *]))](makeblock 0 a/295 b/296))
+                                                 (makeblock 0 a/296 b/297))
+                                              p/298))
+(function {nlocal = 0} a/296[int] b/297
+  [(consts ()) (non_consts ([0: [int], *]))](makeblock 0 a/296 b/297))
 - : bool -> 'a -> bool * 'a = <fun>
 |}];;
 
@@ -136,20 +136,20 @@ let _ = fun a b -> match a, b with
 | (false as x, _) as p -> x, p
 (* outside, simple *)
 [%%expect {|
-(function {nlocal = 0} a/301[int] b/302
+(function {nlocal = 0} a/302[int] b/303
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], *]))]]))]
   (let
-    (x/303 =a[int] a/301
-     p/304 =a[(consts ()) (non_consts ([0: [int], *]))]
-       (makeblock 0 a/301 b/302))
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) x/303
-      p/304)))
-(function {nlocal = 0} a/301[int] b/302
+    (x/304 =a[int] a/302
+     p/305 =a[(consts ()) (non_consts ([0: [int], *]))]
+       (makeblock 0 a/302 b/303))
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) x/304
+      p/305)))
+(function {nlocal = 0} a/302[int] b/303
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], *]))]]))]
-  (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) a/301
-    (makeblock 0 a/301 b/302)))
+  (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) a/302
+    (makeblock 0 a/302 b/303)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -158,20 +158,20 @@ let _ = fun a b -> match a, b with
 | ((false as x, _) as p) -> x, p
 (* inside, simple *)
 [%%expect {|
-(function {nlocal = 0} a/307[int] b/308
+(function {nlocal = 0} a/308[int] b/309
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], *]))]]))]
   (let
-    (x/309 =a[int] a/307
-     p/310 =a[(consts ()) (non_consts ([0: [int], *]))]
-       (makeblock 0 a/307 b/308))
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) x/309
-      p/310)))
-(function {nlocal = 0} a/307[int] b/308
+    (x/310 =a[int] a/308
+     p/311 =a[(consts ()) (non_consts ([0: [int], *]))]
+       (makeblock 0 a/308 b/309))
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) x/310
+      p/311)))
+(function {nlocal = 0} a/308[int] b/309
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], *]))]]))]
-  (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) a/307
-    (makeblock 0 a/307 b/308)))
+  (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) a/308
+    (makeblock 0 a/308 b/309)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -180,30 +180,30 @@ let _ = fun a b -> match a, b with
 | (false, x) as p -> x, p
 (* outside, complex *)
 [%%expect{|
-(function {nlocal = 0} a/317[int] b/318[int]
+(function {nlocal = 0} a/318[int] b/319[int]
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], [int]]))]]))]
-  (if a/317
+  (if a/318
     (let
-      (x/319 =a[int] a/317
-       p/320 =a[(consts ()) (non_consts ([0: [int], [int]]))]
-         (makeblock 0 a/317 b/318))
-      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/319
-        p/320))
+      (x/320 =a[int] a/318
+       p/321 =a[(consts ()) (non_consts ([0: [int], [int]]))]
+         (makeblock 0 a/318 b/319))
+      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/320
+        p/321))
     (let
-      (x/321 =a[(consts ()) (non_consts ([0: ]))] b/318
-       p/322 =a[(consts ()) (non_consts ([0: [int], [int]]))]
-         (makeblock 0 a/317 b/318))
-      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/321
-        p/322))))
-(function {nlocal = 0} a/317[int] b/318[int]
+      (x/322 =a[(consts ()) (non_consts ([0: ]))] b/319
+       p/323 =a[(consts ()) (non_consts ([0: [int], [int]]))]
+         (makeblock 0 a/318 b/319))
+      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/322
+        p/323))))
+(function {nlocal = 0} a/318[int] b/319[int]
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], [int]]))]]))]
-  (if a/317
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) a/317
-      (makeblock 0 a/317 b/318))
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) b/318
-      (makeblock 0 a/317 b/318))))
+  (if a/318
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) a/318
+      (makeblock 0 a/318 b/319))
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) b/319
+      (makeblock 0 a/318 b/319))))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -213,33 +213,33 @@ let _ = fun a b -> match a, b with
   -> x, p
 (* inside, complex *)
 [%%expect{|
-(function {nlocal = 0} a/323[int] b/324[int]
+(function {nlocal = 0} a/324[int] b/325[int]
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], [int]]))]]))]
   (catch
-    (if a/323
+    (if a/324
       (let
-        (x/331 =a[int] a/323
-         p/332 =a[(consts ()) (non_consts ([0: [int], [int]]))]
-           (makeblock 0 a/323 b/324))
-        (exit 10 x/331 p/332))
+        (x/332 =a[int] a/324
+         p/333 =a[(consts ()) (non_consts ([0: [int], [int]]))]
+           (makeblock 0 a/324 b/325))
+        (exit 10 x/332 p/333))
       (let
-        (x/329 =a[(consts ()) (non_consts ([0: ]))] b/324
-         p/330 =a[(consts ()) (non_consts ([0: [int], [int]]))]
-           (makeblock 0 a/323 b/324))
-        (exit 10 x/329 p/330)))
-   with (10 x/325[int] p/326[(consts ()) (non_consts ([0: [int], [int]]))])
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/325
-      p/326)))
-(function {nlocal = 0} a/323[int] b/324[int]
+        (x/330 =a[(consts ()) (non_consts ([0: ]))] b/325
+         p/331 =a[(consts ()) (non_consts ([0: [int], [int]]))]
+           (makeblock 0 a/324 b/325))
+        (exit 10 x/330 p/331)))
+   with (10 x/326[int] p/327[(consts ()) (non_consts ([0: [int], [int]]))])
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/326
+      p/327)))
+(function {nlocal = 0} a/324[int] b/325[int]
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], [int]]))]]))]
   (catch
-    (if a/323 (exit 10 a/323 (makeblock 0 a/323 b/324))
-      (exit 10 b/324 (makeblock 0 a/323 b/324)))
-   with (10 x/325[int] p/326[(consts ()) (non_consts ([0: [int], [int]]))])
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/325
-      p/326)))
+    (if a/324 (exit 10 a/324 (makeblock 0 a/324 b/325))
+      (exit 10 b/325 (makeblock 0 a/324 b/325)))
+   with (10 x/326[int] p/327[(consts ()) (non_consts ([0: [int], [int]]))])
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/326
+      p/327)))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -252,30 +252,30 @@ let _ = fun a b -> match a, b with
 | (false as x, _) as p -> x, p
 (* outside, onecase *)
 [%%expect {|
-(function {nlocal = 0} a/333[int] b/334[int]
+(function {nlocal = 0} a/334[int] b/335[int]
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], [int]]))]]))]
-  (if a/333
+  (if a/334
     (let
-      (x/335 =a[int] a/333
-       _p/336 =a[(consts ()) (non_consts ([0: [int], [int]]))]
-         (makeblock 0 a/333 b/334))
-      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/335
+      (x/336 =a[int] a/334
+       _p/337 =a[(consts ()) (non_consts ([0: [int], [int]]))]
+         (makeblock 0 a/334 b/335))
+      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/336
         [0: 1 1]))
     (let
-      (x/337 =a[int] a/333
-       p/338 =a[(consts ()) (non_consts ([0: [int], [int]]))]
-         (makeblock 0 a/333 b/334))
-      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/337
-        p/338))))
-(function {nlocal = 0} a/333[int] b/334[int]
+      (x/338 =a[int] a/334
+       p/339 =a[(consts ()) (non_consts ([0: [int], [int]]))]
+         (makeblock 0 a/334 b/335))
+      (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) x/338
+        p/339))))
+(function {nlocal = 0} a/334[int] b/335[int]
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], [int]]))]]))]
-  (if a/333
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) a/333
+  (if a/334
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) a/334
       [0: 1 1])
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) a/333
-      (makeblock 0 a/333 b/334))))
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], [int]]))]) a/334
+      (makeblock 0 a/334 b/335))))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -284,20 +284,20 @@ let _ = fun a b -> match a, b with
 | ((false as x, _) as p) -> x, p
 (* inside, onecase *)
 [%%expect{|
-(function {nlocal = 0} a/339[int] b/340
+(function {nlocal = 0} a/340[int] b/341
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], *]))]]))]
   (let
-    (x/341 =a[int] a/339
-     p/342 =a[(consts ()) (non_consts ([0: [int], *]))]
-       (makeblock 0 a/339 b/340))
-    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) x/341
-      p/342)))
-(function {nlocal = 0} a/339[int] b/340
+    (x/342 =a[int] a/340
+     p/343 =a[(consts ()) (non_consts ([0: [int], *]))]
+       (makeblock 0 a/340 b/341))
+    (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) x/342
+      p/343)))
+(function {nlocal = 0} a/340[int] b/341
   [(consts ())
    (non_consts ([0: [int], [(consts ()) (non_consts ([0: [int], *]))]]))]
-  (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) a/339
-    (makeblock 0 a/339 b/340)))
+  (makeblock 0 (int,[(consts ()) (non_consts ([0: [int], *]))]) a/340
+    (makeblock 0 a/340 b/341)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -314,23 +314,23 @@ let _ =fun a b -> match a, b with
 | (_, _) as p -> p
 (* outside, tuplist *)
 [%%expect {|
-(function {nlocal = 0} a/352[int]
-  b/353[(consts (0))
+(function {nlocal = 0} a/353[int]
+  b/354[(consts (0))
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))]]))]
   [(consts ())
    (non_consts ([0: [int], [(consts (0)) (non_consts ([0: *]))]]))](catch
-                                                                    (if a/352
-                                                                    (if b/353
+                                                                    (if a/353
+                                                                    (if b/354
                                                                     (let
-                                                                    (p/354 =a
+                                                                    (p/355 =a
                                                                     (field_imm 0
-                                                                    b/353))
-                                                                    p/354)
+                                                                    b/354))
+                                                                    p/355)
                                                                     (exit 12))
                                                                     (exit 12))
                                                                     with (12)
                                                                     (let
-                                                                    (p/355 =a
+                                                                    (p/356 =a
                                                                     [(consts ())
                                                                     (non_consts (
                                                                     [0:
@@ -339,24 +339,24 @@ let _ =fun a b -> match a, b with
                                                                     (non_consts (
                                                                     [0: *]))]]))]
                                                                     (makeblock 0
-                                                                    a/352
-                                                                    b/353))
-                                                                    p/355)))
-(function {nlocal = 0} a/352[int]
-  b/353[(consts (0))
+                                                                    a/353
+                                                                    b/354))
+                                                                    p/356)))
+(function {nlocal = 0} a/353[int]
+  b/354[(consts (0))
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))]]))]
   [(consts ())
    (non_consts ([0: [int], [(consts (0)) (non_consts ([0: *]))]]))](catch
-                                                                    (if a/352
-                                                                    (if b/353
+                                                                    (if a/353
+                                                                    (if b/354
                                                                     (field_imm 0
-                                                                    b/353)
+                                                                    b/354)
                                                                     (exit 12))
                                                                     (exit 12))
                                                                     with (12)
                                                                     (makeblock 0
-                                                                    a/352
-                                                                    b/353)))
+                                                                    a/353
+                                                                    b/354)))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
 |}]
 
@@ -365,25 +365,25 @@ let _ = fun a b -> match a, b with
 | ((_, _) as p) -> p
 (* inside, tuplist *)
 [%%expect{|
-(function {nlocal = 0} a/356[int]
-  b/357[(consts (0))
+(function {nlocal = 0} a/357[int]
+  b/358[(consts (0))
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))]]))]
   [(consts ())
    (non_consts ([0: [int], [(consts (0)) (non_consts ([0: *]))]]))](catch
                                                                     (catch
-                                                                    (if a/356
-                                                                    (if b/357
+                                                                    (if a/357
+                                                                    (if b/358
                                                                     (let
-                                                                    (p/361 =a
+                                                                    (p/362 =a
                                                                     (field_imm 0
-                                                                    b/357))
+                                                                    b/358))
                                                                     (exit 13
-                                                                    p/361))
+                                                                    p/362))
                                                                     (exit 14))
                                                                     (exit 14))
                                                                     with (14)
                                                                     (let
-                                                                    (p/360 =a
+                                                                    (p/361 =a
                                                                     [(consts ())
                                                                     (non_consts (
                                                                     [0:
@@ -392,11 +392,11 @@ let _ = fun a b -> match a, b with
                                                                     (non_consts (
                                                                     [0: *]))]]))]
                                                                     (makeblock 0
-                                                                    a/356
-                                                                    b/357))
+                                                                    a/357
+                                                                    b/358))
                                                                     (exit 13
-                                                                    p/360)))
-                                                                    with (13 p/358
+                                                                    p/361)))
+                                                                    with (13 p/359
                                                                     [(consts ())
                                                                     (non_consts (
                                                                     [0:
@@ -404,26 +404,26 @@ let _ = fun a b -> match a, b with
                                                                     [(consts (0))
                                                                     (non_consts (
                                                                     [0: *]))]]))])
-                                                                    p/358))
-(function {nlocal = 0} a/356[int]
-  b/357[(consts (0))
+                                                                    p/359))
+(function {nlocal = 0} a/357[int]
+  b/358[(consts (0))
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))]]))]
   [(consts ())
    (non_consts ([0: [int], [(consts (0)) (non_consts ([0: *]))]]))](catch
                                                                     (catch
-                                                                    (if a/356
-                                                                    (if b/357
+                                                                    (if a/357
+                                                                    (if b/358
                                                                     (exit 13
                                                                     (field_imm 0
-                                                                    b/357))
+                                                                    b/358))
                                                                     (exit 14))
                                                                     (exit 14))
                                                                     with (14)
                                                                     (exit 13
                                                                     (makeblock 0
-                                                                    a/356
-                                                                    b/357)))
-                                                                    with (13 p/358
+                                                                    a/357
+                                                                    b/358)))
+                                                                    with (13 p/359
                                                                     [(consts ())
                                                                     (non_consts (
                                                                     [0:
@@ -431,6 +431,6 @@ let _ = fun a b -> match a, b with
                                                                     [(consts (0))
                                                                     (non_consts (
                                                                     [0: *]))]]))])
-                                                                    p/358))
+                                                                    p/359))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
 |}]
diff --git a/testsuite/tests/effects/backtrace.reference b/testsuite/tests/effects/backtrace.reference
index 98f72da8966..0be22eec6ce 100644
--- a/testsuite/tests/effects/backtrace.reference
+++ b/testsuite/tests/effects/backtrace.reference
@@ -1,6 +1,6 @@
-Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33
-Called from Backtrace.foo in file "backtrace.ml", line 12, characters 11-27
-Called from Backtrace.bar in file "backtrace.ml", line 20, characters 4-9
-Called from Backtrace.task1 in file "backtrace.ml", line 29, characters 4-10
-Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "effect.ml", line 68, characters 41-75
-Called from Backtrace.task2 in file "backtrace.ml", line 36, characters 4-16
+Raised at Stdlib.failwith in file "stdlib.ml" (inlined), line 35, characters 17-33
+Called from Backtrace.foo in file "backtrace.ml", line 14, characters 11-27
+Called from Backtrace.bar in file "backtrace.ml", line 22, characters 4-9
+Called from Backtrace.task1 in file "backtrace.ml", line 31, characters 4-10
+Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "stdlib/effect.ml", line 68, characters 41-75
+Called from Backtrace.task2 in file "backtrace.ml", line 38, characters 4-16
diff --git a/testsuite/tests/lib-extensions/modules.ml b/testsuite/tests/lib-extensions/modules.ml
index 0ea4a207c07..261f6f3060f 100644
--- a/testsuite/tests/lib-extensions/modules.ml
+++ b/testsuite/tests/lib-extensions/modules.ml
@@ -1,4 +1,9 @@
 (* TEST
+ flags = "-extension-universe alpha";
+ include stdlib_upstream_compatible;
+ include stdlib_stable;
+ include stdlib_beta;
+ include stdlib_alpha;
  {
    bytecode;
  }{
@@ -7,3 +12,7 @@
 *)
 
 (* Check that extension library modules exist. *)
+module Upstream_compatible = Stdlib_upstream_compatible
+module Stable = Stdlib_stable
+module Beta = Stdlib_beta
+module Alpha = Stdlib_alpha
diff --git a/testsuite/tests/match-side-effects/partiality.ml b/testsuite/tests/match-side-effects/partiality.ml
index 4987e2ac61e..1c27774ce7a 100644
--- a/testsuite/tests/match-side-effects/partiality.ml
+++ b/testsuite/tests/match-side-effects/partiality.ml
@@ -25,17 +25,17 @@ let f x =
 0
 type t = { a : bool; mutable b : int option; }
 (let
-  (f/280 =
-     (function {nlocal = 0} x/282 : int
-       (if (field_int 0 x/282)
-         (let (*match*/286 =o (field_mut 1 x/282))
-           (if *match*/286
-             (if (seq (setfield_ptr 1 x/282 0) 0) 2
-               (let (*match*/287 =o (field_mut 1 x/282))
-                 (field_imm 0 *match*/287)))
+  (f/281 =
+     (function {nlocal = 0} x/283 : int
+       (if (field_int 0 x/283)
+         (let (*match*/287 =o (field_mut 1 x/283))
+           (if *match*/287
+             (if (seq (setfield_ptr 1 x/283 0) 0) 2
+               (let (*match*/288 =o (field_mut 1 x/283))
+                 (field_imm 0 *match*/288)))
              1))
          0)))
-  (apply (field_imm 1 (global Toploop!)) "f" f/280))
+  (apply (field_imm 1 (global Toploop!)) "f" f/281))
 val f : t -> int = <fun>
 |}]
 
@@ -56,13 +56,13 @@ let f x =
 0
 type t = { a : bool; mutable b : int option; }
 (let
-  (f/291 =
-     (function {nlocal = 0} x/292 : int
-       (if (field_int 0 x/292)
-         (let (*match*/296 =o (field_mut 1 x/292))
-           (if *match*/296 (field_imm 0 *match*/296) 1))
+  (f/292 =
+     (function {nlocal = 0} x/293 : int
+       (if (field_int 0 x/293)
+         (let (*match*/297 =o (field_mut 1 x/293))
+           (if *match*/297 (field_imm 0 *match*/297) 1))
          0)))
-  (apply (field_imm 1 (global Toploop!)) "f" f/291))
+  (apply (field_imm 1 (global Toploop!)) "f" f/292))
 val f : t -> int = <fun>
 |}]
 
@@ -85,25 +85,25 @@ let f r =
    unsound here. *)
 [%%expect {|
 (let
-  (f/298 =
-     (function {nlocal = 0} r/299 : int
+  (f/299 =
+     (function {nlocal = 0} r/300 : int
        (region
          (let
-           (*match*/301 =[(consts (0)) (non_consts ([0: *]))]
-              (makelocalblock 0 (*) r/299))
+           (*match*/302 =[(consts (0)) (non_consts ([0: *]))]
+              (makelocalblock 0 (*) r/300))
            (catch
-             (if *match*/301
-               (let (*match*/303 =o (field_mut 0 (field_imm 0 *match*/301)))
-                 (if *match*/303 (exit 7) 0))
+             (if *match*/302
+               (let (*match*/304 =o (field_mut 0 (field_imm 0 *match*/302)))
+                 (if *match*/304 (exit 7) 0))
                (exit 7))
             with (7)
-             (if (seq (setfield_ptr 0 r/299 0) 0) 1
-               (if *match*/301
+             (if (seq (setfield_ptr 0 r/300 0) 0) 1
+               (if *match*/302
                  (let
-                   (*match*/305 =o (field_mut 0 (field_imm 0 *match*/301)))
-                   (field_imm 0 *match*/305))
+                   (*match*/306 =o (field_mut 0 (field_imm 0 *match*/302)))
+                   (field_imm 0 *match*/306))
                  3)))))))
-  (apply (field_imm 1 (global Toploop!)) "f" f/298))
+  (apply (field_imm 1 (global Toploop!)) "f" f/299))
 val f : int option ref -> int = <fun>
 |}]
 
@@ -123,10 +123,10 @@ let test = function
 0
 type _ t = Int : int -> int t | Bool : bool -> bool t
 (let
-  (test/309 =
-     (function {nlocal = 0} param/312[(consts (0)) (non_consts ([0: *]))]
-       : int (if param/312 (field_imm 0 (field_imm 0 param/312)) 0)))
-  (apply (field_imm 1 (global Toploop!)) "test" test/309))
+  (test/310 =
+     (function {nlocal = 0} param/313[(consts (0)) (non_consts ([0: *]))]
+       : int (if param/313 (field_imm 0 (field_imm 0 param/313)) 0)))
+  (apply (field_imm 1 (global Toploop!)) "test" test/310))
 val test : int t option -> int = <fun>
 |}]
 
@@ -144,11 +144,11 @@ let test = function
 0
 type _ t = Int : int -> int t | Bool : bool -> bool t
 (let
-  (test/317 =
-     (function {nlocal = 0} param/319 : int
-       (let (*match*/320 =o (field_mut 0 param/319))
-         (if *match*/320 (field_imm 0 (field_imm 0 *match*/320)) 0))))
-  (apply (field_imm 1 (global Toploop!)) "test" test/317))
+  (test/318 =
+     (function {nlocal = 0} param/320 : int
+       (let (*match*/321 =o (field_mut 0 param/320))
+         (if *match*/321 (field_imm 0 (field_imm 0 *match*/321)) 0))))
+  (apply (field_imm 1 (global Toploop!)) "test" test/318))
 val test : int t option ref -> int = <fun>
 |}]
 
@@ -169,11 +169,11 @@ let test n =
 0
 type _ t = Int : int -> int t | Bool : bool -> bool t
 (let
-  (test/325 =
-     (function {nlocal = 0} n/326 : int
+  (test/326 =
+     (function {nlocal = 0} n/327 : int
        (region
          (let
-           (*match*/329 =[(consts (0)) (non_consts ([0: *]))]
+           (*match*/330 =[(consts (0)) (non_consts ([0: *]))]
               (makelocalblock 0 ([(consts ())
                                   (non_consts ([0: *,
                                                 [(consts ())
@@ -182,13 +182,13 @@ type _ t = Int : int -> int t | Bool : bool -> bool t
                 (makelocalblock 0 (*,[(consts ()) (non_consts ([1: [int]]
                                       [0: [int]]))])
                   (makelocalmutable 0 (int) 1) [0: 42])))
-           (if *match*/329
+           (if *match*/330
              (let
-               (*match*/330 =a (field_imm 0 *match*/329)
-                *match*/332 =o (field_mut 0 (field_imm 0 *match*/330)))
-               (if *match*/332 (field_imm 0 (field_imm 1 *match*/330))
-                 (~ (field_imm 0 (field_imm 1 *match*/330)))))
+               (*match*/331 =a (field_imm 0 *match*/330)
+                *match*/333 =o (field_mut 0 (field_imm 0 *match*/331)))
+               (if *match*/333 (field_imm 0 (field_imm 1 *match*/331))
+                 (~ (field_imm 0 (field_imm 1 *match*/331)))))
              3)))))
-  (apply (field_imm 1 (global Toploop!)) "test" test/325))
+  (apply (field_imm 1 (global Toploop!)) "test" test/326))
 val test : 'a -> int = <fun>
 |}]
diff --git a/testsuite/tests/match-side-effects/test_contexts_code.ml b/testsuite/tests/match-side-effects/test_contexts_code.ml
index 146bdd45303..39e71e7e60f 100644
--- a/testsuite/tests/match-side-effects/test_contexts_code.ml
+++ b/testsuite/tests/match-side-effects/test_contexts_code.ml
@@ -31,11 +31,11 @@ let example_1 () =
       Result.Error 3
   | { a = true; b = Either.Left y } -> Result.Ok y;;
 (let
-  (example_1/295 =
-     (function {nlocal = 0} param/319[int]
+  (example_1/296 =
+     (function {nlocal = 0} param/320[int]
        [(consts ()) (non_consts ([1: *] [0: *]))](region
                                                    (let
-                                                     (input/297 =
+                                                     (input/298 =
                                                         (makelocalmutable 0 (int,
                                                           [(consts ())
                                                            (non_consts (
@@ -43,30 +43,30 @@ let example_1 () =
                                                           1 [0: 1]))
                                                      (if
                                                        (field_int 0
-                                                         input/297)
+                                                         input/298)
                                                        (let
-                                                         (*match*/322 =o
+                                                         (*match*/323 =o
                                                             (field_mut 1
-                                                              input/297))
-                                                         (switch* *match*/322
+                                                              input/298))
+                                                         (switch* *match*/323
                                                           case tag 0:
                                                            (if
                                                              (seq
                                                                (setfield_ptr(maybe-stack) 1
-                                                                 input/297
+                                                                 input/298
                                                                  [1: 3])
                                                                0)
                                                              [1: 3]
                                                              (let
-                                                               (*match*/324 =o
+                                                               (*match*/325 =o
                                                                   (field_mut 1
-                                                                    input/297))
+                                                                    input/298))
                                                                (makeblock 0 (int)
                                                                  (field_imm 0
-                                                                   *match*/324))))
+                                                                   *match*/325))))
                                                           case tag 1: [1: 2]))
                                                        [1: 1])))))
-  (apply (field_imm 1 (global Toploop!)) "example_1" example_1/295))
+  (apply (field_imm 1 (global Toploop!)) "example_1" example_1/296))
 val example_1 : unit -> (bool, int) Result.t = <fun>
 |}]
 
@@ -95,11 +95,11 @@ let example_2 () =
       Result.Error 3
   | { a = true; b = { mut = Either.Left y } } -> Result.Ok y;;
 (let
-  (example_2/331 =
-     (function {nlocal = 0} param/335[int]
+  (example_2/332 =
+     (function {nlocal = 0} param/336[int]
        [(consts ()) (non_consts ([1: *] [0: *]))](region
                                                    (let
-                                                     (input/333 =[(consts ())
+                                                     (input/334 =[(consts ())
                                                                   (non_consts (
                                                                   [0: [int],
                                                                    *]))]
@@ -112,33 +112,33 @@ let example_2 () =
                                                             [0: 1])))
                                                      (if
                                                        (field_int 0
-                                                         input/333)
+                                                         input/334)
                                                        (let
-                                                         (*match*/339 =o
+                                                         (*match*/340 =o
                                                             (field_mut 0
                                                               (field_imm 1
-                                                                input/333)))
-                                                         (switch* *match*/339
+                                                                input/334)))
+                                                         (switch* *match*/340
                                                           case tag 0:
                                                            (if
                                                              (seq
                                                                (setfield_ptr(maybe-stack) 0
                                                                  (field_imm 1
-                                                                   input/333)
+                                                                   input/334)
                                                                  [1: 3])
                                                                0)
                                                              [1: 3]
                                                              (let
-                                                               (*match*/342 =o
+                                                               (*match*/343 =o
                                                                   (field_mut 0
                                                                     (field_imm 1
-                                                                    input/333)))
+                                                                    input/334)))
                                                                (makeblock 0 (int)
                                                                  (field_imm 0
-                                                                   *match*/342))))
+                                                                   *match*/343))))
                                                           case tag 1: [1: 2]))
                                                        [1: 1])))))
-  (apply (field_imm 1 (global Toploop!)) "example_2" example_2/331))
+  (apply (field_imm 1 (global Toploop!)) "example_2" example_2/332))
 val example_2 : unit -> (bool, int) Result.t = <fun>
 |}]
 
@@ -165,11 +165,11 @@ let example_3 () =
       Result.Error 3
   | { mut = (true, Either.Left y) } -> Result.Ok y;;
 (let
-  (example_3/348 =
-     (function {nlocal = 0} param/352[int]
+  (example_3/349 =
+     (function {nlocal = 0} param/353[int]
        [(consts ()) (non_consts ([1: *] [0: *]))](region
                                                    (let
-                                                     (input/350 =mut[(consts ())
+                                                     (input/351 =mut[(consts ())
                                                                     (non_consts (
                                                                     [0:
                                                                     [int],
@@ -178,27 +178,27 @@ let example_3 () =
                                                                     [1: *]
                                                                     [0: *]))]]))]
                                                         [0: 1 [0: 1]]
-                                                      *match*/353 =o
-                                                        *input/350)
+                                                      *match*/354 =o
+                                                        *input/351)
                                                      (if
                                                        (field_imm 0
-                                                         *match*/353)
+                                                         *match*/354)
                                                        (switch* (field_imm 1
-                                                                  *match*/353)
+                                                                  *match*/354)
                                                         case tag 0:
                                                          (if
                                                            (seq
                                                              (assign
-                                                               input/350
+                                                               input/351
                                                                [0: 1 [1: 3]])
                                                              0)
                                                            [1: 3]
                                                            (makeblock 0 (int)
                                                              (field_imm 0
                                                                (field_imm 1
-                                                                 *match*/353))))
+                                                                 *match*/354))))
                                                         case tag 1: [1: 2])
                                                        [1: 1])))))
-  (apply (field_imm 1 (global Toploop!)) "example_3" example_3/348))
+  (apply (field_imm 1 (global Toploop!)) "example_3" example_3/349))
 val example_3 : unit -> (bool, int) Result.t = <fun>
 |}]
diff --git a/testsuite/tests/ppx-empty-cases/test.compilers.reference b/testsuite/tests/ppx-empty-cases/test.compilers.reference
index 87d593b488c..8eaa661b681 100644
--- a/testsuite/tests/ppx-empty-cases/test.compilers.reference
+++ b/testsuite/tests/ppx-empty-cases/test.compilers.reference
@@ -1,40 +1,40 @@
 (setglobal Test!
   (let
-    (empty_cases_returning_string/270 =
-       (function {nlocal = 0} param/272
+    (empty_cases_returning_string/271 =
+       (function {nlocal = 0} param/273
          (raise
            (makeblock 0 (getpredef Match_failure/39!!) [0: "test.ml" 28 50])))
-     empty_cases_returning_float64/273 =
-       (function {nlocal = 0} param/275 : unboxed_float
+     empty_cases_returning_float64/274 =
+       (function {nlocal = 0} param/276 : unboxed_float
          (raise
            (makeblock 0 (getpredef Match_failure/39!!) [0: "test.ml" 29 50])))
-     empty_cases_accepting_string/276 =
-       (function {nlocal = 0} param/278
+     empty_cases_accepting_string/277 =
+       (function {nlocal = 0} param/279
          (raise
            (makeblock 0 (getpredef Match_failure/39!!) [0: "test.ml" 30 50])))
-     empty_cases_accepting_float64/279 =
-       (function {nlocal = 0} param/281[unboxed_float]
+     empty_cases_accepting_float64/280 =
+       (function {nlocal = 0} param/282[unboxed_float]
          (raise
            (makeblock 0 (getpredef Match_failure/39!!) [0: "test.ml" 31 50])))
-     non_empty_cases_returning_string/282 =
-       (function {nlocal = 0} param/284
+     non_empty_cases_returning_string/283 =
+       (function {nlocal = 0} param/285
          (raise
            (makeblock 0 (getpredef Assert_failure/49!!) [0: "test.ml" 32 68])))
-     non_empty_cases_returning_float64/285 =
-       (function {nlocal = 0} param/287 : unboxed_float
+     non_empty_cases_returning_float64/286 =
+       (function {nlocal = 0} param/288 : unboxed_float
          (raise
            (makeblock 0 (getpredef Assert_failure/49!!) [0: "test.ml" 33 68])))
-     non_empty_cases_accepting_string/288 =
-       (function {nlocal = 0} param/290
+     non_empty_cases_accepting_string/289 =
+       (function {nlocal = 0} param/291
          (raise
            (makeblock 0 (getpredef Assert_failure/49!!) [0: "test.ml" 34 68])))
-     non_empty_cases_accepting_float64/291 =
-       (function {nlocal = 0} param/293[unboxed_float]
+     non_empty_cases_accepting_float64/292 =
+       (function {nlocal = 0} param/294[unboxed_float]
          (raise
            (makeblock 0 (getpredef Assert_failure/49!!) [0: "test.ml" 35 68]))))
-    (makeblock 0 empty_cases_returning_string/270
-      empty_cases_returning_float64/273 empty_cases_accepting_string/276
-      empty_cases_accepting_float64/279 non_empty_cases_returning_string/282
-      non_empty_cases_returning_float64/285
-      non_empty_cases_accepting_string/288
-      non_empty_cases_accepting_float64/291)))
+    (makeblock 0 empty_cases_returning_string/271
+      empty_cases_returning_float64/274 empty_cases_accepting_string/277
+      empty_cases_accepting_float64/280 non_empty_cases_returning_string/283
+      non_empty_cases_returning_float64/286
+      non_empty_cases_accepting_string/289
+      non_empty_cases_accepting_float64/292)))
diff --git a/testsuite/tests/typing-unique/overwriting_proj_push_down_bug.ml b/testsuite/tests/typing-unique/overwriting_proj_push_down_bug.ml
index e8891c0bc9c..6ef88f4e0fe 100644
--- a/testsuite/tests/typing-unique/overwriting_proj_push_down_bug.ml
+++ b/testsuite/tests/typing-unique/overwriting_proj_push_down_bug.ml
@@ -17,15 +17,15 @@ type record = { x : string; y : string @@ many aliased; }
 
 let aliased_use x = x
 [%%expect{|
-(let (aliased_use/280 = (function {nlocal = 0} x/282 x/282))
-  (apply (field_imm 1 (global Toploop!)) "aliased_use" aliased_use/280))
+(let (aliased_use/281 = (function {nlocal = 0} x/283 x/283))
+  (apply (field_imm 1 (global Toploop!)) "aliased_use" aliased_use/281))
 val aliased_use : 'a -> 'a = <fun>
 |}]
 
 let unique_use (unique_ x) = x
 [%%expect{|
-(let (unique_use/283 = (function {nlocal = 0} x/285 x/285))
-  (apply (field_imm 1 (global Toploop!)) "unique_use" unique_use/283))
+(let (unique_use/284 = (function {nlocal = 0} x/286 x/286))
+  (apply (field_imm 1 (global Toploop!)) "unique_use" unique_use/284))
 val unique_use : 'a @ unique -> 'a = <fun>
 |}]
 
@@ -36,17 +36,17 @@ let proj_aliased r =
   (r, y)
 [%%expect{|
 (let
-  (aliased_use/280 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
-   proj_aliased/286 =
-     (function {nlocal = 0} r/288[(consts ()) (non_consts ([0: *, *]))]
+  (aliased_use/281 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
+   proj_aliased/287 =
+     (function {nlocal = 0} r/289[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (let
-         (y/289 = (field_imm 1 r/288)
-          r/290 =[(consts ()) (non_consts ([0: *, *]))]
-            (apply aliased_use/280 r/288))
-         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/290 y/289))))
-  (apply (field_imm 1 (global Toploop!)) "proj_aliased" proj_aliased/286))
+         (y/290 = (field_imm 1 r/289)
+          r/291 =[(consts ()) (non_consts ([0: *, *]))]
+            (apply aliased_use/281 r/289))
+         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/291 y/290))))
+  (apply (field_imm 1 (global Toploop!)) "proj_aliased" proj_aliased/287))
 val proj_aliased : record -> record * string = <fun>
 |}]
 
@@ -56,17 +56,17 @@ let proj_unique r =
   (r, y)
 [%%expect{|
 (let
-  (unique_use/283 = (apply (field_imm 0 (global Toploop!)) "unique_use")
-   proj_unique/291 =
-     (function {nlocal = 0} r/293[(consts ()) (non_consts ([0: *, *]))]
+  (unique_use/284 = (apply (field_imm 0 (global Toploop!)) "unique_use")
+   proj_unique/292 =
+     (function {nlocal = 0} r/294[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (let
-         (y/294 = (field_mut 1 r/293)
-          r/295 =[(consts ()) (non_consts ([0: *, *]))]
-            (apply unique_use/283 r/293))
-         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/295 y/294))))
-  (apply (field_imm 1 (global Toploop!)) "proj_unique" proj_unique/291))
+         (y/295 = (field_mut 1 r/294)
+          r/296 =[(consts ()) (non_consts ([0: *, *]))]
+            (apply unique_use/284 r/294))
+         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/296 y/295))))
+  (apply (field_imm 1 (global Toploop!)) "proj_unique" proj_unique/292))
 val proj_unique : record @ unique -> record * string = <fun>
 |}]
 
@@ -79,17 +79,17 @@ let match_aliased r =
     (r, y)
 [%%expect{|
 (let
-  (aliased_use/280 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
-   match_aliased/296 =
-     (function {nlocal = 0} r/298[(consts ()) (non_consts ([0: *, *]))]
+  (aliased_use/281 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
+   match_aliased/297 =
+     (function {nlocal = 0} r/299[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (let
-         (r/300 =[(consts ()) (non_consts ([0: *, *]))]
-            (apply aliased_use/280 r/298))
-         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/300
-           (field_imm 1 r/298)))))
-  (apply (field_imm 1 (global Toploop!)) "match_aliased" match_aliased/296))
+         (r/301 =[(consts ()) (non_consts ([0: *, *]))]
+            (apply aliased_use/281 r/299))
+         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/301
+           (field_imm 1 r/299)))))
+  (apply (field_imm 1 (global Toploop!)) "match_aliased" match_aliased/297))
 val match_aliased : record -> record * string = <fun>
 |}]
 
@@ -101,17 +101,17 @@ let match_unique r =
     (r, y)
 [%%expect{|
 (let
-  (unique_use/283 = (apply (field_imm 0 (global Toploop!)) "unique_use")
-   match_unique/302 =
-     (function {nlocal = 0} r/304[(consts ()) (non_consts ([0: *, *]))]
+  (unique_use/284 = (apply (field_imm 0 (global Toploop!)) "unique_use")
+   match_unique/303 =
+     (function {nlocal = 0} r/305[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (let
-         (y/305 =o (field_mut 1 r/304)
-          r/306 =[(consts ()) (non_consts ([0: *, *]))]
-            (apply unique_use/283 r/304))
-         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/306 y/305))))
-  (apply (field_imm 1 (global Toploop!)) "match_unique" match_unique/302))
+         (y/306 =o (field_mut 1 r/305)
+          r/307 =[(consts ()) (non_consts ([0: *, *]))]
+            (apply unique_use/284 r/305))
+         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/307 y/306))))
+  (apply (field_imm 1 (global Toploop!)) "match_unique" match_unique/303))
 val match_unique : record @ unique -> record * string = <fun>
 |}]
 
@@ -125,19 +125,19 @@ let match_mini_anf_aliased r =
   (r, y)
 [%%expect{|
 (let
-  (aliased_use/280 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
-   match_mini_anf_aliased/308 =
-     (function {nlocal = 0} r/310[(consts ()) (non_consts ([0: *, *]))]
+  (aliased_use/281 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
+   match_mini_anf_aliased/309 =
+     (function {nlocal = 0} r/311[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (let
-         (*match*/316 =[int] 1
-          r/313 =[(consts ()) (non_consts ([0: *, *]))]
-            (apply aliased_use/280 r/310))
-         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/313
-           (field_imm 1 r/310)))))
+         (*match*/317 =[int] 1
+          r/314 =[(consts ()) (non_consts ([0: *, *]))]
+            (apply aliased_use/281 r/311))
+         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/314
+           (field_imm 1 r/311)))))
   (apply (field_imm 1 (global Toploop!)) "match_mini_anf_aliased"
-    match_mini_anf_aliased/308))
+    match_mini_anf_aliased/309))
 val match_mini_anf_aliased : record -> record * string = <fun>
 |}]
 
@@ -151,19 +151,19 @@ let match_mini_anf_unique r =
   (r, y)
 [%%expect{|
 (let
-  (unique_use/283 = (apply (field_imm 0 (global Toploop!)) "unique_use")
-   match_mini_anf_unique/318 =
-     (function {nlocal = 0} r/320[(consts ()) (non_consts ([0: *, *]))]
+  (unique_use/284 = (apply (field_imm 0 (global Toploop!)) "unique_use")
+   match_mini_anf_unique/319 =
+     (function {nlocal = 0} r/321[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (let
-         (y/322 =o (field_mut 1 r/320)
-          *match*/326 =[int] 1
-          r/323 =[(consts ()) (non_consts ([0: *, *]))]
-            (apply unique_use/283 r/320))
-         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/323 y/322))))
+         (y/323 =o (field_mut 1 r/321)
+          *match*/327 =[int] 1
+          r/324 =[(consts ()) (non_consts ([0: *, *]))]
+            (apply unique_use/284 r/321))
+         (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/324 y/323))))
   (apply (field_imm 1 (global Toploop!)) "match_mini_anf_unique"
-    match_mini_anf_unique/318))
+    match_mini_anf_unique/319))
 val match_mini_anf_unique : record @ unique -> record * string = <fun>
 |}]
 
@@ -177,23 +177,23 @@ let match_anf_aliased r =
   (r, y)
 [%%expect{|
 (let
-  (aliased_use/280 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
-   match_anf_aliased/328 =
-     (function {nlocal = 0} r/330[(consts ()) (non_consts ([0: *, *]))]
+  (aliased_use/281 = (apply (field_imm 0 (global Toploop!)) "aliased_use")
+   match_anf_aliased/329 =
+     (function {nlocal = 0} r/331[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (catch
-         (let (y/332 =a (field_imm 1 r/330))
-           (if (== y/332 "") (let (*match*/339 =[int] 0) (exit 8 y/332))
-             (let (*match*/337 =[int] 1) (exit 8 (field_imm 1 r/330)))))
-        with (8 y/331)
+         (let (y/333 =a (field_imm 1 r/331))
+           (if (== y/333 "") (let (*match*/340 =[int] 0) (exit 8 y/333))
+             (let (*match*/338 =[int] 1) (exit 8 (field_imm 1 r/331)))))
+        with (8 y/332)
          (let
-           (r/334 =[(consts ()) (non_consts ([0: *, *]))]
-              (apply aliased_use/280 r/330))
-           (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/334
-             y/331)))))
+           (r/335 =[(consts ()) (non_consts ([0: *, *]))]
+              (apply aliased_use/281 r/331))
+           (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/335
+             y/332)))))
   (apply (field_imm 1 (global Toploop!)) "match_anf_aliased"
-    match_anf_aliased/328))
+    match_anf_aliased/329))
 val match_anf_aliased : record -> record * string = <fun>
 |}]
 
@@ -208,24 +208,24 @@ let match_anf_unique r =
   (r, y)
 [%%expect{|
 (let
-  (unique_use/283 = (apply (field_imm 0 (global Toploop!)) "unique_use")
-   match_anf_unique/340 =
-     (function {nlocal = 0} r/342[(consts ()) (non_consts ([0: *, *]))]
+  (unique_use/284 = (apply (field_imm 0 (global Toploop!)) "unique_use")
+   match_anf_unique/341 =
+     (function {nlocal = 0} r/343[(consts ()) (non_consts ([0: *, *]))]
        [(consts ())
         (non_consts ([0: [(consts ()) (non_consts ([0: *, *]))], *]))]
        (catch
-         (let (y/344 =o (field_mut 1 r/342))
-           (if (== y/344 "") (let (*match*/351 =[int] 0) (exit 14 y/344))
-             (let (y/345 =o (field_mut 1 r/342) *match*/349 =[int] 1)
-               (exit 14 y/345))))
-        with (14 y/343)
+         (let (y/345 =o (field_mut 1 r/343))
+           (if (== y/345 "") (let (*match*/352 =[int] 0) (exit 14 y/345))
+             (let (y/346 =o (field_mut 1 r/343) *match*/350 =[int] 1)
+               (exit 14 y/346))))
+        with (14 y/344)
          (let
-           (r/346 =[(consts ()) (non_consts ([0: *, *]))]
-              (apply unique_use/283 r/342))
-           (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/346
-             y/343)))))
+           (r/347 =[(consts ()) (non_consts ([0: *, *]))]
+              (apply unique_use/284 r/343))
+           (makeblock 0 ([(consts ()) (non_consts ([0: *, *]))],*) r/347
+             y/344)))))
   (apply (field_imm 1 (global Toploop!)) "match_anf_unique"
-    match_anf_unique/340))
+    match_anf_unique/341))
 val match_anf_unique : record @ unique -> record * string = <fun>
 |}]
 
@@ -251,9 +251,9 @@ let swap_inner (t : tree) =
   | _ -> t
 [%%expect{|
 (let
-  (swap_inner/358 =
+  (swap_inner/359 =
      (function {nlocal = 0}
-       t/360[(consts (0))
+       t/361[(consts (0))
              (non_consts ([0: [(consts (0)) (non_consts ([0: *, [int], *]))],
                            [int],
                            [(consts (0)) (non_consts ([0: *, [int], *]))]]))]
@@ -261,11 +261,11 @@ let swap_inner (t : tree) =
         (non_consts ([0: [(consts (0)) (non_consts ([0: *, [int], *]))],
                       [int], [(consts (0)) (non_consts ([0: *, [int], *]))]]))]
        (catch
-         (if t/360
-           (let (*match*/369 =a (field_imm 0 t/360))
-             (if *match*/369
-               (let (*match*/373 =a (field_imm 2 t/360))
-                 (if *match*/373
+         (if t/361
+           (let (*match*/370 =a (field_imm 0 t/361))
+             (if *match*/370
+               (let (*match*/374 =a (field_imm 2 t/361))
+                 (if *match*/374
                    (makeblock 0 ([(consts (0))
                                   (non_consts ([0:
                                                 [(consts (0))
@@ -296,9 +296,9 @@ let swap_inner (t : tree) =
                                       [int],
                                       [(consts (0))
                                        (non_consts ([0: *, [int], *]))]]))])
-                       (field_imm 0 *match*/369) (field_int 1 *match*/369)
-                       (field_imm 0 *match*/373))
-                     (field_int 1 t/360)
+                       (field_imm 0 *match*/370) (field_int 1 *match*/370)
+                       (field_imm 0 *match*/374))
+                     (field_int 1 t/361)
                      (makeblock 0 ([(consts (0))
                                     (non_consts ([0:
                                                   [(consts (0))
@@ -315,13 +315,13 @@ let swap_inner (t : tree) =
                                       [int],
                                       [(consts (0))
                                        (non_consts ([0: *, [int], *]))]]))])
-                       (field_imm 2 *match*/369) (field_int 1 *match*/373)
-                       (field_imm 2 *match*/373)))
+                       (field_imm 2 *match*/370) (field_int 1 *match*/374)
+                       (field_imm 2 *match*/374)))
                    (exit 19)))
                (exit 19)))
            (exit 19))
-        with (19) t/360)))
-  (apply (field_imm 1 (global Toploop!)) "swap_inner" swap_inner/358))
+        with (19) t/361)))
+  (apply (field_imm 1 (global Toploop!)) "swap_inner" swap_inner/359))
 val swap_inner : tree -> tree = <fun>
 |}]
 
diff --git a/testsuite/tests/unboxed-primitive-args/common.ml b/testsuite/tests/unboxed-primitive-args/common.ml
index f3ed7ca9e78..440855bd5bd 100644
--- a/testsuite/tests/unboxed-primitive-args/common.ml
+++ b/testsuite/tests/unboxed-primitive-args/common.ml
@@ -8,6 +8,7 @@ type 'a typ =
   | Int64     : int64     typ
   | Nativeint : nativeint typ
   | Float     : float     typ
+  | Float32   : float32   typ
   | Float64x2 : float64x2 typ
   | Int64x2   : int64x2   typ
 
@@ -54,6 +55,9 @@ external float64x2_of_int64s : int64 -> int64 -> float64x2 = "" "vec128_of_int64
 external float64x2_low_int64 : float64x2 -> int64 = "" "vec128_low_int64" [@@noalloc] [@@unboxed]
 external float64x2_high_int64 : float64x2 -> int64 = "" "vec128_high_int64" [@@noalloc] [@@unboxed]
 
+external float32_of_float : float -> float32 = "%float32offloat"
+external float_of_float32 : float32 -> float = "%floatoffloat32"
+
 let string_of : type a. a typ -> a -> string = function
   | Int       -> Int.to_string
   | Int32     -> Printf.sprintf "%ldl"
@@ -61,6 +65,8 @@ let string_of : type a. a typ -> a -> string = function
   | Nativeint -> Printf.sprintf "%ndn"
   | Float     ->
       fun f -> Printf.sprintf "float_of_bits 0x%LxL" (Int64.bits_of_float f)
+  | Float32   ->
+      fun f -> Printf.sprintf "float32_of_bits 0x%lxl" (Int32.bits_of_float (float_of_float32 f))
   | Int64x2   ->
       fun v -> Printf.sprintf "int64x2 %016Lx:%016Lx" (int64x2_high_int64 v) (int64x2_low_int64 v)
   | Float64x2   ->
@@ -131,6 +137,9 @@ module Buffer = struct
     else
       fun buf ~arg x -> set_int64 buf ~arg (Int64.of_int x)
 
+  let get_float32 buf ~arg = get_int32 buf ~arg |> Int32.float_of_bits |> float32_of_float
+  let set_float32 buf ~arg x = set_int32 buf ~arg (Int32.bits_of_float (float_of_float32 x))
+
   let get_float buf ~arg = get_int64 buf ~arg |> Int64.float_of_bits
   let set_float buf ~arg x = set_int64 buf ~arg (Int64.bits_of_float x)
 
@@ -140,6 +149,7 @@ module Buffer = struct
     | Int64     -> get_int64
     | Nativeint -> get_nativeint
     | Float     -> get_float
+    | Float32   -> get_float32
     | Int64x2   -> get_int64x2
     | Float64x2 -> get_float64x2
 
@@ -149,6 +159,7 @@ module Buffer = struct
     | Int64     -> set_int64
     | Nativeint -> set_nativeint
     | Float     -> set_float
+    | Float32   -> set_float32
     | Int64x2   -> set_int64x2
     | Float64x2 -> set_float64x2
 
@@ -195,6 +206,7 @@ let typ_size : type a. a typ -> int = function
   | Int64     -> 8
   | Nativeint -> Sys.word_size / 8
   | Float     -> 8
+  | Float32   -> 4
   | Int64x2 | Float64x2 -> 16
 
 let rec sizes : type a. a proto -> int list = function
diff --git a/testsuite/tests/unboxed-primitive-args/common.mli b/testsuite/tests/unboxed-primitive-args/common.mli
index 454c589ffb5..a664fa0c6f5 100644
--- a/testsuite/tests/unboxed-primitive-args/common.mli
+++ b/testsuite/tests/unboxed-primitive-args/common.mli
@@ -5,6 +5,7 @@ type 'a typ =
   | Int64     : int64     typ
   | Nativeint : nativeint typ
   | Float     : float     typ
+  | Float32   : float32   typ
   | Float64x2 : float64x2 typ
   | Int64x2   : int64x2   typ
 
diff --git a/testsuite/tests/unboxed-primitive-args/gen_test.ml b/testsuite/tests/unboxed-primitive-args/gen_test.ml
index 5c54dc0996a..ba0d3e00eaa 100644
--- a/testsuite/tests/unboxed-primitive-args/gen_test.ml
+++ b/testsuite/tests/unboxed-primitive-args/gen_test.ml
@@ -6,9 +6,11 @@ type boxed_integer = Pnativeint | Pint32 | Pint64
 
 type boxed_vector = Pint64x2 | Pfloat64x2
 
+type boxed_float = Pfloat32 | Pfloat64
+
 type native_repr =
   | Same_as_ocaml_repr
-  | Unboxed_float
+  | Unboxed_float of boxed_float
   | Unboxed_integer of boxed_integer
   | Untagged_int
   | Unboxed_vector of boxed_vector
@@ -27,7 +29,8 @@ let test_all_combination_up_to_n_args = 5
    result representation in [manual_tests].
 *)
 let test_all_args_combination_of =
-  [ Unboxed_float
+  [ Unboxed_float Pfloat32
+  ; Unboxed_float Pfloat64
   ; Unboxed_integer Pint32
   ; Unboxed_integer Pint64
   ; Unboxed_vector Pint64x2
@@ -36,7 +39,8 @@ let test_all_args_combination_of =
 
 let code_of_repr = function
   | Same_as_ocaml_repr         -> "v" (* for "value" *)
-  | Unboxed_float              -> "f"
+  | Unboxed_float Pfloat64     -> "f"
+  | Unboxed_float Pfloat32     -> "s"
   | Unboxed_integer Pint32     -> "l"
   | Unboxed_integer Pint64     -> "L"
   | Unboxed_integer Pnativeint -> "n"
@@ -46,7 +50,8 @@ let code_of_repr = function
 
 let repr_of_code = function
   | 'v' -> Same_as_ocaml_repr
-  | 'f' -> Unboxed_float
+  | 'f' -> Unboxed_float Pfloat64
+  | 's' -> Unboxed_float Pfloat32
   | 'l' -> Unboxed_integer Pint32
   | 'L' -> Unboxed_integer Pint64
   | 'n' -> Unboxed_integer Pnativeint
@@ -58,6 +63,7 @@ let repr_of_code = function
 let manual_tests =
   [ "v_v"
   ; "f_f"
+  ; "s_s"
   ; "l_l"
   ; "L_L"
   ; "n_n"
@@ -67,6 +73,7 @@ let manual_tests =
   ; "f_ffffff"
   ; "f_fffffff"
   ; "f_fffffffffffffffff"
+  ; "s_sssssssssssssssss"
   ; "x_xxxxx"
   ; "x_xxxxxx"
   ; "x_xxxxxxx"
@@ -83,12 +90,17 @@ let manual_tests =
   ; "v_lfxlfxlfxlfxlfxlfx"
   ; "v_lflxlxlflflxlxlflx"
   ; "v_llllllfffffflxxllxx"
+  ; "v_ssssssssssssss"
+  ; "v_llllslssfffslxsllxx"
+  ; "v_fsfsfsfsfsfsfsfsfs"
+  ; "v_fffsssfffffssssff"
   ]
 
 let ocaml_type_of_repr = function
   (* Doesn't really matters what we choose for this case *)
   | Same_as_ocaml_repr         -> "int"
-  | Unboxed_float              -> "(float [@unboxed])"
+  | Unboxed_float Pfloat64     -> "(float [@unboxed])"
+  | Unboxed_float Pfloat32     -> "(float32 [@unboxed])"
   | Unboxed_integer Pint32     -> "(int32 [@unboxed])"
   | Unboxed_integer Pint64     -> "(int64 [@unboxed])"
   | Unboxed_integer Pnativeint -> "(nativeint [@unboxed])"
@@ -99,7 +111,8 @@ let ocaml_type_of_repr = function
 let ocaml_type_gadt_of_repr = function
   (* Doesn't really matters what we choose for this case *)
   | Same_as_ocaml_repr         -> "Int"
-  | Unboxed_float              -> "Float"
+  | Unboxed_float Pfloat64     -> "Float"
+  | Unboxed_float Pfloat32     -> "Float32"
   | Unboxed_integer Pint32     -> "Int32"
   | Unboxed_integer Pint64     -> "Int64"
   | Unboxed_integer Pnativeint -> "Nativeint"
@@ -109,7 +122,8 @@ let ocaml_type_gadt_of_repr = function
 
 let c_type_of_repr = function
   | Same_as_ocaml_repr         -> "value"
-  | Unboxed_float              -> "double"
+  | Unboxed_float Pfloat64     -> "double"
+  | Unboxed_float Pfloat32     -> "float"
   | Unboxed_integer Pint32     -> "int32_t"
   | Unboxed_integer Pint64     -> "int64_t"
   | Unboxed_integer Pnativeint -> "intnat"
@@ -244,7 +258,8 @@ let generate_stubs () =
         pr "  %(%d%d%);"
           (match p with
            | Same_as_ocaml_repr         -> "set_intnat(%d, Long_val(x%d))"
-           | Unboxed_float              -> "set_double(%d, x%d)"
+           | Unboxed_float Pfloat64     -> "set_double(%d, x%d)"
+           | Unboxed_float Pfloat32     -> "set_float(%d, x%d)"
            | Unboxed_integer Pint32     -> "set_int32(%d, x%d)"
            | Unboxed_integer Pint64     -> "set_int64(%d, x%d)"
            | Unboxed_integer Pnativeint -> "set_intnat(%d, x%d)"
@@ -255,7 +270,8 @@ let generate_stubs () =
       pr "  return %(%d%);"
         (match proto.return with
          | Same_as_ocaml_repr         -> "Val_long(get_intnat(%d))"
-         | Unboxed_float              -> "get_double(%d)"
+         | Unboxed_float Pfloat64     -> "get_double(%d)"
+         | Unboxed_float Pfloat32     -> "get_float(%d)"
          | Unboxed_integer Pint32     -> "get_int32(%d)"
          | Unboxed_integer Pint64     -> "get_int64(%d)"
          | Unboxed_integer Pnativeint -> "get_intnat(%d)"
diff --git a/testsuite/tests/unboxed-primitive-args/test.ml b/testsuite/tests/unboxed-primitive-args/test.ml
index e3f7c3ec4e5..cad15e28c03 100644
--- a/testsuite/tests/unboxed-primitive-args/test.ml
+++ b/testsuite/tests/unboxed-primitive-args/test.ml
@@ -1,6 +1,7 @@
 (* TEST
  readonly_files = "common.mli common.ml test_common.c test_common.h";
  flambda2;
+ arch_amd64;
  setup-ocamlopt.opt-build-env;
  test_file = "${test_source_directory}/gen_test.ml";
  ocaml_script_as_argument = "true";
@@ -10,8 +11,8 @@
  arguments = "ml";
  compiler_output = "main.ml";
  ocaml;
- ocamlopt_flags = "-extension simd -cc '${cc} -msse4.2'";
- all_modules = "test_common.c stubs.c common.mli common.ml test0.ml test1.ml main.ml";
+ ocamlopt_flags = "-extension simd -extension small_numbers -cc '${cc} -msse4.2'";
+ all_modules = "test_common.c stubs.c common.mli common.ml test0.ml test1.ml test2.ml test3.ml test4.ml main.ml";
  ocamlopt.opt;
  run;
  check-program-output;
diff --git a/testsuite/tests/unboxed-primitive-args/test_common.h b/testsuite/tests/unboxed-primitive-args/test_common.h
index 93e9a85b680..be2553b2972 100644
--- a/testsuite/tests/unboxed-primitive-args/test_common.h
+++ b/testsuite/tests/unboxed-primitive-args/test_common.h
@@ -39,6 +39,7 @@ extern char *c_buffer;
 #define get_int32(n) *(int32_t*)(ocaml_buffer+((n)*STRIDE))
 #define get_int64(n) *(int64_t*)(ocaml_buffer+((n)*STRIDE))
 #define get_double(n) *(double*)(ocaml_buffer+((n)*STRIDE))
+#define get_float(n) *(float*)(ocaml_buffer+((n)*STRIDE))
 #define get_int128(n) _mm_loadu_si128((__m128i*)(ocaml_buffer+((n)*STRIDE)))
 #define get_float128(n) _mm_loadu_pd((double*)(ocaml_buffer+((n)*STRIDE)))
 
@@ -46,6 +47,7 @@ extern char *c_buffer;
 #define set_int32(n, x) *(int32_t*)(c_buffer+((n)*STRIDE)) = (x)
 #define set_int64(n, x) *(int64_t*)(c_buffer+((n)*STRIDE)) = (x)
 #define set_double(n, x) *(double*)(c_buffer+((n)*STRIDE)) = (x)
+#define set_float(n, x) *(float*)(c_buffer+((n)*STRIDE)) = (x)
 #define set_int128(n, x) _mm_storeu_si128((__m128i*)(c_buffer+((n)*STRIDE)), (x))
 #define set_float128(n, x) _mm_storeu_pd((double*)(c_buffer+((n)*STRIDE)), (x))
 

From 507277dd619eae7a1813165dba699f82783b38be Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Mon, 2 Dec 2024 16:29:18 +0000
Subject: [PATCH 09/11] Test promotions and fixes

---
 testsuite/tests/effects/backtrace.byte.reference | 6 ++++++
 testsuite/tests/effects/backtrace.ml             | 5 ++++-
 testsuite/tests/effects/test_lazy.ml             | 2 ++
 3 files changed, 12 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/effects/backtrace.byte.reference

diff --git a/testsuite/tests/effects/backtrace.byte.reference b/testsuite/tests/effects/backtrace.byte.reference
new file mode 100644
index 00000000000..60acec92aa9
--- /dev/null
+++ b/testsuite/tests/effects/backtrace.byte.reference
@@ -0,0 +1,6 @@
+Raised at Stdlib.failwith in file "stdlib.ml", line 35, characters 17-33
+Called from Backtrace.foo in file "backtrace.ml", line 14, characters 11-27
+Called from Backtrace.bar in file "backtrace.ml", line 22, characters 4-9
+Called from Backtrace.task1 in file "backtrace.ml", line 31, characters 4-10
+Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "stdlib/effect.ml", line 68, characters 41-75
+Called from Backtrace.task2 in file "backtrace.ml", line 38, characters 4-16
diff --git a/testsuite/tests/effects/backtrace.ml b/testsuite/tests/effects/backtrace.ml
index e4fd22dddf3..dc0a6879cd3 100644
--- a/testsuite/tests/effects/backtrace.ml
+++ b/testsuite/tests/effects/backtrace.ml
@@ -59,6 +59,9 @@ let _ = main ()
  flags = "-g";
  ocamlrunparam += ",b=1";
  runtime5;
- { bytecode; }
+ {
+   reference="${test_source_directory}/backtrace.byte.reference";
+   bytecode;
+ }
  { native; }
 *)
diff --git a/testsuite/tests/effects/test_lazy.ml b/testsuite/tests/effects/test_lazy.ml
index dc9d7dc0999..fb1df3a425e 100644
--- a/testsuite/tests/effects/test_lazy.ml
+++ b/testsuite/tests/effects/test_lazy.ml
@@ -1,4 +1,6 @@
 (* TEST
+   reason = "CR ocaml 5 domains: re-enable this test";
+   skip;
    runtime5;
    { bytecode; }
    { native; }

From 16720ac3a303840a27f6683b92c1bb29a65c52ab Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Mon, 2 Dec 2024 16:33:37 +0000
Subject: [PATCH 10/11] Test promotions and fixes

---
 testsuite/tests/effects/unhandled_unlinked.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/testsuite/tests/effects/unhandled_unlinked.ml b/testsuite/tests/effects/unhandled_unlinked.ml
index f1296130826..b02af4115e7 100644
--- a/testsuite/tests/effects/unhandled_unlinked.ml
+++ b/testsuite/tests/effects/unhandled_unlinked.ml
@@ -1,5 +1,6 @@
 (* TEST
    runtime5;
+   exit_status = "2";
    { bytecode; }
    { native; }
 *)

From a943dfc26f4f3be23019cdb57dde6b3c77a92d42 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@pm.me>
Date: Mon, 2 Dec 2024 16:36:42 +0000
Subject: [PATCH 11/11] Enable test

---
 testsuite/tests/typing-local/effects.ml | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/testsuite/tests/typing-local/effects.ml b/testsuite/tests/typing-local/effects.ml
index 66671c2d7c5..84e5d087799 100644
--- a/testsuite/tests/typing-local/effects.ml
+++ b/testsuite/tests/typing-local/effects.ml
@@ -1,3 +1,9 @@
+(* TEST
+   runtime5;
+   { bytecode; }
+   { native; }
+*)
+
 open Effect
 open Effect.Deep
 
@@ -172,7 +178,7 @@ let[@inline never] g1_local_alloc x y =
   Gc.compact ();
   let in_minor = opaque (opaque x, opaque y) in
   Gc.full_major (); (* XXX *)
-  local_ (opaque (opaque in_minor, opaque in_minor))
+  exclave_ (opaque (opaque in_minor, opaque in_minor))
 
 let g1_comp () =
   let p = g1_local_alloc 1 2 in