Joseph Ferano
2e9b29e549
The first six probes each proved a piece. merged.sh puts them together: the program's @main is renamed out of the way, a C main takes the main thread and runs it there, caml_startup happens on a thread beside it, and clang links the lot -- the emitted program object, flan_rt.c, flan_dev.c, flan_agent.c and the whole compiler as one -output-complete-obj. It runs, and the compiler inside it compiles the very source the program was built from. Nothing is wired up. The two halves share an address space and do not speak. That is the point: the question was whether they can, not what they would say. sig.sh and symbols.sh answer the two questions the first pass got wrong or skipped. The SIGSEGV reading in harness5.c was taken at the wrong moment -- OCaml 5 starts domains after caml_startup returns, so the disposition had to be read from inside the runtime, and against a plain ocamlopt executable as a control. symbols.sh is the hazard nobody looks for until the link fails: four .c files that are compiled into two different processes today, and the OCaml runtime, all landing in one link.
111 lines
4.2 KiB
C
111 lines
4.2 KiB
C
/* Step 5b: the SIGSEGV question, asked properly.
|
|
*
|
|
* 5a read the disposition either side of caml_startup and found SIG_DFL both
|
|
* times, which would mean no collision at all. That is too good, and it is
|
|
* because OCaml 5 installs the handler per *domain*, on the domain's own
|
|
* thread, not once during startup. So this asks at four moments, and then asks
|
|
* the only question that decides anything: with the break loop holding SIGSEGV,
|
|
* does an OCaml stack overflow still raise Stack_overflow, or does it become a
|
|
* hard crash?
|
|
*
|
|
* Two ways of taking it are compared:
|
|
* take_segv -- install ours and discard OCaml's, the naive thing;
|
|
* chain_segv -- install ours, keep OCaml's, and forward to it.
|
|
*/
|
|
#include <caml/callback.h>
|
|
#include <caml/mlvalues.h>
|
|
#include <caml/memory.h>
|
|
#include <signal.h>
|
|
#include <stdio.h>
|
|
#include <string.h>
|
|
#include <unistd.h>
|
|
|
|
static struct sigaction ocaml_segv;
|
|
static int have_ocaml_segv = 0;
|
|
|
|
CAMLprim value spike_show_segv(value when) {
|
|
struct sigaction cur;
|
|
memset(&cur, 0, sizeof cur);
|
|
sigaction(SIGSEGV, NULL, &cur);
|
|
printf(" SIGSEGV %-46s handler=%p flags=%#x%s\n", String_val(when),
|
|
(cur.sa_flags & SA_SIGINFO) ? (void *)cur.sa_sigaction
|
|
: (void *)cur.sa_handler,
|
|
(unsigned)cur.sa_flags,
|
|
cur.sa_handler == SIG_DFL ? " (SIG_DFL)" : "");
|
|
fflush(stdout);
|
|
return Val_unit;
|
|
}
|
|
|
|
/* The break loop's handler. It does not long-jump here -- the point is only to
|
|
* see whether it is reached and whether OCaml still works around it. */
|
|
static void break_segv(int sig, siginfo_t *info, void *ctx) {
|
|
(void)sig;
|
|
if (have_ocaml_segv && ocaml_segv.sa_sigaction &&
|
|
ocaml_segv.sa_handler != SIG_DFL && ocaml_segv.sa_handler != SIG_IGN) {
|
|
/* Chained: hand the fault to OCaml, which turns a guard-page hit into
|
|
* Stack_overflow and re-raises anything else. */
|
|
ocaml_segv.sa_sigaction(sig, info, ctx);
|
|
return;
|
|
}
|
|
/* Taken outright: nothing below us. A real break loop would stop and serve;
|
|
* here we can only abort, which is the honest cost of discarding OCaml's. */
|
|
printf(" break loop caught SIGSEGV at %p with nothing to chain to\n",
|
|
info->si_addr);
|
|
fflush(stdout);
|
|
_exit(9);
|
|
}
|
|
|
|
static void install(int keep_old) {
|
|
struct sigaction sa;
|
|
memset(&sa, 0, sizeof sa);
|
|
memset(&ocaml_segv, 0, sizeof ocaml_segv);
|
|
sigaction(SIGSEGV, NULL, &ocaml_segv);
|
|
have_ocaml_segv = keep_old;
|
|
sa.sa_sigaction = break_segv;
|
|
sa.sa_flags = SA_SIGINFO | SA_ONSTACK | SA_NODEFER;
|
|
sigemptyset(&sa.sa_mask);
|
|
sigaction(SIGSEGV, &sa, NULL);
|
|
}
|
|
|
|
/* A sweep, so "the OCaml runtime installs handlers" can be stated as a list
|
|
* rather than a worry. Called from OCaml with the runtime and a domain up. */
|
|
CAMLprim value spike_sweep(value u) {
|
|
static const int sigs[] = { SIGSEGV, SIGBUS, SIGFPE, SIGILL, SIGINT, SIGTERM,
|
|
SIGPIPE, SIGCHLD, SIGUSR1, SIGUSR2, SIGABRT,
|
|
SIGALRM, SIGPROF, SIGVTALRM, SIGWINCH };
|
|
static const char *names[] = { "SEGV", "BUS", "FPE", "ILL", "INT", "TERM",
|
|
"PIPE", "CHLD", "USR1", "USR2", "ABRT",
|
|
"ALRM", "PROF", "VTALRM", "WINCH" };
|
|
struct sigaction c;
|
|
unsigned i;
|
|
(void)u;
|
|
for (i = 0; i < sizeof sigs / sizeof *sigs; i++) {
|
|
memset(&c, 0, sizeof c);
|
|
sigaction(sigs[i], NULL, &c);
|
|
if (c.sa_handler != SIG_DFL)
|
|
printf(" SIG%-8s %s\n", names[i],
|
|
c.sa_handler == SIG_IGN ? "SIG_IGN" : "custom handler");
|
|
}
|
|
printf(" (every signal not named above is SIG_DFL)\n");
|
|
fflush(stdout);
|
|
return Val_unit;
|
|
}
|
|
|
|
CAMLprim value spike_take_segv(value u) { (void)u; install(0); return Val_unit; }
|
|
CAMLprim value spike_chain_segv(value u) { (void)u; install(1); return Val_unit; }
|
|
|
|
#ifndef SPIKE_NO_MAIN
|
|
int main(int argc, char **argv) {
|
|
struct sigaction cur;
|
|
(void)argc;
|
|
memset(&cur, 0, sizeof cur);
|
|
sigaction(SIGSEGV, NULL, &cur);
|
|
printf(" SIGSEGV %-46s handler=%p%s\n", "before caml_startup",
|
|
(void *)cur.sa_handler, cur.sa_handler == SIG_DFL ? " (SIG_DFL)" : "");
|
|
/* Everything else runs from sig_ml.ml's module initialiser, so the readings
|
|
* happen on the runtime's own thread at the moments that matter. */
|
|
caml_startup(argv);
|
|
return 0;
|
|
}
|
|
#endif
|