remove caml_root API

otherlibs/systhreads/st_stubs.c

@@ -66,7 +66,7 @@ struct caml_thread_struct {
   struct longjmp_buffer *exit_buf;
   int backtrace_pos;
   code_t * backtrace_buffer;
-  caml_root backtrace_last_exn;
+  value backtrace_last_exn;
   value * gc_regs;
   value * gc_regs_buckets;
   value ** gc_regs_slot;
@@ -153,7 +153,7 @@ void caml_thread_save_runtime_state(void)
   Current_thread->local_roots = Caml_state->local_roots;
   Current_thread->backtrace_pos = Caml_state->backtrace_pos;
   Current_thread->backtrace_buffer = Caml_state->backtrace_buffer;
-  Current_thread->backtrace_last_exn = Caml_state->backtrace_last_exn;
+  caml_modify_generational_global_root(&Current_thread->backtrace_last_exn, Caml_state->backtrace_last_exn);
   #ifndef NATIVE_CODE
   Current_thread->trap_sp_off = Caml_state->trap_sp_off;
   Current_thread->trap_barrier_off = Caml_state->trap_barrier_off;
@@ -172,7 +172,7 @@ void caml_thread_restore_runtime_state(void)
   Caml_state->local_roots = Current_thread->local_roots;
   Caml_state->backtrace_pos = Current_thread->backtrace_pos;
   Caml_state->backtrace_buffer = Current_thread->backtrace_buffer;
-  Caml_state->backtrace_last_exn = Current_thread->backtrace_last_exn;
+  caml_modify_generational_global_root(&Caml_state->backtrace_last_exn, Current_thread->backtrace_last_exn);
   #ifndef NATIVE_CODE
   Caml_state->trap_sp_off = Current_thread->trap_sp_off;
   Caml_state->trap_barrier_off = Current_thread->trap_barrier_off;
@@ -221,11 +221,12 @@ static caml_thread_t caml_thread_new_info(void)
   th->exit_buf = NULL;
   th->backtrace_pos = 0;
   th->backtrace_buffer = NULL;
-  th->backtrace_last_exn = caml_create_root(Val_unit);
+  th->backtrace_last_exn = Val_unit;
   th->gc_regs = NULL;
   th->gc_regs_buckets = NULL;
   th->gc_regs_slot = NULL;
   th->exn_handler = NULL;
+  caml_register_generational_global_root(&th->backtrace_last_exn);
 
   #ifndef NATIVE_CODE
   th->trap_sp_off = 1;
@@ -266,7 +267,7 @@ static void caml_thread_remove_info(caml_thread_t th)
   th->next->prev = th->prev;
   th->prev->next = th->next;
   caml_free_stack(th->current_stack);
-  caml_delete_root(th->backtrace_last_exn);
+  caml_remove_generational_global_root(&th->backtrace_last_exn);
   caml_stat_free(th);
   return;
 }
@@ -282,7 +283,7 @@ static void caml_thread_reinitialize(void)
   while (th != Current_thread) {
     next = th->next;
     caml_free_stack(th->current_stack);
-    caml_delete_root(th->backtrace_last_exn);
+    caml_remove_generational_global_root(&th->backtrace_last_exn);
     caml_stat_free(th);
     th = next;
   }

runtime/backtrace.c

@@ -29,11 +29,6 @@
 #include "caml/debugger.h"
 #include "caml/startup.h"
 
-void caml_init_backtrace(void)
-{
-  return;
-}
-
 /* Start or stop the backtrace machinery */
 CAMLprim value caml_record_backtrace(value vflag)
 {
@@ -43,10 +38,9 @@ CAMLprim value caml_record_backtrace(value vflag)
     Caml_state->backtrace_active = flag;
     Caml_state->backtrace_pos = 0;
     if (flag) {
-      Caml_state->backtrace_last_exn = caml_create_root(Val_unit);
+      caml_modify_generational_global_root(&Caml_state->backtrace_last_exn, Val_unit);
     } else {
-      caml_delete_root(Caml_state->backtrace_last_exn);
-      Caml_state->backtrace_last_exn = NULL;
+      caml_remove_generational_global_root(&Caml_state->backtrace_last_exn);
     }
   }
   return Val_unit;
@@ -205,8 +199,7 @@ CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace)
 
   caml_domain_state* domain_state = Caml_state;
 
