From 279a6904626b82c09e10b7d09e39c5b04616bb46 Mon Sep 17 00:00:00 2001 From: Zesen Qian Date: Tue, 5 Dec 2023 10:15:10 +0000 Subject: [PATCH] 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 --- ocaml/otherlibs/systhreads/st_stubs.c | 2 -- ocaml/otherlibs/systhreads4/st_stubs.c | 2 -- ocaml/runtime/minor_gc.c | 8 +++---- ocaml/runtime/signals.c | 2 ++ ocaml/runtime4/signals.c | 2 ++ .../regression/pr2098/in_minor_collection.ml | 12 ++++++++++ .../regression/pr2098/in_minor_collection.run | 4 ++++ .../testsuite/tests/regression/pr2098/stub.c | 24 +++++++++++++++++++ 8 files changed, 48 insertions(+), 8 deletions(-) create mode 100644 ocaml/testsuite/tests/regression/pr2098/in_minor_collection.ml create mode 100644 ocaml/testsuite/tests/regression/pr2098/in_minor_collection.run create mode 100644 ocaml/testsuite/tests/regression/pr2098/stub.c diff --git a/ocaml/otherlibs/systhreads/st_stubs.c b/ocaml/otherlibs/systhreads/st_stubs.c index 096c8480a9..e590c30033 100644 --- a/ocaml/otherlibs/systhreads/st_stubs.c +++ b/ocaml/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; diff --git a/ocaml/otherlibs/systhreads4/st_stubs.c b/ocaml/otherlibs/systhreads4/st_stubs.c index 6743aa2911..da4c328818 100644 --- a/ocaml/otherlibs/systhreads4/st_stubs.c +++ b/ocaml/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; diff --git a/ocaml/runtime/minor_gc.c b/ocaml/runtime/minor_gc.c index 1fc3afa373..08b9972a4a 100644 --- a/ocaml/runtime/minor_gc.c +++ b/ocaml/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, diff --git a/ocaml/runtime/signals.c b/ocaml/runtime/signals.c index 93fe7189d1..5bc8f9eb40 100644 --- a/ocaml/runtime/signals.c +++ b/ocaml/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 (); diff --git a/ocaml/runtime4/signals.c b/ocaml/runtime4/signals.c index a638a3a936..2de9e0b447 100644 --- a/ocaml/runtime4/signals.c +++ b/ocaml/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"); diff --git a/ocaml/testsuite/tests/regression/pr2098/in_minor_collection.ml b/ocaml/testsuite/tests/regression/pr2098/in_minor_collection.ml new file mode 100644 index 0000000000..ec9b69c809 --- /dev/null +++ b/ocaml/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() \ No newline at end of file diff --git a/ocaml/testsuite/tests/regression/pr2098/in_minor_collection.run b/ocaml/testsuite/tests/regression/pr2098/in_minor_collection.run new file mode 100644 index 0000000000..e07c247f8c --- /dev/null +++ b/ocaml/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 $? diff --git a/ocaml/testsuite/tests/regression/pr2098/stub.c b/ocaml/testsuite/tests/regression/pr2098/stub.c new file mode 100644 index 0000000000..bc20955c97 --- /dev/null +++ b/ocaml/testsuite/tests/regression/pr2098/stub.c @@ -0,0 +1,24 @@ +#include +#include + +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); +} \ No newline at end of file