2016-02-18 07:11:59 -08:00
|
|
|
/**************************************************************************/
|
|
|
|
/* */
|
|
|
|
/* OCaml */
|
|
|
|
/* */
|
|
|
|
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
|
|
|
/* */
|
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
|
|
/* en Automatique. */
|
|
|
|
/* */
|
|
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
|
|
/* special exception on linking described in the file LICENSE. */
|
|
|
|
/* */
|
|
|
|
/**************************************************************************/
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2016-07-04 10:00:57 -07:00
|
|
|
#define CAML_INTERNALS
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* Signal handling, code common to the bytecode and native systems */
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
#include <signal.h>
|
2013-05-14 08:48:50 -07:00
|
|
|
#include <errno.h>
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/alloc.h"
|
|
|
|
#include "caml/callback.h"
|
|
|
|
#include "caml/config.h"
|
|
|
|
#include "caml/fail.h"
|
|
|
|
#include "caml/memory.h"
|
|
|
|
#include "caml/misc.h"
|
|
|
|
#include "caml/mlvalues.h"
|
|
|
|
#include "caml/roots.h"
|
|
|
|
#include "caml/signals.h"
|
|
|
|
#include "caml/signals_machdep.h"
|
|
|
|
#include "caml/sys.h"
|
2019-05-09 08:39:35 -07:00
|
|
|
#include "caml/memprof.h"
|
2019-05-23 04:32:22 -07:00
|
|
|
#include "caml/finalise.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2005-07-29 05:11:01 -07:00
|
|
|
#ifndef NSIG
|
|
|
|
#define NSIG 64
|
|
|
|
#endif
|
|
|
|
|
2019-06-05 07:41:07 -07:00
|
|
|
CAMLexport int volatile caml_something_to_do = 0;
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* The set of pending signals (received but not yet processed) */
|
2001-11-05 08:10:12 -08:00
|
|
|
|
2019-06-05 07:41:07 -07:00
|
|
|
static intnat volatile signals_are_pending = 0;
|
2005-09-22 07:21:50 -07:00
|
|
|
CAMLexport intnat volatile caml_pending_signals[NSIG];
|
1999-12-23 09:33:46 -08:00
|
|
|
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
#ifdef POSIX_SIGNALS
|
|
|
|
/* This wrapper makes [sigprocmask] compatible with
|
|
|
|
[pthread_sigmask]. Indeed, the latter returns the error code while
|
|
|
|
the former sets [errno].
|
|
|
|
*/
|
|
|
|
static int sigprocmask_wrapper(int how, const sigset_t *set, sigset_t *oldset) {
|
|
|
|
if(sigprocmask(how, set, oldset) != 0) return errno;
|
|
|
|
else return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
CAMLexport int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *)
|
|
|
|
= sigprocmask_wrapper;
|
|
|
|
#endif
|
|
|
|
|
2020-07-27 08:12:10 -07:00
|
|
|
static int check_for_pending_signals(void)
|
|
|
|
{
|
|
|
|
int i;
|
|
|
|
for (i = 0; i < NSIG; i++) {
|
|
|
|
if (caml_pending_signals[i]) return 1;
|
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* Execute all pending signals */
|
|
|
|
|
2020-09-16 09:41:26 -07:00
|
|
|
CAMLexport value caml_process_pending_signals_exn(void)
|
1999-12-23 09:33:46 -08:00
|
|
|
{
|
2006-04-16 16:28:22 -07:00
|
|
|
int i;
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
#ifdef POSIX_SIGNALS
|
|
|
|
sigset_t set;
|
|
|
|
#endif
|
2018-12-21 08:05:17 -08:00
|
|
|
|
2019-06-05 07:41:07 -07:00
|
|
|
if(!signals_are_pending)
|
2019-10-14 05:19:11 -07:00
|
|
|
return Val_unit;
|
2019-06-05 07:41:07 -07:00
|
|
|
signals_are_pending = 0;
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
|
|
|
|
/* Check that there is indeed a pending signal before issuing the
|
|
|
|
syscall in [caml_sigmask_hook]. */
|
2020-07-27 08:12:10 -07:00
|
|
|
if (!check_for_pending_signals())
|
2019-10-14 05:19:11 -07:00
|
|
|
return Val_unit;
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
|
|
|
|
#ifdef POSIX_SIGNALS
|
|
|
|
caml_sigmask_hook(/* dummy */ SIG_BLOCK, NULL, &set);
|
|
|
|
#endif
|
|
|
|
for (i = 0; i < NSIG; i++) {
|
|
|
|
if (!caml_pending_signals[i])
|
|
|
|
continue;
|
|
|
|
#ifdef POSIX_SIGNALS
|
|
|
|
if(sigismember(&set, i))
|
|
|
|
continue;
|
|
|
|
#endif
|
|
|
|
caml_pending_signals[i] = 0;
|
2019-10-14 05:19:11 -07:00
|
|
|
{
|
|
|
|
value exn = caml_execute_signal_exn(i, 0);
|
|
|
|
if (Is_exception_result(exn)) return exn;
|
|
|
|
}
|
2018-12-21 08:05:17 -08:00
|
|
|
}
|
2019-10-14 05:19:11 -07:00
|
|
|
return Val_unit;
|
2005-07-31 05:31:03 -07:00
|
|
|
}
|
|
|
|
|
2019-06-18 01:46:30 -07:00
|
|
|
CAMLno_tsan /* When called from [caml_record_signal], these memory
|
|
|
|
accesses may not be synchronized. */
|
2019-09-17 14:25:40 -07:00
|
|
|
void caml_set_action_pending(void)
|
2019-06-05 07:41:07 -07:00
|
|
|
{
|
|
|
|
caml_something_to_do = 1;
|
2019-10-09 04:08:13 -07:00
|
|
|
|
2019-06-05 07:41:07 -07:00
|
|
|
/* When this function is called without [caml_c_call] (e.g., in
|
2019-06-17 12:02:34 -07:00
|
|
|
[caml_modify]), this is only moderately effective on ports that cache
|
|
|
|
[Caml_state->young_limit] in a register, so it may take a while before the
|
|
|
|
register is reloaded from [Caml_state->young_limit]. */
|
|
|
|
Caml_state->young_limit = Caml_state->young_alloc_end;
|
2019-06-05 07:41:07 -07:00
|
|
|
}
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* Record the delivery of a signal, and arrange for it to be processed
|
|
|
|
as soon as possible:
|
2019-10-09 11:18:44 -07:00
|
|
|
- via caml_something_to_do, processed in
|
2019-10-14 05:19:11 -07:00
|
|
|
caml_process_pending_actions_exn.
|
2019-10-09 11:18:44 -07:00
|
|
|
- by playing with the allocation limit, processed in
|
|
|
|
caml_garbage_collection and caml_alloc_small_dispatch.
|
2007-02-23 01:29:45 -08:00
|
|
|
*/
|
2005-07-29 05:11:01 -07:00
|
|
|
|
2020-09-16 09:41:26 -07:00
|
|
|
CAMLno_tsan
|
|
|
|
CAMLexport void caml_record_signal(int signal_number)
|
2007-02-23 01:29:45 -08:00
|
|
|
{
|
|
|
|
caml_pending_signals[signal_number] = 1;
|
2019-06-05 07:41:07 -07:00
|
|
|
signals_are_pending = 1;
|
2019-09-17 14:25:40 -07:00
|
|
|
caml_set_action_pending();
|
1999-12-23 09:33:46 -08:00
|
|
|
}
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* Management of blocking sections. */
|
|
|
|
|
2005-07-29 05:11:01 -07:00
|
|
|
static void caml_enter_blocking_section_default(void)
|
|
|
|
{
|
|
|
|
}
|
|
|
|
|
|
|
|
static void caml_leave_blocking_section_default(void)
|
|
|
|
{
|
|
|
|
}
|
|
|
|
|
|
|
|
CAMLexport void (*caml_enter_blocking_section_hook)(void) =
|
|
|
|
caml_enter_blocking_section_default;
|
|
|
|
CAMLexport void (*caml_leave_blocking_section_hook)(void) =
|
|
|
|
caml_leave_blocking_section_default;
|
|
|
|
|
2019-09-17 14:25:40 -07:00
|
|
|
CAMLno_tsan /* The read of [caml_something_to_do] is not synchronized. */
|
2007-02-23 01:29:45 -08:00
|
|
|
CAMLexport void caml_enter_blocking_section(void)
|
|
|
|
{
|
|
|
|
while (1){
|
|
|
|
/* Process all pending signals now */
|
2019-10-14 05:19:11 -07:00
|
|
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
2007-02-23 01:29:45 -08:00
|
|
|
caml_enter_blocking_section_hook ();
|
|
|
|
/* Check again for pending signals.
|
|
|
|
If none, done; otherwise, try again */
|
2019-10-09 11:18:44 -07:00
|
|
|
if (! signals_are_pending) break;
|
2007-02-23 01:29:45 -08:00
|
|
|
caml_leave_blocking_section_hook ();
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2020-06-24 09:16:21 -07:00
|
|
|
CAMLexport void caml_enter_blocking_section_no_pending(void)
|
|
|
|
{
|
|
|
|
caml_enter_blocking_section_hook ();
|
|
|
|
}
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
CAMLexport void caml_leave_blocking_section(void)
|
|
|
|
{
|
2013-05-14 08:48:50 -07:00
|
|
|
int saved_errno;
|
|
|
|
/* Save the value of errno (PR#5982). */
|
|
|
|
saved_errno = errno;
|
2007-02-23 01:29:45 -08:00
|
|
|
caml_leave_blocking_section_hook ();
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
|
|
|
|
/* Some other thread may have switched
|
2019-06-05 07:41:07 -07:00
|
|
|
[signals_are_pending] to 0 even though there are still
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
pending signals (masked in the other thread). To handle this
|
|
|
|
case, we force re-examination of all signals by setting it back
|
|
|
|
to 1.
|
|
|
|
|
|
|
|
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
|
2019-10-14 05:19:11 -07:00
|
|
|
examined by [caml_process_pending_signals_exn], then
|
2019-06-05 07:41:07 -07:00
|
|
|
[signals_are_pending] is 0 but the signal needs to be
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
handled at this point. */
|
2020-07-27 08:12:10 -07:00
|
|
|
if (check_for_pending_signals()) {
|
|
|
|
signals_are_pending = 1;
|
|
|
|
caml_set_action_pending();
|
|
|
|
}
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
|
2013-05-14 08:48:50 -07:00
|
|
|
errno = saved_errno;
|
2007-02-23 01:29:45 -08:00
|
|
|
}
|
2000-11-27 08:10:49 -08:00
|
|
|
|
2005-10-12 05:33:47 -07:00
|
|
|
/* Execute a signal handler immediately */
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
static value caml_signal_handlers = 0;
|
|
|
|
|
2019-10-14 05:19:11 -07:00
|
|
|
value caml_execute_signal_exn(int signal_number, int in_signal_handler)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1999-06-05 05:02:48 -07:00
|
|
|
value res;
|
2016-10-04 05:22:03 -07:00
|
|
|
value handler;
|
1999-06-05 05:02:48 -07:00
|
|
|
#ifdef POSIX_SIGNALS
|
2018-05-02 01:44:10 -07:00
|
|
|
sigset_t nsigs, sigs;
|
1999-06-05 05:02:48 -07:00
|
|
|
/* Block the signal before executing the handler, and record in sigs
|
|
|
|
the original signal mask */
|
2018-05-02 01:44:10 -07:00
|
|
|
sigemptyset(&nsigs);
|
|
|
|
sigaddset(&nsigs, signal_number);
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
caml_sigmask_hook(SIG_BLOCK, &nsigs, &sigs);
|
2016-07-29 07:07:10 -07:00
|
|
|
#endif
|
2016-10-04 05:22:03 -07:00
|
|
|
handler = Field(caml_signal_handlers, signal_number);
|
|
|
|
res = caml_callback_exn(
|
|
|
|
handler,
|
|
|
|
Val_int(caml_rev_convert_signal_number(signal_number)));
|
1999-06-05 05:02:48 -07:00
|
|
|
#ifdef POSIX_SIGNALS
|
|
|
|
if (! in_signal_handler) {
|
|
|
|
/* Restore the original signal mask */
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
|
1999-06-05 05:02:48 -07:00
|
|
|
} else if (Is_exception_result(res)) {
|
|
|
|
/* Restore the original signal mask and unblock the signal itself */
|
|
|
|
sigdelset(&sigs, signal_number);
|
Fix Thread.sigmask, take 2 (#2211)
Fix Thread.sigmaks, by checking whether a signal is masked before handling it.
We use [sigprocmask] (if available) to check whether a signal is
blocked when the systhread library is not loaded. As soon as the
[Thread] module gets loaded, we use [pthread_sigmask] instead, and
redirect all the calls to [sigprocmask] to [pthread_sigmask]. Indeed,
the latter has unspecified behavior in a multi-threaded context
anyway. In practice, this should not change the semantics of
[Unix.sigprocmask] on Linux, since on this platform, [pthread_sigmask]
is actually an alias for [sigprocmask]. On MacOSX, the semantics will
change, since [sigprocmask] changes the masks of the whole process on
this platform.
Also, include [caml_pending_signals] in signals returned by
[Unix.sigpending]. Indeed, some signals might have been handled in the
POSIX sense by the C handler in the OCaml runtime, but not been
handled in the OCaml sense (for example, because they are blocked).
This commit un-reverts 1c82c481a, which has been reverted in
79eb572e4. The issues of the original commit are corrected in this commit.
2019-03-01 05:14:29 -08:00
|
|
|
caml_sigmask_hook(SIG_SETMASK, &sigs, NULL);
|
1999-06-05 05:02:48 -07:00
|
|
|
}
|
|
|
|
#endif
|
2019-10-14 05:19:11 -07:00
|
|
|
return res;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2019-05-09 08:39:35 -07:00
|
|
|
void caml_update_young_limit (void)
|
|
|
|
{
|
|
|
|
/* The minor heap grows downwards. The first trigger is the largest one. */
|
2019-06-17 11:07:49 -07:00
|
|
|
Caml_state->young_limit =
|
|
|
|
caml_memprof_young_trigger < Caml_state->young_trigger ?
|
2019-06-05 23:39:26 -07:00
|
|
|
Caml_state->young_trigger : caml_memprof_young_trigger;
|
2019-05-09 08:39:35 -07:00
|
|
|
|
2019-06-05 07:41:07 -07:00
|
|
|
if(caml_something_to_do)
|
2019-06-05 23:39:26 -07:00
|
|
|
Caml_state->young_limit = Caml_state->young_alloc_end;
|
2019-05-09 08:39:35 -07:00
|
|
|
}
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* Arrange for a garbage collection to be performed as soon as possible */
|
2005-10-12 05:33:47 -07:00
|
|
|
|
2015-11-20 08:54:26 -08:00
|
|
|
void caml_request_major_slice (void)
|
1995-12-22 08:48:17 -08:00
|
|
|
{
|
2019-06-17 12:02:34 -07:00
|
|
|
Caml_state->requested_major_slice = 1;
|
2019-09-17 14:25:40 -07:00
|
|
|
caml_set_action_pending();
|
1995-12-22 08:48:17 -08:00
|
|
|
}
|
|
|
|
|
2015-11-20 08:54:26 -08:00
|
|
|
void caml_request_minor_gc (void)
|
|
|
|
{
|
2019-06-17 12:02:34 -07:00
|
|
|
Caml_state->requested_minor_gc = 1;
|
2019-09-17 14:25:40 -07:00
|
|
|
caml_set_action_pending();
|
2015-11-20 08:54:26 -08:00
|
|
|
}
|
|
|
|
|
2019-10-14 05:19:11 -07:00
|
|
|
value caml_do_pending_actions_exn(void)
|
2019-08-27 04:12:18 -07:00
|
|
|
{
|
2019-10-14 05:19:11 -07:00
|
|
|
value exn;
|
|
|
|
|
2019-06-05 07:41:07 -07:00
|
|
|
caml_something_to_do = 0;
|
2019-10-14 05:19:11 -07:00
|
|
|
|
|
|
|
// Do any pending minor collection or major slice
|
2019-10-09 11:18:44 -07:00
|
|
|
caml_check_urgent_gc(Val_unit);
|
2019-10-14 05:19:11 -07:00
|
|
|
|
2019-05-23 04:32:22 -07:00
|
|
|
caml_update_young_limit();
|
2019-10-14 05:19:11 -07:00
|
|
|
|
In long-running C code, force examining all callbacks at the next safe
point following every minor collection or major slice.
Also run signal handlers first.
Indeed, in some cases, caml_something_to_do is not reliable (spotted
by @jhjourdan):
* We could get into caml_process_pending_actions when
caml_something_to_do is seen as set but not caml_pending_signals,
making us miss the signal.
* If there are two different callbacks (say, a signal and a finaliser)
arriving at the same time, then we set caml_something_to_do to 0
when starting the first one while the second one is still waiting.
We may want to run the second one if the first one is taking long.
In the latter case, the additional fix is to favour signals, which
have a lower latency requirement, whereas the latency of finalisers
keeps the same order of magnitude, and memprof callbacks are served on
a best-effort basis.
2019-10-10 15:12:06 -07:00
|
|
|
// Call signal handlers first
|
|
|
|
exn = caml_process_pending_signals_exn();
|
|
|
|
if (Is_exception_result(exn)) goto exception;
|
|
|
|
|
2019-10-14 05:19:11 -07:00
|
|
|
// 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;
|
|
|
|
|
|
|
|
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;
|
2019-06-05 07:41:07 -07:00
|
|
|
}
|
|
|
|
|
2019-10-09 11:18:44 -07:00
|
|
|
CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */
|
2020-02-11 01:33:55 -08:00
|
|
|
Caml_inline value process_pending_actions_with_root_exn(value extra_root)
|
2019-10-09 11:18:44 -07:00
|
|
|
{
|
|
|
|
if (caml_something_to_do) {
|
|
|
|
CAMLparam1(extra_root);
|
2019-10-14 05:19:11 -07:00
|
|
|
value exn = caml_do_pending_actions_exn();
|
|
|
|
if (Is_exception_result(exn))
|
|
|
|
CAMLreturn(exn);
|
2019-10-09 11:18:44 -07:00
|
|
|
CAMLdrop;
|
|
|
|
}
|
|
|
|
return extra_root;
|
|
|
|
}
|
2019-06-05 07:41:07 -07:00
|
|
|
|
2020-06-24 09:16:21 -07:00
|
|
|
CAMLno_tsan /* The access to [caml_something_to_do] is not synchronized. */
|
|
|
|
int caml_check_pending_actions()
|
|
|
|
{
|
|
|
|
return caml_something_to_do;
|
|
|
|
}
|
|
|
|
|
2019-10-14 05:19:11 -07:00
|
|
|
value caml_process_pending_actions_with_root(value extra_root)
|
2019-06-05 07:41:07 -07:00
|
|
|
{
|
2019-10-14 05:19:11 -07:00
|
|
|
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);
|
2015-11-20 08:54:26 -08:00
|
|
|
}
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* OS-independent numbering of signals */
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
#ifndef SIGABRT
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGABRT -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGALRM
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGALRM -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGFPE
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGFPE -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGHUP
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGHUP -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGILL
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGILL -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGINT
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGINT -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGKILL
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGKILL -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGPIPE
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGPIPE -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGQUIT
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGQUIT -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGSEGV
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGSEGV -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGTERM
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGTERM -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGUSR1
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGUSR1 -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGUSR2
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGUSR2 -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGCHLD
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGCHLD -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGCONT
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGCONT -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGSTOP
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGSTOP -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGTSTP
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGTSTP -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGTTIN
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGTTIN -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
|
|
|
#ifndef SIGTTOU
|
1995-08-10 01:21:42 -07:00
|
|
|
#define SIGTTOU -1
|
1995-05-04 03:15:53 -07:00
|
|
|
#endif
|
1995-10-30 02:21:28 -08:00
|
|
|
#ifndef SIGVTALRM
|
|
|
|
#define SIGVTALRM -1
|
|
|
|
#endif
|
1996-04-18 09:29:57 -07:00
|
|
|
#ifndef SIGPROF
|
|
|
|
#define SIGPROF -1
|
|
|
|
#endif
|
2015-08-02 06:05:45 -07:00
|
|
|
#ifndef SIGBUS
|
|
|
|
#define SIGBUS -1
|
|
|
|
#endif
|
|
|
|
#ifndef SIGPOLL
|
|
|
|
#define SIGPOLL -1
|
|
|
|
#endif
|
|
|
|
#ifndef SIGSYS
|
|
|
|
#define SIGSYS -1
|
|
|
|
#endif
|
|
|
|
#ifndef SIGTRAP
|
|
|
|
#define SIGTRAP -1
|
|
|
|
#endif
|
|
|
|
#ifndef SIGURG
|
|
|
|
#define SIGURG -1
|
|
|
|
#endif
|
|
|
|
#ifndef SIGXCPU
|
|
|
|
#define SIGXCPU -1
|
|
|
|
#endif
|
|
|
|
#ifndef SIGXFSZ
|
|
|
|
#define SIGXFSZ -1
|
|
|
|
#endif
|
1995-05-04 03:15:53 -07:00
|
|
|
|
1998-08-13 08:58:08 -07:00
|
|
|
static int posix_signals[] = {
|
1995-05-04 03:15:53 -07:00
|
|
|
SIGABRT, SIGALRM, SIGFPE, SIGHUP, SIGILL, SIGINT, SIGKILL, SIGPIPE,
|
|
|
|
SIGQUIT, SIGSEGV, SIGTERM, SIGUSR1, SIGUSR2, SIGCHLD, SIGCONT,
|
2015-08-02 06:05:45 -07:00
|
|
|
SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU, SIGVTALRM, SIGPROF, SIGBUS,
|
|
|
|
SIGPOLL, SIGSYS, SIGTRAP, SIGURG, SIGXCPU, SIGXFSZ
|
1995-05-04 03:15:53 -07:00
|
|
|
};
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLexport int caml_convert_signal_number(int signo)
|
1998-08-13 08:58:08 -07:00
|
|
|
{
|
|
|
|
if (signo < 0 && signo >= -(sizeof(posix_signals) / sizeof(int)))
|
|
|
|
return posix_signals[-signo-1];
|
|
|
|
else
|
|
|
|
return signo;
|
|
|
|
}
|
|
|
|
|
2005-04-17 01:23:51 -07:00
|
|
|
CAMLexport int caml_rev_convert_signal_number(int signo)
|
2000-11-27 08:10:49 -08:00
|
|
|
{
|
|
|
|
int i;
|
|
|
|
for (i = 0; i < sizeof(posix_signals) / sizeof(int); i++)
|
|
|
|
if (signo == posix_signals[i]) return -i - 1;
|
|
|
|
return signo;
|
|
|
|
}
|
|
|
|
|
2007-02-23 01:29:45 -08:00
|
|
|
/* Installation of a signal handler (as per [Sys.signal]) */
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_install_signal_handler(value signal_number, value action)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
1999-11-29 11:03:05 -08:00
|
|
|
CAMLparam2 (signal_number, action);
|
|
|
|
CAMLlocal1 (res);
|
2007-02-23 01:29:45 -08:00
|
|
|
int sig, act, oldact;
|
1995-08-10 01:21:42 -07:00
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
sig = caml_convert_signal_number(Int_val(signal_number));
|
2010-01-22 04:48:24 -08:00
|
|
|
if (sig < 0 || sig >= NSIG)
|
2004-01-01 08:42:43 -08:00
|
|
|
caml_invalid_argument("Sys.signal: unavailable signal");
|
1995-08-10 01:21:42 -07:00
|
|
|
switch(action) {
|
|
|
|
case Val_int(0): /* Signal_default */
|
2007-02-23 01:29:45 -08:00
|
|
|
act = 0;
|
1995-05-04 03:15:53 -07:00
|
|
|
break;
|
1995-08-10 01:21:42 -07:00
|
|
|
case Val_int(1): /* Signal_ignore */
|
2007-02-23 01:29:45 -08:00
|
|
|
act = 1;
|
1995-05-04 03:15:53 -07:00
|
|
|
break;
|
1995-08-10 01:21:42 -07:00
|
|
|
default: /* Signal_handle */
|
2007-02-23 01:29:45 -08:00
|
|
|
act = 2;
|
1995-05-04 03:15:53 -07:00
|
|
|
break;
|
|
|
|
}
|
2007-02-23 01:29:45 -08:00
|
|
|
oldact = caml_set_signal_action(sig, act);
|
|
|
|
switch (oldact) {
|
|
|
|
case 0: /* was Signal_default */
|
|
|
|
res = Val_int(0);
|
|
|
|
break;
|
|
|
|
case 1: /* was Signal_ignore */
|
|
|
|
res = Val_int(1);
|
|
|
|
break;
|
|
|
|
case 2: /* was Signal_handle */
|
|
|
|
res = caml_alloc_small (1, 0);
|
2004-01-01 08:42:43 -08:00
|
|
|
Field(res, 0) = Field(caml_signal_handlers, sig);
|
2007-02-23 01:29:45 -08:00
|
|
|
break;
|
|
|
|
default: /* error in caml_set_signal_action */
|
|
|
|
caml_sys_error(NO_ARG);
|
1998-08-08 09:52:33 -07:00
|
|
|
}
|
2000-11-27 08:10:49 -08:00
|
|
|
if (Is_block(action)) {
|
2004-01-01 08:42:43 -08:00
|
|
|
if (caml_signal_handlers == 0) {
|
|
|
|
caml_signal_handlers = caml_alloc(NSIG, 0);
|
2004-01-02 11:23:29 -08:00
|
|
|
caml_register_global_root(&caml_signal_handlers);
|
2000-11-27 08:10:49 -08:00
|
|
|
}
|
2004-01-01 08:42:43 -08:00
|
|
|
caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
|
2000-11-27 08:10:49 -08:00
|
|
|
}
|
2019-10-14 05:19:11 -07:00
|
|
|
caml_raise_if_exception(caml_process_pending_signals_exn());
|
1999-11-29 11:03:05 -08:00
|
|
|
CAMLreturn (res);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|