Resource-safe C interface for async callbacks

Introduce caml_process_pending_actions and
caml_process_pending_actions_exn: a variant of the former which does
not raise but returns a value that has to be checked against
Is_exception_value.

I keep the current conventions from caml_callback{,_exn}: For a
resource-safe interface, we mostly care about the _exn variants, but
every time there is a public _exn function I provide a function that
raises directly for convenience.

They are introduced and documented in caml/signals.h.

Private functions are converted to their _exn variant on the way as
needed: for internal functions of the runtime, it is desirable to go
towards a complete elimination of functions that raise implicitly.

Get rid of the distant logic of caml_raise_in_async_callback. Instead,
caml_process_pending_events takes care itself of its something_to_do
"resource". This avoids calling the former function in places
unrelated to asynchronous callbacks.
master
Guillaume Munch-Maccagnoni 2019-10-14 14:19:11 +02:00
parent d0c8219726
commit d0f70f757a
18 changed files with 172 additions and 106 deletions

View File

@ -1166,18 +1166,39 @@ It would be incorrect to perform
has taken place since "r" was allocated.
\subsection{Asynchronous callbacks}
\label{caml-check-urgent-gc}
\subsection{Pending actions and asynchronous exceptions}
\label{process-pending-actions}
Since 4.10, allocation functions called from C do not call finalisers,
signal handlers, and memory profiler callbacks, but delays their
execution. These asychronous callbacks can execute arbitrary OCaml
code, including raising asynchronous exceptions.
Since 4.10, allocation functions are guaranteed not to call any OCaml
callbacks from C, including finalisers and signal handlers, and delay
their execution instead.
The function \verb"caml_check_urgent_gc" from "memory.h" checks for
pending signals and executes delayed callbacks. In long-running C
code, it can be called at safe points with
\verb"caml_check_urgent_gc(Val_unit)".
The function \verb"caml_process_pending_actions" from
"<caml/signals.h>" executes any pending signal handlers and
finalisers, Memprof callbacks, and requested minor and major garbage
collections. In particular, it can raise asynchronous exceptions. It
is recommended to call it regularly at safe points inside long-running
non-blocking C code.
The variant \verb"caml_process_pending_actions_exn" is provided, that
returns the exception instead of raising it directly into OCaml code.
Its result must be tested using {\tt Is_exception_result}, and
followed by {\tt Extract_exception} if appropriate. It is typically
used for clean up before re-raising:
\begin{verbatim}
CAMLlocal1(exn);
...
exn = caml_process_pending_actions_exn();
if(Is_exception_result(exn)) {
exn = Extract_exception(exn);
...cleanup...
caml_raise(exn);
}
\end{verbatim}
Correct use of exceptional return, in particular in the presence of
garbage collection, is further detailed in Section~\ref{s:callbacks}.
\section{A complete example}
@ -2339,8 +2360,8 @@ resources. It may block until no other thread uses the OCaml run-time
system.
\end{itemize}
These functions check for pending signals by calling asynchronous
callbacks (section~\ref{caml-check-urgent-gc}) before releasing and
These functions poll for pending signals by calling asynchronous
callbacks (section~\ref{process-pending-actions}) before releasing and
after acquiring the lock. They can therefore execute arbitrary OCaml
code including raising an asynchronous exception.

View File

@ -749,12 +749,12 @@ CAMLprim value caml_thread_yield(value unit) /* ML */
our blocking section doesn't contain anything interesting, don't bother
with saving errno.)
*/
caml_process_pending_signals();
caml_raise_if_exception(caml_process_pending_signals_exn());
caml_thread_save_runtime_state();
st_thread_yield(&caml_master_lock);
curr_thread = st_tls_get(thread_descriptor_key);
caml_thread_restore_runtime_state();
caml_process_pending_signals();
caml_raise_if_exception(caml_process_pending_signals_exn());
return Val_unit;
}

View File

