An evaluated expression's module is unloaded when its only strings are literals or registry names, because a literal is a copy the process keeps

TODO.org

@@ -1498,10 +1498,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;
@@ -1822,11 +1818,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 after an allocating thunk once answered without the value
-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", so the global
-direct reruns. Intermittent and GC-shaped: a dyn global read after a collection a
+was intact and the first read's reply lacked the value: not the collector. Not
-C-x C-e thunk triggered. Needs reproducing under load and fixing.
+reproduced in 350 churn-and-read cycles under 8-way load, three concurrent test_dev
+runs, or a valgrind run of the cycle, which was clean.
 
 * Editor
 

lib/emit.ml

@@ -536,6 +536,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
@@ -2562,6 +2568,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"
@@ -4957,6 +4973,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)
@@ -5273,7 +5291,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;
@@ -5749,6 +5767,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
@@ -5868,7 +5887,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) ->
@@ -5887,8 +5906,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));
@@ -5898,7 +5919,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
@@ -5967,10 +5988,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,

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. *)
@@ -5315,6 +5326,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)
@@ -5419,7 +5431,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);
@@ -5598,13 +5613,11 @@ 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 = []

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/test_dev.ml

@@ -6604,12 +6604,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)\" \
-                  "(: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. *)
@@ -6629,11 +6629,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
-                 fail
+                 (* The failing reply itself, and not a second read: the one
-                   "--%s: after a thunk that allocates (cycle %d) the parked \
+                    recorded failure here re-read and got "kept", so what the
-                    program's dyn global reads %S"
+                    first read answered is the whole of the evidence. *)
-                   backend cycle (read ());
+                 let r = read_reply () in
+                 if not (contains_sub (answer r) "kept") then
+                   fail
+                     "--%s: after a thunk that allocates (cycle %d) the \
+                      parked program's dyn global read %S (%s: %s)"
+                     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
@@ -6642,7 +6648,48 @@ 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
            end;
            ignore (request c "(:op \"close\")");
            (try Unix.close c with Unix.Unix_error _ -> ());
@@ -8761,6 +8808,28 @@ 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]

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);