The dev daemon re-runs under two processes, knows whose break it is, guards its socket, runs under sanitizers, and unloads evaluated modules

README.md

@@ -262,9 +262,9 @@ driver at all — it goes `llc` + `ld -shared` + `dlopen`, which is what makes
 is a confusing shape of failure to meet without warning.
 
 Variables beginning `FLAN_DEV_` other than `FLAN_DEV_LEAKS`, plus
-`FLAN_AGENT_SOCKET` and `FLAN_COMPILER_STAMP`, are internal: `flan dev` sets
+`FLAN_AGENT_SOCKET`, `FLAN_AGENT_OWNER` and `FLAN_COMPILER_STAMP`, are
-them across its own `exec` to hand the merged binary what it needs. Setting
+internal: `flan dev` sets them across its own `exec` to hand the merged binary
-them by hand is not supported.
+what it needs. Setting them by hand is not supported.
 
 ## Checking it
 

TODO.org

@@ -1484,10 +1484,6 @@ out the first element typing the rest.
 
 * Dev loop
 
-** TODO Every evaluated expression leaves its module mapped
-Each C-x C-e loads its own =.so= and never unloads it, so a session's mapping count
-grows by about four per evaluation; the kernel's limit (65530) ends a long session.
-
 ** TODO A prelude function shadowed live is reached by the prelude's own calls
 A defn of a prelude function's name sent to a running =flan dev= installs into the
 host's cell for that name, so the prelude's calls compiled into the host follow it;
@@ -1529,12 +1525,6 @@ A finished program parks instead of dying, and a daemon op wakes it and re-enter
 Globals are not reset between runs — the process never died. Rules out a fresh
 process per run.
 
-** NEXT Re-run does not work under --two-process
-Decided 2026-09-25: re-run under =--two-process= starts a fresh child, installed redefinitions included, and says that globals start over because the process is new.
-A finished child process is genuinely gone, so there is nothing to wake. Re-run is
-merged-build only, and since the default backend runs merged it is no longer the
-blocked case.
-
 ** DONE An accepted re-run reads as running
 CLOSED: [2026-09-21]
 A caller that asked for a re-run and then waited for the program to park was
@@ -1570,14 +1560,6 @@ was delivered" is a generation number rather than a name, so evaluating from
 inside a break into a thunk that stops on the same condition class is settled by
 comparing two integers.
 
-** NEXT Whose break it is, which no counter answers
-Decided 2026-09-25: fix it. A stop records whether the thread that stopped was running the evaluation's thunk or the program's own code, so the sentence is decided by the frame and not by the generation counter.
-A game loop that signals during the build or the wait bumps the generation exactly
-as a thunk would. The machine-readable fields stay right; what is wrong is the
-sentence. The per-frame program-or-eval label is computed by the daemon from
-ownership, not from anything in the frame, so this is not the shadow-stack gap it
-was once written down as. Not queued — the window is narrow.
-
 ** DONE The first evaluation no longer stalls behind the agent socket
 The accept loop used to sit behind a ten-second wait for the agent socket, so a
 program that binds its socket late — or not at all — looked ready and answered
@@ -1623,13 +1605,6 @@ prunes a package nothing calls into in a release build. =flan dev= links the
 agent's C into every program it builds whether or not the source imports it; a
 release build links it only when the program calls into it.
 
-** NEXT FLAN_AGENT_SOCKET in a shell's environment steals the socket
-Decided 2026-09-25: narrow the gate. The daemon also exports its own pid, and the constructor binds the socket only when that pid is the program's parent (or the program itself, in a merged build).
-Binding unlinks the path first, and before the constructor that unlink was reached
-only by an explicit call. A sentence about the shape of the gate rather than an
-observed problem: only the daemon sets the variable and it never runs release
-builds. The fix, if it is ever felt, is a narrower gate.
-
 ** DONE The daemon's "has not called (agent/start ...)" note is unreachable
 CLOSED: [2026-09-25]
 Retired, with the matching arm of an evaluation's timeout, because it named the
@@ -1729,10 +1704,11 @@ out versioned bodies and trampolines, and redirecting a value taken before the
 change. =main= stays refused: its caller is startup code no cell reaches.
 docs/BUILT.md, "A signature change installs".
 
-** DONE A module carrying a string literal is never unloaded
+** DONE An expression's module is unloaded unless it hands out a constant
-The transient rule is that a module retaining nothing may go, and a string literal
+CLOSED: [2026-09-25]
-counts as something retained — which silently stopped every module carrying one
+A thunk's string literal is a copy the process keeps, and registry names and initial
-from ever being unloaded. That is why frame descriptors got their own counter.
+images are copied by the runtime, so none of them pins the module; a condition's
+name or a restart's text still does. Rules out unloading on a guess about a literal.
 
 ** DONE A redefinition delivered while parked installs on the next re-run
 The park used to drain the agent ring only when something had asked it to poll,
@@ -1778,13 +1754,6 @@ nothing orders the two. The read raised on a closed socket and the test binary
 exited 1 with no failure line, which is the worst shape a failure can have when
 a lane is judged on the exit status.
 
-** NEXT A program driven by a real flan dev daemon under a sanitizer
-Decided 2026-09-25: =flan dev --sanitize= builds the host under ASan/UBSan on the LLVM backend (refused by name with =--x86=), and the @sanitize alias gains a case driving a real session through reloads and a break.
-The daemon builds its host through its own path and the CLI has no way to pass a
-sanitizer flag to it. Named as the check worth adding next; a day rather than an
-hour. The x86 backend is not a gap here — that pair is refused by name, because
-there is no sanitizer pass over hand-written assembly.
-
 ** DONE A transient signal 11 on a globals daemon
 CLOSED: [2026-09-25]
 Not a segfault. The report was OCaml's signal number, and in OCaml's numbering
@@ -1836,11 +1805,12 @@ line and every later row unrun.
 gone. The dev daemon now removes its own on a clean end; the one-shot commands do
 not.
 
-** TODO An x86 dev session's dyn global sometimes reads wrong after an allocating thunk
+** WAIT An x86 dev session's read of a dyn global after an allocating thunk failed once
-test_dev's =--x86: after a thunk that allocates (cycle 1) the parked program's dyn
+WAIT on a recurrence; the test now prints the failing read's own reply.
-global reads "kept"= failed once in a full =dune test= on 2026-09-25 and passed three
+The one failure's message came from a second read, which said "kept"; the failing
-direct reruns. Intermittent and GC-shaped: a dyn global read after a collection a
+reply itself was not recorded. Not reproduced in 350 churn-and-read cycles under
-C-x C-e thunk triggered. Needs reproducing under load and fixing.
+8-way load, three concurrent test_dev runs, or a valgrind run of the cycle, which
+was clean.
 
 * Editor
 

bin/main.ml

@@ -799,7 +799,11 @@ let () =
        which is the point of leaving it readable here — the combination stays
        refused by name, it is just no longer somewhere you arrive by typing one
        flag. *)
-    let x86 = backend_x86 ~default:(not debug) rest in
+    (* --sanitize takes [--llvm]'s side for the reason [--debug] does: the
+       sanitizers are LLVM passes. [--x86] written as well is refused by name
+       in [Dev.start]. *)
+    let sanitize = List.mem sanitize_flag rest in
+    let x86 = backend_x86 ~default:(not (debug || sanitize)) rest in
     let asked_x86 = List.mem x86_flag rest in
     let merged = not (List.mem two_process_flag rest) in
     let rest = List.filter (fun a -> not (is_flag a)) rest in