@ -280,7 +280,7 @@ CAMLprim value caml_floatarray_create(value len)
result = caml_alloc_shr (wosize, Double_array_tag);
}
// Give the GC a chance to run, and run memprof callbacks
return caml_check_urgent_gc_and_callbacks (result);
return caml_process_pending_actions_with_root (result);
}
/* [len] is a [value] representing number of words or floats */
@ -331,7 +331,8 @@ CAMLprim value caml_make_vect(value len, value init)
}
}
// Give the GC a chance to run, and run memprof callbacks
CAMLreturn (caml_check_urgent_gc_and_callbacks(res));
caml_process_pending_actions ();
CAMLreturn (res);
}
/* [len] is a [value] representing number of floats */
@ -384,7 +385,8 @@ CAMLprim value caml_make_array(value init)
Store_double_flat_field(res, i, d);
}
// run memprof callbacks
CAMLreturn (caml_check_urgent_gc_and_callbacks(res));
caml_process_pending_actions();
CAMLreturn (res);
}
}
#else
@ -521,8 +523,8 @@ static value caml_array_gather(intnat num_arrays,
/* Many caml_initialize in a row can create a lot of old-to-young
refs. Give the minor GC a chance to run if it needs to.
Run memprof callback for the major allocation. */
res = caml_check_urgent_gc_and_callbacks (res);
Run memprof callbacks for the major allocation. */
res = caml_process_pending_actions_with_root (res);
}
CAMLreturn (res);
}

View File

@ -22,7 +22,7 @@
void caml_final_update_mark_phase (void);
void caml_final_update_clean_phase (void);
void caml_final_do_calls (void);
value caml_final_do_calls_exn (void);
void caml_final_do_roots (scanning_action f);
void caml_final_invert_finalisable_values (void);
void caml_final_oldify_young_roots (void);

View File

@ -24,7 +24,7 @@
extern int caml_memprof_suspended;
extern void caml_memprof_handle_postponed();
extern value caml_memprof_handle_postponed_exn();
extern void caml_memprof_track_alloc_shr(value block);
extern void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml);

View File

@ -30,6 +30,19 @@
extern "C" {
#endif
CAMLextern void caml_enter_blocking_section (void);
CAMLextern void caml_leave_blocking_section (void);
CAMLextern void caml_process_pending_actions (void);
/* Checks for pending actions and executes them. This includes pending
minor and major collections, signal handlers, finalisers, and
Memprof callbacks. Assumes that the runtime lock is held. Can raise
exceptions asynchronously into OCaml code. */
CAMLextern value caml_process_pending_actions_exn (void);
/* Same as [caml_process_pending_actions], but returns the exception
if any (otherwise returns [Val_unit]). */
#ifdef CAML_INTERNALS
CAMLextern intnat volatile caml_pending_signals[];
CAMLextern int volatile caml_something_to_do;
@ -39,13 +52,12 @@ void caml_request_major_slice (void);
void caml_request_minor_gc (void);
CAMLextern int caml_convert_signal_number (int);
CAMLextern int caml_rev_convert_signal_number (int);
void caml_execute_signal(int signal_number, int in_signal_handler);
value caml_execute_signal_exn(int signal_number, int in_signal_handler);
void caml_record_signal(int signal_number);
void caml_process_pending_signals(void);
value caml_process_pending_signals_exn(void);
void caml_set_action_pending (void);
void caml_do_urgent_gc_and_callbacks (void);
value caml_check_urgent_gc_and_callbacks (value extra_root);
void caml_raise_in_async_callback (value exc);
value caml_do_pending_actions_exn (void);
value caml_process_pending_actions_with_root (value extra_root); // raises
int caml_set_signal_action(int signo, int action);
void caml_setup_stack_overflow_detection(void);
@ -57,9 +69,6 @@ CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
#endif
#endif /* CAML_INTERNALS */
CAMLextern void caml_enter_blocking_section (void);
CAMLextern void caml_leave_blocking_section (void);
#ifdef __cplusplus
}
#endif

View File

