Review follow-ups: the park had the original bug inside it

- SA_NODEFER. sigaction without it blocks the handler's own signal for the
  whole handler, and here the handler is the park — it never returns. A
  hardware SIGSEGV delivered while SIGSEGV is blocked is not handled: the
  kernel forces the default action. Fault, park, eval something at the
  break loop that faults, daemon gone, exactly the author's session one
  level in. Measured both ways; flan_crash_entered is cleared before the
  hook so each break-loop fault still gets its line, and the case is pinned
  (trap_park ~refault:true), confirmed to fail without the flag.
- Scope the handler to the thread it was armed on. A disposition is per
  process and a merged dev session is one process, so this was shadowing
  OCaml's SIGSEGV handler — and Stack_overflow — for the daemon's whole
  life. Other threads chain to what was installed before. Arming per run
  would leave the parked prompt's evaluations unprotected, since those are
  program code too; the comment says so. Also makes the per-thread
  sigaltstack honest.
- Sweep dyn-view.flan and string-eq.flan, which dev-loop added after the
  first sweep. string-eq:46 wanted the aliasing outright: its comment is
  about two slices sharing a base pointer.
- A StorageExhausted row for bytes, asserting the retry copies once and
  whole rather than re-evaluating its argument.
- Gate the flan_dev_crash_enable declare to dev builds, so this lane adds
  no dev-only text to a release module. flan_bytes_dup stays ungated: a
  release build really calls it.
- Guard the section for wasm32, which compiles this file and has no
  signals.

FIX.org

@@ -4143,6 +4143,30 @@ took compiler, socket and session down together.
    the no-channel traps — the daemon stays alive, describe answers
    :condition "SegFault", evals still run. Release builds are untouched.
 