@@ -809,8 +813,8 @@ let () =
       | [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock"
       | _ ->
         prerr_endline
-          "usage: flan dev <program.flan> [-s socket] [--debug] [--llvm] \
+          "usage: flan dev <program.flan> [-s socket] [--debug] [--sanitize] \
-           [--two-process]";
+           [--llvm] [--two-process]";
         exit 2
     in
     (* Only this command hands one over, and only when it chose the backend
@@ -826,7 +830,7 @@ let () =
       else None
     in
     with_errors ?x86_hint path (fun () ->
-      Flan.Dev.start ~debug ~merged ~x86 ~file:path ~sock ())
+      Flan.Dev.start ~debug ~sanitize ~merged ~x86 ~file:path ~sock ())
 
   (* One redefinition, built the way an editor will ask for it: a session over
      the program the process was built from, and a file of the forms that

docs/BUILT.md

@@ -1045,8 +1045,9 @@ the two builds are *supposed* to differ, since `flan_dev_crash_enable` checks a
 install the handler when ASan is in the process. So the case asserts ASan's report and the absence of the handler's
 line, built at `-O0` because at `-O2` a store through a zeroed `(Ptr u8)` is undefined and need not fault. That yield had
 never run in any build anywhere: it was behind a link that did not happen. Twenty-six seconds of the alias's 2m30 warm.
-What it still does not reach is a program driven by a real daemon under ASan: `flan dev` builds its host through its own
+`dev_session` drives a real `flan dev --sanitize` session — merged, LLVM, the compiler's OCaml in the same process as
-path and has no `--sanitize` to pass it.
+the sanitized host — through a break, three reloads and a second break; the modules it sends are still not
+instrumented.
 
 **Two aliases were green only because `dune test` runs first, and that is the same disease in a different place.**
 `@sanitize` never listed the package directories `pkg-diamond.flan` imports and `@page` never listed `sand.flan`, which
@@ -1821,7 +1822,9 @@ shape TODO.org's "The compiler is a thread inside the program" landed on: **the
 program's process. It is SLIME's model — you start the image, it serves, the editor connects.
 
 `--two-process` is the escape hatch, for a machine where the compiler object cannot be built (no `ocamlfind`, no
-`flan.cmxa` beside the binary). It has its own test and it stays.
+`flan.cmxa` beside the binary). It has its own test and it stays. A re-run there is a new child built from the session
+as it stands, so the redefinitions are in it and the globals start over; the daemon outlives a finished child to take
+that request.
 
 **The editor socket and its wire protocol did not move.** Emacs cannot tell the difference, which is what made the merge
 testable: the whole existing suite is the check.

lib/dev.ml

@@ -28,11 +28,15 @@ type t = {
   (* The running program. [Some pid] is the two-process daemon, which launched
      it; [None] is the merged build, where the program is *this* process and
      the compiler is a thread inside it. That is the whole of the difference at
-     this layer — see [merged_setup] for why there is no third case. *)
+     this layer — see [merged_setup] for why there is no third case. A re-run
-  child   : int option;
+     under --two-process replaces the child with a new one. *)
+  mutable child : int option;
   agent   : string;              (* where it listens for modules *)
   dir     : string;              (* modules are built here, one per eval *)
-  stdout  : Unix.file_descr;     (* the program's output, on its way to here *)
+  mutable stdout : Unix.file_descr; (* the program's output, on its way here *)
+  (* --two-process only: build the program again from the session as it is
+     now and start it, answering the new child and its stdout. *)
+  relaunch : (unit -> int * Unix.file_descr) option;
   out     : Buffer.t;            (* ...buffered until an editor asks for it *)
   mutable n : int;               (* dlopen caches by path: never reuse one *)
   (* Bookkeeping for disassembly, and the reason it can exist at all: the
@@ -268,10 +272,41 @@ let deliver_at_stop t ~gen path =
    [None] where the program cannot be reached or answers something else, and
    the caller treats that the way it treats a missing refusal count: as no
    evidence, not as zero. Zero is a fact — it means running. *)
-let stop_gen t : int option =
+let stop_reply t =
   match request t "stop" with
   | exception Unix.Unix_error _ -> None
-  | text -> int_of_string_opt (String.trim text)
+  | text ->
+    (match String.split_on_char ' ' (String.trim text) with
+     | g :: rest ->
+       Option.map (fun g -> (g, rest)) (int_of_string_opt g)
+     | [] -> None)
+
+let stop_gen t : int option = Option.map fst (stop_reply t)
+
+(* How many evaluated expressions the agent has queued, and the highest one
+   that has returned a value; [None] from an agent without the verb. *)
+let calls t : (int * int) option =
+  match request t "calls" with
+  | exception Unix.Unix_error _ -> None
+  | text ->
+    (match String.split_on_char ' ' (String.trim text) with
+     | [ q; v ] ->
+       (match int_of_string_opt q, int_of_string_opt v with
+        | Some q, Some v -> Some (q, v)
+        | _ -> None)
+     | _ -> None)
+
+(* The same stop with whose code it stopped in: [Some true] when the thread
+   was running an evaluated thunk, [Some false] when it was in the program's
+   own code, [None] from an agent that does not say. *)
+let stop_owner t : (int * bool option) option =
+  Option.map
+    (fun (g, rest) ->
+       (g, match rest with
+           | [ "eval" ] -> Some true
+           | [ "program" ] -> Some false
+           | _ -> None))
+    (stop_reply t)
 
 (* How many stopped-only modules the program has thrown away for reaching the
    game thread while it was running, and the sentence the agent says about it.
@@ -804,7 +839,8 @@ let build_module (c : Session.change) ~debug ~out =
    spelled once so that every op tells the same story.
 
    [gone] is what all of them used to say and is now said only where it is
-   true: there is no process left and nothing short of a new one will help.
+   true: there is no process left and nothing short of a new one will help —
+   which, under --two-process, a re-run is.
 
    [parked] is the new half, and the sentence it appends is the whole point of
    the distinction. Somebody reading it has a program that is *there* — its
@@ -815,7 +851,7 @@ let build_module (c : Session.change) ~debug ~out =
    refused for want of a frame boundary and an op refused for want of a stopped
    stack are refused by the same state for different causes, and a reader who
    cannot tell them apart cannot tell what to do instead. *)
-let gone = "the program exited; restart flan dev"
+let gone = "the program exited; M-x flan-rerun starts it again"
 
 let parked_msg why =
   why
@@ -1018,7 +1054,25 @@ let eval ?forms ?base ?(extra = []) t ~code ~origin ~pause =
      nothing that can go wrong after it. *)
   let before = Session.held t.session in
   let refused msg = Session.restore t.session before; error msg in
-  if now = Gone then error gone
+  if now = Gone && t.relaunch <> None then
+    (* --two-process, the child ended: the form is checked into the session
+       and nothing is sent, because the next process is built from the
+       session whole ([rerun]). *)
+    match
+      Session.eval ~origin ?base ?forms ?pause ~running:false t.session code
+    with
+    | c ->
+      ok
+        ([ ":names " ^ Wire.strings c.Session.names; ":fns ()";
+           ":note "
+           ^ Wire.quote
+               "loaded; the program has ended, so this is in it when M-x \
+                flan-rerun starts it again" ]
+         @ extra)
+    | exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } ->
+      Session.restore t.session before;
+      error ~loc:(Loc.to_string l) msg
+  else if now = Gone then error gone
   else
     match
       Session.eval ~origin ?base ?forms ?pause ~running:(not parked_now)
@@ -1212,6 +1266,10 @@ let eval_expr t ~code ~origin ~pause =
     match Session.eval_expr ~origin ~pause t.session code with
     | c ->
       let before = match result t with Some (g, _) -> g | None -> 0L in
+      (* This expression's number among those the agent has queued: an
+         earlier one resumed by a restart can publish after this one is sent,
+         and the result counter alone would take its value for this one's. *)
+      let mine = Option.map (fun (q, _) -> q + 1) (calls t) in
       (* Read here, beside [before], and for the same kind of reason: all
          three are the "how things stood" half of a difference the wait below
          measures. A program already sitting in a break when the request
@@ -1225,17 +1283,9 @@ let eval_expr t ~code ~origin ~pause =
          the reason [stop_gen]'s note gives at its definition. The name is kept
          beside it as the fallback for an agent that cannot answer the verb.
 
-         As early as it usefully can be, and still not early enough to be
+         A game loop that signals *on its own* while this is in flight bumps
-         exact: [build_module] below takes a couple of hundred milliseconds,
+         the generation too, so a fresh stop is not yet the thunk's. The stop
-         and a game loop that signals *on its own* during them — or mid-wait,
+         itself says whose it is — see [settled] below. *)
-         while the thunk is still perfectly fine — bumps the generation too.
-         The reply then says "the expression stopped on X" about an expression
-         that had not run. Its machine-readable half stays right, so the editor
-         opens the break the program is actually in; only the sentence is
-         wrong, and no counter closes this one, because the program's break and
-         the thunk's are the same kind of event. Separating them wants the
-         per-frame origin the backtrace carries, which is LLVM-only.
-         TODO.org, "Whose break it is, which no counter answers" has it. *)
       let entered = state t in
       let entered_gen = stop_gen t in
       t.n <- t.n + 1;
@@ -1323,12 +1373,17 @@ let eval_expr t ~code ~origin ~pause =
                re-stop between them could pair a stale name with a fresh
                generation; it cannot manufacture one, since the generation only
                climbs when a break really was entered. *)
+            (* A fresh stop in the program's own code is not an answer: the
+               thunk has not run, and the break loop that stop entered polls
+               the ring, so the thunk runs inside it and its value arrives on
+               a later tick. *)
             let settled now =
               match now with
               | Stopped c ->
                 let fresh =
-                  match stop_gen t, entered_gen with
+                  match stop_owner t, entered_gen with
-                  | Some g, Some g0 -> g > g0
+                  | Some (_, Some false), _ -> false
+                  | Some (g, _), Some g0 -> g > g0
                   | _ ->
                     (match entered with Stopped c0 -> c0 <> c | _ -> true)
                 in
@@ -1368,6 +1423,13 @@ let eval_expr t ~code ~origin ~pause =
                  the sleep has to stay a sleep. *)
               drain t;
               let value () =
+                let returned =
+                  match mine, calls t with
+                  | Some m, Some (_, v) -> v >= m
+                  | _ -> true
+                in
+                if not returned then None
+                else
                   match result t with
                   | Some (g, v) when Int64.compare g before > 0 -> Some v
                   | _ -> None
@@ -3643,7 +3705,54 @@ let abort t =
    park, the next request went out while the first run had not started, and the
    pair of them produced one run — or, a moment later, a refusal saying the
    program was already running. Both faces are gone with the lag. *)
+(* Under --two-process a finished child is gone and there is no thread to
+   wake, so a re-run is a new process: the program is built again from the
+   session as it stands, which puts every accepted redefinition in it from
+   the start, and its globals start over. *)
+let relaunch_child t relaunch =
+  match liveness t with
+  | Live | Parked ->
+    error
+      (if parked_break t then
+         "the program is stopped at a break, so it cannot be started again \
+          until that ends: resume it or abort it"
+       else
+         "the program is still running; a re-run starts it again in a new \
+          process once this one has finished. Close its window, or let it \
+          finish, and ask again")
+  | Gone ->
+    (* The whole program is checked again first ([Session.rehost]); a caller
+       left compiled against a signature that has since changed is where
+       that fails. *)
+    let refused (d : Loc.diag) =
+      error ~loc:(Loc.to_string d.Loc.dloc)
+        ("a re-run builds the whole program again, and it does not compile: "
+         ^ d.Loc.dmsg ^ ". Fix this and load it with C-c C-c, then ask again")
+    in
+    (match relaunch () with
+     | child, rd ->
+       drain t;
+       (try Unix.close t.stdout with Unix.Unix_error _ -> ());
+       t.stdout <- rd;
+       t.child <- Some child;
+       t.finished <- false;
+       t.died <- None;
+       (* Every body is in the new host now, so no module owns one. *)
+       Hashtbl.reset t.owners;
+       ok
+         [ ":note "
+           ^ Wire.quote
+               "started the program again in a new process, built with every \
+                change loaded so far; its globals start over, because the \
+                process is new" ]
+     | exception Failure m -> error m
+     | exception Loc.Error d -> refused d
+     | exception Loc.Errors (d :: _) -> refused d)
+
 let rerun t =
+  match t.relaunch with
+  | Some relaunch -> relaunch_child t relaunch
+  | None ->
   match liveness t with
   | Gone -> error gone
   (* A file started with no [main] runs a stub that returns at once; running
@@ -5062,8 +5171,11 @@ let accept_loop ?grace t ls =
        where a session with no editor attached spends its time. *)
     agent_check t;
     match liveness t with
-    | Gone -> ()
+    | Gone when t.relaunch = None -> ()
-    | (Live | Parked) as live ->
+    | live ->
+      (* A --two-process child that has ended can be started again, so the
+         session waits as a parked one does, on the parked grace. *)
+      let live = if live = Gone then Parked else live in
       let idle = Unix.gettimeofday () -. !since in
       if orphaned ~grace ~served:!served ~idle live then
         (* The measured gap and not the threshold it crossed: the threshold is
@@ -5076,7 +5188,10 @@ let accept_loop ?grace t ls =
       else
         (* The program's pipe is in the same select as the listening socket: it
            has to be drained whether or not an editor is asking for anything. *)
-        match Unix.select [ ls; t.stdout ] [] [] 0.2 with
+        (* Not once it has read EOF: an ended child's pipe is readable for
+           ever, and the loop would spin on it. *)
+        let fds = if t.finished then [ ls ] else [ ls; t.stdout ] in
+        match Unix.select fds [] [] 0.2 with
         | [], _, _ -> go ()
         | ready, _, _ when not (List.mem ls ready) -> drain t; go ()
         | _ ->
@@ -5224,7 +5339,7 @@ let report_dropped ~file = function
    deletes it — and silently making every reloaded body -O0 would change the
    frame time of the one function you are iterating on, in the loop whose whole
    point is watching that number. *)