@ -166,7 +166,7 @@ void caml_final_update_clean_phase (){
/* Call the finalisation functions for the finalising set.
Note that this function must be reentrant.
*/
void caml_final_do_calls (void)
value caml_final_do_calls_exn (void)
{
struct final f;
value res;
@ -201,12 +201,12 @@ void caml_final_do_calls (void)
caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
#endif
running_finalisation_function = 0;
if (Is_exception_result (res))
caml_raise_in_async_callback(Extract_exception(res));
if (Is_exception_result (res)) return res;
}
caml_gc_message (0x80, "Done calling finalisation functions.\n");
if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
}
return Val_unit;
}
/* Call a scanning_action [f] on [x]. */

View File

@ -512,7 +512,7 @@ CAMLprim value caml_gc_set(value v)
CAML_INSTR_TIME (tmr, "explicit/gc_set");
/* The compaction may have triggered some finalizers that we need to call. */
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
return Val_unit;
}
@ -523,7 +523,7 @@ CAMLprim value caml_gc_minor(value v)
CAMLassert (v == Val_unit);
caml_request_minor_gc ();
// call the gc and call finalisers
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_minor");
return Val_unit;
}
@ -552,7 +552,7 @@ CAMLprim value caml_gc_major(value v)
caml_finish_major_cycle ();
test_and_compact ();
// call finalisers
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_major");
return Val_unit;
}
@ -565,12 +565,12 @@ CAMLprim value caml_gc_full_major(value v)
caml_empty_minor_heap ();
caml_finish_major_cycle ();
// call finalisers
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
caml_empty_minor_heap ();
caml_finish_major_cycle ();
test_and_compact ();
// call finalisers
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_full_major");
return Val_unit;
}
@ -592,12 +592,12 @@ CAMLprim value caml_gc_compaction(value v)
caml_empty_minor_heap ();
caml_finish_major_cycle ();
// call finalisers
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
caml_empty_minor_heap ();
caml_finish_major_cycle ();
caml_compact_heap (-1);
// call finalisers
caml_do_urgent_gc_and_callbacks ();
caml_process_pending_actions();
CAML_INSTR_TIME (tmr, "explicit/gc_compact");
return Val_unit;
}

View File

