add in_minor_collection and port #1743 (Add some checks that the mi…

…nor GC does not recurse) (#2075)
ocaml-flambda · Nov 23, 2023 · 2418ffb · 2418ffb
1 parent c31e025
commit 2418ffb
Show file tree

Hide file tree

Showing 5 changed files with 11 additions and 0 deletions.
diff --git a/ocaml/otherlibs/systhreads/st_stubs.c b/ocaml/otherlibs/systhreads/st_stubs.c
@@ -188,6 +188,8 @@ static void caml_thread_scan_roots(
 
 static void save_runtime_state(void)
 {
+  if (Caml_state->in_minor_collection)
+    caml_fatal_error("Thread switch from inside minor GC");
   CAMLassert(This_thread != NULL);
   caml_thread_t this_thread = This_thread;
   this_thread->current_stack = Caml_state->current_stack;

diff --git a/ocaml/runtime/caml/domain_state.tbl b/ocaml/runtime/caml/domain_state.tbl
@@ -109,6 +109,8 @@ DOMAIN_STATE(int, parser_trace)
 
 DOMAIN_STATE(asize_t, minor_heap_wsz)
 
+DOMAIN_STATE(intnat, in_minor_collection)
+
 DOMAIN_STATE(struct caml_heap_state*, shared_heap)
 
 DOMAIN_STATE(int, id)

diff --git a/ocaml/runtime/caml/minor_gc.h b/ocaml/runtime/caml/minor_gc.h
@@ -27,6 +27,7 @@
 #define caml_young_alloc_start Caml_state->young_start
 #define caml_young_alloc_end Caml_state->young_end
 #define caml_minor_heap_wsz Caml_state->minor_heap_wsz
+#define caml_in_minor_collection Caml_state->in_minor_collection
 
 
 #define CAML_TABLE_STRUCT(t) { \

diff --git a/ocaml/runtime/domain.c b/ocaml/runtime/domain.c
@@ -629,6 +629,8 @@ static void domain_create(uintnat initial_minor_heap_wsize) {
     goto reallocate_minor_heap_failure;
   }
 
+  domain_state->in_minor_collection = 0;
+
   domain_state->dls_root = Val_unit;
   caml_register_generational_global_root(&domain_state->dls_root);
 

diff --git a/ocaml/runtime/minor_gc.c b/ocaml/runtime/minor_gc.c
@@ -493,6 +493,9 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   caml_gc_log ("Minor collection of domain %d starting", domain->id);
   CAML_EV_BEGIN(EV_MINOR);
   call_timing_hook(&caml_minor_gc_begin_hook);
+  if (Caml_state->in_minor_collection)
+    caml_fatal_error("Minor GC triggered recursively");
+  Caml_state->in_minor_collection = 1;
 
   if( participating[0] == Caml_state ) {
     CAML_EV_BEGIN(EV_MINOR_GLOBAL_ROOTS);
@@ -639,6 +642,7 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   domain->stat_minor_words += Wsize_bsize (minor_allocated_bytes);
   domain->stat_promoted_words += domain->allocated_words - prev_alloc_words;
 
+  Caml_state->in_minor_collection = 0;
   call_timing_hook(&caml_minor_gc_end_hook);
   CAML_EV_COUNTER(EV_C_MINOR_PROMOTED,
                   Bsize_wsize(domain->allocated_words - prev_alloc_words));