-  if (domain_state->backtrace_last_exn != NULL)
-    caml_modify_root (domain_state->backtrace_last_exn, exn);
+  caml_modify_generational_global_root (&domain_state->backtrace_last_exn, exn);
 
   bt_size = Wosize_val(backtrace);
   if(bt_size > BACKTRACE_BUFFER_SIZE){

runtime/backtrace_byt.c

@@ -273,9 +273,9 @@ void caml_stash_backtrace(value exn, value * sp, int reraise)
 {
   value *trap_sp;
 
-  if (exn != caml_read_root(Caml_state->backtrace_last_exn) || !reraise) {
+  if (exn != Caml_state->backtrace_last_exn || !reraise) {
     Caml_state->backtrace_pos = 0;
-    caml_modify_root(Caml_state->backtrace_last_exn, exn);
+    caml_modify_generational_global_root(&Caml_state->backtrace_last_exn, exn);
   }
 
   if (Caml_state->backtrace_buffer == NULL &&

runtime/backtrace_nat.c

@@ -80,9 +80,9 @@ void caml_stash_backtrace(value exn, uintnat pc, char * sp, char* trapsp)
   caml_domain_state* domain_state = Caml_state;
   caml_frame_descrs fds;
 
-  if (exn != caml_read_root(domain_state->backtrace_last_exn)) {
+  if (exn != domain_state->backtrace_last_exn) {
     domain_state->backtrace_pos = 0;
-    caml_modify_root(domain_state->backtrace_last_exn, exn);
+    caml_modify_generational_global_root(&domain_state->backtrace_last_exn, exn);
   }
 
   if (Caml_state->backtrace_buffer == NULL &&

runtime/callback.c

@@ -272,7 +272,7 @@ CAMLexport value caml_callbackN (value closure, int narg, value args[])
 /* Naming of OCaml values */
 
 struct named_value {
-  caml_root val;
+  value val;
   struct named_value * next;
   char name[1];
 };
@@ -304,7 +304,7 @@ CAMLprim value caml_register_named_value(value vname, value val)
   caml_plat_lock(&named_value_lock);
   for (nv = named_value_table[h]; nv != NULL; nv = nv->next) {
     if (strcmp(name, nv->name) == 0) {
-      caml_modify_root(nv->val, val);
+      caml_modify_generational_global_root(&nv->val, val);
       found = 1;
       break;
     }
@@ -313,9 +313,10 @@ CAMLprim value caml_register_named_value(value vname, value val)
     nv = (struct named_value *)
       caml_stat_alloc(sizeof(struct named_value) + namelen);
     memcpy(nv->name, name, namelen + 1);
-    nv->val = caml_create_root(val);
+    nv->val = val;
     nv->next = named_value_table[h];
     named_value_table[h] = nv;
+    caml_register_generational_global_root(&nv->val);
   }
   caml_plat_unlock(&named_value_lock);
   return Val_unit;
@@ -324,18 +325,17 @@ CAMLprim value caml_register_named_value(value vname, value val)
 CAMLexport const value* caml_named_value(char const *name)
 {
   struct named_value * nv;
-  caml_root ret = NULL;
   caml_plat_lock(&named_value_lock);
   for (nv = named_value_table[hash_value_name(name)];
        nv != NULL;
        nv = nv->next) {
     if (strcmp(name, nv->name) == 0){
-      ret = nv->val;
-      break;
+      caml_plat_unlock(&named_value_lock);
+      return &nv->val;
     }
   }
   caml_plat_unlock(&named_value_lock);
-  return Op_val(ret);
+  return NULL;
 }
 
 CAMLexport int caml_get_callback_depth ()

runtime/caml/domain_state.h

@@ -25,8 +25,6 @@
 
 #include "misc.h"
 
-typedef struct caml_root_private* caml_root;
-
 /* This structure sits in the TLS area and is also accessed efficiently
  * via native code, which is why the indices are important */
 typedef struct {

runtime/caml/domain_state.tbl

@@ -84,7 +84,7 @@ DOMAIN_STATE(intnat, backtrace_active)
 
 DOMAIN_STATE(code_t*, backtrace_buffer)
 
-DOMAIN_STATE(caml_root, backtrace_last_exn)
+DOMAIN_STATE(value, backtrace_last_exn)
 
 DOMAIN_STATE(intnat, compare_unordered)
 
@@ -113,7 +113,7 @@ DOMAIN_STATE(struct pool**, pools_to_rescan)
 DOMAIN_STATE(int, pools_to_rescan_len)
 DOMAIN_STATE(int, pools_to_rescan_count)
 
-DOMAIN_STATE(caml_root, dls_root)
+DOMAIN_STATE(value, dls_root)
 /* Domain-local state */
 
 DOMAIN_STATE(value, unique_token_root)

runtime/caml/fiber.h

@@ -77,7 +77,7 @@ struct c_stack_link {
 #define NUM_STACK_SIZE_CLASSES 5
 
 /* The table of global identifiers */
-extern caml_root caml_global_data;
+extern value caml_global_data;
 
 #define Trap_pc(tp) ((tp)[0])
 #define Trap_link(tp) ((tp)[1])

runtime/caml/memory.h

@@ -563,26 +563,6 @@ struct caml__roots_block {
 
 #define End_roots() CAML_LOCAL_ROOTS = caml__roots_block.next; }
 
-/* [caml_create_root] creates a new GC root, initialised to the given
-   value.  The value stored in this root may only be read and written
-   with [caml_read_root] and [caml_modify_root]. */
-
-CAMLextern caml_root caml_create_root (value);
-CAMLextern caml_root caml_create_root_noexc(value);
-
-/* [caml_delete_root] deletes a root created by caml_create_root */
-
-CAMLextern void caml_delete_root (caml_root);
-
-/* [caml_read_root] loads the value stored in a root */
-
-CAMLextern value caml_read_root (caml_root);
-
-/* [caml_modify_root] stores a new value in a root */
-
-CAMLextern void caml_modify_root (caml_root, value);
-
-
 /** Compatability with old C-API **/
 
 /* [caml_register_global_root] registers a global C variable as a memory root

runtime/debugger.c

@@ -35,7 +35,7 @@
 int caml_debugger_in_use = 0;
 uintnat caml_event_count;
 int caml_debugger_fork_mode = 1; /* parent by default */
-caml_root marshal_flags;
+value marshal_flags;
 
 #if !defined(HAS_SOCKETS) || defined(NATIVE_CODE)
 
@@ -192,7 +192,8 @@ void caml_debugger_init(void)
   flags = caml_alloc(2, Tag_cons);
   Store_field(flags, 0, Val_int(1)); /* Marshal.Closures */
   Store_field(flags, 1, Val_emptylist);
-  marshal_flags = caml_create_root(flags);
+  marshal_flags = flags;
+  caml_register_generational_global_root(&marshal_flags);
 
   a = caml_secure_getenv(T("CAML_DEBUG_SOCKET"));
   address = a ? caml_stat_strdup_of_os(a) : NULL;
@@ -284,7 +285,7 @@ static void safe_output_value(struct channel *chan, value val)
   saved_external_raise = Caml_state->external_raise;
   if (sigsetjmp(raise_buf.buf, 0) == 0) {
     Caml_state->external_raise = &exception_ctx;
-    caml_output_val(chan, val, caml_read_root(marshal_flags));
+    caml_output_val(chan, val, marshal_flags);
   } else {
     /* Send wrong magic number, will cause [caml_input_value] to fail */
     caml_really_putblock(chan, "\000\000\000\000", 4);
@@ -523,7 +524,7 @@ void caml_debugger(enum event_kind event, value param)
       break;
     case REQ_GET_GLOBAL:
       i = caml_getword(dbg_in);
-      putval(dbg_out, Field(caml_read_root(caml_global_data), i));
+      putval(dbg_out, Field(caml_global_data, i));
       caml_flush(dbg_out);
       break;
     case REQ_GET_ACCU:

runtime/domain.c

@@ -276,10 +276,11 @@ static void create_domain(uintnat initial_minor_heap_wsize) {
       goto reallocate_minor_heap_failure;
     }
 
-    domain_state->dls_root = caml_create_root_noexc(Val_unit);
-    if(domain_state->dls_root == NULL) {
+    domain_state->dls_root = Val_unit;
+    if(domain_state->dls_root == (value)NULL) {
       goto create_dls_root_failure;
     }
+    caml_register_generational_global_root(&domain_state->dls_root);
 
     domain_state->unique_token_root = caml_alloc_shr_noexc(Abstract_tag, Val_unit);
     if(domain_state->unique_token_root == (value)NULL) {
@@ -300,6 +301,8 @@ static void create_domain(uintnat initial_minor_heap_wsize) {
     }
 
     domain_state->backtrace_buffer = NULL;
+    domain_state->backtrace_last_exn = Val_unit;
+    caml_register_generational_global_root(&domain_state->backtrace_last_exn);
 #ifndef NATIVE_CODE
     domain_state->external_raise = NULL;
     domain_state->trap_sp_off = 1;
@@ -321,7 +324,7 @@ static void create_domain(uintnat initial_minor_heap_wsize) {
 alloc_main_stack_failure:
 create_stack_cache_failure:
   caml_remove_generational_global_root(&domain_state->unique_token_root);
-  caml_delete_root(domain_state->dls_root);
+  caml_remove_generational_global_root(&domain_state->dls_root);
 create_unique_token_failure:
 create_dls_root_failure:
 reallocate_minor_heap_failure:
@@ -422,7 +425,7 @@ enum domain_status { Dom_starting, Dom_started, Dom_failed };
 struct domain_startup_params {
   struct interruptor* parent;
   enum domain_status status;
-  caml_root callback;
+  value* callback;
   dom_internal* newdom;
   uintnat unique_id;
 };
@@ -534,7 +537,7 @@ static void domain_terminate();
 static void* domain_thread_func(void* v)
 {
   struct domain_startup_params* p = v;
-  caml_root callback = p->callback;
+  value *domain_callback = (value*) p->callback;
 
   create_domain(caml_params->init_minor_heap_wsz);
   p->newdom = domain_self;
@@ -555,8 +558,9 @@ static void* domain_thread_func(void* v)
     caml_gc_log("Domain starting (unique_id = %"ARCH_INTNAT_PRINTF_FORMAT"u)",
                 domain_self->interruptor.unique_id);
     caml_domain_start_hook();
-    caml_callback(caml_read_root(callback), Val_unit);
-    caml_delete_root(callback);
+    caml_callback(*domain_callback, Val_unit);
+    caml_remove_generational_global_root(domain_callback);
+    caml_stat_free(domain_callback);
     domain_terminate();
   } else {
     caml_gc_log("Failed to create domain");
@@ -577,7 +581,9 @@ CAMLprim value caml_domain_spawn(value callback)
   p.parent = &domain_self->interruptor;
   p.status = Dom_starting;
 
-  p.callback = caml_create_root(callback);
+  p.callback = (value*) caml_stat_alloc_noexc(sizeof(value));
+  *p.callback = callback;
+  caml_register_generational_global_root(p.callback);
 
   err = pthread_create(&th, 0, domain_thread_func, (void*)&p);
   if (err) {
@@ -599,7 +605,8 @@ CAMLprim value caml_domain_spawn(value callback)
     Assert (p.status == Dom_failed);
     /* failed */
     pthread_join(th, 0);
-    caml_delete_root(p.callback);
+    caml_remove_generational_global_root(p.callback);
+    caml_stat_free(p.callback);
     caml_failwith("failed to allocate domain");
   }
   install_backup_thread(domain_self);
@@ -1264,7 +1271,6 @@ static void domain_terminate()
   int finished = 0;
 
   caml_gc_log("Domain terminating");
-  caml_delete_root(domain_state->dls_root);
   s->terminating = 1;
 
   while (!finished) {
@@ -1311,6 +1317,8 @@ static void domain_terminate()
   }
   caml_sample_gc_collect(domain_state);
   caml_remove_generational_global_root(&domain_state->unique_token_root);
+  caml_remove_generational_global_root(&domain_state->dls_root);
+  caml_remove_generational_global_root(&domain_state->backtrace_last_exn);
 
   caml_stat_free(domain_state->final_info);
   // run the domain termination hook
@@ -1576,12 +1584,12 @@ CAMLprim value caml_ml_domain_cpu_relax(value t)
 CAMLprim value caml_domain_dls_set(value t)
 {
   CAMLnoalloc;
-  caml_modify_root(Caml_state->dls_root, t);
+  caml_modify_generational_global_root(&Caml_state->dls_root, t);
   return Val_unit;
 }
 
 CAMLprim value caml_domain_dls_get(value unused)
 {
   CAMLnoalloc;
-  return caml_read_root(Caml_state->dls_root);
+  return Caml_state->dls_root;
 }