From 1cbe8ed3862d2f9f61079090b380f31055f539c8 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 22:17:41 +0700 Subject: [PATCH] The break loop keeps its condition, and the daemon renders it MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The break loop used to discard the pointer it was handed, so the buffer could name a BoundsError's fields and never show 648. Now the snapshot stashes it, flan_agent_condition hands it back on the stopped thread, and a daemon-built thunk — locals pointed at the condition — renders each field. Delivered at-stop, so a resume-and-restop cannot get the old type read over the new pointer. The trap sites publish their loc around the hook call, the snapshot copies it, and break answers :site with the line's text as :source — the frame lines say where each call was; this is the only record of the indexing itself. Compiler temps are hidden from the locals listing rather than refused as s4; a shadowing rebind strips its ~N except where the outer binding is on the same list, where both keep their raw spelling. --- lib/dev.ml | 162 ++++++++++++++++++++++++++++++-- lib/session.ml | 168 +++++++++++++++++++++++++++++----- runtime/flan_rt.c | 37 ++++++-- test/programs/dev-locals.flan | 23 +++-- test/test_dev.ml | 99 +++++++++++++++++++- vendor/agent/flan_agent.c | 77 ++++++++++++++-- 6 files changed, 511 insertions(+), 55 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index 5e2ab4f..b0d221c 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -388,6 +388,29 @@ let restarts t = end | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) +(* Whether the break on top holds a condition value a render thunk can be + aimed at. [+] or [-]; the pointer itself never crosses the wire. *) +let condition_present t = + match ask t "condition" with + | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) + | text -> + let line = String.trim text in + if line = "+" then Ok true + else if line = "-" then Ok false + else Error line + +(* Where the expression that trapped is written — file:line:col — or [None] + for a stop that has no site: a user (error ...), a (pause). The frame + lines say where each call was; this is the only record of the indexing or + the division itself. *) +let trap_site t = + match ask t "site" with + | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) + | text -> + let line = String.trim text in + if String.length line >= 3 && String.sub line 0 3 = "err" then Error line + else Ok (if line = "-" || line = "" then None else Some line) + (* Where a stopped program is, one frame per line, innermost first — the same framing [restarts] uses, terminated by a lone dot, because it comes back over the same one-line-out socket. @@ -1355,6 +1378,47 @@ let layout t ~ty = other, so an editor reads the same two keys whatever it asked. What this op adds is the restart names, which cost a second round trip to the program and are wanted only when someone is about to choose one. *) +(* The text of the line a site names, for the pointer the break buffer draws + under the headline. Best effort by design: the site is authoritative and a + file this end cannot read simply contributes no line — a build directory + moved, a program compiled on another machine. Parsed from the right, + because the path is the one piece that could contain a colon. *) +let source_line site = + match String.rindex_opt site ':' with + | None -> None + | Some c -> + (match String.rindex_from_opt site (c - 1) ':' with + | None -> None + | Some l -> + (match int_of_string_opt (String.sub site (l + 1) (c - l - 1)) with + | None -> None + | Some line when line > 0 -> + let path = String.sub site 0 l in + (match open_in path with + | exception Sys_error _ -> None + | ic -> + let rec skip n = + match input_line ic with + | exception End_of_file -> None + | text -> if n <= 1 then Some text else skip (n - 1) + in + let r = skip line in + close_in_noerr ic; + r) + | Some _ -> None)) + +(* The two site fields [break] adds when the stop has one. [:site] is where + the expression that trapped is written; [:source] is that line's text, when + the file can be read from here. *) +let site_fields t = + match trap_site t with + | Error _ | Ok None -> [] + | Ok (Some site) -> + (":site " ^ Wire.quote site) + :: (match source_line site with + | None -> [] + | Some text -> [ ":source " ^ Wire.quote text ]) + let break t = match liveness t with | Gone -> error gone @@ -1386,12 +1450,13 @@ let break t = rather than filtered, because a client that quietly dropped them would leave someone asking where their restart went. *) ok - [ ":restarts " ^ Wire.strings (List.map (fun (_, _, n) -> n) rs); - ":unreachable " - ^ Wire.ints - (List.filter_map - (fun (i, ok, _) -> if ok then None else Some i) - rs) ] + ([ ":restarts " ^ Wire.strings (List.map (fun (_, _, n) -> n) rs); + ":unreachable " + ^ Wire.ints + (List.filter_map + (fun (i, ok, _) -> if ok then None else Some i) + rs) ] + @ site_fields t) | Error m -> error ("the program refused to list its restarts: " ^ m)) (* [(:op "backtrace")] — the frames of a stopped program, innermost first. @@ -1714,9 +1779,7 @@ let locals t ~frame = if Array.length fn.Tast.slots = 0 then ok [ ":frame " ^ Wire.quote name; ":locals ()"; ":refused ()"; - ":note " - ^ Wire.quote - "that frame records no slots; every slot in it is one the compiler made up" ] + ":note " ^ Wire.quote "this frame has no named locals" ] else (match bound_slots t ~frame with | Error m -> error ("the program refused to say which slots are bound: " ^ m) @@ -1751,6 +1814,86 @@ let locals t ~frame = (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ]) refused) ])) +(* [(:op "condition")] — the stopped condition's fields, with their values. + + [layout] answers the *shape* out of [Tast.structs] with no program + involved; this is the other half. The break loop stashed the pointer it + was handed in the agent's snapshot, and this end knows the type at that + address — it compiled it, and [status] reports its qualified name. So it + is [locals] pointed at the condition: a thunk renders each field through + [flan/dev-cond], on the stopped thread, and the text comes back the same + way. + + Delivered at-stop, and that is the correctness of it rather than a nicety. + The thunk reads whatever pointer the snapshot on top holds when it runs; a + program that resumed and stopped again holds a *different* condition, and + rendering the old stop's type over the new stop's pointer would be a + misread with a plausible shape. Naming the stop makes the agent drop the + thunk instead. + + Refused, by name, for a stop that has no value to read: a trap like + [NullAllocator] is a name with no struct behind it, and a trap with no + transfer channel reached the break loop with no condition at all. *) +let condition_op t = + match liveness t with + | Gone -> error gone + | Parked when not (parked_break t) -> + parked "a parked program is not stopped on a condition" + | Live | Parked -> + match state t with + | Running -> + error "the program is running; a condition is read where it stopped" + | Unreachable m -> error ("cannot ask the program what it stopped on: " ^ m) + | Stopped cname -> + match + List.find_opt + (fun (s : Tast.structure) -> String.equal s.Tast.sname cname) + t.session.Session.program.Tast.structs + with + | None -> + error + (cname + ^ " is not a struct this session knows, so there are no fields to \ + read") + | Some st -> + match condition_present t with + | Error m -> error ("cannot ask the program for its condition: " ^ m) + | Ok false -> + error + ("this stop was not handed a condition value; there is nothing to \ + render for " ^ cname) + | Ok true -> + match stop_gen t with + | None | Some 0 -> + error "cannot pin the stop this condition belongs to; ask again" + | Some gen -> + let c, refused = Session.render_condition t.session ~st in + (match run_render_thunk ~at_stop:gen t ~tag:"c" ~c with + | Error m -> error m + | Ok v -> + (* One line per field — name, type, value, tab separated, and + safe because every string the renderer emits is escaped. *) + let entries = + List.filter_map + (fun line -> + match String.split_on_char '\t' line with + | [ n; ty; value ] -> + Some + (Wire.list + [ Wire.quote n; Wire.quote ty; Wire.quote value ]) + | _ -> None) + (String.split_on_char '\n' v) + in + ok + [ ":type " ^ Wire.quote cname; + ":fields " ^ Wire.list entries; + ":refused " + ^ Wire.list + (List.map + (fun (n, why) -> + Wire.list [ Wire.quote n; Wire.quote why ]) + refused) ]) + (* [(:op "inspect" :frame N :slot I :path (...))] — the inspector's second rooting mode. [docs/BUILT.md]'s "Two ways to root a walk" says what each root can and cannot do; this is the half that names a frame. @@ -3222,6 +3365,7 @@ let handle t req = | Some "describe" -> describe t | Some "defs" -> defs t | Some "break" -> break t + | Some "condition" -> condition_op t | Some "backtrace" -> backtrace_op t | Some "locals" -> locals t ~frame:(match Wire.int_field req "frame" with Some n -> n | None -> 0) diff --git a/lib/session.ml b/lib/session.ml index 0d30878..0456ad5 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -941,6 +941,12 @@ let externs : Tast.extern list = { Tast.ename = "flan/dev-slot"; esym = "flan_agent_frame_slot"; eparams = [ Types.Int Types.I64; Types.Int Types.I64 ]; eret = Types.Ptr (Types.Int Types.U8); eloc = Loc.unknown }; + (* The condition the stopped program is holding, same contract: the agent + resolves it against the snapshot on top when the thunk runs, and NULL + when there is none. See [render_condition]. *) + { Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition"; + eparams = []; eret = Types.Ptr (Types.Int Types.U8); + eloc = Loc.unknown }; { Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin"; eparams = []; eret = Types.Unit; eloc = Loc.unknown }; { Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end"; @@ -1011,6 +1017,51 @@ let dev_pointers : Render.pointers = (* ── The locals of a stopped frame ─────────────────────────────────── *) +(* What a slot is *shown as*. Two departures from the raw [snames] entry, + both about keeping the listing in the words the person wrote. + + A compiler temp — [dotimes]'s hidden bound, the slot a (min) evaluates an + operand into — has no name at all, and it is hidden rather than refused: + [s4] is not a variable anyone can find in the file, and a row explaining + its absence was noise on every frame that had one. [None] here means + "not shown". + + A shadowing rebind — [check.ml]'s [bind] suffixes the repeat as [v~2] so + the debug info never claims one binding is the other — is shown under the + written name, because the depth is the compiler's bookkeeping. Only a + trailing [~N] is stripped: [~] is the reader's delimiter and a synthesized + name like [destructure~nth] carries it for a different reason. And when + stripping would put one name on two slots of this frame, both keep their + raw spelling — two rows called [v] with nothing to tell them apart is the + lie the suffix existed to prevent. *) +let strip_rebind name = + match String.rindex_opt name '~' with + | Some k when k > 0 && k < String.length name - 1 -> + let suffix = String.sub name (k + 1) (String.length name - k - 1) in + if String.for_all (fun c -> c >= '0' && c <= '9') suffix + then String.sub name 0 k + else name + | _ -> name + +let shown_names (fn : Tast.fn) : string option array = + let n = Array.length fn.Tast.slots in + let raw = + Array.init n (fun i -> + if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) else None) + in + let stripped = Array.map (Option.map strip_rebind) raw in + let count name = + Array.fold_left + (fun acc s -> if s = Some name then acc + 1 else acc) + 0 stripped + in + Array.mapi + (fun i s -> + match s with + | None -> None + | Some d -> if count d > 1 then raw.(i) else Some d) + stripped + (* The second half of what a break loop can show, and it is the same primitive as [C-x C-e] pointed somewhere else. @@ -1095,27 +1146,20 @@ let render_locals ?(origin = "") t ~frame ~(fn : Tast.fn) ~bound refuse name why; None in + let names = shown_names fn in let body = List.concat ((List.filter_map (fun i -> let ty = fn.Tast.slots.(i) in - let name = - if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) - else None - in - match name with + match names.(i) with | None -> - (* A slot the compiler made up: [dotimes]'s hidden bound, the - temporary a (min) evaluates an operand into. There is no - name to show and inventing one would put a variable in the - list that nobody can find in the file. *) - refuse (Printf.sprintf "s%d" i) - "a slot the compiler made up; no name was written for it"; + (* A slot the compiler made up — hidden, not refused; see + [shown_names]. *) None | Some name when not (List.mem i bound) -> refuse name - "not bound yet at the point the program stopped"; + "not bound yet where the program stopped"; None | Some name -> one i ty name) (List.init (Array.length fn.Tast.slots) (fun i -> i)))) @@ -1142,6 +1186,90 @@ let render_locals ?(origin = "") t ~frame ~(fn : Tast.fn) ~bound ignore origin; ({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused) +(* ── The fields of the condition a break is holding ────────────────── *) + +(* [render_locals] pointed at the condition instead of a frame. The break + loop stashes the pointer it was handed in the snapshot, the thunk reads it + back through [flan/dev-cond], and the type at that address is the struct + whose qualified name the agent reported as the condition — this end + compiled it, so the layout is its own to know. One line per field: + name, type, value, tab separated. + + The thunk carries no address of its own — [flan/dev-cond] resolves against + the snapshot on top when it runs — but the *type* it reads with was chosen + against a particular stop, so the caller delivers it at-stop: a program + that resumed and stopped again holds a different condition, and rendering + the old type over the new pointer is the misread the at-stop check + refuses. *) +let render_condition t ~(st : Tast.structure) : change * (string * string) list = + let loc = Loc.unknown in + let extra = ref [] and nslots = ref 0 in + let c = + { Render.structs = t.program.Tast.structs; + datas = t.program.Tast.datas; + unions = t.program.Tast.unions; + enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums []; + emit = dev_emitter; + ptrs = Some dev_pointers; + alloc = (fun ty -> + let i = !nslots in + incr nslots; + extra := ty :: !extra; + i) } + in + let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in + let bytes_of str = + { Tast.e = + Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]); + ty = Types.Slice (Types.Int Types.U8); loc } + in + let lit str = c.Render.emit.Render.ebytes (bytes_of str) in + let refused = ref [] in + let cty = Types.Named st.Tast.sname in + let address = + { Tast.e = Tast.Call ("flan/dev-cond", []); + ty = Types.Ptr (Types.Int Types.U8); loc } + in + let typed = + { Tast.e = Tast.Prim (Tast.Cast (Types.Ptr cty), [ address ]); + ty = Types.Ptr cty; loc } + in + let root = { Tast.e = Tast.Deref typed; ty = cty; loc } in + let one i (f : Tast.field) = + let v = { Tast.e = Tast.Field (root, i); ty = f.Tast.fty; loc } in + match Render.render c 0 v with + | parts -> + Some + ((lit (f.Tast.fname ^ "\t" ^ Types.to_string f.Tast.fty ^ "\t") :: parts) + @ [ lit "\n" ]) + | exception Loc.Error { Loc.dmsg = why; _ } -> + (* A field the structural printer has no arm for. Named with the + reason, so the buffer shows the field and says why its value is + not beside it. *) + refused := (f.Tast.fname, why) :: !refused; + None + in + let body = + List.concat + (List.filter_map Fun.id (List.mapi (fun i f -> one i f) st.Tast.fields)) + in + t.thunks <- t.thunks + 1; + let name = Printf.sprintf "condition/%d" t.thunks in + let thunk : Tast.fn = + { Tast.name; params = []; ret = Types.Unit; + body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ]; + fdefers = []; fparent = None; floc = loc; + slots = Array.of_list (List.rev !extra); + snames = Array.make (List.length !extra) None } + in + let program = + { t.program with + Tast.fns = t.program.Tast.fns @ [ thunk ]; + externs = t.program.Tast.externs @ externs } + in + let ir = redefinition t ~call:name program ~fns:[ name ] in + ({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused) + (* ── One slot of a stopped frame, walked ───────────────────────────── *) (* The inspector's second rooting mode, and the whole of what it needed. @@ -1327,15 +1455,13 @@ let render_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path (Printf.sprintf "there is no slot %d in %s; it has %d" slot fn.Tast.name nslots_of_fn) else - let sname = - if slot < Array.length fn.Tast.snames then fn.Tast.snames.(slot) else None - in + let sname = (shown_names fn).(slot) in match sname with | None -> Error (Printf.sprintf - "slot %d of %s is one the compiler made up; no name was written for \ - it, and it is not something the listing offers" + "slot %d of %s has no name in the source; the listing does not \ + show it and there is nothing here to inspect" slot fn.Tast.name) | Some name -> let extra = ref [] and nslots = ref 0 in @@ -1529,15 +1655,13 @@ let write_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path third of a second to say it. *) Error "there is nothing to store: nothing in this was changed" else - let sname = - if slot < Array.length fn.Tast.snames then fn.Tast.snames.(slot) else None - in + let sname = (shown_names fn).(slot) in match sname with | None -> Error (Printf.sprintf - "slot %d of %s is one the compiler made up; no name was written for \ - it, and it is not something the listing offers" + "slot %d of %s has no name in the source; the listing does not \ + show it and there is nothing here to inspect" slot fn.Tast.name) | Some name -> let where = name ^ path_text path in diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index e57ed4d..0cc5b09 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -761,10 +761,24 @@ typedef struct { int64_t low, high, length; } flan_bounds_cond; static const uint8_t flan_bounds_name[] = "BoundsError"; #define FLAN_BOUNDS_NAMELEN 11 +/* Where the expression that trapped is written — the loc every checked site + * already passes for its unhandled message, published for the break hook. + * The frame chain says where each *call* was; this is the only record of the + * `at` or the division itself, which is the line a person wants pointed at. + * + * Set immediately before the hook runs and cleared when it returns, so the + * agent's snapshot (taken on entry to the break loop, on this same thread) + * reads it while it is true and a later break through [flan_error] — a user + * (error ...), which carries no loc — cannot inherit a stale one. NULL + * outside that window, and NULL is the honest answer for a signal that has + * no expression to point at. */ +const uint8_t *flan_break_site; +int64_t flan_break_site_len; + /* Returns nonzero if something transferred, in which case the caller returns * and its caller's guard carries the transfer out. */ -static int flan_bounds_signal(void *xfer, int64_t low, int64_t high, - int64_t len) { +static int flan_bounds_signal(const uint8_t *loc, int64_t loclen, void *xfer, + int64_t low, int64_t high, int64_t len) { flan_bounds_cond c; uint32_t id = flan_name_id(flan_bounds_name, FLAN_BOUNDS_NAMELEN); c.low = low; @@ -773,7 +787,11 @@ static int flan_bounds_signal(void *xfer, int64_t low, int64_t high, flan_signal(id, &c, xfer); if (*(void **)xfer != NULL) return 1; if (flan_break_hook != NULL) { + flan_break_site = loc; + flan_break_site_len = loclen; flan_break_hook(flan_bounds_name, FLAN_BOUNDS_NAMELEN, &c, xfer); + flan_break_site = NULL; + flan_break_site_len = 0; if (*(void **)xfer != NULL) return 1; } return 0; @@ -781,13 +799,13 @@ static int flan_bounds_signal(void *xfer, int64_t low, int64_t high, void flan_bounds_error(const uint8_t *loc, int64_t loclen, int64_t idx, int64_t len, void *xfer) { - if (flan_bounds_signal(xfer, idx, idx, len)) return; + if (flan_bounds_signal(loc, loclen, xfer, idx, idx, len)) return; flan_bounds_fail(loc, loclen, idx, len); } void flan_slice_error(const uint8_t *loc, int64_t loclen, int64_t lo, int64_t hi, int64_t len, void *xfer) { - if (flan_bounds_signal(xfer, lo, hi, len)) return; + if (flan_bounds_signal(loc, loclen, xfer, lo, hi, len)) return; flan_slice_fail(loc, loclen, lo, hi, len); } @@ -832,7 +850,7 @@ _Noreturn void flan_slice_promise_fail(const uint8_t *loc, int64_t loclen, void flan_slice_promise_error(const uint8_t *loc, int64_t loclen, int64_t n, void *xfer) { - if (flan_bounds_signal(xfer, 0, n, 0)) return; + if (flan_bounds_signal(loc, loclen, xfer, 0, n, 0)) return; flan_slice_promise_fail(loc, loclen, n); } @@ -936,7 +954,11 @@ void flan_arith_error(const uint8_t *loc, int64_t loclen, int32_t op, flan_signal(id, &c, xfer); if (*(void **)xfer != NULL) return; if (flan_break_hook != NULL) { + flan_break_site = loc; + flan_break_site_len = loclen; flan_break_hook(flan_arith_name, FLAN_ARITH_NAMELEN, &c, xfer); + flan_break_site = NULL; + flan_break_site_len = 0; if (*(void **)xfer != NULL) return; } flan_arith_fail(loc, loclen, op, lhs, rhs); @@ -1706,7 +1728,8 @@ void *flan_vec_at(flan_vec *v, int32_t i, int64_t size, const uint8_t *loc, /* The same unsigned comparison the fixed-array bounds check uses: a negative * index sign-extends to a huge unsigned and is caught by the one test. */ if ((uint64_t)(int64_t)i >= (uint64_t)v->len) { - if (flan_bounds_signal(xfer, (int64_t)i, (int64_t)i, v->len)) return NULL; + if (flan_bounds_signal(loc, loclen, xfer, (int64_t)i, (int64_t)i, v->len)) + return NULL; flan_vec_bounds_fail(loc, loclen, (int64_t)i, v->len); } return (uint8_t *)v->ptr + (int64_t)i * size; @@ -1723,7 +1746,7 @@ void flan_vec_as_slice(flan_vec *v, void *out, int32_t lo, int32_t hi, /* Both ends, because both are what went wrong — the fixed-array slice * check reports the same pair. [out] is left untouched on the transfer * path; the caller's guard branches before it reads the slice. */ - if (flan_bounds_signal(xfer, l, h, v->len)) return; + if (flan_bounds_signal(loc, loclen, xfer, l, h, v->len)) return; flan_vec_bounds_fail(loc, loclen, l, v->len); } s.p = (uint8_t *)v->ptr + l * size; diff --git a/test/programs/dev-locals.flan b/test/programs/dev-locals.flan index 7a7ef4a..906793c 100644 --- a/test/programs/dev-locals.flan +++ b/test/programs/dev-locals.flan @@ -15,13 +15,22 @@ (let [p (Point {.x 1.5 .y 2.5}) xs [10 20 30] flag (> n 0)] - (restart-case - (do (error (Boom {.why 7})) - ;; Never reached before the break, so [after] is a slot with nothing - ;; in it: the frame records a null for it and this is what "not bound - ;; yet" has to mean. - (let [after (i64 99)] after)) - (carry-on [] 5)))) + ;; A loop, for its hidden bound: [dotimes] allocates a slot nobody named, + ;; and the listing must *hide* it rather than refuse it by an invented + ;; name — [s6] is not a variable anyone can find in this file. + (dotimes [hop 0] (print "")) + ;; And a shadowing rebind. The checker suffixes the repeat as [label~2] + ;; so the debug info never claims one binding is the other; the listing + ;; keeps both raw spellings, because two rows both called [label] with + ;; nothing to tell them apart would be worse. + (let [label "inner"] + (restart-case + (do (error (Boom {.why 7})) + ;; Never reached before the break, so [after] is a slot with nothing + ;; in it: the frame records a null for it and this is what "not bound + ;; yet" has to mean. + (let [after (i64 99)] after)) + (carry-on [] 5))))) (defvar ticks i64) diff --git a/test/test_dev.ml b/test/test_dev.ml index 60f92c9..a99a66b 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -875,6 +875,21 @@ let () = [ { Form.v = Form.Str "id"; _ }; { Form.v = Form.Str "i32"; _ } ]; _ } ]; _ } -> () | _ -> fail "the stopped program's condition has the wrong layout"); + (* And the value behind the shape: [fetch 1] built the condition, so + [.id] holds 1, and the daemon's thunk reads it out of the stopped + frame's own storage — a user [error], not a trap, so the same path + serves both. *) + let r = ask "(:op \"condition\")" in + if status r <> "ok" then + fail "condition values at a user error: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")) + else + (match Wire.field r "fields" with + | Some { Form.v = Form.List [ { Form.v = Form.List + [ { Form.v = Form.Str "id"; _ }; { Form.v = Form.Str "i32"; _ }; + { Form.v = Form.Str "1"; _ } ]; _ } ]; _ } -> () + | _ -> fail "the condition's own field value did not render"); + (* What is on offer, innermost first. [break] carries the names and nothing else — the state is the annotation's business, so there is one place in the daemon that decides it. *) @@ -1273,6 +1288,58 @@ let () = if names <> [ "low"; "high"; "length" ] then fail "BoundsError's fields: %s" (String.concat ", " names) | _ -> fail "BoundsError's layout has no fields"); + (* The values, not just the shape. The break loop stashed the pointer + it was handed, the daemon knows the type — it compiled it — and a + thunk it builds renders the fields in the stopped program. This is + what turns "BoundsError" into "9 is past the end of a length-4 + array" in the buffer, with nothing special-casing BoundsError. *) + let r = ask "(:op \"condition\")" in + if status r <> "ok" then + fail "condition values: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")) + else begin + let fields = + match Wire.field r "fields" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List + [ { Form.v = Form.Str n; _ }; + { Form.v = Form.Str ty; _ }; + { Form.v = Form.Str v; _ } ] -> Some (n, ty, v) + | _ -> None) + l + | _ -> [] + in + if + fields + <> [ ("low", "i64", "9"); ("high", "i64", "9"); + ("length", "i64", "4") ] + then + fail "the condition's fields: %s" + (String.concat ", " + (List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) fields)) + end; + (* Where the *expression* is. The frame lines say where each call was; + the trap's own loc is the only record of the indexing itself, and + [break] carries it with the line's text so a buffer can point at + the column Elm-style. *) + (let r = ask "(:op \"break\")" in + match Wire.string_field r "site" with + | None -> fail "break over a bad index carries no :site" + | Some site -> + let has hay needle = + let n = String.length hay and m = String.length needle in + let rec go i = i + m <= n && (String.sub hay i m = needle || go (i + 1)) in + m = 0 || go 0 + in + if not (has site "dev-break-bounds.flan:") then + fail "the site does not point into the program: %s" site; + (match Wire.string_field r "source" with + | Some line when has line "(at grid i)" -> () + | Some line -> fail "the site's source line reads %S" line + | None -> fail "break carries a :site but no :source line")); (* Only the program's own restart is on offer. Nothing is pushed at the failing index, so a list with anything else on it would mean a site restart had been established after all. *) @@ -1573,12 +1640,33 @@ let () = note here used to say was still owed. *) ("p", "Point", "(Point {.x 1.5 .y 2.5})"); ("xs", "[3 i32]", "[ 10 20 30]"); - ("flag", "bool", "true") ] + ("flag", "bool", "true"); + (* [hop] is [dotimes]'s index and it is listed; the loop's + hidden bound sits in the very next slot and is *not* — a + compiler temp is hidden, not refused, because [s6] is not a + variable anyone can find in the file. *) + ("hop", "i32", "0"); + (* The shadowing rebind keeps its raw spelling here because the + outer [label] is on the same list: strip the suffix from one + and the frame shows two rows called [label] with nothing to + tell them apart. *) + ("label~2", "string", "\"inner\"") ] in if got <> want then fail "locals of the stopped frame: %s" (String.concat ", " (List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) got)); + (* No refusal mentions an invented name: the hidden bound must be + absent from both lists, not moved to the other one. *) + (match + List.filter + (fun (n, _, _) -> String.length n > 0 && n.[0] = 's') + (pairs r "refused") + with + | [] -> () + | rs -> + fail "a compiler temp leaked into the refusals: %s" + (String.concat ", " (List.map (fun (n, _, _) -> n) rs))); (* And the one that must not be rendered. [after] is bound inside the restart-case *past* the error, so its slot is storage nothing has written: the frame records a null for it, and a thunk that @@ -1629,7 +1717,7 @@ let () = holding [p]'s value and nothing would say so. *) let r = ask - "(:op \"eval\" :code \"(defn look [n i64 label string] i64 (let [q (Point {.x 9.0 .y 9.0}) ys [1 2 3] mark (< n 0)] (restart-case (do (error (Boom {.why 7})) (let [after (i64 99)] after)) (carry-on [] 5))))\" :file \"/tmp/buf.flan\")" + "(:op \"eval\" :code \"(defn look [n i64 label string] i64 (let [q (Point {.x 9.0 .y 9.0}) ys [1 2 3] mark (< n 0)] (dotimes [pip 0] (print \\\"\\\")) (let [tag \\\"x\\\"] (restart-case (do (error (Boom {.why 7})) (let [later (i64 99)] later)) (carry-on [] 5)))))\" :file \"/tmp/buf.flan\")" in if status r <> "ok" then fail "installing a renamed body while stopped: %s" @@ -4574,7 +4662,12 @@ let () = ("label", "string", "\"hello\""); ("p", "Point", "(Point {.x 1.5 .y 2.5})"); ("xs", "[3 i32]", "[ 10 20 30]"); - ("flag", "bool", "true") ] + ("flag", "bool", "true"); + (* Same two rows the LLVM listing pins: the loop index shown, + the loop's hidden bound hidden, the shadowing rebind kept + raw because the outer [label] is on the same list. *) + ("hop", "i32", "0"); + ("label~2", "string", "\"inner\"") ] in let got = triples r "locals" in if got <> want then diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 5afe532..3ba4cee 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -325,6 +325,12 @@ extern void *flan_dev_frame_slot(const void *frame, int32_t i); extern const uint8_t *flan_restart_name(int32_t i, int64_t *len); extern void *flan_restart_frame(int32_t i); extern void flan_restart_take(void *frame, void *xfer); +/* Where the expression that trapped is written (runtime/flan_rt.c). Set by + * the trap sites around their call into the break hook and NULL otherwise, + * so it is read here exactly once, while the snapshot is being taken on the + * thread the trap stopped. */ +extern const uint8_t *flan_break_site; +extern int64_t flan_break_site_len; /* -- How far down a transfer can actually land ----------------------- */ @@ -441,6 +447,18 @@ typedef struct { int32_t fmine[FRAME_MAX]; /* 0 = the evaluation's, not the * program's */ char ftext[FRAME_TEXT]; + /* The condition this break was entered with, or NULL for a trap that + * carries none. An address into the signalling frame, which is live for + * exactly as long as this snapshot is on top — nothing unwound — so a + * render thunk aimed at it through [flan_agent_condition] reads storage + * that is still there. Never dereferenced here: its type is the daemon's + * to know, and rendering it is the daemon-built thunk's job. */ + void *cond; + /* Where the expression that trapped is written, copied from the runtime's + * [flan_break_site] at the same held-still moment as everything else. + * Empty for a stop with no site — a user (error ...), a (pause). */ + int32_t sitelen; + char site[512]; } snapshot; /* One per nested break loop, because an inner break must not answer with the @@ -477,6 +495,17 @@ void *flan_agent_frame_slot(int64_t frame, int64_t slot) { return flan_dev_frame_slot(s->fframe[frame], (int32_t)slot); } +/* The condition this break holds, for the render thunk the daemon builds to + * show its fields. Same contract as [flan_agent_frame_slot]: called on the + * stopped game thread, resolved against the snapshot on top *when the thunk + * runs*, NULL for a break that carries none — and the daemon delivers the + * thunk at-stop, so a resume between the asking and the running drops it + * rather than rendering one break's type over another break's pointer. */ +void *flan_agent_condition(void) { + snapshot *s = snap_top(); + return s == NULL ? NULL : s->cond; +} + static snapshot *snap_top(void) { int d = atomic_load(&snap_depth); return d <= 0 ? NULL : &snaps[d - 1]; @@ -486,13 +515,21 @@ static snapshot *snap_top(void) { * to nest, which the caller reports rather than serving a stale one. */ static int32_t snap_gen; /* monotone; 0 is "no snapshot" */ -static int snap_push(int resumable) { +static int snap_push(int resumable, void *cond) { int d = atomic_load(&snap_depth); if (d >= BREAK_MAX) return 0; snapshot *s = &snaps[d]; int32_t n = flan_restart_count(); s->gen = ++snap_gen; s->resumable = resumable; + s->cond = cond; + s->sitelen = 0; + if (flan_break_site != NULL && flan_break_site_len > 0) { + int64_t k = flan_break_site_len; + if (k > (int64_t)sizeof s->site) k = (int64_t)sizeof s->site; + memcpy(s->site, flan_break_site, (size_t)k); + s->sitelen = (int32_t)k; + } s->total = n; s->used = 0; s->n = 0; @@ -563,10 +600,11 @@ static void snap_pop(void) { if (d > 0) atomic_store(&snap_depth, d - 1); } /* The condition's class name, so an editor can say what stopped rather than - * only that something did. It is all there is to say: the hook is handed the - * name and an opaque pointer, and nothing at run time can render a value whose - * type it does not know. Written before [broken] is set and read only while - * [broken] is 1, so the listener never sees half of it. */ + * only that something did. The pointer beside it goes into the snapshot: this + * side still cannot render a value whose type it does not know, but the + * daemon knows the type — it compiled it — and builds a thunk that reads the + * fields through [flan_agent_condition]. Written before [broken] is set and + * read only while [broken] is 1, so the listener never sees half of it. */ static char condition_name[128]; int32_t flan_agent_poll(void); @@ -651,7 +689,6 @@ static _Noreturn void die_now(void) { static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition, void *xfer, int resumable) { struct timespec step = { 0, 2000000 }; /* 2ms */ - (void)condition; fflush(stdout); fprintf(stderr, "\nflan: unhandled %.*s — stopped, not dead.\n", (int)namelen, (const char *)name); @@ -660,7 +697,7 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition, * are then the same list, numbered the same way, and the numbers are what a * choice is made of. */ int32_t my_gen; - if (!snap_push(resumable)) { + if (!snap_push(resumable, condition)) { fflush(stdout); fprintf(stderr, "flan: %d nested break loops - giving up rather than " "spinning\n", BREAK_MAX); @@ -1010,6 +1047,32 @@ static void handle_line(char *line, sink *o) { reply(o, "running\n"); return; } + /* Whether the break on top holds a condition value a render thunk could be + * aimed at. [+] or [-] and nothing else: the pointer itself never crosses + * the wire — an address in another process's frame is not something the + * daemon can read — and the *type* is already answered by [status]. The + * daemon asks this before spending a build on a thunk that would render + * nothing. */ + if (strcmp(line, "condition") == 0) { + if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; } + snapshot *s = snap_top(); + if (s == NULL) { reply(o, "err no snapshot\n"); return; } + reply(o, s->cond != NULL ? "+\n" : "-\n"); + return; + } + /* Where the expression that trapped is written — file:line:col, or [-] for + * a stop that has no site (a user (error ...), a (pause)). The frame lines + * say where each call was; this is the only record of the indexing or the + * division itself. */ + if (strcmp(line, "site") == 0) { + if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; } + snapshot *s = snap_top(); + if (s == NULL) { reply(o, "err no snapshot\n"); return; } + if (s->sitelen > 0) emit(o, s->site, (size_t)s->sitelen); + else reply(o, "-"); + reply(o, "\n"); + return; + } /* One line per restart, innermost first: the index it is taken by, a flag * for whether it can be taken at all, and the name. The index leads * because it is the identity - two frames can offer [retry] and only one