+** Found by review, fixed on the same branch
+- The park had the original bug inside it. sigaction without SA_NODEFER
+  blocks the handler's own signal for the whole handler, and here the
+  handler *is* the park — it never returns. A hardware SIGSEGV delivered
+  while SIGSEGV is blocked is not handled at all: the kernel forces the
+  default action. So fault, park, evaluate something at the break loop that
+  faults, and the daemon died exactly the way the author's session did.
+  Measured both ways before and after the flag. SA_NODEFER added,
+  flan_crash_entered cleared before the hook so each break-loop fault gets
+  its own line, and the case is pinned (trap_park ~refault:true) — the pin
+  was confirmed to fail without the flag rather than pass vacuously.
+- A disposition is per process, and a merged `flan dev' is one process with
+  the daemon in it: the handler was shadowing OCaml's SIGSEGV handler for
+  the daemon's whole life, including after the program run ended, which
+  turns a daemon-side stack overflow into a park instead of Stack_overflow.
+  Scoped to the thread it was armed on; other threads chain to whatever was
+  installed before. Arming per *run* was considered and is wrong — a
+  finished program still runs Flan from flan_merged_park's poll, so every
+  C-x C-e at the parked prompt would have been left unprotected. The thread
+  test also makes the per-thread sigaltstack honest, since only the armed
+  thread has one.
+- wasm32 compiles flan_dev.c and has no signals; the section is guarded and
+  flan_dev_crash_enable is a no-op there.
+
 ** Open directions left here
 - Read-only slice types. bytes-view is read-only *by convention* only: the
   type system has no way to say a [u8] cannot be stored through, so the

lib/check.ml

@@ -7550,7 +7550,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
              mk loc index_ty (Tast.Int (-1L, Types.I32));
              size_of loc u8; here loc ]
        in
-       expect loc ~want
+       expect ctx loc ~want
          (mk loc (Types.Slice u8)
             (Tast.Let
                ([ (sv, s);

lib/emit.ml

@@ -3831,7 +3831,6 @@ declare void @flan_dyn_root_globals_begin()
 declare void @flan_dyn_root_globals_end()
 declare void @flan_gc_init()
 declare void @flan_dev_reg_enable()
-declare void @flan_dev_crash_enable()
 declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64)
 declare void @flan_dev_reg_note_map(ptr, i64, i64, ptr, i64)
 declare i8 @flan_vec_init(ptr, ptr, i64, i64, i64, ptr, i64)
@@ -4354,6 +4353,14 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
       "@llvm.global_ctors = appending global [2 x { i32, ptr, ptr }] \
        [{ i32, ptr, ptr } { i32 65535, ptr @flan_dev_reg_enable, ptr null }, \
         { i32, ptr, ptr } { i32 65535, ptr @flan_dev_crash_enable, ptr null }]\n";
+    (* Declared here rather than in the preamble, which is the one place a
+       declare is worth gating: this lane then adds no dev-only text at all to
+       a release module, and the only line it does add there —
+       [flan_bytes_dup] — is a function release builds really call, since
+       (bytes s) allocates in every build. The neighbouring
+       [flan_dev_reg_enable] stays in the preamble ungated; it predates this
+       and moving it is not this lane's to make. *)
+    Buffer.add_string m.out "declare void @flan_dev_crash_enable()\n";
     Buffer.add_char m.out '\n'
   end;
   List.iter (emit_global m ~hidden) p.Tast.globals;

runtime/flan_dev.c

@@ -1863,22 +1863,67 @@ static void flan_reg_report(void) {
  *     because the commonest dev segfault is a stack overflow and a handler
  *     on the overflowed stack never runs. Thunks evaluated while parked run
  *     on that stack too, so it is a real stack, not a landing pad.
- *   - A fault inside the handler (or a second fault while parked) restores
+ *   - A fault inside the *reporting* restores the default disposition and
- *     the default disposition and re-raises: one loud death, never a loop.
+ *     re-raises: one loud death, never a loop. A fault raised by something
- *   - In a merged `flan dev' this shadows the OCaml runtime's own SIGSEGV
+ *     evaluated while parked is a different case and gets its own line and
- *     handler, which it uses to turn daemon-side stack overflow into a
+ *     its own break — see the clear of [flan_crash_entered] below, and
- *     Stack_overflow exception. That trade is accepted with eyes open: the
+ *     SA_NODEFER, without which neither could happen at all.
- *     program faulting is the case that happens, the daemon overflowing its
+ *   - A disposition is per *process*, and in a merged `flan dev' the daemon
- *     OCaml stack is not.
+ *     is that same process: the compiler thread and the agent's listener run
+ *     alongside the program, and OCaml installs a SIGSEGV handler of its own
+ *     to turn a daemon-side stack overflow into [Stack_overflow] (lib/dev.ml
+ *     deliberately lets that propagate). So this handler is scoped to the
+ *     ONE thread it was armed on — the thread the constructor ran on, which
+ *     is the thread that runs the program, since .init_array runs before any
+ *     other is spawned and [flan_program_main] wants the main thread for
+ *     raylib's sake. A fault on any other thread chains to whatever was
+ *     installed before, which is OCaml's handler, so the daemon keeps its
+ *     own behaviour unchanged.
+ *
+ *     Scoping by thread rather than by run is deliberate. The obvious
+ *     alternative — arm at the start of a run and restore when it ends —
+ *     is wrong here, because a finished program does not stop running Flan:
+ *     [flan_merged_park] polls from the parked process and every C-x C-e
+ *     typed at that prompt executes program code on this same thread.
+ *     Restoring at the end of the run would leave exactly those evaluations
+ *     unprotected, which is the crash this whole section exists to stop.
+ *     The thread test holds for the whole life of the process instead, and
+ *     needs nothing to remember where a run began or ended.
+ *
+ *     It is also what keeps the alternate stack honest: [sigaltstack] is
+ *     per-thread, so only the armed thread has one, and a thread without one
+ *     would run this handler on the stack that just overflowed. Those are
+ *     now the same set of threads by construction.
  *   - Under ASan the sanitizer's handler is the better report and arrives
  *     armed before any constructor here; detected (the weak __asan_init)
- *     and left alone.
+ *     and left alone. That skip is the one path here no test drives — it
+ *     needs the @sanitize sweep, not `dune test'.
+ *   - The report goes to fd 2 by write(2), where the break loop's own
+ *     listing already goes. What nobody has checked is whether a merged
+ *     build that routes fd 1 into a pipe leaves fd 2 somewhere an editor
+ *     actually shows; if a session ever reports a park with no line above
+ *     it, that is the first thing to look at, and the park itself is
+ *     visible over the socket regardless (describe answers "SegFault").
  *
  * Installed by a global constructor the compiler emits ONLY into dev builds,
  * next to the one that arms the allocation registry — a release build never
  * calls this, links no constructor naming it, and dies the way it always
  * did. */
 
