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
parent
d0c8219726
commit
d0f70f757a
|
@ -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.
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]. */
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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 */
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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]. */
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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. */
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue