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

The break loop keeps its condition, and the daemon renders it

Browse Source 
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.
This commit is contained in:
Joseph Ferano 2026-09-20 22:17:41 +07:00
parent aa989931dc
commit 1cbe8ed386
6 changed files with 511 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

162
lib/dev.ml
View File

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

168
lib/session.ml
View File

@ -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 = "<locals>") 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 = "<locals>") 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 = "<inspect>") 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 = "<set>") 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

37
runtime/flan_rt.c
View File

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

23
test/programs/dev-locals.flan
View File

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

99
test/test_dev.ml
View File

@ -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

77
vendor/agent/flan_agent.c vendored
View File

@ -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