@ -692,7 +692,9 @@ static header_t* intern_add_to_heap(mlsize_t whsize)
return res;
}
static value intern_end(value res, mlsize_t whsize) {
static value intern_end(value res, mlsize_t whsize)
{
CAMLparam1(res);
header_t *block = intern_add_to_heap(whsize);
header_t *blockend = intern_dest;
@ -705,7 +707,9 @@ static value intern_end(value res, mlsize_t whsize) {
caml_memprof_track_interned(block, blockend);
// Give gc a chance to run, and run memprof callbacks
return caml_check_urgent_gc_and_callbacks(res);
caml_process_pending_actions();
CAMLreturn(res);
}
/* Parsing the header */

View File

@ -913,7 +913,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
process_actions:
Setup_for_event;
caml_check_urgent_gc_and_callbacks(Val_unit);
caml_process_pending_actions();
Restore_after_event;
Next;

View File

@ -142,7 +142,7 @@ CAMLprim value caml_memprof_set(value v)
callback. We have to make sure that the postponed queue is empty
before continuing. */
if (!caml_memprof_suspended)
caml_memprof_handle_postponed();
caml_raise_if_exception(caml_memprof_handle_postponed_exn());
else
/* But if we are currently running a callback, there is nothing
else we can do than purging the queue. */
@ -182,14 +182,14 @@ enum ml_alloc_kind {
Unmarshalled = Val_long(2)
};
/* When we call do_callback, we suspend/resume sampling. In order to
to avoid a systematic unnecessary calls to [caml_check_urgent_gc]
after each memprof callback, we do not set [caml_something_to_do]
when resuming. Therefore, any call to [do_callback] has to also
make sure the postponed queue will be handled fully at some
point. */
static value do_callback(tag_t tag, uintnat wosize, uintnat occurrences,
value callstack, enum ml_alloc_kind cb_kind) {
/* When we call do_callback_exn, we suspend/resume sampling. In order
to avoid a systematic unnecessary polling after each memprof
callback, we do not call [caml_set_action_pending] when resuming.
Therefore, any call to [do_callback_exn] has to also make sure the
postponed queue will be handled fully at some point. */
static value do_callback_exn(tag_t tag, uintnat wosize, uintnat occurrences,
value callstack, enum ml_alloc_kind cb_kind)
{
CAMLparam1(callstack);
CAMLlocal1(sample_info);
value res; /* Not a root, can be an exception result. */
@ -208,11 +208,6 @@ static value do_callback(tag_t tag, uintnat wosize, uintnat occurrences,
caml_memprof_suspended = 0;
if (Is_exception_result(res))
/* We are not necessarily called from `caml_check_urgent_gc`, but
this is OK to call this regardless of this fact. */
caml_raise_in_async_callback(Extract_exception(res));
CAMLreturn(res);
}
@ -326,14 +321,14 @@ static void register_postponed_callback(value block, uintnat occurrences,
if (!caml_memprof_suspended) caml_set_action_pending();
}
void caml_memprof_handle_postponed(void)
value caml_memprof_handle_postponed_exn(void)
{
CAMLparam0();
CAMLlocal1(block);
value ephe;
if (caml_memprof_suspended)
CAMLreturn0;
CAMLreturn(Val_unit);
while (postponed_tl != postponed_hd) {
struct postponed_block pb = *postponed_tl;
@ -344,13 +339,15 @@ void caml_memprof_handle_postponed(void)
/* If using threads, this call can trigger reentrant calls to
[caml_memprof_handle_postponed] even though we set
[caml_memprof_suspended]. */
ephe = do_callback(Tag_val(block), Wosize_val(block),
pb.occurrences, pb.callstack, pb.kind);
ephe = do_callback_exn(Tag_val(block), Wosize_val(block),
pb.occurrences, pb.callstack, pb.kind);
if (Is_exception_result(ephe)) CAMLreturn(ephe);
if (Is_block(ephe)) caml_ephemeron_set_key(Field(ephe, 0), 0, block);
}
CAMLreturn0;
CAMLreturn(Val_unit);
}
/* We don't expect these roots to live long. No need to have a special
@ -456,10 +453,11 @@ void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml)
/* Empty the queue to make sure callbacks are called in the right
order. */
caml_memprof_handle_postponed();
caml_raise_if_exception(caml_memprof_handle_postponed_exn());
callstack = capture_callstack();
ephe = do_callback(tag, wosize, occurrences, callstack, Minor);
ephe = caml_raise_if_exception(do_callback_exn(tag, wosize, occurrences,
callstack, Minor));
/* We can now restore the minor heap in the state needed by
[Alloc_small_aux]. */

View File

@ -186,7 +186,8 @@ CAMLprim value caml_realloc_global(value size)
Field (new_global_data, i) = Val_long (0);
}
// Give gc a chance to run, and run memprof callbacks
caml_global_data = caml_check_urgent_gc_and_callbacks(new_global_data);
caml_global_data = new_global_data;
caml_process_pending_actions();
}
return Val_unit;
}

View File

@ -487,8 +487,10 @@ void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags)
while(1) {
/* We might be here because of an async callback / urgent GC
request. Take the opportunity to do what has been requested. */
if (flags & CAML_FROM_CAML) caml_do_urgent_gc_and_callbacks ();
else caml_check_urgent_gc (Val_unit);
if (flags & CAML_FROM_CAML)
caml_raise_if_exception(caml_do_pending_actions_exn ());
else
caml_check_urgent_gc (Val_unit);
/* Now, there might be enough room in the minor heap to do our
allocation. */

View File

@ -120,7 +120,7 @@ CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
res = caml_alloc_shr(sz, tg);
for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
// Give gc a chance to run, and run memprof callbacks
res = caml_check_urgent_gc_and_callbacks(res);
caml_process_pending_actions();
}
CAMLreturn (res);
}

