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.
|
has taken place since "r" was allocated.
|
||||||
|
|
||||||
|
|
||||||
\subsection{Asynchronous callbacks}
|
\subsection{Pending actions and asynchronous exceptions}
|
||||||
\label{caml-check-urgent-gc}
|
\label{process-pending-actions}
|
||||||
|
|
||||||
Since 4.10, allocation functions called from C do not call finalisers,
|
Since 4.10, allocation functions are guaranteed not to call any OCaml
|
||||||
signal handlers, and memory profiler callbacks, but delays their
|
callbacks from C, including finalisers and signal handlers, and delay
|
||||||
execution. These asychronous callbacks can execute arbitrary OCaml
|
their execution instead.
|
||||||
code, including raising asynchronous exceptions.
|
|
||||||
|
|
||||||
The function \verb"caml_check_urgent_gc" from "memory.h" checks for
|
The function \verb"caml_process_pending_actions" from
|
||||||
pending signals and executes delayed callbacks. In long-running C
|
"<caml/signals.h>" executes any pending signal handlers and
|
||||||
code, it can be called at safe points with
|
finalisers, Memprof callbacks, and requested minor and major garbage
|
||||||
\verb"caml_check_urgent_gc(Val_unit)".
|
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}
|
\section{A complete example}
|
||||||
|
|
||||||
|
@ -2339,8 +2360,8 @@ resources. It may block until no other thread uses the OCaml run-time
|
||||||
system.
|
system.
|
||||||
\end{itemize}
|
\end{itemize}
|
||||||
|
|
||||||
These functions check for pending signals by calling asynchronous
|
These functions poll for pending signals by calling asynchronous
|
||||||
callbacks (section~\ref{caml-check-urgent-gc}) before releasing and
|
callbacks (section~\ref{process-pending-actions}) before releasing and
|
||||||
after acquiring the lock. They can therefore execute arbitrary OCaml
|
after acquiring the lock. They can therefore execute arbitrary OCaml
|
||||||
code including raising an asynchronous exception.
|
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
|
our blocking section doesn't contain anything interesting, don't bother
|
||||||
with saving errno.)
|
with saving errno.)
|
||||||
*/
|
*/
|
||||||
caml_process_pending_signals();
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
||||||
caml_thread_save_runtime_state();
|
caml_thread_save_runtime_state();
|
||||||
st_thread_yield(&caml_master_lock);
|
st_thread_yield(&caml_master_lock);
|
||||||
curr_thread = st_tls_get(thread_descriptor_key);
|
curr_thread = st_tls_get(thread_descriptor_key);
|
||||||
caml_thread_restore_runtime_state();
|
caml_thread_restore_runtime_state();
|
||||||
caml_process_pending_signals();
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
||||||
|
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
|
|
@ -280,7 +280,7 @@ CAMLprim value caml_floatarray_create(value len)
|
||||||
result = caml_alloc_shr (wosize, Double_array_tag);
|
result = caml_alloc_shr (wosize, Double_array_tag);
|
||||||
}
|
}
|
||||||
// Give the GC a chance to run, and run memprof callbacks
|
// 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 */
|
/* [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
|
// 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 */
|
/* [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);
|
Store_double_flat_field(res, i, d);
|
||||||
}
|
}
|
||||||
// run memprof callbacks
|
// run memprof callbacks
|
||||||
CAMLreturn (caml_check_urgent_gc_and_callbacks(res));
|
caml_process_pending_actions();
|
||||||
|
CAMLreturn (res);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#else
|
#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
|
/* 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.
|
refs. Give the minor GC a chance to run if it needs to.
|
||||||
Run memprof callback for the major allocation. */
|
Run memprof callbacks for the major allocation. */
|
||||||
res = caml_check_urgent_gc_and_callbacks (res);
|
res = caml_process_pending_actions_with_root (res);
|
||||||
}
|
}
|
||||||
CAMLreturn (res);
|
CAMLreturn (res);
|
||||||
}
|
}
|
||||||
|
|
|
@ -22,7 +22,7 @@
|
||||||
|
|
||||||
void caml_final_update_mark_phase (void);
|
void caml_final_update_mark_phase (void);
|
||||||
void caml_final_update_clean_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_do_roots (scanning_action f);
|
||||||
void caml_final_invert_finalisable_values (void);
|
void caml_final_invert_finalisable_values (void);
|
||||||
void caml_final_oldify_young_roots (void);
|
void caml_final_oldify_young_roots (void);
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
|
|
||||||
extern int caml_memprof_suspended;
|
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_alloc_shr(value block);
|
||||||
extern void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml);
|
extern void caml_memprof_track_young(tag_t tag, uintnat wosize, int from_caml);
|
||||||
|
|
|
@ -30,6 +30,19 @@
|
||||||
extern "C" {
|
extern "C" {
|
||||||
#endif
|
#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
|
#ifdef CAML_INTERNALS
|
||||||
CAMLextern intnat volatile caml_pending_signals[];
|
CAMLextern intnat volatile caml_pending_signals[];
|
||||||
CAMLextern int volatile caml_something_to_do;
|
CAMLextern int volatile caml_something_to_do;
|
||||||
|
@ -39,13 +52,12 @@ void caml_request_major_slice (void);
|
||||||
void caml_request_minor_gc (void);
|
void caml_request_minor_gc (void);
|
||||||
CAMLextern int caml_convert_signal_number (int);
|
CAMLextern int caml_convert_signal_number (int);
|
||||||
CAMLextern int caml_rev_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_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_set_action_pending (void);
|
||||||
void caml_do_urgent_gc_and_callbacks (void);
|
value caml_do_pending_actions_exn (void);
|
||||||
value caml_check_urgent_gc_and_callbacks (value extra_root);
|
value caml_process_pending_actions_with_root (value extra_root); // raises
|
||||||
void caml_raise_in_async_callback (value exc);
|
|
||||||
int caml_set_signal_action(int signo, int action);
|
int caml_set_signal_action(int signo, int action);
|
||||||
void caml_setup_stack_overflow_detection(void);
|
void caml_setup_stack_overflow_detection(void);
|
||||||
|
|
||||||
|
@ -57,9 +69,6 @@ CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
|
||||||
#endif
|
#endif
|
||||||
#endif /* CAML_INTERNALS */
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
CAMLextern void caml_enter_blocking_section (void);
|
|
||||||
CAMLextern void caml_leave_blocking_section (void);
|
|
||||||
|
|
||||||
#ifdef __cplusplus
|
#ifdef __cplusplus
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -166,7 +166,7 @@ void caml_final_update_clean_phase (){
|
||||||
/* Call the finalisation functions for the finalising set.
|
/* Call the finalisation functions for the finalising set.
|
||||||
Note that this function must be reentrant.
|
Note that this function must be reentrant.
|
||||||
*/
|
*/
|
||||||
void caml_final_do_calls (void)
|
value caml_final_do_calls_exn (void)
|
||||||
{
|
{
|
||||||
struct final f;
|
struct final f;
|
||||||
value res;
|
value res;
|
||||||
|
@ -201,12 +201,12 @@ void caml_final_do_calls (void)
|
||||||
caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
|
caml_spacetime_trie_node_ptr = saved_spacetime_trie_node_ptr;
|
||||||
#endif
|
#endif
|
||||||
running_finalisation_function = 0;
|
running_finalisation_function = 0;
|
||||||
if (Is_exception_result (res))
|
if (Is_exception_result (res)) return res;
|
||||||
caml_raise_in_async_callback(Extract_exception(res));
|
|
||||||
}
|
}
|
||||||
caml_gc_message (0x80, "Done calling finalisation functions.\n");
|
caml_gc_message (0x80, "Done calling finalisation functions.\n");
|
||||||
if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
|
if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
|
||||||
}
|
}
|
||||||
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Call a scanning_action [f] on [x]. */
|
/* 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");
|
CAML_INSTR_TIME (tmr, "explicit/gc_set");
|
||||||
|
|
||||||
/* The compaction may have triggered some finalizers that we need to call. */
|
/* 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;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
@ -523,7 +523,7 @@ CAMLprim value caml_gc_minor(value v)
|
||||||
CAMLassert (v == Val_unit);
|
CAMLassert (v == Val_unit);
|
||||||
caml_request_minor_gc ();
|
caml_request_minor_gc ();
|
||||||
// call the gc and call finalisers
|
// call the gc and call finalisers
|
||||||
caml_do_urgent_gc_and_callbacks ();
|
caml_process_pending_actions();
|
||||||
CAML_INSTR_TIME (tmr, "explicit/gc_minor");
|
CAML_INSTR_TIME (tmr, "explicit/gc_minor");
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
@ -552,7 +552,7 @@ CAMLprim value caml_gc_major(value v)
|
||||||
caml_finish_major_cycle ();
|
caml_finish_major_cycle ();
|
||||||
test_and_compact ();
|
test_and_compact ();
|
||||||
// call finalisers
|
// call finalisers
|
||||||
caml_do_urgent_gc_and_callbacks ();
|
caml_process_pending_actions();
|
||||||
CAML_INSTR_TIME (tmr, "explicit/gc_major");
|
CAML_INSTR_TIME (tmr, "explicit/gc_major");
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
@ -565,12 +565,12 @@ CAMLprim value caml_gc_full_major(value v)
|
||||||
caml_empty_minor_heap ();
|
caml_empty_minor_heap ();
|
||||||
caml_finish_major_cycle ();
|
caml_finish_major_cycle ();
|
||||||
// call finalisers
|
// call finalisers
|
||||||
caml_do_urgent_gc_and_callbacks ();
|
caml_process_pending_actions();
|
||||||
caml_empty_minor_heap ();
|
caml_empty_minor_heap ();
|
||||||
caml_finish_major_cycle ();
|
caml_finish_major_cycle ();
|
||||||
test_and_compact ();
|
test_and_compact ();
|
||||||
// call finalisers
|
// call finalisers
|
||||||
caml_do_urgent_gc_and_callbacks ();
|
caml_process_pending_actions();
|
||||||
CAML_INSTR_TIME (tmr, "explicit/gc_full_major");
|
CAML_INSTR_TIME (tmr, "explicit/gc_full_major");
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
@ -592,12 +592,12 @@ CAMLprim value caml_gc_compaction(value v)
|
||||||
caml_empty_minor_heap ();
|
caml_empty_minor_heap ();
|
||||||
caml_finish_major_cycle ();
|
caml_finish_major_cycle ();
|
||||||
// call finalisers
|
// call finalisers
|
||||||
caml_do_urgent_gc_and_callbacks ();
|
caml_process_pending_actions();
|
||||||
caml_empty_minor_heap ();
|
caml_empty_minor_heap ();
|
||||||
caml_finish_major_cycle ();
|
caml_finish_major_cycle ();
|
||||||
caml_compact_heap (-1);
|
caml_compact_heap (-1);
|
||||||
// call finalisers
|
// call finalisers
|
||||||
caml_do_urgent_gc_and_callbacks ();
|
caml_process_pending_actions();
|
||||||
CAML_INSTR_TIME (tmr, "explicit/gc_compact");
|
CAML_INSTR_TIME (tmr, "explicit/gc_compact");
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
|
|
@ -692,7 +692,9 @@ static header_t* intern_add_to_heap(mlsize_t whsize)
|
||||||
return res;
|
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 *block = intern_add_to_heap(whsize);
|
||||||
header_t *blockend = intern_dest;
|
header_t *blockend = intern_dest;
|
||||||
|
|
||||||
|
@ -705,7 +707,9 @@ static value intern_end(value res, mlsize_t whsize) {
|
||||||
caml_memprof_track_interned(block, blockend);
|
caml_memprof_track_interned(block, blockend);
|
||||||
|
|
||||||
// Give gc a chance to run, and run memprof callbacks
|
// 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 */
|
/* Parsing the header */
|
||||||
|
|
|
@ -913,7 +913,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
|
||||||
|
|
||||||
process_actions:
|
process_actions:
|
||||||
Setup_for_event;
|
Setup_for_event;
|
||||||
caml_check_urgent_gc_and_callbacks(Val_unit);
|
caml_process_pending_actions();
|
||||||
Restore_after_event;
|
Restore_after_event;
|
||||||
Next;
|
Next;
|
||||||
|
|
||||||
|
|
|
@ -142,7 +142,7 @@ CAMLprim value caml_memprof_set(value v)
|
||||||
callback. We have to make sure that the postponed queue is empty
|
callback. We have to make sure that the postponed queue is empty
|
||||||
before continuing. */
|
before continuing. */
|
||||||
if (!caml_memprof_suspended)
|
if (!caml_memprof_suspended)
|
||||||
caml_memprof_handle_postponed();
|
caml_raise_if_exception(caml_memprof_handle_postponed_exn());
|
||||||
else
|
else
|
||||||
/* But if we are currently running a callback, there is nothing
|
/* But if we are currently running a callback, there is nothing
|
||||||
else we can do than purging the queue. */
|
else we can do than purging the queue. */
|
||||||
|
@ -182,14 +182,14 @@ enum ml_alloc_kind {
|
||||||
Unmarshalled = Val_long(2)
|
Unmarshalled = Val_long(2)
|
||||||
};
|
};
|
||||||
|
|
||||||
/* When we call do_callback, we suspend/resume sampling. In order to
|
/* When we call do_callback_exn, we suspend/resume sampling. In order
|
||||||
to avoid a systematic unnecessary calls to [caml_check_urgent_gc]
|
to avoid a systematic unnecessary polling after each memprof
|
||||||
after each memprof callback, we do not set [caml_something_to_do]
|
callback, we do not call [caml_set_action_pending] when resuming.
|
||||||
when resuming. Therefore, any call to [do_callback] has to also
|
Therefore, any call to [do_callback_exn] has to also make sure the
|
||||||
make sure the postponed queue will be handled fully at some
|
postponed queue will be handled fully at some point. */
|
||||||
point. */
|
static value do_callback_exn(tag_t tag, uintnat wosize, uintnat occurrences,
|
||||||
static value do_callback(tag_t tag, uintnat wosize, uintnat occurrences,
|
value callstack, enum ml_alloc_kind cb_kind)
|
||||||
value callstack, enum ml_alloc_kind cb_kind) {
|
{
|
||||||
CAMLparam1(callstack);
|
CAMLparam1(callstack);
|
||||||
CAMLlocal1(sample_info);
|
CAMLlocal1(sample_info);
|
||||||
value res; /* Not a root, can be an exception result. */
|
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;
|
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);
|
CAMLreturn(res);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -326,14 +321,14 @@ static void register_postponed_callback(value block, uintnat occurrences,
|
||||||
if (!caml_memprof_suspended) caml_set_action_pending();
|
if (!caml_memprof_suspended) caml_set_action_pending();
|
||||||
}
|
}
|
||||||
|
|
||||||
void caml_memprof_handle_postponed(void)
|
value caml_memprof_handle_postponed_exn(void)
|
||||||
{
|
{
|
||||||
CAMLparam0();
|
CAMLparam0();
|
||||||
CAMLlocal1(block);
|
CAMLlocal1(block);
|
||||||
value ephe;
|
value ephe;
|
||||||
|
|
||||||
if (caml_memprof_suspended)
|
if (caml_memprof_suspended)
|
||||||
CAMLreturn0;
|
CAMLreturn(Val_unit);
|
||||||
|
|
||||||
while (postponed_tl != postponed_hd) {
|
while (postponed_tl != postponed_hd) {
|
||||||
struct postponed_block pb = *postponed_tl;
|
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
|
/* If using threads, this call can trigger reentrant calls to
|
||||||
[caml_memprof_handle_postponed] even though we set
|
[caml_memprof_handle_postponed] even though we set
|
||||||
[caml_memprof_suspended]. */
|
[caml_memprof_suspended]. */
|
||||||
ephe = do_callback(Tag_val(block), Wosize_val(block),
|
ephe = do_callback_exn(Tag_val(block), Wosize_val(block),
|
||||||
pb.occurrences, pb.callstack, pb.kind);
|
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);
|
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
|
/* 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
|
/* Empty the queue to make sure callbacks are called in the right
|
||||||
order. */
|
order. */
|
||||||
caml_memprof_handle_postponed();
|
caml_raise_if_exception(caml_memprof_handle_postponed_exn());
|
||||||
|
|
||||||
callstack = capture_callstack();
|
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
|
/* We can now restore the minor heap in the state needed by
|
||||||
[Alloc_small_aux]. */
|
[Alloc_small_aux]. */
|
||||||
|
|
|
@ -186,7 +186,8 @@ CAMLprim value caml_realloc_global(value size)
|
||||||
Field (new_global_data, i) = Val_long (0);
|
Field (new_global_data, i) = Val_long (0);
|
||||||
}
|
}
|
||||||
// Give gc a chance to run, and run memprof callbacks
|
// 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;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
|
|
@ -487,8 +487,10 @@ void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags)
|
||||||
while(1) {
|
while(1) {
|
||||||
/* We might be here because of an async callback / urgent GC
|
/* We might be here because of an async callback / urgent GC
|
||||||
request. Take the opportunity to do what has been requested. */
|
request. Take the opportunity to do what has been requested. */
|
||||||
if (flags & CAML_FROM_CAML) caml_do_urgent_gc_and_callbacks ();
|
if (flags & CAML_FROM_CAML)
|
||||||
else caml_check_urgent_gc (Val_unit);
|
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
|
/* Now, there might be enough room in the minor heap to do our
|
||||||
allocation. */
|
allocation. */
|
||||||
|
|
|
@ -120,7 +120,7 @@ CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
|
||||||
res = caml_alloc_shr(sz, tg);
|
res = caml_alloc_shr(sz, tg);
|
||||||
for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
|
for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
|
||||||
// Give gc a chance to run, and run memprof callbacks
|
// Give gc a chance to run, and run memprof callbacks
|
||||||
res = caml_check_urgent_gc_and_callbacks(res);
|
caml_process_pending_actions();
|
||||||
}
|
}
|
||||||
CAMLreturn (res);
|
CAMLreturn (res);
|
||||||
}
|
}
|
||||||
|
|
|
@ -64,7 +64,7 @@ CAMLexport int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *)
|
||||||
|
|
||||||
/* Execute all pending signals */
|
/* Execute all pending signals */
|
||||||
|
|
||||||
void caml_process_pending_signals(void)
|
value caml_process_pending_signals_exn(void)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
int really_pending;
|
int really_pending;
|
||||||
|
@ -73,7 +73,7 @@ void caml_process_pending_signals(void)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
if(!signals_are_pending)
|
if(!signals_are_pending)
|
||||||
return;
|
return Val_unit;
|
||||||
signals_are_pending = 0;
|
signals_are_pending = 0;
|
||||||
|
|
||||||
/* Check that there is indeed a pending signal before issuing the
|
/* Check that there is indeed a pending signal before issuing the
|
||||||
|
@ -85,7 +85,7 @@ void caml_process_pending_signals(void)
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
if(!really_pending)
|
if(!really_pending)
|
||||||
return;
|
return Val_unit;
|
||||||
|
|
||||||
#ifdef POSIX_SIGNALS
|
#ifdef POSIX_SIGNALS
|
||||||
caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set);
|
caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set);
|
||||||
|
@ -98,8 +98,12 @@ void caml_process_pending_signals(void)
|
||||||
continue;
|
continue;
|
||||||
#endif
|
#endif
|
||||||
caml_pending_signals[i] = 0;
|
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
|
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
|
/* Record the delivery of a signal, and arrange for it to be processed
|
||||||
as soon as possible:
|
as soon as possible:
|
||||||
- via caml_something_to_do, processed in
|
- 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
|
- by playing with the allocation limit, processed in
|
||||||
caml_garbage_collection and caml_alloc_small_dispatch.
|
caml_garbage_collection and caml_alloc_small_dispatch.
|
||||||
*/
|
*/
|
||||||
|
@ -165,7 +169,7 @@ CAMLexport void caml_enter_blocking_section(void)
|
||||||
{
|
{
|
||||||
while (1){
|
while (1){
|
||||||
/* Process all pending signals now */
|
/* Process all pending signals now */
|
||||||
caml_process_pending_signals ();
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
||||||
caml_enter_blocking_section_hook ();
|
caml_enter_blocking_section_hook ();
|
||||||
/* Check again for pending signals.
|
/* Check again for pending signals.
|
||||||
If none, done; otherwise, try again */
|
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
|
Another case where this is necessary (even in a single threaded
|
||||||
setting) is when the blocking section unmasks a pending signal:
|
setting) is when the blocking section unmasks a pending signal:
|
||||||
If the signal is pending and masked but has already been
|
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
|
[signals_are_pending] is 0 but the signal needs to be
|
||||||
handled at this point. */
|
handled at this point. */
|
||||||
signals_are_pending = 1;
|
signals_are_pending = 1;
|
||||||
caml_process_pending_signals ();
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
||||||
|
|
||||||
errno = saved_errno;
|
errno = saved_errno;
|
||||||
}
|
}
|
||||||
|
@ -203,7 +207,7 @@ CAMLexport void caml_leave_blocking_section(void)
|
||||||
|
|
||||||
static value caml_signal_handlers = 0;
|
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 res;
|
||||||
value handler;
|
value handler;
|
||||||
|
@ -258,8 +262,7 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
|
||||||
caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
|
caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
if (Is_exception_result(res))
|
return res;
|
||||||
caml_raise_in_async_callback(Extract_exception(res));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void caml_update_young_limit (void)
|
void caml_update_young_limit (void)
|
||||||
|
@ -287,43 +290,68 @@ void caml_request_minor_gc (void)
|
||||||
caml_set_action_pending();
|
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;
|
caml_something_to_do = 0;
|
||||||
|
|
||||||
|
// Do any pending minor collection or major slice
|
||||||
caml_check_urgent_gc(Val_unit);
|
caml_check_urgent_gc(Val_unit);
|
||||||
|
|
||||||
caml_update_young_limit();
|
caml_update_young_limit();
|
||||||
caml_memprof_handle_postponed();
|
|
||||||
caml_final_do_calls();
|
// Call memprof callbacks
|
||||||
caml_process_pending_signals();
|
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. */
|
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) {
|
if (caml_something_to_do) {
|
||||||
CAMLparam1(extra_root);
|
CAMLparam1(extra_root);
|
||||||
caml_do_urgent_gc_and_callbacks();
|
value exn = caml_do_pending_actions_exn();
|
||||||
|
if (Is_exception_result(exn))
|
||||||
|
CAMLreturn(exn);
|
||||||
CAMLdrop;
|
CAMLdrop;
|
||||||
}
|
}
|
||||||
return extra_root;
|
return extra_root;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* If an exception is raised during an asynchronous callback (i.e.,
|
value caml_process_pending_actions_with_root(value extra_root)
|
||||||
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)
|
|
||||||
{
|
{
|
||||||
caml_set_action_pending();
|
value res = process_pending_actions_with_root_exn(extra_root);
|
||||||
caml_raise(exc);
|
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 */
|
/* 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_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
|
||||||
}
|
}
|
||||||
caml_process_pending_signals();
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
||||||
CAMLreturn (res);
|
CAMLreturn (res);
|
||||||
}
|
}
|
||||||
|
|
|
@ -21,10 +21,11 @@
|
||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
#include "caml/config.h"
|
#include "caml/config.h"
|
||||||
#include "caml/memory.h"
|
#include "caml/memory.h"
|
||||||
|
#include "caml/fail.h"
|
||||||
|
#include "caml/finalise.h"
|
||||||
#include "caml/osdeps.h"
|
#include "caml/osdeps.h"
|
||||||
#include "caml/signals.h"
|
#include "caml/signals.h"
|
||||||
#include "caml/signals_machdep.h"
|
#include "caml/signals_machdep.h"
|
||||||
#include "caml/finalise.h"
|
|
||||||
|
|
||||||
#ifndef NSIG
|
#ifndef NSIG
|
||||||
#define NSIG 64
|
#define NSIG 64
|
||||||
|
@ -46,7 +47,7 @@ static void handle_signal(int signal_number)
|
||||||
#endif
|
#endif
|
||||||
if (signal_number < 0 || signal_number >= NSIG) return;
|
if (signal_number < 0 || signal_number >= NSIG) return;
|
||||||
if (caml_try_leave_blocking_section_hook()) {
|
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();
|
caml_enter_blocking_section_hook();
|
||||||
}else{
|
}else{
|
||||||
caml_record_signal(signal_number);
|
caml_record_signal(signal_number);
|
||||||
|
|
|
@ -91,7 +91,7 @@ void caml_garbage_collection(void)
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
caml_do_urgent_gc_and_callbacks();
|
caml_raise_if_exception(caml_do_pending_actions_exn());
|
||||||
}
|
}
|
||||||
|
|
||||||
DECLARE_SIGNAL_HANDLER(handle_signal)
|
DECLARE_SIGNAL_HANDLER(handle_signal)
|
||||||
|
@ -104,7 +104,7 @@ DECLARE_SIGNAL_HANDLER(handle_signal)
|
||||||
#endif
|
#endif
|
||||||
if (sig < 0 || sig >= NSIG) return;
|
if (sig < 0 || sig >= NSIG) return;
|
||||||
if (caml_try_leave_blocking_section_hook ()) {
|
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();
|
caml_enter_blocking_section_hook();
|
||||||
} else {
|
} else {
|
||||||
caml_record_signal(sig);
|
caml_record_signal(sig);
|
||||||
|
|
|
@ -112,7 +112,7 @@ CAMLprim value caml_ephe_create (value len)
|
||||||
{
|
{
|
||||||
value res = caml_ephemeron_create(Long_val(len));
|
value res = caml_ephemeron_create(Long_val(len));
|
||||||
// run memprof callbacks
|
// 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)
|
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
|
// run memprof callbacks both for the option we are allocating here
|
||||||
// and the calling function.
|
// and the calling function.
|
||||||
caml_check_urgent_gc_and_callbacks(Val_unit);
|
caml_process_pending_actions();
|
||||||
CAMLreturn(res);
|
CAMLreturn(res);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue