Support for locals in the 5.x runtime (#2066)

* Basic runtime support for stack allocations

Follows the structure of the 4.14 implementation, except that it
uses the NON_MARKABLE colour (shared by externals and statics)
instead of using Caml_blue.

* Stack allocation primitives for arrays, strings, etc.

* Missing CAMLextern

* Fix Cmm_helpers definitions of caml_local

* Fix get_header test

---------

Co-authored-by: Mark Shinwell <[email protected]>

Author: stedolan

backend/cmm_helpers.ml

@@ -49,7 +49,8 @@ let bind_list name args fn =
 
 let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
 
-let caml_local = Nativeint.shift_left (Nativeint.of_int 2) 8
+let caml_local =
+  Nativeint.shift_left (Nativeint.of_int (if Config.runtime5 then 3 else 2)) 8
 (* cf. runtime/caml/gc.h *)
 
 (* Loads *)

ocaml/asmcomp/cmm_helpers.ml

@@ -38,7 +38,9 @@ let bind_nonvar name arg fn =
   | _ -> let id = V.create_local name in Clet(VP.create id, arg, fn (Cvar id))
 
 let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
-let caml_local = Nativeint.shift_left (Nativeint.of_int 2) 8
+let caml_local =
+  Nativeint.shift_left (Nativeint.of_int (if Config.runtime5 then 3 else 2)) 8
+(* cf. runtime/caml/gc.h *)
     (* cf. runtime/caml/gc.h *)
 
 (* Loads *)

ocaml/configure

@@ -2120,8 +2120,6 @@ AS_CASE([$host],
 
 if [[ x"$enable_runtime5" = x"yes" ]]; then
   runtime_suffix=
-  # CR ocaml 5 runtime: forward port locals
-  enable_stack_allocation="no"
 else
   runtime_suffix=4
 fi

ocaml/configure.ac

@@ -80,6 +80,7 @@ struct caml_thread_struct {
   /* Note: we do not save Caml_state->stack_cache, because it can
      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;
   int backtrace_pos;           /* saved value of Caml_state->backtrace_pos */
   backtrace_slot * backtrace_buffer;
     /* saved value of Caml_state->backtrace_buffer */
@@ -173,7 +174,8 @@ static void caml_thread_scan_roots(
       if (th != Active_thread) {
         if (th->current_stack != NULL)
           caml_do_local_roots(action, fflags, fdata,
-                              th->local_roots, th->current_stack, th->gc_regs);
+                              th->local_roots, th->current_stack, th->gc_regs,
+                              th->local_arenas);
       }
       th = th->next;
     } while (th != Active_thread);
@@ -198,6 +200,7 @@ static void save_runtime_state(void)
   this_thread->gc_regs_buckets = Caml_state->gc_regs_buckets;
   this_thread->exn_handler = Caml_state->exn_handler;
   this_thread->local_roots = Caml_state->local_roots;
+  this_thread->local_arenas = caml_get_local_arenas(Caml_state);
   this_thread->backtrace_pos = Caml_state->backtrace_pos;
   this_thread->backtrace_buffer = Caml_state->backtrace_buffer;
   this_thread->backtrace_last_exn = Caml_state->backtrace_last_exn;
@@ -218,6 +221,7 @@ static void restore_runtime_state(caml_thread_t th)
   Caml_state->gc_regs_buckets = th->gc_regs_buckets;
   Caml_state->exn_handler = th->exn_handler;
   Caml_state->local_roots = th->local_roots;
+  caml_set_local_arenas(Caml_state, th->local_arenas);
   Caml_state->backtrace_pos = th->backtrace_pos;
   Caml_state->backtrace_buffer = th->backtrace_buffer;
   Caml_state->backtrace_last_exn = th->backtrace_last_exn;
@@ -285,6 +289,7 @@ static caml_thread_t caml_thread_new_info(void)
   }
   th->c_stack = NULL;
   th->local_roots = NULL;
+  th->local_arenas = NULL;
   th->backtrace_pos = 0;
   th->backtrace_buffer = NULL;
   th->backtrace_last_exn = Val_unit;
@@ -321,6 +326,8 @@ void caml_thread_free_info(caml_thread_t th)
   caml_free_stack(th->current_stack);
   caml_free_backtrace_buffer(th->backtrace_buffer);
 
+  // CR sdolan: free local arenas
+
   /* Remark: we could share gc_regs_buckets between threads on a same
      domain, but this might break the invariant that it is always
      non-empty at the point where we switch from OCaml to C, so we

ocaml/otherlibs/systhreads/st_stubs.c

@@ -193,6 +193,20 @@ CAMLexport value caml_alloc_string (mlsize_t len)
   return result;
 }
 
+/* [len] is a number of bytes (chars) */
+CAMLexport value caml_alloc_local_string (mlsize_t len)
+{
+  mlsize_t offset_index;
+  mlsize_t wosize = (len + sizeof (value)) / sizeof (value);
+  value result;
+
+  result = caml_alloc_local(wosize, String_tag);
+  Field (result, wosize - 1) = 0;
+  offset_index = Bsize_wsize (wosize) - 1;
+  Byte (result, offset_index) = offset_index - len;
+  return result;
+}
+
 /* [len] is a number of bytes (chars) */
 CAMLexport value caml_alloc_initialized_string (mlsize_t len, const char *p)
 {

ocaml/runtime/alloc.c

@@ -581,6 +581,20 @@ CFI_STARTPROC
 CFI_ENDPROC
 ENDFUNCTION(G(caml_allocN))
 
+FUNCTION(G(caml_call_local_realloc))
+CFI_STARTPROC
+        CFI_SIGNAL_FRAME
+        ENTER_FUNCTION
+        SAVE_ALL_REGS
+        SWITCH_OCAML_TO_C
+        C_call  (GCALL(caml_local_realloc))
+        SWITCH_C_TO_OCAML
+        RESTORE_ALL_REGS
+        LEAVE_FUNCTION
+        ret
+CFI_ENDPROC
+ENDFUNCTION(G(caml_call_local_realloc))
+
 /******************************************************************************/
 /* Call a C function from OCaml */
 /******************************************************************************/