View File

@ -64,7 +64,7 @@ CAMLexport int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *)
/* Execute all pending signals */
void caml_process_pending_signals(void)
value caml_process_pending_signals_exn(void)
{
int i;
int really_pending;
@ -73,7 +73,7 @@ void caml_process_pending_signals(void)
#endif
if(!signals_are_pending)
return;
return Val_unit;
signals_are_pending = 0;
/* Check that there is indeed a pending signal before issuing the
@ -85,7 +85,7 @@ void caml_process_pending_signals(void)
break;
}
if(!really_pending)
return;
return Val_unit;
#ifdef POSIX_SIGNALS
caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set);
@ -98,8 +98,12 @@ void caml_process_pending_signals(void)
continue;
#endif
caml_pending_signals[i] = 0;
caml_execute_signal(i, 0);
{
value exn = caml_execute_signal_exn(i, 0);
if (Is_exception_result(exn)) return exn;
}
}
return Val_unit;
}
CAMLno_tsan /* When called from [caml_record_signal], these memory
@ -118,7 +122,7 @@ void caml_set_action_pending(void)
/* Record the delivery of a signal, and arrange for it to be processed
as soon as possible:
- via caml_something_to_do, processed in
caml_check_urgent_gc_and_callbacks.
caml_process_pending_actions_exn.
- by playing with the allocation limit, processed in
caml_garbage_collection and caml_alloc_small_dispatch.
*/
@ -165,7 +169,7 @@ CAMLexport void caml_enter_blocking_section(void)
{
while (1){
/* Process all pending signals now */
caml_process_pending_signals ();
caml_raise_if_exception(caml_process_pending_signals_exn());
caml_enter_blocking_section_hook ();
/* Check again for pending signals.
If none, done; otherwise, try again */
@ -190,11 +194,11 @@ CAMLexport void caml_leave_blocking_section(void)
Another case where this is necessary (even in a single threaded
setting) is when the blocking section unmasks a pending signal:
If the signal is pending and masked but has already been
examined by [caml_process_pending_signals], then
examined by [caml_process_pending_signals_exn], then
[signals_are_pending] is 0 but the signal needs to be
handled at this point. */
signals_are_pending = 1;
caml_process_pending_signals ();
caml_raise_if_exception(caml_process_pending_signals_exn());
errno = saved_errno;
}
@ -203,7 +207,7 @@ CAMLexport void caml_leave_blocking_section(void)
static value caml_signal_handlers = 0;
void caml_execute_signal(int signal_number, int in_signal_handler)
value caml_execute_signal_exn(int signal_number, int in_signal_handler)
{
value res;
value handler;
@ -258,8 +262,7 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
}
#endif
if (Is_exception_result(res))
caml_raise_in_async_callback(Extract_exception(res));
return res;
}
void caml_update_young_limit (void)
@ -287,43 +290,68 @@ void caml_request_minor_gc (void)
caml_set_action_pending();
}
void caml_do_urgent_gc_and_callbacks(void)
value caml_do_pending_actions_exn(void)
{
value exn;
caml_something_to_do = 0;
// Do any pending minor collection or major slice
caml_check_urgent_gc(Val_unit);
caml_update_young_limit();
caml_memprof_handle_postponed();
caml_final_do_calls();
caml_process_pending_signals();
// Call memprof callbacks
exn = caml_memprof_handle_postponed_exn();
if (Is_exception_result(exn)) goto exception;
// Call finalisers
exn = caml_final_do_calls_exn();
if (Is_exception_result(exn)) goto exception;
// Call signal handlers
exn = caml_process_pending_signals_exn();
if (Is_exception_result(exn)) goto exception;
return Val_unit;
exception:
/* If an exception is raised during an asynchronous callback, then
it might be the case that we did not run all the callbacks we
needed. Therefore, we set [caml_something_to_do] again in order
to force reexamination of callbacks. */
caml_set_action_pending();
return exn;
}
CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */
value caml_check_urgent_gc_and_callbacks(value extra_root)
static inline value process_pending_actions_with_root_exn(value extra_root)
{
if (caml_something_to_do) {
CAMLparam1(extra_root);
caml_do_urgent_gc_and_callbacks();
value exn = caml_do_pending_actions_exn();
if (Is_exception_result(exn))
CAMLreturn(exn);
CAMLdrop;
}
return extra_root;
}
/* If an exception is raised during an asynchronous callback (i.e.,
from an OCaml function called in `caml_check_urgent_gc`), then it
might be the case that we did not run all the callbacks we needed
to run even though [caml_something_to_do] has been reset to 0 at
the begining of [caml_check_urgent_gc]. Therefore, we set
[caml_something_to_do] in order to force reexamination of
callbacks.
Apart from a reasonable performance penalty (an extra call to
`caml_check_urgent_gc`), it is OK to call this function where
`caml_raise` would have been more appropriate (i.e., not called
from `caml_check_urgent_gc`). */
void caml_raise_in_async_callback (value exc)
value caml_process_pending_actions_with_root(value extra_root)
{
caml_set_action_pending();
caml_raise(exc);
value res = process_pending_actions_with_root_exn(extra_root);
return caml_raise_if_exception(res);
}
CAMLexport value caml_process_pending_actions_exn(void)
{
return process_pending_actions_with_root_exn(Val_unit);
}
CAMLexport void caml_process_pending_actions(void)
{
value exn = process_pending_actions_with_root_exn(Val_unit);
caml_raise_if_exception(exn);
}
/* OS-independent numbering of signals */
@ -495,6 +523,6 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
}
caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
}
caml_process_pending_signals();
caml_raise_if_exception(caml_process_pending_signals_exn());
CAMLreturn (res);
}