-let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
+let two_process ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock () =
   let t0 = Unix.gettimeofday () in
   (* Absolute, because every location this daemon ever reports is derived from
      it and an editor is not in this process's working directory. [flan dev
@@ -5251,19 +5366,22 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
      against each module as it loads either way, but a breakpoint set on a line
      in the .flan buffer needs a line table on both sides — the host's to fire
      before the first C-c C-c, the module's to follow the reload. *)
-  let _, kept =
-    Build.executable
-      ~opts:{ Build.default with Build.dev = true; Build.keep = true;
-                                 Build.debug; Build.x86 }
-      ~csrcs ~lflags session.Session.host ~out:exe
-  in
   (* Host and modules are chosen together, which is the whole licence: an
      [--x86] host gets [--x86] modules because one flag set both, and the
      source [Build.executable] kept is assembly rather than IR. *)
   let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in
-  (match kept with
+  let build_host () =
+    let _, kept =
+      Build.executable
+        ~opts:{ Build.default with Build.dev = true; Build.keep = true;
+                                   Build.debug; Build.sanitize; Build.x86 }
+        ~csrcs ~lflags session.Session.host ~out:exe
+    in
+    match kept with
     | Some src -> (try Sys.rename src host_ll with Sys_error _ -> ())
-   | None -> ());
+    | None -> ()
+  in
+  build_host ();
   let agent = Filename.concat dir "agent.sock" in
 
   (* The program's source names some socket path; the daemon is the one that
@@ -5271,6 +5389,10 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
      environment. Guessing instead would fail silently — everything compiles,
      the module is built, and nothing ever receives it. *)
   Unix.putenv "FLAN_AGENT_SOCKET" agent;
+  (* The child binds that path only if this pid is its parent, so a process
+     that merely inherited the variable leaves the socket alone
+     (flan_agent.c, [daemon_socket]). *)
+  Unix.putenv "FLAN_AGENT_OWNER" (string_of_int (Unix.getpid ()));
   (* And who its parent is, which is the child's licence to end itself.
      vendor/agent/flan_agent.c carries the argument at length; the half that
      belongs here is that this daemon is the only thing that ever kills its
@@ -5295,23 +5417,39 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
      the pipe it was writing to; that also meant the pipe could never reach
      EOF while the child lived, so "wait for EOF on the daemon's end" was never
      the mechanism it looked like it could be. *)
+  let spawn () =
+    (* A socket file a previous child left behind would answer the wait below
+       before this child has bound anything. *)
+    (try Unix.unlink agent with Unix.Unix_error _ -> ());
     let rd, wr = Unix.pipe ~cloexec:true () in
     let child = Unix.create_process exe [| exe |] Unix.stdin wr Unix.stderr in
     Unix.close wr;
     Unix.set_nonblock rd;
-
+    (* Wait for it to bind before accepting an evaluation. One that arrives
-  (* Wait for it to bind before accepting an evaluation. One that arrives first
+       first would fail for a reason that reads like a compiler bug. *)
-     would fail for a reason that reads like a compiler bug. *)
     if not (await (fun () -> Sys.file_exists agent)) then begin
       (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
+      (try Unix.close rd with Unix.Unix_error _ -> ());
       failwith
         ("the program did not open its agent socket at " ^ agent
          ^ ". Under --two-process every edit reaches the program through that \
             socket.")
     end;
+    (child, rd)
+  in
+  let child, rd = spawn () in
+  (* A re-run: the host is built again from the session as it stands, so
+     every redefinition accepted so far is in the new process from its first
+     instruction rather than delivered to it later. *)
+  let relaunch () =
+    Session.rehost session;
+    build_host ();
+    spawn ()
+  in
 
   let t =
     { session; child = Some child; agent; dir; stdout = rd;
+      relaunch = Some relaunch;
       out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
       host_ll; host_exe = exe; finished = false; agent_watch = None;
         park_noted = false; died = None; dropped = 0 }
@@ -5325,9 +5463,12 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
     ((Unix.gettimeofday () -. t0) *. 1000.);
   Fun.protect
     ~finally:(fun () ->
-      (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
+      (match t.child with
+       | Some child ->
+         (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ())
+       | None -> ());
       (try Unix.close ls with Unix.Unix_error _ -> ());
-      (try Unix.close rd with Unix.Unix_error _ -> ());
+      (try Unix.close t.stdout with Unix.Unix_error _ -> ());
       (try Unix.unlink sock with Unix.Unix_error _ -> ()))
     (fun () -> accept_loop t ls);
   (* Here only when the loop returned: an exception out of it has already
@@ -6170,7 +6311,7 @@ let merged_setup () =
       with Unix.Unix_error _ -> Sys.executable_name
     in
     let t =
-      { session; child = None; agent; dir; stdout = rd;
+      { session; child = None; agent; dir; stdout = rd; relaunch = None;
         out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
         host_ll; host_exe = exe; finished = false; agent_watch = None;
         park_noted = false; died = None; dropped = 0 }
@@ -6253,7 +6394,7 @@ let merged_serve () =
 (* The merged build is made here and then [exec]'d, so what an editor talks to
    is the program itself rather than something that launched it. The launcher
    does not survive: there is one process from the first reply onwards. *)
-let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
+let start_merged ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock () =
   let t0 = Unix.gettimeofday () in
   let dir = session_dir ~file ~sock in
   let given = file in
@@ -6271,7 +6412,8 @@ let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
   let host_ll = Filename.concat dir (if x86 then "host.s" else "host.ll") in
   ignore
     (merged_executable
-       ~opts:{ Build.default with Build.dev = true; Build.debug; Build.x86 }
+       ~opts:{ Build.default with Build.dev = true; Build.debug;
+                                  Build.sanitize; Build.x86 }
        ~csrcs ~lflags ~pnames:[]
        session.Session.host ~out:exe ~ll:host_ll);
   (* Read by the park, so the first one says the session is waiting rather
@@ -6284,6 +6426,9 @@ let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
      that the game thread's [getenv] cannot race the compiler thread's
      [putenv]: there is no ordering left to get wrong. *)
   Unix.putenv "FLAN_AGENT_SOCKET" agent;
+  (* This pid, because the exec below keeps it: the program is the owner
+     flan_agent.c's [daemon_socket] looks for. *)
+  Unix.putenv "FLAN_AGENT_OWNER" (string_of_int (Unix.getpid ()));
   Unix.putenv "FLAN_DEV_SOURCE" file;
   Unix.putenv "FLAN_DEV_SOCK" sock;
   Unix.putenv "FLAN_DEV_DIR" dir;
@@ -6309,7 +6454,17 @@ let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
    flan.cmxa beside the binary — and it is what every behaviour in this file
    was written against, so it stays until the transport it exists to drive is
    actually deleted. *)
-let start ?(debug = false) ?(merged = true) ?(x86 = true) ~file ~sock () =
+let start ?(debug = false) ?(sanitize = false) ?(merged = true) ?(x86 = true)
+    ~file ~sock () =
+  (* The sanitizers are LLVM passes, and the x86 backend's host is written
+     by hand with no pass run over it. The modules a session sends are not
+     instrumented on either backend; what is checked is the host and the
+     runtime, which is where a dev session's own bookkeeping lives. *)
+  if x86 && sanitize then
+    failwith
+      "flan dev --x86 --sanitize: the sanitizers instrument LLVM's output, and \
+       the x86 backend writes its code by hand, so the program's own code \
+       would not be checked. Drop --x86 to build this session with LLVM.";
   (* x86 unless told otherwise, and the default is here rather than only in
      [bin/main.ml] so that there is one answer to "what backend is a dev
      session". A library caller that starts a daemon starts the same daemon the
@@ -6359,5 +6514,5 @@ let start ?(debug = false) ?(merged = true) ?(x86 = true) ~file ~sock () =
 
      [--x86 --debug] above is still refused, and for a reason that has nothing
      to do with this one. *)
-  if merged then start_merged ~debug ~x86 ~file ~sock ()
+  if merged then start_merged ~debug ~sanitize ~x86 ~file ~sock ()
-  else two_process ~debug ~x86 ~file ~sock ()
+  else two_process ~debug ~sanitize ~x86 ~file ~sock ()

lib/emit.ml

@@ -539,6 +539,12 @@ type m = {
      [annot]. *)
   ann : bool;
   mutable nstr : int;
+  (* Set while an expression thunk's module is emitted: a string literal's
+     value is then a copy [flan_dev_literal] keeps for the life of the
+     process, so storing it anywhere leaves nothing pointing into the module,
+     and the literal is not counted in [nstr]. Without it every C-x C-e that
+     wrote a string or a keyword kept its mapping. *)
+  mutable pool : bool;
   (* The frame descriptors a dev build's shadow stack points at, counted apart
      from [nstr] deliberately. [nstr] is the test [redefinition] uses to decide
      whether an expression thunk's module may be unloaded — a string literal in
@@ -2591,6 +2597,16 @@ and value_at f (e : Tast.expr) : string =
   | Tast.Int (n, _) -> Int64.to_string n
   | Tast.Float (x, k) -> float_const k x
   | Tast.Bool b -> if b then "true" else "false"
+  | Tast.Str s when f.md.pool ->
+    (* See [pool]: the bytes are still this module's, but only the copy
+       leaves it, so they are [fi_bytes]' kind of constant and not
+       [string_bytes']. The copy carries the NUL. *)
+    let id, n = fi_bytes f.md s in
+    let p = fresh f in
+    ins f "%s = call ptr @flan_dev_literal(ptr %s, i64 %d)" p id n;
+    let v = fresh f in
+    ins f "%s = insertvalue %%slice { ptr poison, i64 %d }, ptr %s, 0" v n p;
+    v
   | Tast.Str s -> string_const f.md s
   | Tast.Unit | Tast.Zero _ | Tast.None_ -> "zeroinitializer"
   | Tast.Uninit _ -> "poison"
@@ -4992,6 +5008,8 @@ declare void @flan_dev_watch_emit_i64(i64)
 declare void @flan_dev_watch_emit_u64(i64)
 declare void @flan_dev_watch_emit_f64(double)
 declare void @flan_dev_watch_end()
+; An expression thunk's string literals, copied to storage the process keeps.
+declare ptr @flan_dev_literal(ptr, i64)
 declare i64 @flan_dyn_need_i64(i64)
 declare double @flan_dyn_need_f64(i64)
 declare i32 @flan_dyn_need_bool(i64)
@@ -5309,7 +5327,7 @@ let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false)
     globals = Hashtbl.create 16;
     externs = Hashtbl.create 32;
     checks; dev; gcfn = dev || makes_closures p;
-    known; nstr = 0; nfi = 0; sanitize; ann = annotate;
+    known; nstr = 0; pool = false; nfi = 0; sanitize; ann = annotate;
     descs = Hashtbl.create 8;
     dbg = (if debug then Some (new_dbg p) else None);
     fsigs = fsigs_of p;
@@ -5752,6 +5770,43 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
 
    String literals still have to come along: they are this module's own
    constants, and omitting them is an undefined [@.str.N] at link time. *)
+
+(* Whether an expression thunk makes a function value anywhere in its body or
+   in the clauses lifted out of it. Such a value's code address is in this
+   module — a lambda's body, or the thick wrapper a named function is handed
+   out through — and it may be stored anywhere, so the module must stay
+   mapped. Both backends ask this before marking a thunk's module
+   unloadable. *)
+let thunk_makes_fn_values (p : Tast.program) name =
+  let mine = Hashtbl.create 8 in
+  Hashtbl.replace mine name ();
+  (* Lifted clauses nest: a lambda inside a lambda is lifted out of the
+     outer one's body, so the set grows until nothing new joins it. *)
+  let rec close () =
+    let grew = ref false in
+    List.iter
+      (fun (f : Tast.fn) ->
+         match f.Tast.fparent with
+         | Some q when Hashtbl.mem mine q && not (Hashtbl.mem mine f.Tast.name) ->
+           Hashtbl.replace mine f.Tast.name (); grew := true
+         | _ -> ())
+      p.Tast.fns;
+    if !grew then close ()
+  in
+  close ();
+  let found = ref false in
+  List.iter
+    (fun (f : Tast.fn) ->
+       if Hashtbl.mem mine f.Tast.name then
+         List.iter
+           (Tast.walk (fun (e : Tast.expr) ->
+              match e.Tast.e with
+              | Tast.FnAddr _ | Tast.Closure _ | Tast.Thicken _ -> found := true
+              | _ -> ()))
+           f.Tast.body)
+    p.Tast.fns;
+  !found
+
 let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
       ?(known = fun _ -> true) ?(retains = true)
       ?call ?(consts = []) ?(annotate = false) (p : Tast.program) ~fns
@@ -5791,6 +5846,7 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
     List.filter (fun (f : Tast.fn) -> f.Tast.fparent = None) p.Tast.fns
   in
   let m = new_module ~checks ~dev ~known ~debug ~annotate p in
+  m.pool <- call <> None && retains;
   (* A thunk the module runs itself is excluded from all of this: it is called
      directly by [flan_reload_call], so it needs no cell, must not be published
      into one, and must not take a registry slot — there are 4096 of those and
@@ -5910,7 +5966,7 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
          let t = fresh () in
          Buffer.add_string b
            (Printf.sprintf "  %s = call ptr @flan_dev_cell(ptr %s)\n  store ptr %s, ptr %s\n"
-              t (cstring m (Mangle.sym f.Tast.name)) t (cellptr f.Tast.name)))
+              t (fi_cstring m (Mangle.sym f.Tast.name)) t (cellptr f.Tast.name)))
       new_fns;
     List.iter
       (fun (g : Tast.global) ->
@@ -5929,8 +5985,10 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
            match initial_image p g with
            | None -> "null"
            | Some v ->
-             let init = Printf.sprintf "@\".init.%d\"" m.nstr in
+             (* Copied by the runtime and not kept, so not counted in
-             m.nstr <- m.nstr + 1;
+                [nstr]; a string inside it is, through [const]. *)
+             let init = Printf.sprintf "@\".init.%d\"" m.nfi in
+             m.nfi <- m.nfi + 1;
              Buffer.add_string m.strs
                (Printf.sprintf "%s = private constant %s %s\n" init
                   (ll g.Tast.gty) (const m v));
@@ -5940,7 +5998,7 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
            (Printf.sprintf
               "  %s = call ptr @flan_dev_global(ptr %s, i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64), ptr %s)\n  \
                store ptr %s, ptr %s\n"
-              t (cstring m (Mangle.sym g.Tast.gname)) (ll g.Tast.gty) init t
+              t (fi_cstring m (Mangle.sym g.Tast.gname)) (ll g.Tast.gty) init t
               (globalptr g.Tast.gname)))
       new_globals;
     (* A constant whose value the checker never consumed is just bytes in the
@@ -6009,10 +6067,12 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
          expression may store one anywhere it likes — [(set msg "tuned")] on a
          string global leaves that global pointing into the mapping the agent
          is about to drop. The next thunk can be mapped at the same address, so
-         the result is silent garbage rather than a fault. A module with no
+         the result is silent garbage rather than a fault. So a thunk's
-         string constants has nothing in its image anyone could still be
+         literal is a copy the process keeps (see [pool]) and is not counted;
-         pointing at; one with any keeps its mapping, which costs a page and is
+         what [nstr] still counts is a constant something may go on pointing
-         the same bargain every redefinition already makes. *)
+         at, such as a condition's name, and a module with one keeps its
+         mapping. The registry names above are not counted: flan_dev.c copies
+         a name it keeps, and an initial image is copied on allocation. *)
       (* [retains = false] is a caller saying it knows where every literal in
          this module goes. The [m.nstr] test below is a conservative stand-in
          for that — an expression may store a string literal anywhere it likes,
@@ -6022,7 +6082,8 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
          into the result buffer, so nothing outside the module holds an address
          inside it once the call has returned. Without this, clicking through
          the frames of a break loop costs a permanent mapping per click. *)
-      if fns = [ fn ] && consts = [] && ((not retains) || m.nstr = 0) then
+      if fns = [ fn ] && consts = [] && ((not retains) || m.nstr = 0)
+         && not (thunk_makes_fn_values p fn) then
         Buffer.add_string m.out "\n@flan_reload_transient = global i8 1\n"
     | None -> ()
   end;

lib/program.ml

@@ -98,6 +98,5 @@ let rerun ?(stopped = false) () =
        its window, or let it finish, and ask again"
   | _ ->
     Error
-      "this session's program is a process of its own, so there is no parked \
+      "this process has no program thread of its own, so there is nothing \
-       thread here to send round again; it is the merged build that can re-run \
+       here to run again"
-       a program, not --two-process"

lib/session.ml

@@ -65,7 +65,7 @@ type t = {
   mutable decls   : Ast.decl list;       (* post-Load: flat, one namespace *)
   mutable program : Tast.program;        (* the last thing that checked *)
   mutable env     : Check.env;           (* the same, as the checker sees it *)
-  host            : Tast.program;        (* what the process was built from *)
+  mutable host    : Tast.program;        (* what the process was built from *)
   pkgs            : Load.pkg list;       (* alias, directory, names owned *)
   (* Every [defmacro] this session can expand a call to: the imports', under
      their aliases, and the buffer's own, under the names the buffer writes.
@@ -782,6 +782,24 @@ let restore t h =
    newest one and no older activation is left running. *)
 let rerun t = t.live <- SM.empty
 
+(* The process is about to be built again from what the session holds now
+   (a --two-process re-run), so that becomes what it was built from. Checked
+   whole rather than taken from [program], which can hold a caller's old body
+   beside a callee whose signature changed (see [eval]); a fresh build of that
+   pair would be wrong, so it raises the checker's error instead. *)
+let rehost t =
+  let p, env =
+    let was = !Check.print_warnings in
+    Check.print_warnings := false;
+    Fun.protect ~finally:(fun () -> Check.print_warnings := was)
+      (fun () -> Check.program_with_env t.decls)
+  in
+  t.program <- p;
+  t.env <- env;
+  t.host <- p;
+  t.built <- record_built env p p.Tast.fns SM.empty;
+  t.live <- SM.empty
+
 (* [forms], when given, are [src] already read — [pruned] runs this over a
    file a form fewer each round and has no text for the subset. [base] is the
    file an [(import ...)] in them is resolved against, the session's own when

lib/x86.ml

@@ -491,7 +491,8 @@ let layout_ctx ~checks ~dev (p : Tast.program) : Emit.m =
     globals; externs = Hashtbl.create 1; checks;
     dev; gcfn = dev || Emit.makes_closures p;
     known = (fun _ -> true); dbg = None; sanitize = false; ann = false;
-    nstr = 0; nfi = 0; descs = Hashtbl.create 8; fsigs = Emit.fsigs_of p }
+    nstr = 0; pool = false; nfi = 0; descs = Hashtbl.create 8;
+    fsigs = Emit.fsigs_of p }
 
 let sizeof md t = fst (Emit.lay md t)
 
@@ -1812,6 +1813,16 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
     let l = float_const f x ~f64 in
     fload f.b ~dst:xmm0 ~mm:(Sym (l, 0)) ~f64;
     fstore f.b ~src:xmm0 ~mm:(lmem f dst ~scratch:r11) ~f64
+  | Tast.Str s when f.md.Emit.pool ->
+    (* [Emit]'s [pool]: an expression thunk's literal is a copy the process
+       keeps, so nothing is left pointing into the module. *)
+    let l, n = fi_bytes f s in
+    lea f.b ~dst:rdi ~mm:(Sym (l, 0));
+    imm_into f ~reg:rsi (Int64.of_int n);
+    call_sym f.b "flan_dev_literal";
+    store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8;
+    imm_into f ~reg:rax (Int64.of_int n);
+    store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8
   | Tast.Str s ->
     (* A string and a [u8] slice are the same two words, which is why [Bytes]
        below is a non-instruction. *)
@@ -5316,6 +5327,7 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
       p.Tast.globals
   in
   let md = layout_ctx ~checks ~dev p in
+  md.Emit.pool <- call <> None && retains;
   let externs = Hashtbl.create 16 in
   List.iter
     (fun (e : Tast.extern) -> Hashtbl.replace externs e.Tast.ename e.Tast.esym)
@@ -5420,7 +5432,10 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
      the same and [test_reload.ml] checks it there by grepping the IR text;
      there is no text to grep on this side, so the guarantee is this loop
      order and this comment. *)
-  let cstr sym = let l = string_const f sym in lea f.b ~dst:rdi ~mm:(Sym (l, 0)) in
+  (* Not counted in [nstr]: flan_dev.c's registry copies a name it keeps, so
+     nothing is left pointing at these once the lookup returns. Counted, every
+     module after the session's first new name would keep its mapping. *)
+  let cstr sym = let l = fi_cstring f sym in lea f.b ~dst:rdi ~mm:(Sym (l, 0)) in
   List.iter
     (fun (fn : Tast.fn) ->
        cstr (Mangle.sym fn.Tast.name);
@@ -5599,16 +5614,14 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
      store one anywhere it likes -- [(set msg "tuned")] on a string global
      leaves that global pointing into the mapping the agent is about to drop.
      The next thunk can be mapped at the same address, so the result is silent
-     garbage rather than a fault. A module with no string constants has nothing
+     garbage rather than a fault. So a thunk's literal is a copy the process
-     in its image anyone could still be pointing at; one with any keeps its
+     keeps ([Emit]'s [pool]) and is not counted; what [string_const] still
-     mapping, which costs a page and is the same bargain every redefinition
+     counts is a constant something may go on pointing at, such as a
-     already makes. [string_const] is where the count is kept, and the install
+     condition's name, and a module with one keeps its mapping. The install
-     function's own registry names go through it too -- which is right rather
+     function's registry names are not counted: the registry copies them. *)
-     than incidental, since a module that interned a name left something
-     behind. *)
   (match call with
    | Some fn
-     when fns = [ fn ] && consts = []
+     when fns = [ fn ] && consts = [] && not (Emit.thunk_makes_fn_values p fn)
           && ((not retains) || md.Emit.nstr = 0) ->
      Buffer.add_string out
        "\n\t.data\n\t.globl\tflan_reload_transient\n\

runtime/flan_dev.c

@@ -436,6 +436,56 @@ void flan_dev_result_end(void) {
  * when it was sizing something to send through a socket. */
 uint64_t flan_dev_result_cap(void) { return RESULT_MAX; }
 
+/* ── An expression thunk's string literals ──────────────────────────── */
+
+/* A literal in an evaluated expression is a copy made here and kept for the
+ * life of the process, one per distinct text, NUL after the bytes as the
+ * module's own constants have. The expression may store it anywhere, so
+ * pointing it into the thunk's module would keep that module mapped for ever
+ * (Emit's [pool]); pointing it here lets the agent unload the module once the
+ * thunk returns. Game thread only: thunks run there. */
+typedef struct lit { struct lit *next; int64_t len; uint8_t bytes[]; } lit;
+
+static lit    **lits;
+static size_t   lits_cap, lits_n;
+
+static uint64_t lit_hash(const uint8_t *p, int64_t n) {
+  uint64_t h = 1469598103934665603ULL;            /* FNV-1a */
+  for (int64_t i = 0; i < n; i++) { h ^= p[i]; h *= 1099511628211ULL; }
+  return h;
+}
+
+const uint8_t *flan_dev_literal(const uint8_t *p, int64_t n) {
+  if (n < 0) n = 0;
+  if (lits_n >= lits_cap / 2) {
+    size_t cap = lits_cap ? lits_cap * 2 : 64;
+    lit  **t = calloc(cap, sizeof *t);
+    if (t == NULL) die("out of memory", "a string literal");
+    for (size_t i = 0; i < lits_cap; i++)
+      for (lit *e = lits[i], *nx; e != NULL; e = nx) {
+        nx = e->next;
+        size_t b = lit_hash(e->bytes, e->len) & (cap - 1);
+        e->next = t[b];
+        t[b] = e;
+      }
+    free(lits);
+    lits = t;
+    lits_cap = cap;
+  }
+  size_t b = lit_hash(p, n) & (lits_cap - 1);
+  for (lit *e = lits[b]; e != NULL; e = e->next)
+    if (e->len == n && memcmp(e->bytes, p, (size_t)n) == 0) return e->bytes;
+  lit *e = malloc(sizeof *e + (size_t)n + 1);
+  if (e == NULL) die("out of memory", "a string literal");
+  e->len = n;
+  if (n > 0) memcpy(e->bytes, p, (size_t)n);
+  e->bytes[n] = 0;
+  e->next = lits[b];
+  lits[b] = e;
+  lits_n++;
+  return e->bytes;
+}
+
 /* Called between the copy and the second read of the counter, when set. It
  * exists for test/dev_limits.c and nothing else sets it: the losing side of
  * the race is a write landing inside that window, and a second thread cannot

test/dune

@@ -140,7 +140,9 @@
   ; a Flan program: flan_dyn.c has no Flan spelling yet. It is also the one
   ; translation unit here that frees the most, which is what makes it worth a
   ; sanitized run at all. See [dyn_sweep].
-  (file dyn_ops.c))
+  (file dyn_ops.c)
+  ; [dev_session] drives a real flan dev --sanitize.
+  (file %{workspace_root}/bin/main.exe))
  (action (run ./test_sanitize.exe)))
 
 ; The corpus a third time, under Valgrind's memcheck. Its own alias for the

test/programs/dev-own-break.flan

@@ -0,0 +1,22 @@
+;;;; A program that stops on its own while an evaluation is in flight.
+;;;;
+;;;; Setting [go] from the editor starts it: the loop sees it, sleeps without
+;;;; polling for longer than a module takes to build, and then signals. An
+;;;; expression evaluated just after [go] is therefore waiting in the ring
+;;;; when the program's own break is entered, and runs inside that break's
+;;;; loop. The stop is the program's and the value is the expression's.
+(import agent "vendor:agent")
+
+(declare-c usleep [us i32] i32 "usleep")
+
+(defstruct Late [])
+
+(defonce go i64)
+
+(defn main [] i32
+  (while (= go 0)
+    (agent/wait 5))
+  (usleep 1500000)
+  (restart-case
+    (do (error (Late {})) 0)
+    (carry-on [] 0)))

test/test_agent.ml

@@ -61,6 +61,14 @@ let send path line =
   Unix.close s;
   Buffer.contents b
 
+(* The pair the daemon sets: the path, and the pid it is meant for. This test
+   binary is the parent of every program it starts, which is the
+   --two-process shape. *)
+let daemon_env path =
+  let me = string_of_int (Unix.getpid ()) in
+  [| "FLAN_AGENT_SOCKET=" ^ path; "FLAN_AGENT_OWNER=" ^ me;
+     "FLAN_DEV_PARENT=" ^ me |]
+
 let () =
   match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
   | 0 ->
@@ -298,7 +306,7 @@ let () =
     let bad = tmp "bad.out" in
     let bfd' = ofd bad in
     let benv =
-      Array.append aenv [| "FLAN_AGENT_SOCKET=/nonexistent-dir/agent.sock" |]
+      Array.append aenv (daemon_env "/nonexistent-dir/agent.sock")
     in
     let bpid' = Unix.create_process_env aexe [| aexe |] benv Unix.stdin bfd' bfd' in
     Unix.close bfd';
@@ -325,6 +333,79 @@ let () =
           "cannot listen\n"
     end;
 
+    (* ── The variable inherited by a process the daemon did not start ── *)
+
+    (* A shell opened from inside a [flan dev] program carries its
+       FLAN_AGENT_SOCKET, and so does anything run from that shell. Binding
+       unlinks the path first, so honouring it there would take the session's
+       socket from its program. FLAN_AGENT_OWNER names the process the daemon
+       launched; pid 1 is neither this program nor its parent, so the variable
+       is not this program's, and it picks and announces a path of its own as
+       if nothing were set. The file standing in for the session's socket has
+       to still be the same file afterwards. *)
+    let inherited ~shape ~owner =
+      let stolen = tmp "stolen.sock" and serr = tmp "stolen.err" in
+      Out_channel.with_open_bin stolen (fun oc ->
+        output_string oc "the session's");
+      let senv =
+        Array.append aenv
+          [| "FLAN_AGENT_SOCKET=" ^ stolen; "FLAN_AGENT_OWNER=" ^ owner |]
+      in
+      let s1 = ofd (tmp "stolen.out") and s2 = ofd serr in
+      let spid = Unix.create_process_env aexe [| aexe |] senv Unix.stdin s1 s2 in
+      Unix.close s1;
+      Unix.close s2;
+      let prefix = "flan agent: listening on " in
+      let sannounced () =
+        let text = In_channel.with_open_bin serr In_channel.input_all in
+        List.find_map
+          (fun l ->
+             if String.length l > String.length prefix
+                && String.sub l 0 (String.length prefix) = prefix
+             then Some (String.sub l (String.length prefix)
+                          (String.length l - String.length prefix))
+             else None)
+          (String.split_on_char '\n' text)
+      in
+      (match
+         if await (fun () -> sannounced () <> None) then sannounced () else None
+       with
+       | None ->
+         fail "%s: a program with someone else's FLAN_AGENT_SOCKET announced no \
+               socket of its own" shape;
+         (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ())
+       | Some p ->
+         if p = stolen then fail "%s: the inherited path was bound: %S" shape p;
+         if not (await (fun () -> Sys.file_exists p)) then
+           fail "%s: nothing was bound at the announced %S" shape p
+         else ignore (send p aso);
+         let reaped =
+           await ~ms:5000 (fun () ->
+             match Unix.waitpid [ Unix.WNOHANG ] spid with
+             | 0, _ -> false
+             | _ -> true)
+         in
+         if not reaped then begin
+           (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ());
+           fail "%s: the program with an inherited variable never finished" shape
+         end);
+      (match In_channel.with_open_bin stolen In_channel.input_all with
+       | "the session's" -> ()
+       | _ -> fail "%s: the inherited FLAN_AGENT_SOCKET's file was replaced" shape
+       | exception Sys_error _ ->
+         fail "%s: the inherited FLAN_AGENT_SOCKET's file was removed" shape);
+      List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
+        [ stolen; serr; tmp "stolen.out" ]
+    in
+    (* Nobody's pid. *)
+    inherited ~shape:"an owner that is not this process" ~owner:"1";
+    (* A merged build's owner is the program itself, so a process the program
+       starts has the owner as its parent; with no FLAN_DEV_PARENT naming it,
+       that is not the --two-process shape and the socket is not its. Here the
+       test binary stands in for the program. *)
+    inherited ~shape:"a child of a merged program"
+      ~owner:(string_of_int (Unix.getpid ()));
+
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ aexe; aso; aout; aerr; bad ];
 
@@ -359,7 +440,7 @@ let () =
     let nc = Session.eval nt "(defn tick [] i64 1000)" in
     ignore (Build.shared ~opts:dev ~ir:nc.Session.ir ~out:nso ());
     let nenv =
-      Array.append (Unix.environment ()) [| "FLAN_AGENT_SOCKET=" ^ nsock |]
+      Array.append (Unix.environment ()) (daemon_env nsock)
     in
     let nfd =
       Unix.openfile nout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
@@ -412,7 +493,7 @@ let () =
          bt.Session.host ~out:bexe);
     let bfd = Unix.openfile bout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
     let env =
-      Array.append (Unix.environment ()) [| "FLAN_AGENT_SOCKET=" ^ bsock |]
+      Array.append (Unix.environment ()) (daemon_env bsock)
     in
     let bpid =
       Unix.create_process_env bexe [| bexe |] env Unix.stdin bfd bfd
@@ -753,7 +834,7 @@ let () =
          lt.Session.host ~out:lexe);
     let lfd = Unix.openfile lout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
     let lenv =
-      Array.append (Unix.environment ()) [| "FLAN_AGENT_SOCKET=" ^ lsock |]
+      Array.append (Unix.environment ()) (daemon_env lsock)
     in
     let lpid = Unix.create_process_env lexe [| lexe |] lenv Unix.stdin lfd lfd in
     Unix.close lfd;

test/test_dev.ml

@@ -5161,20 +5161,124 @@ let () =
               ignore (ask "(:op \"describe\")");
               contains_sub (Buffer.contents seen) "42"))
       then fail "--two-process: the reload was never installed";
-      (* And the one verb this shape cannot have. Running [main] again means
+      (* A re-run here is a new process. Refused while the child runs; once
-         waking a thread that parked inside this process, and here the program
+         it has finished, the program is built again from the session, so the
-         is a child: when it finishes it is gone, and there is nothing to wake.
+         redefined [step] is what the new run's first line prints — the host
-         Refused by naming what this daemon is rather than with the message a
+         the daemon started with would print 1. *)
-         merged one gives, because "the program is already running" would send
-         somebody back to try again after it had exited — and [--x86] arrives
-         here too, since it refuses the merged daemon for the -rdynamic reason
-         given below. *)
       let r = ask "(:op \"rerun\")" in
       let why = Option.value ~default:(status r) (Wire.string_field r "message") in
-      if status r <> "error" then
+      if status r <> "error" || not (contains_sub why "still running") then
-        fail "--two-process answered a rerun it cannot perform"
+        fail "--two-process: a rerun while the child runs answered %s: %s"
-      else if not (contains_sub why "two-process") then
+          (status r) why;
-        fail "--two-process refuses a rerun as: %s" why;
+      (* Two more deliveries take the program past its last two waits. *)
+      List.iter
+        (fun n ->
+           let r =
+             ask
+               (Printf.sprintf
+                  "(:op \"eval\" :code \"(defn step [] i64 %d)\" \
+                   :file \"/tmp/buf.flan\")" n)
+           in
+           if status r <> "ok" then fail "--two-process: eval %d was refused" n;
+           if not
+                (await (fun () ->
+                   ignore (ask "(:op \"describe\")");
+                   contains_sub (Buffer.contents seen) (string_of_int n)))
+           then fail "--two-process: %d was never installed" n)
+        [ 43; 44 ];
+      (* 44 was the old child's last line, so anything from here on is the
+         new child's. *)
+      Buffer.clear seen;
+      let taken = ref (ask "(:op \"describe\")") in
+      if not
+           (await ~ms:10000 (fun () ->
+              taken := ask "(:op \"rerun\")";
+              status !taken = "ok"))
+      then
+        fail "--two-process: a rerun after the child finished: %s"
+          (Option.value ~default:(status !taken)
+             (Wire.string_field !taken "message"))
+      else begin
+        let note = Option.value ~default:"" (Wire.string_field !taken "note") in
+        if not (contains_sub note "globals start over") then
+          fail "--two-process: the rerun's note does not say the globals \
+                start over: %S" note;
+        if not
+             (await (fun () ->
+                ignore (ask "(:op \"describe\")");
+                contains_sub (Buffer.contents seen) "\n"))
+        then fail "--two-process: the new child printed nothing"
+        else if not (String.starts_with ~prefix:"44\n" (Buffer.contents seen))
+        then
+          fail "--two-process: the new child did not start with the \
+                redefinition: %S" (Buffer.contents seen);
+        (* And it is reachable: a delivery to the new child installs. *)
+        let r =
+          ask
+            "(:op \"eval\" :code \"(defn step [] i64 45)\" :file \"/tmp/buf.flan\")"
+        in
+        if status r <> "ok" then fail "--two-process: eval after rerun refused";
+        if not
+             (await (fun () ->
+                ignore (ask "(:op \"describe\")");
+                contains_sub (Buffer.contents seen) "45"))
+        then fail "--two-process: the new child never installed a delivery";
+        (* A signature change leaves [user] compiled for the old one. The
+           next build is of the whole program, so the re-run is refused at
+           the stale call; a fix evaluated while the child has ended goes
+           into the session, and the re-run after it builds. *)
+        let ev code =
+          ask
+            (Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/buf.flan\")"
+               (Wire.quote code))
+        in
+        let alive () =
+          match Wire.field (ask "(:op \"describe\")") "alive" with
+          | Some { Form.v = Form.Sym "nil"; _ } -> false
+          | _ -> true
+        in
+        List.iter
+          (fun code ->
+             if status (ev code) <> "ok" then
+               fail "--two-process: %s was refused" code)
+          [ "(defn helper [] i64 1)"; "(defn user [] i64 (helper))" ];
+        if not (await ~ms:10000 (fun () -> not (alive ()))) then
+          fail "--two-process: the new child did not finish"
+        else begin
+          let r = ev "(defn helper [x i64] i64 x)" in
+          if status r <> "ok" then
+            fail "--two-process: a change while the child has ended: %s"
+              (Option.value ~default:"" (Wire.string_field r "message"));
+          let r = ask "(:op \"rerun\")" in
+          if status r <> "error"
+          || not (contains_sub
+                    (Option.value ~default:"" (Wire.string_field r "loc"))
+                    "/tmp/buf.flan:1:")
+          then
+            fail "--two-process: a re-run over a stale caller answered %s \
+                  (%s)" (status r)
+              (Option.value ~default:"" (Wire.string_field r "message"));
+          List.iter
+            (fun code ->
+               if status (ev code) <> "ok" then
+                 fail "--two-process: %s was refused" code)
+            [ "(defn user [] i64 (helper 5))"; "(defn step [] i64 (user))" ];
+          Buffer.clear seen;
+          let r = ask "(:op \"rerun\")" in
+          if status r <> "ok" then
+            fail "--two-process: the re-run after the fix: %s"
+              (Option.value ~default:"" (Wire.string_field r "message"))
+          else if not
+                    (await (fun () ->
+                       ignore (ask "(:op \"describe\")");
+                       contains_sub (Buffer.contents seen) "\n"))
+                  || not (String.starts_with ~prefix:"5\n"
+                            (Buffer.contents seen))
+          then
+            fail "--two-process: the fixed program printed %S"
+              (Buffer.contents seen)
+        end
+      end;
       ignore (ask "(:op \"close\")");
       Unix.close tc
     end;
@@ -6595,12 +6699,12 @@ let () =
            let answer r =
              Option.value ~default:"" (Wire.string_field r "value")
            in
-           let read () =
+           let read_reply () =
-             answer
+             request c
-               (request c
                "(:op \"eval-expr\" :code \"(get config :s)\" \
-                   :file \"programs/dev-dyn-global.flan\")")
+                :file \"programs/dev-dyn-global.flan\")"
            in
+           let read () = answer (read_reply ()) in
            (* A hundred thousand small maps: flan_dyn.c collects at a
               one-megabyte floor, so this is several collections and not a
               heap that merely grew. *)
@@ -6620,11 +6724,17 @@ let () =
                if status r <> "ok" then
                  fail "--%s: the churning thunk (cycle %d): %s" backend cycle
                    (said r)
-               else if not (contains_sub (read ()) "kept") then
+               else begin
+                 (* The failing reply itself, and not a second read: the one
+                    recorded failure here re-read and got "kept", so what the
+                    first read answered is the whole of the evidence. *)
+                 let r = read_reply () in
+                 if not (contains_sub (answer r) "kept") then
                    fail
-                   "--%s: after a thunk that allocates (cycle %d) the parked \
+                     "--%s: after a thunk that allocates (cycle %d) the \
-                    program's dyn global reads %S"
+                      parked program's dyn global read %S (%s: %s)"
-                   backend cycle (read ());
+                     backend cycle (answer r) (status r) (said r)
+               end;
                (* And round main again, which re-enters the very code that
                   pushed those roots. *)
                let r = request c "(:op \"rerun\")" in
@@ -6633,7 +6743,79 @@ let () =
                if not (await ~ms:20000 parked) then
                  fail "--%s: the program did not park again (cycle %d)" backend
                    cycle
-             done
+             done;
+             (* An expression's module is unloaded once it returns, string
+                literals and all: a literal is a copy the process keeps, so a
+                global left holding one still reads it after the module that
+                wrote it is gone and later ones have been mapped where it
+                was. The mapping count is what the kernel limits. *)
+             let ev code =
+               request c
+                 (Printf.sprintf
+                    "(:op \"eval-expr\" :code %s \
+                     :file \"programs/dev-dyn-global.flan\")" (Wire.quote code))
+             in
+             let r =
+               request c
+                 "(:op \"eval\" :code \"(defonce msg string)\" \
+                  :file \"programs/dev-dyn-global.flan\")"
+             in
+             if status r <> "ok" then fail "--%s: defonce msg: %s" backend (said r)
+             else begin
+               ignore (ev "(do (set msg \"tuned\") 0)");
+               let maps () =
+                 List.length
+                   (String.split_on_char '\n'
+                      (In_channel.with_open_bin
+                         (Printf.sprintf "/proc/%d/maps" dpid)
+                         In_channel.input_all))
+               in
+               let m0 = maps () in
+               for i = 1 to 20 do
+                 ignore (ev (Printf.sprintf "(do (println \"other %d\") %d)" i i))
+               done;
+               let m1 = maps () in
+               if m1 - m0 >= 20 then
+                 fail "--%s: twenty expressions with a string literal left %d \
+                       more mappings" backend (m1 - m0);
+               let r = ev "msg" in
+               if Wire.string_field r "value" <> Some "\"tuned\"" then
+                 fail "--%s: a literal stored by an unloaded module reads %S \
+                       (%s)" backend
+                   (Option.value ~default:"" (Wire.string_field r "value"))
+                   (said r)
+             end;
+             (* A function value an expression makes has its code in that
+                expression's module — a lambda's body, or the wrapper a named
+                function is handed out through — so that module stays mapped.
+                Later expressions are mapped between the store and the call,
+                where an unloaded one would have been. *)
+             let defd code =
+               let r =
+                 request c
+                   (Printf.sprintf
+                      "(:op \"eval\" :code %s \
+                       :file \"programs/dev-dyn-global.flan\")" (Wire.quote code))
+               in
+               if status r <> "ok" then fail "--%s: %s: %s" backend code (said r)
+             in
+             defd "(defonce kept (Option (Fn [i64] i64)))";
+             defd "(defn twice [x i64] i64 (* x 2))";
+             let call_kept want what =
+               for i = 1 to 3 do
+                 ignore (ev (Printf.sprintf "(do (println \"pad %d\") %d)" i i))
+               done;
+               let r = ev "(match kept (Some f) (f 1) (None) -1)" in
+               if Wire.string_field r "value" <> Some want then
+                 fail "--%s: %s kept by an unloaded expression answered %S \
+                       (%s)" backend what
+                   (Option.value ~default:"" (Wire.string_field r "value"))
+                   (said r)
+             in
+             ignore (ev "(do (set kept (Some (fn [x] (+ x 7)))) 0)");
+             call_kept "8" "a lambda";
+             ignore (ev "(do (set kept (Some twice)) 0)");
+             call_kept "2" "a named function"
            end;
            ignore (request c "(:op \"close\")");
            (try Unix.close c with Unix.Unix_error _ -> ());
@@ -8752,6 +8934,110 @@ let () =
     hook_block ~llvm:false;
     hook_block ~llvm:true;
 
+    (* ── --sanitize on the backend it cannot instrument ───────────── *)
+
+    (* Refused before anything is built, by name and with the way out. The
+       session itself is driven under the sanitizers by @sanitize. *)
+    let zerr = tmp "x86san.err" in
+    let zfd = Unix.openfile zerr [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+    let zpid =
+      Unix.create_process flan
+        [| flan; "dev"; "programs/dev-loop.flan"; "-s"; tmp "x86san.sock";
+           "--x86"; "--sanitize" |]
+        Unix.stdin zfd zfd
+    in
+    Unix.close zfd;
+    (match Unix.waitpid [] zpid with
+     | _, Unix.WEXITED 1 ->
+       let said = In_channel.with_open_bin zerr In_channel.input_all in
+       if not (contains_sub said "--x86 --sanitize"
+               && contains_sub said "Drop --x86") then
+         fail "flan dev --x86 --sanitize was refused as: %S" said
+     | _ -> fail "flan dev --x86 --sanitize was not refused");
+    (try Sys.remove zerr with Sys_error _ -> ());
+
+    (* ── Whose break it is ─────────────────────────────────────────── *)
+
+    (* The program stops on its own while an evaluation is in flight: [go]
+       makes it sleep for longer than a module takes to build and then
+       signal, without polling in between. The stop is fresh, as a thunk's
+       would be, and it is not the expression's; the expression runs inside
+       the program's break loop and its value is the answer. On the default
+       backend, because the stop's owner is the agent's and not the
+       backend's. *)
+    let osock = tmp "ownbreak.sock" and oout = tmp "ownbreak.out" in
+    (try Sys.remove osock with Sys_error _ -> ());
+    let ofd = Unix.openfile oout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+    let opid =
+      Unix.create_process flan
+        [| flan; "dev"; "programs/dev-own-break.flan"; "-s"; osock |]
+        Unix.stdin ofd Unix.stderr
+    in
+    Unix.close ofd;
+    if not (listening ~pid:opid osock) then begin
+      fail "the own-break daemon %s" !listen_why;
+      (try Unix.kill opid Sys.sigkill with Unix.Unix_error _ -> ())
+    end
+    else begin
+      let c = connect osock in
+      let said r =
+        Option.value ~default:(status r) (Wire.string_field r "message")
+      in
+      let ev code =
+        request c
+          (Printf.sprintf
+             "(:op \"eval-expr\" :code %s :file \"programs/dev-own-break.flan\")"
+             (Wire.quote code))
+      in
+      (* An expression stopped in a break and resumed by a restart finishes
+         after the restart's reply, and here it finishes after the next
+         expression has been sent: its value must not answer for that one. *)
+      let r =
+        ev "(restart-case (do (error (Late {})) 0) \
+            (slow [] (do (usleep 500000) 5)))"
+      in
+      if status r <> "error" then
+        fail "resumed value: the first expression did not stop: %s" (said r)
+      else begin
+        let r = request c "(:op \"restart\" :name \"slow\")" in
+        if status r <> "ok" then fail "resumed value: restart: %s" (said r);
+        let r = ev "(do (usleep 300000) 23)" in
+        if Wire.string_field r "value" <> Some "23" then
+          fail "resumed value: the next expression answered %S (%s)"
+            (Option.value ~default:"" (Wire.string_field r "value")) (said r)
+      end;
+      let r = ev "(do (set go 1) 0)" in
+      if status r <> "ok" then fail "own break: setting go: %s" (said r)
+      else begin
+        (* The sleep keeps the thunk running inside the program's break for
+           many of the daemon's ticks, so a wait that took any fresh stop for
+           the thunk's would answer before the value exists. *)
+        let r = ev "(do (usleep 300000) 42)" in
+        if status r <> "ok"
+        || Wire.string_field r "value" <> Some "42" then
+          fail "own break: an expression in flight when the program stopped \
+                on its own answered %s %S (value %S)"
+            (status r) (said r)
+            (Option.value ~default:"" (Wire.string_field r "value"));
+        (match Wire.field r "condition" with
+         | Some { Form.v = Form.Str "Late"; _ } -> ()
+         | _ -> fail "own break: the reply does not carry the program's stop")
+      end;
+      ignore (aborted c);
+      (try Unix.close c with Unix.Unix_error _ -> ());
+      if not
+           (await ~ms:10000 (fun () ->
+              match Unix.waitpid [ Unix.WNOHANG ] opid with
+              | 0, _ -> false
+              | _ -> true))
+      then begin
+        fail "own break: the daemon did not end on abort";
+        (try Unix.kill opid Sys.sigkill with Unix.Unix_error _ -> ());
+        (try ignore (Unix.waitpid [] opid) with Unix.Unix_error _ -> ())
+      end
+    end;
+    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ osock; oout ];
+
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ sock; out; bsock; bout ];
     Test_support.report ~label:"dev" ()

test/test_sanitize.ml

@@ -376,13 +376,8 @@ let dyn_sweep () =
    part that carries the weight; the run is what says the constructor the fix
    introduced actually calls both of the things it replaced.
 
-   Not covered, and worth naming rather than leaving to be discovered the way
+   A program driven by a real [flan dev] session is [dev_session] below, and
-   this bug was: a program driven by [flan dev] under ASan. The daemon builds
+   the faulting dev build is [dev_segv]. *)
-   its host through its own path and the CLI has no [--sanitize] to pass it,
-   so that one wants a flag and a way through [Dev.serve]. See TODO.org, "A
-   program driven by a real flan dev daemon under a sanitizer". The faulting
-   dev build, which was on that list too, is covered now — see
-   [dev_segv] below. *)
 let dev_corpus =
   [ (* The only [dev-*] program with no agent import: it prints and returns.
        Here because it is the one program in the tree written for a dev
@@ -474,6 +469,93 @@ let dev_segv () =
             prevent\n%s" text;
     (try Sys.remove exe with Sys_error _ -> ())
 
+(* A program driven by a real [flan dev --sanitize] session: the host and the
+   runtime under ASan and UBSan, the modules the session sends built as
+   always (llc and ld, not instrumented). dev-break stops on its first frame,
+   so the session starts at a break; it is resumed, [step] is redefined three
+   times with an expression evaluated after each, an expression is evaluated
+   into a second break and resumed out of it, and the session is closed. The
+   daemon's own output is the program's stderr, so a report anywhere in the
+   session lands in it. *)
+let dev_session () =
+  let flan = "../bin/main.exe" in
+  let sock = Filename.concat scratch "flan-san-dev.sock" in
+  let log = Filename.concat scratch "flan-san-dev.log" in
+  let src = "programs/dev-break.flan" in
+  (try Sys.remove sock with Sys_error _ -> ());
+  let fd = Unix.openfile log [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+  let env =
+    Array.append (Unix.environment ())
+      [| "ASAN_OPTIONS=detect_leaks=0"; "UBSAN_OPTIONS=print_stacktrace=1" |]
+  in
+  let pid =
+    Unix.create_process_env flan
+      [| flan; "dev"; src; "-s"; sock; "--sanitize" |]
+      env Unix.stdin fd fd
+  in
+  Unix.close fd;
+  let said () = In_channel.with_open_bin log In_channel.input_all in
+  if not (Test_support.listening ~ms:180000 ~pid sock) then begin
+    fail "dev session: flan dev --sanitize %s\n%s" !Test_support.listen_why
+      (said ());
+    (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ())
+  end
+  else begin
+    let c = Test_support.connect sock in
+    let ask q = Wire.parse (Wire.send c q; Wire.recv c) in
+    let field r k = Option.value ~default:"" (Wire.string_field r k) in
+    let stopped () =
+      match Wire.field (ask "(:op \"describe\")") "stopped" with
+      | Some { Form.v = Form.Sym "t"; _ } -> true
+      | _ -> false
+    in
+    let expect what r =
+      if field r "status" <> "ok" then
+        fail "dev session: %s: %s" what (field r "message")
+    in
+    let f = Printf.sprintf ":file %S" src in
+    if not (Test_support.await ~ms:30000 stopped) then
+      fail "dev session: the program never reached its first break"
+    else begin
+      expect "retry" (ask "(:op \"restart\" :name \"retry\")");
+      if not (Test_support.await ~ms:10000 (fun () -> not (stopped ()))) then
+        fail "dev session: the program did not resume";
+      for i = 1 to 3 do
+        expect "a redefinition"
+          (ask
+             (Printf.sprintf
+                "(:op \"eval\" :code \"(defn step [] i64 (set ticks (+ ticks \
+                 %d)) ticks)\" %s)" (100 * i) f));
+        expect "an expression"
+          (ask (Printf.sprintf "(:op \"eval-expr\" :code \"(+ ticks 1)\" %s)" f))
+      done;
+      let r = ask (Printf.sprintf "(:op \"eval-expr\" :code \"(divide 1 0)\" %s)" f) in
+      if not (contains (field r "condition") "ArithError") then
+        fail "dev session: (divide 1 0) did not stop on ArithError: %s"
+          (field r "message");
+      expect "use-zero" (ask "(:op \"restart\" :name \"use-zero\")");
+      if not (Test_support.await ~ms:10000 (fun () -> not (stopped ()))) then
+        fail "dev session: the program did not resume from the second break";
+      expect "an expression after both breaks"
+        (ask (Printf.sprintf "(:op \"eval-expr\" :code \"(+ 1 2)\" %s)" f))
+    end;
+    (try ignore (ask "(:op \"close\")") with _ -> ());
+    (try Unix.close c with Unix.Unix_error _ -> ());
+    if not
+         (Test_support.await ~ms:30000 (fun () ->
+            match Unix.waitpid [ Unix.WNOHANG ] pid with
+            | 0, _ -> false
+            | _ -> true))
+    then begin
+      fail "dev session: the daemon did not end on close";
+      (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
+      (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
+    end;
+    if reported (said ()) then
+      fail "dev session: sanitizer report\n%s" (said ())
+  end;
+  List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; log ]
+
 (* The positive controls, which are the only evidence that a clean sweep means
    anything. Both are written here rather than kept in test/programs because
    neither is a program anybody should build: one reads off the end of an
@@ -600,6 +682,7 @@ let () =
     dyn_sweep ();
     dev_sweep ();
     dev_segv ();
+    dev_session ();
     unchecked_controls ();
     if !failures = 0 then print_endline "sanitizer sweep: clean"
     else Printf.printf "%d sanitizer failure(s)\n" !failures;

test/test_session.ml

@@ -1315,17 +1315,25 @@ let () =
   if has c.Session.ir "@flan_reload_transient" then
     fail "a module that publishes a body claimed to be unloadable";
 
-  (* And a third condition, about data rather than text. A string literal lives
+  (* And a third condition, about data rather than text. An expression may
-     in the evaluating module's own image, and an expression may store one
+     store a string literal anywhere — [(set msg "x")] on a string global — so
-     anywhere: [(set msg "x")] on a string global would leave that global
+     a literal's value is a copy [flan_dev_literal] keeps for the process, and
-     pointing into a mapping the agent then drops — and since the next thunk can
+     nothing is left pointing into the module. A string constant the module
-     be mapped at the same address, the result is silent garbage rather than a
+     does hand out still keeps its mapping: a condition's name, which a handler
-     fault. A module carrying any string constant keeps its mapping. *)
+     may carry away. *)
   let str = Session.eval_expr t "(println \"tuned\")" in
-  if not (has str.Session.ir ".str.0") then
+  if not (has str.Session.ir "@flan_dev_literal(ptr") then
-    fail "the fixture stopped carrying a string constant, so it proves nothing";
+    fail "an expression's string literal is not a kept copy";
-  if has str.Session.ir "@flan_reload_transient" then
+  if has str.Session.ir ".str." then
-    fail "an expression holding a string claimed to be unloadable";
+    fail "an expression's string literal is still a constant of its module";
+  if not (has str.Session.ir "@flan_reload_transient") then
+    fail "an expression whose only string is a literal kept its mapping";
+  let held =
+    Session.eval_expr t
+      "(restart-case (+ 1 2) (use-zero [] :report \"Answer 0\" 0))"
+  in
+  if has held.Session.ir "@flan_reload_transient" then
+    fail "an expression establishing a restart claimed to be unloadable";
 
   (* ── Generics in the dev loop ─────────────────────────────────────────
      A generic [defn] produces no [Tast.fn] of its own — only its copies do —
@@ -1523,7 +1531,7 @@ let () =
      (* And the slot names, in the packed form the runtime splits — which is
         what says the call carries *this* class's new list and not some
         other module's leftovers. *)
-     if not (has c.Session.ir "c\"x\\0Ay\\0Az\\00\"") then
+     if not (has c.Session.ir "c\"x\\0Ay\\0Az\"") then
        fail "the registration did not carry the new slot list"
    | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "adding a slot to a class was refused: %s" m);
@@ -1556,7 +1564,7 @@ let () =
    | c ->
      if not (has c.Session.ir "call void @flan_dyn_class_def") then
        fail "an unchanged class definition registered nothing";
-     if not (has c.Session.ir "c\"x\\0Ay\\00\"") then
+     if not (has c.Session.ir "c\"x\\0Ay\"") then
        fail "an unchanged class registered some other slot list"
    | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "re-evaluating an unchanged class was refused: %s" m);
@@ -1620,7 +1628,7 @@ let () =
    ignore (Session.eval t "(defn origin [] dyn (point 0 0))");
    match Session.eval t "(defclass point [x i64 y])" with
    | c ->
-     if not (has c.Session.ir "c\"x i64\\0Ay\\00\"") then
+     if not (has c.Session.ir "c\"x i64\\0Ay\"") then
        fail "a slot's new type did not reach the registration"
    | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "a slot's type changed under a compiled caller was refused: %s" m);

vendor/agent/flan_agent.c

@@ -214,8 +214,19 @@ typedef struct {
   void      *handle;
   int        stopped_only;
   int32_t    at_stop;
+  uint32_t   call_id;          /* its place among jobs with a call; 0 if none */
 } job;
 
+/* Which evaluated expression the result buffer holds. Every job with a call
+ * is numbered as the listener queues it, and a call that returns records its
+ * number, so a daemon waiting for its own expression's value is not answered
+ * by an earlier expression that a restart resumed and that published after
+ * the new one was sent. The highest wins: an expression run inside another's
+ * break returns first, and the outer one only resumes on a later request.
+ * The [calls] verb answers both counts. */
+static _Atomic uint32_t calls_queued;
+static _Atomic uint32_t calls_valued;
+
 /* Said once, in one place, and shipped to the daemon over [refusals] rather
  * than written down again at the other end. A refusal is a sentence naming
  * what actually happened, and the thing that actually happened is not "the
@@ -437,6 +448,15 @@ static const uint8_t abandon_report[] =
  * saved and restored around the call like [eval_boundary]. */
 static sigjmp_buf *eval_escape;
 
+/* Whether the game thread is inside an evaluated thunk's call, at any depth,
+ * rather than in the program's own code. A break records it, and it is what
+ * says whose break that is: a game loop that signals on its own while an
+ * evaluation is in flight stops exactly as a thunk would, and the stop
+ * counter cannot tell the two apart. Not [eval_boundary], which a class
+ * migration clears inside a thunk, nor [frame_floor], which it sets outside
+ * one. Game thread only, saved and restored around the call. */
+static int in_thunk;
+
 /* What the chains looked like when the evaluation was called, weak for the
  * reason the frame walk below is: the runtime is linked into every program
  * that links this, but not every build carries the dev and dyn halves. */
@@ -505,6 +525,7 @@ static int migrate_call(void *fn, uint64_t instance, uint64_t added,
 void flan_agent_run_reset(void) {
   eval_boundary = NULL;
   eval_escape = NULL;
+  in_thunk = 0;
   restart_floor = 0;
   frame_floor = -1;
 }
@@ -567,6 +588,7 @@ static _Atomic int aborting;
 
 typedef struct {
   int32_t gen;                             /* never reused, never 0 */
+  int32_t in_eval;                         /* stopped inside a thunk */
   /* Whether *any* restart on this list can be taken, which is a property of
    * the break and not of the restarts. [reachable] answers a different
    * question — that one is per restart, and it is about the thunk boundary.
@@ -773,6 +795,7 @@ static int snap_push(int resumable, void *cond) {
   snapshot *s = &snaps[d];
   int32_t   n = flan_restart_count();
   s->gen   = ++snap_gen;
+  s->in_eval = in_thunk;
   s->resumable = resumable;
   s->cond  = cond;
   s->sitelen = 0;
@@ -1310,6 +1333,7 @@ int32_t flan_agent_poll(void) {
        * signal handler, and the jump leaves the handler. */
       sigjmp_buf  escape;
       sigjmp_buf *oescape = eval_escape;
+      int         othunk = in_thunk;
       void       *mh = NULL, *mr = NULL, *mf = NULL;
       int32_t     md = 0;
       int64_t     mroots = 0;
@@ -1318,9 +1342,12 @@ int32_t flan_agent_poll(void) {
       if (flan_dyn_root_mark) mroots = flan_dyn_root_mark();
       uint64_t    mctx[2] = { 0, 0 };
       if (flan_context_save) flan_context_save(mctx);
+      in_thunk = 1;
       if (sigsetjmp(escape, 1) == 0) {
         eval_escape = &escape;
         j.call();
+        if (j.call_id > atomic_load(&calls_valued))
+          atomic_store(&calls_valued, j.call_id);
       } else {
         if (flan_condition_stacks_restore) flan_condition_stacks_restore(mh, mr, md);
         if (flan_dev_frames_restore) flan_dev_frames_restore(mf);
@@ -1328,6 +1355,7 @@ int32_t flan_agent_poll(void) {
         if (flan_context_load) flan_context_load(mctx);
       }
       eval_escape = oescape;
+      in_thunk = othunk;
       /* Popped whichever way the thunk left — returning with a value, or
        * unwinding past this frame because someone abandoned it. */
       flan_restart_pop_c(eval_boundary);
@@ -1903,10 +1931,23 @@ static void handle_line(char *line, sink *o) {
    * of those have readers in flight and a reply format is a thing two ends
    * agree on. Answered while running as well, for [status]'s reason: an
    * editor polls this without knowing the state already. */
+  /* After the number, whose code stopped: "eval" when the thread was inside
+   * an evaluated thunk, "program" when it was in the program's own code. */
+  if (strcmp(line, "calls") == 0) {
+    char hdr[48];
+    int  k = snprintf(hdr, sizeof hdr, "%u %u\n",
+                      (unsigned)atomic_load(&calls_queued),
+                      (unsigned)atomic_load(&calls_valued));
+    if (k > 0) emit(o, hdr, (size_t)k);
+    return;
+  }
   if (strcmp(line, "stop") == 0) {
     snapshot *s = (atomic_load(&depth) > 0) ? snap_top() : NULL;
     char hdr[32];
-    int  k = snprintf(hdr, sizeof hdr, "%d\n", s == NULL ? 0 : s->gen);
+    int  k = s == NULL
+               ? snprintf(hdr, sizeof hdr, "0\n")
+               : snprintf(hdr, sizeof hdr, "%d %s\n", s->gen,
+                          s->in_eval ? "eval" : "program");
     if (k > 0) emit(o, hdr, (size_t)k);
     return;
   }
@@ -2179,7 +2220,9 @@ static void handle_line(char *line, sink *o) {
    * is the failure being fixed. */
   if (!publish((job){ .install = f, .call = c,
                       .handle = transient == NULL ? NULL : h,
-                      .stopped_only = stopped_only, .at_stop = at_stop }))
+                      .stopped_only = stopped_only, .at_stop = at_stop,
+                      .call_id = c == NULL ? 0
+                                 : atomic_fetch_add(&calls_queued, 1) + 1 }))
     fprintf(stderr, "flan: reload queue full after it was checked\n");
   return;
 }
@@ -2459,17 +2502,49 @@ failed:
   return -1;
 }
 
+/* The daemon's socket for this process, or NULL when there is none.
+ *
+ * FLAN_AGENT_SOCKET alone is not enough, because an environment is inherited:
+ * a shell started from inside a [flan dev] program, or anything that program
+ * starts, carries it too, and binding unlinks the path first, so such a
+ * process would take the session's socket from the program it belongs to. So
+ * the daemon also names the process it launched, in FLAN_AGENT_OWNER, and the
+ * path is honoured only there: the owner is this process in a merged build,
+ * where the launcher execs into the program, and this process's parent under
+ * --two-process, where the daemon started it. */
+static const char *daemon_socket(void) {
+  const char *env = getenv("FLAN_AGENT_SOCKET");
+  const char *own = getenv("FLAN_AGENT_OWNER");
+  char *end;
+  long pid;
+  if (env == NULL || env[0] == '\0' || own == NULL || own[0] == '\0')
+    return NULL;
+  pid = strtol(own, &end, 10);
+  if (end == own || *end != '\0' || pid <= 0) return NULL;
+  if (pid == (long)getpid()) return env;
+  /* The parent only under --two-process, which is the one shape that sets
+   * FLAN_DEV_PARENT, and to the same pid. In a merged build the owner is the
+   * program itself, so a process it starts has the owner as its parent and
+   * must not take the socket. */
+  {
+    const char *par = getenv("FLAN_DEV_PARENT");
+    if (par != NULL && strcmp(par, own) == 0 && pid == (long)getppid())
+      return env;
+  }
+  return NULL;
+}
+
 /* [path] is a Flan string: ptr and len, not NUL-terminated.
  *
- * FLAN_AGENT_SOCKET overrides it. A program's source has to name some path,
+ * The daemon's socket overrides it (see [daemon_socket]). A program's source
- * and the daemon that launches the program is the one that knows where it
+ * has to name some path, and the daemon that launches the program is the one that knows where it
  * wants to talk to it — without the override the daemon would have to guess,
  * and guessing wrong fails silently: everything compiles, the module is built,
  * and nothing ever receives it. */
 int32_t flan_agent_start(const uint8_t *path, int64_t len) {
   char buf[sizeof(((struct sockaddr_un *)0)->sun_path)];
-  const char *env = getenv("FLAN_AGENT_SOCKET");
+  const char *env = daemon_socket();
-  if (env != NULL && env[0] != '\0') return start_on(env) < 0 ? -1 : 0;
+  if (env != NULL) return start_on(env) < 0 ? -1 : 0;
   if (len <= 0 || (size_t)len >= sizeof buf) return -1;
   memcpy(buf, path, (size_t)len);
   buf[len] = '\0';
@@ -2493,8 +2568,8 @@ int32_t flan_agent_start_auto(void) {
   char path[sizeof(((struct sockaddr_un *)0)->sun_path)];
   struct timespec ts;
   int32_t r;
-  const char *env = getenv("FLAN_AGENT_SOCKET");
+  const char *env = daemon_socket();
-  if (env != NULL && env[0] != '\0') return start_on(env) < 0 ? -1 : 0;
+  if (env != NULL) return start_on(env) < 0 ? -1 : 0;
   if (clock_gettime(CLOCK_REALTIME, &ts) != 0) ts.tv_nsec = 0;
   snprintf(path, sizeof path, "/tmp/flan-agent-%ld-%08lx.sock",
            (long)getpid(), (unsigned long)(ts.tv_nsec & 0xffffffffL));
@@ -2511,11 +2586,11 @@ int32_t flan_agent_start_auto(void) {
 /* And the call itself, gone. A program under [flan dev] that imports this
  * package gets the listener before main, without asking.
  *
- * FLAN_AGENT_SOCKET is the whole condition, and it is the right one: the
+ * [daemon_socket] is the condition: the daemon sets both of its variables in
- * daemon sets it in both shapes — before the fork in --two-process, before the
+ * both shapes — before the fork in --two-process, before the exec in the
- * exec in the merged build — and nothing else on a machine sets it. So an
+ * merged build — so an ordinary run of an ordinary program falls straight
- * ordinary run of an ordinary program falls straight through here and this
+ * through here, and so does a process that only inherited them. (Not
- * costs it one getenv. (Not FLAN_DEV_PARENT, which is deliberately unset in
+ * FLAN_DEV_PARENT, which is deliberately unset in
  * the merged build; gating on it would quietly skip half the daemon.)
  *
  * WHAT THIS DOES NOT REACH, because it is a fact about linking rather than a
@@ -2540,8 +2615,8 @@ int32_t flan_agent_start_auto(void) {
  * cannot, in either shape — it has an editor to hear from first, and a module
  * to compile after that. */
 __attribute__((constructor)) static void auto_start(void) {
-  const char *env = getenv("FLAN_AGENT_SOCKET");
+  const char *env = daemon_socket();
-  if (env == NULL || env[0] == '\0') return;
+  if (env == NULL) return;
   /* The answer is dropped because there is nobody to give it to: this is ELF
    * init, before main, before the program has decided anything. What matters
    * is that a failure here is not final — [start_on] gives [started] back, so