A parked program's full reload ring says why it is full

The agent refuses a module it has no room to queue with "the program is not
calling agent/poll". For a running program that is the cause. For a parked one
it is confidently wrong: there is no game thread left to poll with, nothing
drains the ring until somebody runs the program again, and the ring is full
precisely because Dev.eval accepts evaluations while parked and promises they
install at the next run. At install sixty-five that promise breaks, and the
reply sent the reader to inspect a loop that is not running.

The agent cannot know this — parking is the merged shim's state — so the
daemon, which has just asked liveness, rewrites that one reply the way
abi_mismatch rewrites dlerror's. Every other refusal is still quoted in the
agent's own words, and a running program's is unchanged.

Pinned on Dev.refusal rather than end to end: filling the ring is sixty-four
real clang runs, and what the daemon does with the agent's words is the whole
of the change.

lib/dev.ml

@@ -527,6 +527,40 @@ let parked_msg why =
 
 let parked why = error (parked_msg why)
 
+let contains hay needle =
+  let n = String.length needle and h = String.length hay in
+  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
+  n = 0 || go 0
+
+(* A module the agent would not take, said in the daemon's words rather than
+   only in the agent's.
+
+   The agent refuses a full reload ring with "the program is not calling
+   agent/poll", which is the right cause for a program that is running and the
+   wrong one for a program that has finished. A parked process is not failing
+   to poll: it has no game thread left to poll with, it is waiting in the park
+   for somebody to run it again, and nothing drains the ring until then — so
+   the sixty-fifth module queued since it parked is refused for the very
+   behaviour [eval] below promises it — that a body redefined while parked
+   installs when the program is run again. A reader told to check their
+   [agent/poll] calls would go looking at a loop that is not running.
+
+   The agent cannot say this itself. Parking is the merged shim's state and the
+   agent is vendored beside it knowing nothing about runs; what knows is this
+   daemon, which has just asked [liveness] and is about to quote a reply. So
+   the substitution is made here, on a substring of a reply this side did not
+   write — the same move [abi_mismatch] makes on [dlerror]'s text, and made for
+   the same reason: the component that has the words does not have the
+   context. *)
+let refusal ~parked reply =
+  if parked && contains reply "reload queue full" then
+    "the program refused the module: its reload ring is full, and a parked \
+     program drains none of it — every module queued since it finished is \
+     still waiting for a frame boundary, and M-x flan-rerun is what gives it \
+     one; this one was not queued, so send it again once the program is \
+     running"
+  else "the program refused the module: " ^ reply
+
 (* [pause], when given, is the position of the form to stop at — §9. It rides
    beside the code rather than in it, and the reply echoes it back so an editor
    marks the buffer only for a mark the session actually applied.
@@ -607,7 +641,7 @@ let eval t ~code ~origin ~pause =
                            when it is run again rather than at its next frame \
                            boundary" ]
                   else []))
-          | reply -> refused ("the program refused the module: " ^ reply)
+          | reply -> refused (refusal ~parked:parked_now reply)
           | exception Unix.Unix_error (e, _, _) ->
             refused
               ("cannot reach the program on " ^ t.agent ^ ": "
@@ -714,7 +748,11 @@ let eval_expr t ~code ~origin ~pause =
              the wait then says: a timeout is a frame boundary not reached
              yet, not a module refused, so the instances in it stay in the
              session. Only the two arms below, where nothing was accepted,
-             put the session back. *)
+             put the session back.
+
+             No [refusal] either, and that is not an omission: this verb
+             refuses a parked program before it compiles anything, so the one
+             reply whose cause that rewrites cannot arrive here. *)
           | reply -> refused ("the program refused the module: " ^ reply)
           | exception Unix.Unix_error (e, _, _) ->
             refused ("cannot reach the program: " ^ Unix.error_message e))
@@ -2064,11 +2102,6 @@ let run_capture cmd =
   let code = match Unix.close_process_in ic with Unix.WEXITED c -> c | _ -> -1 in
   (code, Buffer.contents b)
 
-let contains hay needle =
-  let n = String.length needle and h = String.length hay in
-  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
-  n = 0 || go 0
-
 (* The IR of one function out of a module's text. [Emit] writes a define's
    closing brace at column 0 and nowhere else, so the end is unambiguous
    without parsing LLVM. One .ll can carry several bodies — [C-c C-k] sends a

test/test_dev.ml

@@ -152,6 +152,42 @@ let contains_sub hay needle =
   in
   go 0
 
+(* ── Whose fault a full reload ring is ──────────────────────────────── *)
+
+(* The agent refuses a module it has no room to queue with "the program is not
+   calling agent/poll", and for a running program that is the cause. For a
+   parked one it is the wrong cause said confidently: there is no game thread
+   left to poll with, the ring is full precisely *because* the program
+   finished, and [Dev.eval]'s own note promises exactly that a body redefined
+   while parked installs when the program is run again. Somebody sent
+   the sixty-fifth one, and the reply sent them to read a loop that is not
+   running.
+
+   Pinned on the decision rather than end to end. Filling the ring means
+   sixty-four modules through a real clang, which is minutes of [dune test] to
+   assert one sentence; what the daemon *does* with the agent's words is the
+   whole of the change, and it is a function of two arguments. The pass-through
+   is asserted too: a running program's refusal must still arrive in the
+   agent's own words, because for it they are true. *)
+let () =
+  let full = "err reload queue full; the program is not calling agent/poll" in
+  let parked = Dev.refusal ~parked:true full in
+  if contains_sub parked "not calling agent/poll" then
+    fail "a parked program's queue-full refusal still blames its poll: %S"
+      parked;
+  if not (contains_sub parked "flan-rerun") then
+    fail "a parked program's queue-full refusal names no way out: %S" parked;
+  let live = Dev.refusal ~parked:false full in
+  if not (contains_sub live "not calling agent/poll") then
+    fail "a running program's queue-full refusal lost the agent's reason: %S"
+      live;
+  (* Only that one reply is rewritten. Every other refusal a parked program
+     can give — a bad ABI, a module with no installer — is the agent's to
+     explain and is quoted as it stands. *)
+  let other = Dev.refusal ~parked:true "err flan.abi.x86: the module is x86" in
+  if not (contains_sub other "flan.abi.x86") then
+    fail "a parked program's other refusals were rewritten too: %S" other
+
 let () =
   match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
   | 0 ->