diff --git a/lib/dev.ml b/lib/dev.ml index 3d41df1a..c8885570 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 = " 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 diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 14c2dba5..ea488a33 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -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); } diff --git a/test/programs/dev-dyn-trap.flan b/test/programs/dev-dyn-trap.flan new file mode 100644 index 00000000..383b78b6 --- /dev/null +++ b/test/programs/dev-dyn-trap.flan @@ -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) diff --git a/test/test_dev.ml b/test/test_dev.ml index cf615cff..a1824b1f 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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 diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 2092b10c..46767be3 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -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) {