JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A dyn value the inspector reads is rendered on the program's own thread, so one that traps or faults is a nested break and the daemon keeps answering.

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 20:24:34 +07:00
parent ae23787c04
commit 72c35ff05c
5 changed files with 182 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
lib/dev.ml
View File

@ -2186,30 +2186,41 @@ let backtrace_op t =
the reader never saw. So a write names the generation it was built against,
and the agent compares it against the stop actually in force at the moment
it claims the job, and drops it otherwise. *)
let run_render_thunk ?at_stop t ~tag
let rec run_render_thunk ?at_stop t ~tag
~(c : Session.change) : (string, string) result =
let before = match result t with Some (g, _) -> g | None -> 0L in
(* Read *before* the build, not before the wait: the resume this is watching
for can land while llc is still running, and the job it kills is this one.
[None] when the program cannot say, in which case nothing below compares
against it — a missing count is no evidence either way. *)
let watched = at_stop <> None in
let refused_before = if watched then refusals t else None in
let resumed () =
match (refused_before, if watched then refusals t else None) with
| Some (before, _), Some (now, why) when now > before -> Some why
| _ -> None
in
(* The counters are read *before* the build, not before the wait: the
resume this is watching for can land while llc is still running, and the
job it kills is this one. *)
let mark = job_mark ?at_stop t in
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "%s%d.so" tag t.n) in
match build_module c ~debug:t.session.Session.debug ~out with
| exception Failure m -> Error m
| _ ->
(match
(match at_stop with
| Some gen -> deliver_at_stop t ~gen out
| None -> deliver t out)
with
await_job mark t (fun () ->
match at_stop with
| Some gen -> deliver_at_stop t ~gen out
| None -> deliver t out)
(* What a wait compares against: the result generation, and the agent's
count of dropped jobs when the job names a stop. [None] where the program
cannot say, in which case nothing compares against it — a missing count is
no evidence either way. *)
and job_mark ?at_stop t =
let before = match result t with Some (g, _) -> g | None -> 0L in
let refused_before = if at_stop <> None then refusals t else None in
(before, refused_before, stop_gen t)
(* Hand a job to the program with [send], and wait for the value it writes
into the result buffer. Shared by a compiled thunk and by the [dyn] verb,
which renders a dyn value on the program's own thread. *)
and await_job (before, refused_before, gen) t send : (string, string) result =
let resumed () =
match (refused_before, if refused_before <> None then refusals t else None) with
| Some (before, _), Some (now, why) when now > before -> Some why
| _ -> None
in
(match send () with
| exception Unix.Unix_error (e, _, _) ->
Error (unreachable t e)
| "ok" ->
@ -2233,6 +2244,15 @@ let run_render_thunk ?at_stop t ~tag
| _ ->
match resumed () with
| Some why -> Error why
| None when (match (gen, stop_gen t) with
| Some g, Some g' -> g' > g
| _ -> false) ->
(* The job itself stopped the program — a trap in the value it
was rendering — and the break it pushed is holding the thread.
Said now rather than after the five seconds. *)
Error
"the program stopped again while producing the value, and the \
break buffer is holding it: take a restart there, or abort"
| None ->
(* Two sentences for the same silence, because there are two
causes and each names a different thing to go and look at.
@ -2338,11 +2358,19 @@ let agent_mem t : Inspect.mem =
"<ptr", as the thunk's [reg-emit] wrote it. *)
| Ok l when starts l "dead" -> Inspect.Dead (after l "dead")
| _ -> Inspect.Unknown);
(* Rendered by the program, on its own thread, as an evaluation is: the
dyn printer follows pointers and can trap, and a trap there is a nested
break rather than a daemon that never answers again. See the agent's
[dyn] verb. *)
dyn =
(fun w ->
match agent_line t (Printf.sprintf "dyn %Lu" w) with
| Ok l when starts l "ok " -> unhex (after l "ok ")
| Ok l | Error l -> raise (Inspect.Unreadable ("a dyn value: " ^ l))) }
let mark = job_mark ~at_stop:1 t in
match
await_job mark t (fun () ->
String.trim (request t (Printf.sprintf "dyn %Lu" w)))
with
| Ok v -> v
| Error m -> raise (Inspect.Unreadable ("a dyn value: " ^ m))) }
let reader t =
Inspect.make ~program:t.session.Session.program
@ -2368,9 +2396,13 @@ let one_stop t f =
let r = f () in
if stop_gen t = before then r
else
Error
"the program moved on while it was being read, so what was read may \
mix two stops; ask again"
match r with
| Error _ -> r
| Ok _ ->
Error
"the program stopped somewhere else while it was being read — a value \
it was asked to render may have trapped, and the break buffer is \
holding that stop — so what was read may mix two stops; ask again"
(* The frame checks, which every verb that reads a *frame* has to make and
must make the same way. [inspect] exists precisely because the listing is

5
runtime/flan_dyn.c
View File

@ -735,11 +735,6 @@ void flan_dyn_print(flan_dyn v) { render(flan_write_stdout, v, 0, 0); }
void flan_dyn_emit_dev(flan_dyn v) { render(flan_dev_emit, v, 0, 1); }
void flan_dyn_emit_watch(flan_dyn v) { render(flan_dev_watch_emit, v, 0, 1); }
/* And into whatever sink the caller hands over — the agent's, when the
* daemon's inspector reads a dyn word out of a stopped program's memory and
* wants its rendering as a reply rather than in the result buffer. */
void flan_dyn_emit_to(dyn_sink w, flan_dyn v) { render(w, v, 0, 1); }
/* And into a condition's message, which flan_rt.c's sink bounds. */
void flan_msg_emit(const uint8_t *p, int64_t n);
void flan_dyn_emit_msg(flan_dyn v) { render(flan_msg_emit, v, 0, 1); }

34
test/programs/dev-dyn-trap.flan Normal file
View File

@ -0,0 +1,34 @@
;;;; Two dyn values the dyn printer cannot print. [dv] is a dyn view of a Vec
;;;; whose arena was freed, which traps DynRange when printed; the first
;;;; element of [s] is a word that reads as a boxed pointer to address 0x10,
;;;; which faults when printed as a dyn. The inspector hands each to the
;;;; program's own thread to render, so both become a nested break and the
;;;; daemon keeps answering.
(import agent "vendor:agent")
(defstruct Boom [why i32])
(defonce tv (Vec i64))
(defonce dv dyn)
(defonce n i32)
(defn as-dyn [d dyn] dyn d)
(defn inner [s [i64]] i64
(set dv dv) (set n n)
(error (Boom {.why 3}))
(at s 0))
(defn main [] i32
(agent/start "/tmp/flan-dev-dyn-trap-fallback.sock")
(let [ar (arena-new 4096)]
(set tv (vec-new i64 ar))
(push tv 7)
(set dv (as-dyn tv))
(free-all ar))
(set n 5)
(let [v (vec-new i64)]
(push v -1407374883553264)
(push v 5)
(print (inner (slice v))) (println ""))
(dotimes [i 4000] (agent/wait 5))
0)

58
test/test_dev.ml
View File

@ -6347,6 +6347,64 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ psock; pout ])
[ "--llvm"; "--x86" ];
(* ── A dyn value that traps or faults while it is printed ─────────── *)
(* The reader hands a dyn word to the program's own thread to render,
because the dyn printer follows pointers: a view of a freed arena
traps, and a scribbled word faults. Rendered on the agent's thread
either one hung the daemon for good or killed it. Here each must come
back as a refusal, and the daemon must go on answering. *)
let dsock = tmp "dyntrap.sock" and dout = tmp "dyntrap.out" in
(try Sys.remove dsock with Sys_error _ -> ());
let dfd = Unix.openfile dout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let dpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-dyn-trap.flan"; "-s"; dsock; "--llvm" |]
Unix.stdin dfd Unix.stderr
in
Unix.close dfd;
if not (listening ~pid:dpid dsock) then begin
fail "the dyn-trap daemon %s" !listen_why;
(try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect dsock in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
let answers what =
let r = request c "(:op \"eval-expr\" :code \"n\")" in
if Wire.string_field r "value" <> Some "5" then
fail "after %s the daemon no longer answers: %s" what
(Option.value ~default:(status r) (Wire.string_field r "message"))
in
if not (await (fun () -> stopped (request c "(:op \"describe\")"))) then
fail "the dyn-trap program never stopped"
else begin
let r = request c "(:op \"inspect\" :frame 0 :slot 0 :path (0))" in
(match Wire.field r "addr" with
| Some { Form.v = Form.Int a; _ } ->
let r =
request c (Printf.sprintf "(:op \"at\" :addr %Ld :type \"dyn\")" a)
in
if status r <> "error" then
fail "a dyn word pointing at 0x10 rendered: %s"
(Option.value ~default:"" (Wire.string_field r "value"));
answers "a dyn word that faults"
| _ -> fail "inspecting the slice element gave no :addr");
let r = request c "(:op \"globals\")" in
if status r <> "error" then
fail "a dyn view of a freed arena rendered in the globals section";
answers "a dyn value that traps"
end;
ignore (request c "(:op \"close\")");
(try Unix.close c with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] dpid) with Unix.Unix_error _ -> ())
end;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ dsock; dout ];
(* ── What a half-finished assignment looks like from the break ────── *)
(* A condition signalled from inside the value being assigned stops the

63
vendor/agent/flan_agent.c vendored
View File

@ -127,11 +127,12 @@ int flan_dev_reg_overflowed(void);
int32_t flan_dev_reg_live(const void *p);
int32_t flan_dev_reg_epitaph(const void *p, char *buf, int64_t cap);
void *flan_dev_global_find(const char *name);
/* A dyn word's rendering, into a sink of the caller's. Weak: flan_dyn.c is
* linked only into a program that uses a dyn operation, and a program with no
* dyn value has nothing to ask it about. */
void flan_dyn_emit_to(void (*w)(const uint8_t *, int64_t), uint64_t v)
__attribute__((weak));
/* A dyn word's rendering, into the result buffer. Weak: flan_dyn.c is linked
* only into a program that uses a dyn operation, and a program with no dyn
* value has nothing to ask it about. */
void flan_dyn_emit_dev(uint64_t v) __attribute__((weak));
void flan_dev_result_begin(void);
void flan_dev_result_end(void);
void flan_free_temp(void);
void *flan_temp_scratch_begin(void);
void flan_temp_scratch_end(void *prev);
@ -1495,17 +1496,13 @@ static void reply_unarmed(sink *o, snapshot *s, int32_t i) {
static pthread_mutex_t request_lock = PTHREAD_MUTEX_INITIALIZER;
/* Where [dyn]'s rendering collects. Static, because [request_lock] makes
* that verb one caller at a time, and the renderer's sink is a bare function
* with nowhere to carry a pointer. Longer than any rendering the daemon keeps:
* it cuts every value at the result buffer's size. */
static char dyn_text[8192];
static size_t dyn_text_len;
static void dyn_text_put(const uint8_t *p, int64_t n) {
size_t k = n < 0 ? 0 : (size_t)n;
if (k > sizeof dyn_text - dyn_text_len) k = sizeof dyn_text - dyn_text_len;
memcpy(dyn_text + dyn_text_len, p, k);
dyn_text_len += k;
/* The word [dyn] hands the game thread. One slot, because the daemon waits
* for each rendering before asking for the next. */
static uint64_t dyn_word;
static void dyn_job(void) {
flan_dev_result_begin();
flan_dyn_emit_dev(dyn_word);
flan_dev_result_end();
}
static void handle_line(char *line, sink *o) {
@ -2065,26 +2062,34 @@ static void handle_line(char *line, sink *o) {
reply(o, "\n");
return;
}
/* "dyn WORD" — the rendering of one dyn value, as hex. The walk that takes
* a dyn apart is the runtime's, so the daemon hands it the word. */
/* "dyn WORD" — render one dyn value into the result buffer, on the game
* thread, and answer [ok] for having queued it; the daemon reads the value
* back as it reads a thunk's.
*
* Not rendered here. The dyn printer follows the value's pointers and can
* trap — a view of a Vec whose arena was freed — or fault on a scribbled
* word, and on this thread either one is a break loop that holds
* [request_lock] for ever, or the daemon's own death. On the game thread it
* runs as an evaluation does, inside [flan_agent_poll]'s escape, so it
* becomes a nested break the break buffer shows. */
if (strncmp(line, "dyn ", 4) == 0) {
char *end = NULL;
unsigned long long w = strtoull(line + 4, &end, 0);
static const char hex[] = "0123456789abcdef";
snapshot *s = snap_top();
job j = { 0 };
if (end == line + 4) { reply(o, "err dyn wants a word\n"); return; }
if (flan_dyn_emit_to == NULL) {
if (flan_dyn_emit_dev == NULL) {
reply(o, "err this program has no dyn runtime linked\n");
return;
}
dyn_text_len = 0;
flan_dyn_emit_to(dyn_text_put, (uint64_t)w);
reply(o, "ok ");
for (size_t k = 0; k < dyn_text_len; k++) {
unsigned char c = (unsigned char)dyn_text[k];
char two[2] = { hex[c >> 4], hex[c & 15] };
emit(o, two, 2);
}
reply(o, "\n");
if (s == NULL) { reply(o, "err no snapshot\n"); return; }
if (!queue_room()) { reply(o, "err the install queue is full\n"); return; }
dyn_word = (uint64_t)w;
j.call = dyn_job;
j.stopped_only = 1;
j.at_stop = s->gen;
if (!publish(j)) { reply(o, "err the install queue is full\n"); return; }
reply(o, "ok\n");
return;
}
if (strcmp(line, "result") == 0) {