View File

@ -21,10 +21,11 @@
#include <errno.h>
#include "caml/config.h"
#include "caml/memory.h"
#include "caml/fail.h"
#include "caml/finalise.h"
#include "caml/osdeps.h"
#include "caml/signals.h"
#include "caml/signals_machdep.h"
#include "caml/finalise.h"
#ifndef NSIG
#define NSIG 64
@ -46,7 +47,7 @@ static void handle_signal(int signal_number)
#endif
if (signal_number < 0 || signal_number >= NSIG) return;
if (caml_try_leave_blocking_section_hook()) {
caml_execute_signal(signal_number, 1);
caml_raise_if_exception(caml_execute_signal_exn(signal_number, 1));
caml_enter_blocking_section_hook();
}else{
caml_record_signal(signal_number);

View File

@ -91,7 +91,7 @@ void caml_garbage_collection(void)
}
#endif
caml_do_urgent_gc_and_callbacks();
caml_raise_if_exception(caml_do_pending_actions_exn());
}
DECLARE_SIGNAL_HANDLER(handle_signal)
@ -104,7 +104,7 @@ DECLARE_SIGNAL_HANDLER(handle_signal)
#endif
if (sig < 0 || sig >= NSIG) return;
if (caml_try_leave_blocking_section_hook ()) {
caml_execute_signal(sig, 1);
caml_raise_if_exception(caml_execute_signal_exn(sig, 1));
caml_enter_blocking_section_hook();
} else {
caml_record_signal(sig);

View File

@ -112,7 +112,7 @@ CAMLprim value caml_ephe_create (value len)
{
value res = caml_ephemeron_create(Long_val(len));
// run memprof callbacks
return caml_check_urgent_gc_and_callbacks(res);
return caml_process_pending_actions_with_root(res);
}
CAMLprim value caml_weak_create (value len)
@ -294,7 +294,7 @@ static value optionalize(int status, value *x)
}
// run memprof callbacks both for the option we are allocating here
// and the calling function.
caml_check_urgent_gc_and_callbacks(Val_unit);
caml_process_pending_actions();
CAMLreturn(res);
}