Locals x effects

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;

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,13 +318,25 @@
         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;                     \
         CFI_DEF_CFA_OFFSET(8);                            \
     /* 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

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). */

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)

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);

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;

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 */
 

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 */
 

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;

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;

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));
       }