+/* wasm32 has no signals at all — its <signal.h> is an #error unless a build
+ * asks for emulation — and it has no daemon to keep alive either: there is
+ * no merged `flan dev' in a browser, so the crash this section exists to
+ * survive cannot happen there. The symbol still has to resolve, because the
+ * constructor the emitter writes for a dev build does not know the target,
+ * so the whole section reduces to a no-op. Same guard shape flan_rt.c uses
+ * for the two things it cannot have there. */
+#if defined(__wasm__)
+
+void flan_dev_crash_enable(void) {}
+
+#else
+
+#include <pthread.h>
 #include <signal.h>
 #include <unistd.h>
 
@@ -1887,6 +1932,34 @@ extern void __asan_init(void) __attribute__((weak));
 
 static volatile sig_atomic_t flan_crash_entered;
 
+/* The thread this was armed on, and what was installed before it — the two
+ * halves of the scoping the header describes. [crash_prev] is kept per
+ * signal so that a chained SIGBUS is not handed SIGSEGV's old handler. */
+static pthread_t       crash_thread;
+static struct sigaction crash_prev_segv, crash_prev_bus;
+
+/* Hand the fault to whoever had the signal before this did. Three
+ * dispositions to honour and they are not interchangeable: a handler is
+ * called (SA_SIGINFO decides with which signature), SIG_DFL means restore
+ * and re-raise so the process dies the way it would have, and SIG_IGN on a
+ * hardware fault is not ignorable at all — the kernel forces the default —
+ * so it takes the same path as SIG_DFL rather than returning into an
+ * instruction that would fault again forever. */
+static void crash_chain(int sig, siginfo_t *si, void *uc) {
+  const struct sigaction *p = sig == SIGBUS ? &crash_prev_bus : &crash_prev_segv;
+  if ((p->sa_flags & SA_SIGINFO) != 0 && p->sa_sigaction != NULL) {
+    p->sa_sigaction(sig, si, uc);
+    return;
+  }
+  if (p->sa_handler != SIG_DFL && p->sa_handler != SIG_IGN
+      && p->sa_handler != NULL) {
+    p->sa_handler(sig);
+    return;
+  }
+  signal(sig, SIG_DFL);
+  raise(sig);
+}
+
 /* write(2) and byte-spelling only: the fault may have landed anywhere,
  * including inside stdio. */
 static void crash_puts(const char *s, size_t n) {
@@ -1904,7 +1977,12 @@ static void crash_hex(uintptr_t x) {
 }
 
 static void crash_handler(int sig, siginfo_t *si, void *uc) {
-  (void)uc;
+  /* Not the program's thread: this is the daemon's own fault to deal with,
+   * and OCaml's handler is the one that knows how. See the header. */
+  if (!pthread_equal(pthread_self(), crash_thread)) {
+    crash_chain(sig, si, uc);
+    return;
+  }
   if (flan_crash_entered++) goto die;
   crash_puts("\nflan: ", 7);
   if (sig == SIGBUS) crash_puts("SIGBUS", 6); else crash_puts("SIGSEGV", 7);
@@ -1928,6 +2006,15 @@ static void crash_handler(int sig, siginfo_t *si, void *uc) {
     crash_puts(why, sizeof why - 1);
   }
   if (flan_trap_hook != NULL) {
+    /* Cleared before the park, not after it, and this is the whole reason
+     * the guard is armed so narrowly. The park below runs arbitrary Flan —
+     * every C-x C-e typed at the break loop — so a *second* fault down there
+     * is a new fault in new code and deserves its own line and its own
+     * break, not the guard's silent death. What the guard still covers is a
+     * fault in the reporting above, where a second attempt would only fault
+     * again. The break loop's own BREAK_MAX is what stops a loop of these
+     * from nesting forever. */
+    flan_crash_entered = 0;
     /* Parks for good, exactly like NullAllocator and the other no-channel
      * traps: there is no address to resume *at* — the faulting instruction
      * would fault again — so this is a place to stand and read. */
@@ -1956,8 +2043,23 @@ void flan_dev_crash_enable(void) {
   if (ss.ss_sp == NULL || sigaltstack(&ss, NULL) != 0) return;
   memset(&sa, 0, sizeof sa);
   sa.sa_sigaction = crash_handler;
-  sa.sa_flags = SA_SIGINFO | SA_ONSTACK;
+  /* SA_NODEFER is load-bearing and was the original bug relocated. Without
+   * it the kernel blocks this signal for the whole handler — which here is
+   * the whole *park*, since the loop never returns — and a hardware SIGSEGV
+   * delivered while SIGSEGV is blocked is not queued or handled: the kernel
+   * forces the default action and the process dies on the spot, with no
+   * message. That is exactly the author's vanished session, one level in:
+   * fault, park, evaluate something at the break loop that faults, daemon
+   * gone. With SA_NODEFER the second fault re-enters this handler, which is
+   * what makes [flan_crash_entered] a guard that can actually run. */
+  sa.sa_flags = SA_SIGINFO | SA_ONSTACK | SA_NODEFER;
   sigemptyset(&sa.sa_mask);
-  sigaction(SIGSEGV, &sa, NULL);
+  /* Recorded before the install, not after: once [sigaction] returns, a
-  sigaction(SIGBUS, &sa, NULL);
+   * fault can arrive, and a handler that has not yet learned which thread it
+   * belongs to would take the daemon's faults as the program's. */
+  crash_thread = pthread_self();
+  sigaction(SIGSEGV, &sa, &crash_prev_segv);
+  sigaction(SIGBUS, &sa, &crash_prev_bus);
 }
+
+#endif  /* !__wasm__ */

test/programs/exhausted.flan

@@ -86,6 +86,35 @@
       (free v)))
   (println (> failures 0))              ; true
 
+  ;; And (bytes s), which became an allocating operation when it stopped
+  ;; aliasing the string (FIX.org, the INSERTIONSORT crash). It is under the
+  ;; same rule as everything above and had better prove it: the copy is one
+  ;; request for the string's whole length, so a ceiling below that fails it
+  ;; outright, the handler raises the ceiling and retries, and what comes back
+  ;; is the complete copy rather than a short one.
+  ;;
+  ;; The retry is the half worth pinning. The string is bound to a slot before
+  ;; the guard's loop — the same rule push follows for its element — so a
+  ;; retry re-attempts the *copy* and never re-evaluates the expression that
+  ;; produced the string. A second evaluation would be invisible here if the
+  ;; bytes were right, which is exactly why the count is asserted too.
+  (set-alloc-budget tight 8)
+  (set failures 0)
+  (handler-bind
+    [(StorageExhausted [c]
+       (set failures (+ failures 1))
+       (set-alloc-budget tight 4096)
+       (invoke-restart 'retry))]
+    (let [b (bytes "INSERTIONSORT" tight)]
+      (println (len b))                 ; 13 — the whole string, not a prefix
+      (println (at b 0))                ; 73 — \I
+      (println (at b 12))               ; 84 — \T, the last byte
+      ;; Writable, which is the point of the copy, and the literal is untouched.
+      (set (at b 0) \Z)
+      (println (at b 0))                ; 90
+      (println "INSERTIONSORT")))       ; INSERTIONSORT
+  (println failures)                    ; 1 — failed once, retried once
+
   ;; And the restart is not once-per-program: it is established at each
   ;; allocation, so a later one offers it again.
   (set-alloc-budget tight 0)

test/test_acceptance.ml

@@ -1538,7 +1538,10 @@ let () =
        the whole block at once and clone asks for the source's length.
        At -O0 because the retry loop and the guard after the error are control
        flow an optimiser would otherwise launder. *)
-    let exhausted_out = "64\n0\n126\ntrue\ntrue\n4\ntrue\n0\n8\n7\ntrue\n" in
+    let exhausted_out =
+      "64\n0\n126\ntrue\ntrue\n4\ntrue\n0\n8\n7\ntrue\n\
+       13\n73\n84\n90\nINSERTIONSORT\n1\n"
+    in
     outputs "storage exhausted, retried" "programs/exhausted.flan" exhausted_out;
     outputs ~opt:"-O0" "storage exhausted, retried, -O0" "programs/exhausted.flan"
       exhausted_out;

test/test_dev.ml

@@ -1527,7 +1527,7 @@ let () =
        standalone half of the same claim is test_acceptance.ml's
        free-all-refused, which still exits 134: nothing installs the hook in a
        program that did not import the agent. *)
-    let trap_park what prog cond restarts =
+    let trap_park ?(refault = false) what prog cond restarts =
       let tsock = tmp (prog ^ ".sock") and tout = tmp (prog ^ ".out") in
       (try Sys.remove tsock with Sys_error _ -> ());
       let tfd =
@@ -1643,6 +1643,39 @@ let () =
           if Wire.string_field r "value" <> Some "4" then
             fail "an expression while parked at the %s trap: %s" what
               (Option.value ~default:(status r) (Wire.string_field r "message"));
+          (* And the fault taken *while already parked*, which is the first
+             bug this whole section fixed, relocated one level in. A handler
+             installed without SA_NODEFER leaves its own signal blocked for
+             the life of the park — and the park never returns — so a second
+             hardware SIGSEGV is not delivered to it at all: the kernel
+             forces the default action and the process dies on the spot with
+             no message. Fault, park, evaluate something at the break loop
+             that faults, daemon gone, exactly the way the author's session
+             went. Measured before the flag was added: the evaluation below
+             got no reply and the next request found a dead socket.
+
+             What is asserted is only the part that matters — that the
+             daemon is still there afterwards. The faulting evaluation's own
+             reply is an error either way (the thunk never reaches a frame
+             boundary) and is not worth pinning a sentence of. *)
+          if refault then begin
+            let faulting =
+              "(:op \"eval-expr\" :code \
+               \"(let [v (bytes-view \\\"refault\\\")] (set (at v 0) 90) 1)\" \
+               :file \"/tmp/buf.flan\")"
+            in
+            (match ask faulting with _ -> () | exception _ -> ());
+            let r =
+              try
+                ask "(:op \"eval-expr\" :code \"(+ 2 2)\" :file \"/tmp/buf.flan\")"
+              with _ -> Wire.parse "(:status \"gone\")"
+            in
+            if Wire.string_field r "value" <> Some "4" then
+              fail
+                "a second fault at the %s break killed the daemon — the park \
+                 is only as good as SA_NODEFER: %s"
+                what (status r)
+          end;
           (* Torn down by [abort], not by [close]: a trap parks for good, so
              there is no resume to wait for and nothing to gain by waiting.
 
@@ -1683,7 +1716,7 @@ let () =
        asserts for them holds here too: stopped and describable, an eval still
        answered, a resume refused. The program writes through bytes-view,
        which is the surviving spelling of that crash. *)
-    trap_park "segfault" "dev-segv.flan" "SegFault" [];
+    trap_park ~refault:true "segfault" "dev-segv.flan" "SegFault" [];
 
     (* ── The locals of a stopped frame ─────────────────────────────── *)