flambda-backend: Wider scope of in_minor_collection (#2098)

 * Make the check that custom finalisers do not trigger GC / thread switches apply even in the absence of systhreads
 * Add a test

otherlibs/systhreads/st_stubs.c

@@ -192,8 +192,6 @@ 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;

otherlibs/systhreads4/st_stubs.c

@@ -251,8 +251,6 @@ static void memprof_ctx_iter(th_ctx_action f, void* data)
 
 CAMLexport void caml_thread_save_runtime_state(void)
 {
-  if (Caml_state->_in_minor_collection)
-    caml_fatal_error("Thread switch from inside minor GC");
 #ifdef NATIVE_CODE
   curr_thread->top_of_stack = Caml_state->_top_of_stack;
   curr_thread->bottom_of_stack = Caml_state->_bottom_of_stack;

runtime/minor_gc.c

@@ -493,9 +493,6 @@ 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);
@@ -643,7 +640,6 @@ 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));
@@ -712,6 +708,9 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain,
   uintnat* initial_young_ptr = (uintnat*)domain->young_ptr;
   CAMLassert(caml_domain_is_in_stw());
 #endif
+  if (Caml_state->in_minor_collection)
+    caml_fatal_error("Minor GC triggered recursively");
+  Caml_state->in_minor_collection = 1;
 
   if( participating[0] == Caml_state ) {
     atomic_fetch_add(&caml_minor_cycles_started, 1);
@@ -761,6 +760,7 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain,
 
   CAML_EV_END(EV_MINOR_CLEAR);
   caml_gc_log("finished stw empty_minor_heap");
+  Caml_state->in_minor_collection = 0;
 }
 
 static void caml_stw_empty_minor_heap (caml_domain_state* domain, void* unused,

runtime/signals.c

@@ -147,6 +147,8 @@ CAMLexport void caml_enter_blocking_section(void)
 {
   caml_domain_state * domain = Caml_state;
   while (1){
+    if (Caml_state->in_minor_collection)
+      caml_fatal_error("caml_enter_blocking_section from inside minor GC");
     /* Process all pending signals now */
     caml_process_pending_actions();
     caml_enter_blocking_section_hook ();

runtime4/signals.c

@@ -153,6 +153,8 @@ CAMLno_tsan /* The read of [caml_something_to_do] is not synchronized. */
 CAMLexport void caml_enter_blocking_section(void)
 {
   while (1){
+    if (Caml_state->in_minor_collection)
+      caml_fatal_error("caml_enter_blocking_section from inside minor GC");
     /* Process all pending signals now */
     caml_raise_async_if_exception(caml_process_pending_signals_exn(),
                                   "signal handler");

testsuite/tests/regression/pr2098/in_minor_collection.ml

@@ -0,0 +1,12 @@
+(* TEST
+   modules = "stub.c"
+   * not-windows
+   ** native
+*)
+
+type t
+external alloc : unit -> t = "caml_test_alloc"
+
+let () =
+  ignore (alloc());
+  Gc.minor()

testsuite/tests/regression/pr2098/in_minor_collection.run

@@ -0,0 +1,4 @@
+#!/bin/sh
+ulimit -c 0
+(${program} > ${output}) 2>&1 | grep -q 'from inside minor GC'
+exit $?

testsuite/tests/regression/pr2098/stub.c

@@ -0,0 +1,24 @@
+#include <caml/custom.h>
+#include <caml/signals.h>
+
+static void caml_test_finalize(value v)
+{
+  caml_enter_blocking_section();
+  caml_leave_blocking_section();
+}
+
+static struct custom_operations caml_test_ops = {
+  "_test",
+  caml_test_finalize,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+value caml_test_alloc(value unit)
+{
+  return caml_alloc_custom(&caml_test_ops, 0, 0, 1);
+}