Joseph Ferano
d272a5b1e5
Item 12 asks five questions and says to answer them with a spike rather than a rewrite. spike/embed/ is that spike: one script, six binaries, each one built to fail loudly at the thing it is asking about. It is deliberately not a dune target -- the root dune only excludes old-ocaml/, so a dune file here would land in @default and make the spike part of the build. It drives ocamlfind and clang by hand against the flan.cmxa dune already produces. The probes, in the order they would kill the idea: the smallest possible link, a C main() reaching one OCaml function; the whole compiler linked in and doing real work; the same again with lib/dynload_stubs.c from the unmerged dlopen branch, because that is the only C the compiler itself is built from; the game keeping the main thread while caml_startup happens on a pthread beside it; the SIGSEGV disposition read on both sides of caml_startup; and an 8 MiB arena checked byte for byte across a compaction. No result is written down yet. This is the apparatus.
92 lines
3.2 KiB
C
92 lines
3.2 KiB
C
/* Step 5: who owns SIGSEGV.
|
|
*
|
|
* The OCaml runtime installs a SIGSEGV handler to turn a stack-guard-page hit
|
|
* into the Stack_overflow exception. The break loop wants SIGSEGV for the
|
|
* crash case. This is the one real collision, so it is measured in both
|
|
* directions:
|
|
*
|
|
* a. what the disposition is before caml_startup, and after it;
|
|
* b. whether a handler installed AFTER caml_startup actually receives a
|
|
* genuine fault in program memory -- i.e. whether the break loop can have
|
|
* what it wants by installing last.
|
|
*
|
|
* SIGPIPE is not probed: flan_agent.c sends with MSG_NOSIGNAL throughout and
|
|
* does not rely on a disposition.
|
|
*/
|
|
#include <caml/callback.h>
|
|
#include <caml/mlvalues.h>
|
|
#include <setjmp.h>
|
|
#include <signal.h>
|
|
#include <stdio.h>
|
|
#include <string.h>
|
|
|
|
static void describe(const char *when, int sig) {
|
|
struct sigaction old;
|
|
memset(&old, 0, sizeof old);
|
|
sigaction(sig, NULL, &old);
|
|
printf(" %-22s %-8s handler=%p flags=%#x %s%s\n", when,
|
|
sig == SIGSEGV ? "SIGSEGV" : sig == SIGINT ? "SIGINT" : "SIGFPE",
|
|
(old.sa_flags & SA_SIGINFO) ? (void *)old.sa_sigaction : (void *)old.sa_handler,
|
|
(unsigned)old.sa_flags,
|
|
(old.sa_flags & SA_ONSTACK) ? "ONSTACK " : "",
|
|
old.sa_handler == SIG_DFL ? "(SIG_DFL)"
|
|
: old.sa_handler == SIG_IGN ? "(SIG_IGN)" : "(custom)");
|
|
}
|
|
|
|
static sigjmp_buf escape;
|
|
static volatile sig_atomic_t ours_ran = 0;
|
|
|
|
static void our_segv(int sig, siginfo_t *info, void *ctx) {
|
|
(void)sig; (void)ctx;
|
|
ours_ran = 1;
|
|
/* What a break loop would do here is stop and serve; the spike just proves
|
|
the handler was reached, with the faulting address in hand. */
|
|
printf(" our SIGSEGV handler ran, fault address = %p\n", info->si_addr);
|
|
siglongjmp(escape, 1);
|
|
}
|
|
|
|
int main(int argc, char **argv) {
|
|
struct sigaction sa, ocaml_segv;
|
|
volatile int *bad = (int *)0x10;
|
|
(void)argc;
|
|
|
|
printf("before caml_startup:\n");
|
|
describe("before startup", SIGSEGV);
|
|
describe("before startup", SIGINT);
|
|
describe("before startup", SIGFPE);
|
|
|
|
caml_startup(argv);
|
|
|
|
printf("after caml_startup:\n");
|
|
describe("after startup", SIGSEGV);
|
|
describe("after startup", SIGINT);
|
|
describe("after startup", SIGFPE);
|
|
memset(&ocaml_segv, 0, sizeof ocaml_segv);
|
|
sigaction(SIGSEGV, NULL, &ocaml_segv);
|
|
|
|
/* Now install ours last, the way the break loop would. */
|
|
memset(&sa, 0, sizeof sa);
|
|
sa.sa_sigaction = our_segv;
|
|
sa.sa_flags = SA_SIGINFO | SA_ONSTACK;
|
|
sigemptyset(&sa.sa_mask);
|
|
sigaction(SIGSEGV, &sa, NULL);
|
|
printf("break loop installs last:\n");
|
|
describe("after break loop", SIGSEGV);
|
|
|
|
if (sigsetjmp(escape, 1) == 0) {
|
|
printf(" dereferencing %p ...\n", (void *)bad);
|
|
*bad = 1;
|
|
printf(" no fault -- UNEXPECTED\n");
|
|
} else {
|
|
printf(" recovered; a handler installed after caml_startup does receive "
|
|
"a real fault: %s\n", ours_ran ? "yes" : "no");
|
|
}
|
|
|
|
/* And the cost of taking it: OCaml's own handler is now displaced, so its
|
|
stack-overflow detection is gone unless ours chains to the saved one. */
|
|
printf(" OCaml's displaced SIGSEGV handler was %p -- chaining to it is what "
|
|
"keeps Stack_overflow working\n",
|
|
(void *)ocaml_segv.sa_sigaction);
|
|
return 0;
|
|
}
|