/* 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