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

The locals of a stopped frame, read where they live

Browse Source 
The half the shadow stack was built for. A slot's entry in the frame is its
address, null until the binding that fills it has run, so "not bound yet at
this point" is a null and needs no liveness analysis. The daemon compiles a
thunk that renders the types it already knows -- Tast.fn.slots, with snames
beside them -- at the addresses the stopped program supplies, and reads the
text back the way C-x C-e does. Nothing is copied out, because a value with
no header is bytes with no meaning anywhere but in the program that holds
it.

That is render.ml's walk with its root changed, which is the pointer-rooted
thunk NEXT.md said this needed, and one new arm in the backend: a cast from
one pointer type to another, which emits nothing.

Only named slots are recorded. A recorded slot escapes and stops being
promotable, and the slots that would cost most are the ones with nothing to
show -- dotimes' bound, the temporaries min and max use, the walk's own
scratch. They are refused by name rather than shown under an invented one.
Recording every slot was built and timed and is inside the noise, so the
rule stands on what it shows.

Four refusals, each by name and with its reason: a slot nobody named, a
slot the program has not reached, a type the printer has no arm for, and
two whole frames -- an evaluation's thunk, and a frame running a body that
has been redefined since, where every slot index would be a guess.

Measured, minimum of nine runs: +61% on call-heavy code over globals
against +33% for the frames alone, 0.06% of a frame at 60fps.
This commit is contained in:
Joseph Ferano 2026-09-12 12:00:29 +07:00
parent 6ce4282337
commit 0ff4ce56a5
9 changed files with 696 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
BUILT.md
View File

@ -1150,23 +1150,81 @@ belonging to the program is not.
**Refused while the program is running**, like every other break verb. The chain is the game thread's and it is pushed
and popped on every call; a walk of it from the daemon would have the shape of a backtrace and the contents of a race.
**What it costs, measured rather than assumed.** Three compilers built, three pairs of binaries, timed interleaved so
that machine load falls on all of them:
**What it costs, measured rather than assumed.** Two benchmarks, one compiler built per variant, every binary kept and
then run alternately. The figure is the **minimum of nine runs**, because this machine is shared and a mean measures
whatever else was running; the whole table reproduces to three digits on a second pass.
| Dev build, -O2 | without frames | with |
|---|---|---|
| 600 frames of sand's simulation | 64.9 ms | 84.0 ms (+29%) |
| fib(30) plus 20M calls in a loop | 90.6 ms | 97.5 ms (+7.6%) |
| Dev build, -O2 | no frames | frames | frames + slots |
|---|---|---|---|
| 2000 sweeps of a 100×100 grid — sand's inner loop, in miniature | 30.0 ms | 40.0 ms (+33%) | 48.3 ms (+61%) |
| fib(30) plus 20M calls in a loop — nothing but calls | 28.7 ms | 31.1 ms (+8%) | 35.1 ms (+22%) |
That is **32 µs per frame of sand**, or 0.19% of a 16.6 ms frame at 60fps, and about 0.3 ns per call. The dev loop's
premise is that redefinition does not stutter a running game, and a fifth of a percent of a frame does not.
Per call that is about **0.1 ns** for the frame and **0.3 ns** for the frame and the slot table together; per sweep of
the grid, 5 µs and 10 µs, which is 0.03% and 0.06% of a 16.6 ms frame at 60fps. The dev loop's premise is that
redefinition does not stutter a running game, and a sixteenth of a percent of a frame does not. A dev build is already
deliberately slower than a release one — every call goes through a cell, every index is checked, no `defconst` folds —
and this joins that list rather than starting a new one.
The shape was chosen by that measurement and not before it. An array with a stack pointer — no alloca, no address
escaping — was built and timed as the obvious alternative, and it is *worse* on both benchmarks (sand +34%, fib +27%):
the frame record on the stack is already hot, and the array's indexed store into a megabyte of BSS is not. It also has
a fixed depth, which the chain does not. One measurement in between said the opposite, loudly, and was an artefact of
comparing a 40-frame binary with a 600-frame one — which is why all six numbers above come from binaries built in one
sitting and run alternately.
The chain's *shape* was chosen by measurement and not before it. An array with a stack pointer — no alloca, no address
escaping — was built and timed as the obvious alternative and is worse on both benchmarks: the frame record on the
calling function's own stack is already hot, and an indexed store into a megabyte of BSS is not. It also has a fixed
depth, which a chain of stack records does not.
### Locals of a stopped frame
The half the shadow stack was built for. `(:op "locals" :frame N)` answers what a stopped frame's named locals hold.
```
(:op "locals" :frame 0) → (:status "ok" :frame "look"
:locals (("n" "i64" "3") ("label" "string" "\"hello\"")
("p" "Point" "(Point {:x 1.5 :y 2.5})")
("xs" "[3 i32]" "[ 10 20 30]") ("flag" "bool" "true"))
:refused (("after" "not bound yet at the point the program stopped")))
```
**Nothing is copied out of the program, and nothing could be.** A Flan value carries no header, so bytes read from
another process would be bytes with no meaning. What the daemon has instead is the *type* — `Tast.fn.slots`, from the
build it owns — and the name beside it in `snames`, which was already there for the DWARF work. So it compiles a thunk
that renders those types **at those addresses, in the program**, on the stopped thread, and reads the text back through
the same seqlocked result buffer `C-x C-e` uses. The only fact that comes from the running program is where the frame
is. That is `render.ml`'s existing walk with its root changed: `Render.render` over `(Deref (Ptr T) (flan/dev-slot f
i))` instead of over an expression — the **pointer-rooted render thunk** NEXT.md said locals needed, and it turned out
to need one new arm in the whole backend (a pointer-to-pointer cast, which under opaque pointers emits nothing).
**A slot's entry is its address, and null until it is bound.** That is the whole of the liveness answer: there is no
analysis, no PC-to-scope map and no bitmap. The store that binds a slot stores the address, so a slot the program has
not reached yet reads as null and is refused by name. Without it, `(let [after 99] …)` sitting past an `error` would
render whatever the stack held, and a slice or a struct of garbage does not misprint — it faults, on the game thread of
a program that is already stopped, which is the worst moment this project has to offer. The daemon asks the program
which slots are bound *before* it builds the thunk, so the set it emits code for is the set the thunk will resolve.
**Only named slots are recorded**, and this is where most of the cost went. A slot whose address is stored anywhere
escapes, and an escaped alloca is one `mem2reg` cannot promote — so recording a slot is paying for it in every call to
that function, for ever. The slots that would hurt most are exactly the ones with nothing to show: `dotimes`'s hidden
bound, the temporaries `(min)` and `(max)` evaluate their operands into, the render walk's own scratch. They keep their
promotion and are refused by name (`s4`, "a slot the compiler made up") rather than shown under an invented one.
Recording every slot instead was built and timed and came out inside the noise on both benchmarks, so the rule stands
on what it shows rather than on what it saves.
**Shadowing is right here, and that is not an accident of this design — it is the thing the DWARF route still owes.**
`check.ml`'s `fresh_slot` only ever allocates, so `(let [v 22] …)` inside `(let [v 11] …)` is two slots, both named
`v`, and both appear with their own values. lldb answers `p v` with 11 in that program and will until a
`!DILexicalBlock` per `Let` exists.
**Four refusals, each by name and with its reason.** Three per slot — invented, not yet bound, and no printer for the
type (a map, a function value, a type variable; the arm exists, no program the checker accepts has reached it yet, so
it is written and untested) — and two whole frames: one belonging to a `C-x C-e` thunk, whose `Tast` the session does
not keep, and one whose slot count does not match the body this session holds, which is a frame running a body that has
been redefined since and where every slot index would be a guess.
**A `(Vec T)` shows as `<vec>` and a `(Ptr T)` as `<ptr>`**, because that is what `render.ml` already does for them
everywhere else: following a pointer a REPL was handed is not a safe thing to do on someone's behalf, and walking a
`Vec` structurally is a walk over storage the frame does not own — `(print (as-slice v))` is how that is asked for,
and it says at the call site that it borrowed.
Each slot is rendered **from its address** rather than copied into the thunk first. A copy would be one `alloca` the
size of the slot — 40KB for sand's grid — and the walk only ever shows eight elements of it. The cost is one call to
`flan/dev-slot` per leaf the walk reaches rather than one per slot, which the depth and span caps already bound.
### Conditions — step 2: `restart-case` and `invoke-restart`

17
NEXT.md
View File

@ -247,7 +247,11 @@ it is how a save file disappears with nothing said. So `barf` on web signals a c
program decides. This is the language having something Odin does not; use it. Per-package target isolation, if a
whole desktop-only package is ever wanted, is the `@native`/`@wasi`/`@web` link-line tagging the web lane built.
**3. Build the shadow stack.** plan.org:591 has specified it in the dev-build column since the beginning and nothing
**3. Build the shadow stack.** ~~Not yet built.~~ **Built**, both halves — see BUILT.md. Kept here as the decision it
was, with the measurement it asked for: +33% on call-heavy code over globals for the frames, +61% with the slot table,
and 0.06% of a 60fps frame.
plan.org:591 has specified it in the dev-build column since the beginning and nothing
has ever built it. It is the route to `(:op "backtrace")` *and* to locals, together, and it is dev-only so a shipped
game pays nothing. Chosen over the DWARF route deliberately: DWARF still owes a `!DILexicalBlock` per `Let` before
`p v` under shadowing is even honest, and that buys locals in lldb rather than in the break loop. The author's reason
@ -682,7 +686,10 @@ sanitized sweep (`@sanitize`) is under the same watchdog but has never been obse
- **`(:op "condition")` → the stopped program's condition, rendered.** Two steps: `break_loop` currently does
`(void)condition;` and *discards the pointer*, so stash it beside `condition_name`; then the daemon builds a render
thunk aimed at that address, which is `Session.render` rooted at a `Ptr` instead of an expression.
thunk aimed at that address, which is `Session.render` rooted at a `Ptr` instead of an expression. **The second step
now exists** — `Session.render_locals` is exactly that thunk, rooted at an address the program supplies — so what is
left is the first: keep the pointer, and give the agent a verb that hands it back. The type is already known: it is
the `condition_name` the break loop reports, which `layout` already resolves.
- **The type identity is settled, and it is the qualified name** — `layout` is in, see BUILT.md. `Load` qualifies
every declaration at import, so the names in `Tast.structs` are a flat namespace where two packages' `Missing` are
`a/Missing` and `b/Missing`; a bare name is refused with the candidates rather than resolved. `condition` inherits
@ -691,9 +698,9 @@ sanitized sweep (`@sanitize`) is under the same watchdog but has never been obse
reads is not qualified by anything.
- ~~**`(:op "backtrace")` is blocked** on frame metadata.~~ **Built**, and not out of DWARF: decision 3's shadow
stack carries the name and the location on the frame itself, so a backtrace needs no debug information at all. See
BUILT.md, "The shadow stack, and `backtrace`", for what it costs — 0.19% of a 60fps frame. Locals are no longer
blocked on a frame layout either; what is left of them is the pointer-rooted render thunk. Restart source locations
and arity are still blocked — `flan_restart` carries `prev`, `name_id`, `name` and `namelen`, so both need a new
BUILT.md, "The shadow stack, and `backtrace`", for what it costs. **Locals landed with it** — the pointer-rooted
render thunk turned out to be `Render.render` over a `Deref` of a slot's address, and one new arm in the backend.
See "Locals of a stopped frame" for the four things it refuses. Restart source locations and arity are still blocked — `flan_restart` carries `prev`, `name_id`, `name` and `namelen`, so both need a new
field in the frame, which means the compiler emitting it.
### One line away

151
lib/dev.ml
View File

@ -280,6 +280,30 @@ let backtrace t =
end
| exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)
(* Which of a frame's slots have been reached. One line per slot, [I ±], the
same framing as everything else the agent answers.
Asked before a thunk is built rather than after: an unbound slot is a null
address, and a thunk that rendered one would take a fault on the game
thread of a program that is already stopped — which is the one place a
crash costs the most, because it is where someone is standing over the
wreck deciding what to do about it. *)
let bound_slots t ~frame =
match ask t (Printf.sprintf "locals %d" frame) with
| text ->
let lines = List.map String.trim (String.split_on_char '\n' text) in
if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines
then Error (String.trim text)
else
Ok
(List.filter_map
(fun l ->
match String.split_on_char ' ' l with
| [ i; "+" ] -> int_of_string_opt i
| _ -> None)
(List.filter (fun l -> l <> "" && l <> ".") lines))
| exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)
let alive t =
match Unix.waitpid [ Unix.WNOHANG ] t.child with
| 0, _ -> true
@ -685,6 +709,131 @@ let backtrace_op t =
Printf.sprintf ":more %d" more ]
| Error m -> error ("the program refused to say where it is: " ^ m))
(* [(:op "locals" :frame N)] — what a stopped frame's named locals hold.
The half of a break loop that the author actually wanted, and the reason
the shadow stack was built rather than more DWARF: DWARF would have put
these in lldb, and the point is to need lldb less often.
Nothing is copied out of the program. A Flan value has no header, so bytes
read from another process would be bytes with no meaning; what this end has
is the *type* — [Tast.fn.slots], from the build it owns — and the name
beside it in [snames]. So it compiles a thunk that renders those types at
those addresses, in the program, on the stopped thread, and reads the text
back the way [C-x C-e] does. The only thing that comes from the running
program is where the frame is.
Three refusals, each by name and with its reason rather than by omission:
a slot the compiler invented and nobody named; a slot whose binding had not
run when the program stopped, which is a null address and would be a fault;
and a type the structural printer has no arm for. A local that is missing
and a local that could not be printed are different facts, and a list that
showed neither would be the same lie twice.
And two whole frames it refuses: one belonging to a [C-x C-e] thunk, which
this session does not keep the [Tast] of, and one whose slot count does not
match the body this session holds — which is a frame running a body that
has since been redefined, where every slot index would be a guess. *)
let locals t ~frame =
if not (alive t) then error "the program exited; restart flan dev"
else
match state t with
| Running ->
error
"the program is running; locals are read from a stopped frame, and \
nothing in a frame that is still executing holds still"
| Unreachable m -> error ("cannot ask the program for its locals: " ^ m)
| Stopped _ ->
(match backtrace t with
| Error m -> error ("the program refused to say where it is: " ^ m)
| Ok (frames, _) ->
(match List.nth_opt frames frame with
| None ->
error
(Printf.sprintf "there is no frame %d; the backtrace has %d" frame
(List.length frames))
| Some (name, _, mine, nslots) ->
if not mine then
error
(name
^ " is a frame of the expression this break is inside, not of the program; its thunk is not part of the session, so there is no record of what its slots are called")
else
match find_fn t name with
| None ->
error
(name
^ " is not a function this session holds; a lifted handler clause has no declaration of its own to read slot names from")
| Some fn ->
if nslots = 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" ]
else if nslots <> Array.length fn.Tast.slots then
error
(Printf.sprintf
"%s on the stack has %d slots and the %s this session holds has %d: the frame is running a body that has been redefined since, so every slot index here would be a guess"
name nslots name (Array.length fn.Tast.slots))
else
match bound_slots t ~frame with
| Error m -> error ("the program refused to say which slots are bound: " ^ m)
| Ok bound ->
let c, refused = Session.render_locals t.session ~frame ~fn ~bound in
let before = match result t with Some (g, _) -> g | None -> 0L in
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "l%d.so" t.n) in
(match Build.shared
~opts:{ Build.default with Build.dev = true;
Build.debug = t.session.Session.debug }
~ir:c.Session.ir ~out () with
| _ ->
(match deliver t out with
| "ok" ->
let rec wait ms =
match result t with
| Some (g, v) when Int64.compare g before > 0 -> Some v
| _ when ms <= 0 -> None
| _ ->
ignore (Unix.select [] [] [] 0.005);
if alive t then wait (ms - 5) else None
in
(match wait 5000 with
| Some v ->
(* One line per slot, name and type and value,
tab separated — 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
[ ":frame " ^ Wire.quote name;
":locals " ^ Wire.list entries;
":refused "
^ Wire.list
(List.map
(fun (n, why) ->
Wire.list
[ Wire.quote n; Wire.quote why ])
refused) ]
| None ->
error
"the program did not reach a frame boundary; is \
it calling (agent/poll)?")
| reply -> error ("the program refused the module: " ^ reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e))
| exception Failure m -> error m)))
(* A choice is validated by the *program*, on its listener thread, against a
stack the stopped game thread is holding still — not here. The daemon has no
copy of that stack and anything it checked would be a guess that was true a
@ -1074,6 +1223,8 @@ let handle t req =
| Some "defs" -> defs t
| Some "break" -> break t
| Some "backtrace" -> backtrace_op t
| Some "locals" ->
locals t ~frame:(match Wire.int_field req "frame" with Some n -> n | None -> 0)
| Some "layout" ->
(match Wire.string_field req "type" with
| Some ty -> layout t ~ty

100
lib/emit.ml
View File

@ -414,6 +414,16 @@ type f = {
what makes the pop happen on the transfer path as well as the normal one.
[None] in a release build, where there is no frame at all. *)
mutable frame : string option;
(* Where a dev build records each slot's address, so that a stopped frame's
locals can be read. [None] in a release build and in a function with no
named slot at all. Only *named* slots are recorded: a slot the compiler
invented has no name to show, and leaving its alloca unrecorded leaves it
promotable, which is where most of the cost of this would otherwise be.
An entry is null until the binding that fills the slot has run — that is
how "not bound yet at this point" is told from "bound", with no liveness
analysis and no bitmap. *)
mutable slotv : string option;
snames : string option array;
(* The [, !dbg !N] suffix every instruction in this function carries, or "".
Uniform rather than only on the instructions that want a line: LLVM's
verifier rejects a call without a location inside a function that has
@ -457,6 +467,24 @@ let ret f v =
| None -> ());
term f "ret %s %s" (ll f.ret) v
(* The store that says "this slot is bound now". Emitted at each binding of a
named slot — a [let], a match arm, a restart clause's parameters — and at
entry for the parameters, which are bound before any of the body runs.
It is deliberately the *address* and not a flag: the reader needs the
address anyway, so one store carries both facts, and a slot that has not
been reached yet reads as null rather than as a plausible value at an
address nobody wrote. *)
let bind_slot f i =
match f.slotv with
| None -> ()
| Some v ->
if i < Array.length f.snames && f.snames.(i) <> None then begin
let p = fresh f in
ins f "%s = getelementptr inbounds ptr, ptr %s, i32 %d" p v i;
ins f "store ptr %s, ptr %s" f.slots.(i) p
end
let alloca f ty =
let name = fresh f in
Buffer.add_string f.allocas (Printf.sprintf " %s = alloca %s\n" name (ll ty));
@ -665,7 +693,8 @@ and value_at f (e : Tast.expr) : string =
List.iter
(fun (slot, v) ->
let v' = value f v in
ins f "store %s %s, ptr %s" (ll v.Tast.ty) v' f.slots.(slot))
ins f "store %s %s, ptr %s" (ll v.Tast.ty) v' f.slots.(slot);
bind_slot f slot)
bs;
block f body
| Tast.If (c, t, e') -> emit_if f e.Tast.ty c t e'
@ -1199,7 +1228,8 @@ and emit_restart_case f ty clauses body =
ins f "%s = getelementptr inbounds %s, ptr %s, i32 0, i32 %d"
p (args_type c) buf i;
let v = load f p ty in
ins f "store %s %s, ptr %s" (ll ty) v f.slots.(slot_i))
ins f "store %s %s, ptr %s" (ll ty) v f.slots.(slot_i);
bind_slot f slot_i)
c.Tast.rparams
in
let rec dispatch = function
@ -1290,7 +1320,8 @@ and emit_match f ty scrut arms =
(fun slot ->
let v = fresh f in
ins f "%s = extractvalue %s %s, 1" v sty sv;
ins f "store %s %s, ptr %s" (ll payload_ty) v f.slots.(slot))
ins f "store %s %s, ptr %s" (ll payload_ty) v f.slots.(slot);
bind_slot f slot)
a.Tast.binds;
let v = block f a.Tast.abody in
(match result with
@ -1571,6 +1602,12 @@ and cast f (x : Tast.expr) target =
| Types.Float _, Types.Int b -> if Types.signed b then "fptosi" else "fptoui"
| Types.Float a, Types.Float b ->
if Types.bits_f b > Types.bits_f a then "fpext" else "fptrunc"
(* Nothing in the surface language writes this: [check.ml] has no cast
between pointer types. The locals thunk does — it is handed a slot's
address as a raw pointer and has to read it as the type the slot
holds — and under opaque pointers there is no instruction to emit for
it, both sides being [ptr]. *)
| Types.Ptr _, Types.Ptr _ -> "bitcast"
| _ -> failwith "unsupported cast"
in
if op = "bitcast" then v
@ -1646,7 +1683,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
slots = Array.init n (fun i -> Printf.sprintf "%%s%d" i);
slot_tys = fn.Tast.slots;
pads = []; unwind = "unwind"; unwound = false; defers = fn.Tast.fdefers;
frame = None;
frame = None; slotv = None; snames = fn.Tast.snames;
dsub;
dline = (if fn.Tast.floc.Loc.line = 0 then 1 else fn.Tast.floc.Loc.line);
dloc = "";
@ -1681,7 +1718,36 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
right: it really is on the stack, and a backtrace that skipped it would
show a gap exactly where the handler ran. *)
if m.dev then begin
let info = fninfo m fn ~nslots:0 in
(* The slot table, and it is the whole of what [locals] reads. One [ptr]
per slot, null until the slot is bound; the frame points at it.
Only a function with at least one *named* slot gets one, and only named
slots are ever recorded in it. That is not a saving of stores — the
nulls are written either way — it is a saving of *optimisation*: a slot
whose address is stored anywhere escapes, and an escaped alloca is one
mem2reg cannot promote. The slots that would hurt most to demote are
exactly the ones with no name to show: [dotimes]'s hidden bound, the
temporaries (min) and (max) evaluate their operands into, the walk's own
scratch in a render thunk. *)
let named = Array.exists (fun n -> n <> None) fn.Tast.snames in
if named && n > 0 then begin
let v = fresh f in
Buffer.add_string f.allocas
(Printf.sprintf " %s = alloca [%d x ptr]\n" v n);
(* Every entry, not only the named ones: "null means not bound" has to
hold at every index, or a reader has to know which indices it may
trust, and that is a second thing to keep in step. *)
for i = 0 to n - 1 do
let p = fresh f in
Buffer.add_string f.allocas
(Printf.sprintf " %s = getelementptr inbounds ptr, ptr %s, i32 %d\n"
p v i);
Buffer.add_string f.allocas
(Printf.sprintf " store ptr null, ptr %s\n" p)
done;
f.slotv <- Some v
end;
let info = fninfo m fn ~nslots:(if f.slotv = None then 0 else n) in
let prev = fresh f in
Buffer.add_string f.allocas " %frame = alloca %flanframe
";
@ -1696,11 +1762,25 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
[ "%frame.i = getelementptr inbounds %flanframe, ptr %frame, i32 0, i32 1";
Printf.sprintf "store ptr %s, ptr %%frame.i" info;
"%frame.s = getelementptr inbounds %flanframe, ptr %frame, i32 0, i32 2";
"store ptr null, ptr %frame.s";
"%frame.k = getelementptr inbounds %flanframe, ptr %frame, i32 0, i32 3";
"store i64 0, ptr %frame.k";
Printf.sprintf "store ptr %s, ptr %%frame.s"
(match f.slotv with Some v -> v | None -> "null");
"store ptr %frame, ptr @flan_frame_head" ];
f.frame <- Some prev
f.frame <- Some prev;
(* The parameters are bound before the body starts, so they are recorded
here rather than at a binding site there is none of. *)
List.iteri (fun i _ ->
match f.slotv with
| None -> ()
| Some v ->
if i < Array.length fn.Tast.snames && fn.Tast.snames.(i) <> None then begin
let p = fresh f in
Buffer.add_string f.allocas
(Printf.sprintf " %s = getelementptr inbounds ptr, ptr %s, i32 %d\n"
p v i);
Buffer.add_string f.allocas
(Printf.sprintf " store ptr %s, ptr %s\n" f.slots.(i) p)
end)
fn.Tast.params
end;
(* One [llvm.dbg.declare] per slot, in the entry block beside the alloca it
describes. This is the whole of what lldb needs to print a local: the slot
@ -1868,7 +1948,7 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
; every [ret] restores the head, the transfer path included. A release build
; emits neither, and the head below is then a symbol nothing in the .ll names.
%fninfo = type { ptr, i64, ptr, i64, i32, i32 }
%flanframe = type { ptr, ptr, ptr, i64 }
%flanframe = type { ptr, ptr, ptr }
@flan_frame_head = external global ptr
declare void @flan_rt_init(i32, ptr)

132
lib/session.ml
View File

@ -403,6 +403,14 @@ let externs : Tast.extern list =
one emit_i64 "flan_dev_emit_i64";
one emit_u64 "flan_dev_emit_u64";
one emit_f64 "flan_dev_emit_f64";
(* The address of a slot in a *stopped* frame, resolved by the agent
against the snapshot that break took. It is the one piece a locals
thunk cannot work out for itself: the compiler knows every slot's type
and name, and nothing but the running program knows where the frame
is. See [render_locals]. *)
{ 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) };
{ Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin";
eparams = []; eret = Types.Unit };
{ Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end";
@ -421,6 +429,130 @@ let dev_emitter : Render.emitter =
eu64 = call emit_u64;
ef64 = call emit_f64 }
(* ── The locals of a stopped frame ─────────────────────────────────── *)
(* The second half of what a break loop can show, and it is the same primitive
as [C-x C-e] pointed somewhere else.
Nothing marshals and nothing is read across the process boundary. A Flan
value carries no header, so the daemon could not make sense of bytes it
copied out even if it had them; what it has instead is the *type*, from
[Tast.fn.slots], and a name for it, from [snames] beside it. So it compiles
a thunk that renders those types at those addresses, in the program, and
reads back the text — exactly what an evaluated expression does, except
that the root is an address rather than an expression. That address is the
only thing that comes from the running program.
[bound] is which slots the program says have been reached. It is not an
optimisation: an unbound slot's entry is null, and a thunk that rendered
one would dereference null on the game thread of a program that is already
stopped. So the refusal happens here, before any code is emitted for it.
What comes back is one line per slot — name, type, value, tab separated.
Tab and newline are safe separators because every string the renderer emits
goes through [flan_dev_emit_str], which escapes both.
Each slot is rendered from its address rather than copied into the thunk
first. A copy would be one [alloca] the size of the slot — 40KB for sand's
grid — and the walk only ever shows eight elements of it. The cost is one
call to [flan/dev-slot] per leaf the walk reaches instead of one per slot,
which the depth and span caps already bound. *)
let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
: change * (string * string) list =
let loc = fn.Tast.floc in
let extra = ref [] and nslots = ref 0 in
let c =
{ Render.structs = t.program.Tast.structs;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
emit = dev_emitter;
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 refuse name why = refused := (name, why) :: !refused in
let one i ty name =
let idx n =
{ Tast.e = Tast.Int (Int64.of_int n, Types.I64); ty = Types.Int Types.I64; loc }
in
let address =
{ Tast.e = Tast.Call ("flan/dev-slot", [ idx frame; idx i ]);
ty = Types.Ptr (Types.Int Types.U8); loc }
in
let typed =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr ty), [ address ]);
ty = Types.Ptr ty; loc }
in
let v = { Tast.e = Tast.Deref typed; ty; loc } in
match Render.render c 0 v with
| parts ->
Some
((lit (name ^ "\t" ^ Types.to_string ty ^ "\t") :: parts) @ [ lit "\n" ])
| exception Loc.Error (_, why) ->
(* A type the structural printer has no arm for — a map, a function
value, a type variable. Named, with the reason, rather than left out
of the list: a local that is missing and a local that could not be
printed are different facts. *)
refuse name why;
None
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
| 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";
None
| Some name when not (List.mem i bound) ->
refuse name
"not bound yet at the point the program stopped";
None
| Some name -> one i ty name)
(List.init (Array.length fn.Tast.slots) (fun i -> i))))
in
t.thunks <- t.thunks + 1;
let name = Printf.sprintf "locals/%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);
(* Every slot in here is the walk's own scratch: the locals being shown
are the *other* frame's, and this thunk reaches them by address. *)
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 =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
program ~fns:[ name ]
in
ignore origin;
({ ir; names = []; fns = []; installs = true }, List.rev !refused)
let eval_expr ?(origin = "<eval>") t src : change =
let form =
match Reader.read_all ~file:origin src with

21
runtime/flan_dev.c
View File

@ -341,11 +341,12 @@ typedef struct {
typedef struct flan_frame {
struct flan_frame *prev;
const flan_fninfo *info;
/* Where each slot lives, and which of them have been bound at the point the
* frame was interrupted. Both are null/zero unless the build records them;
* see emit.ml. Read through [flan_dev_frame_slot], never directly. */
/* One entry per slot, each null until the binding that fills that slot has
* run — so "not bound yet at the point this frame stopped" is a null and
* needs no liveness analysis to work out. Null altogether for a function
* with no named slot, and in a release build there is no frame at all.
* Read through [flan_dev_frame_slot], which is where the bound is checked. */
void **slots;
uint64_t init;
} flan_frame;
/* The compiler names this symbol directly. A redefinition module reaches it
@ -389,3 +390,15 @@ int32_t flan_dev_frame_nslots(const void *frame) {
return (f == NULL || f->info == NULL) ? 0 : f->info->nslots;
}
/* Where slot [i] of this frame lives, or NULL — which means one of three
* things, all of which are "there is nothing to read here": this build records
* no slots, the index is not one of them, or the binding that fills it had not
* run when the frame stopped. A caller renders what it is given and refuses
* what it is not; nothing here guesses. */
void *flan_dev_frame_slot(const void *frame, int32_t i) {
const flan_frame *f = frame;
if (f == NULL || f->info == NULL || f->slots == NULL) return NULL;
if (i < 0 || i >= f->info->nslots) return NULL;
return f->slots[i];
}

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

@ -0,0 +1,34 @@
;;;; A program that stops with something worth looking at in the frame.
;;;;
;;;; dev-break.flan proves an editor can find out *that* a program stopped and
;;;; choose a restart; this one is about what the frame holds while it is
;;;; stopped. One local of each shape the structural printer has an arm for —
;;;; a parameter, a string, a struct, a fixed array, a bool — plus one that is
;;;; bound only *after* the error, which is the case that must come back
;;;; refused rather than rendered: its slot is storage nothing has written yet.
(import agent "vendor:agent")
(defstruct Point [x f32 y f32])
(defstruct Boom [why i32])
(defn look [n i64 label string] i64
(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))))
(defvar ticks i64)
(defn main [] i32
(agent/start "/tmp/flan-dev-locals-fallback.sock")
(print (look 3 "hello")) (println "")
(dotimes [i 4000]
(agent/wait 5)
(set ticks (+ ticks 1)))
0)

125
test/test_dev.ml
View File

@ -708,6 +708,131 @@ let () =
(try ignore (Unix.waitpid [] bpid) with Unix.Unix_error _ -> ())
end
end;
(* ── The locals of a stopped frame ─────────────────────────────── *)
(* A third daemon, over a program that stops with something worth looking
at. This is the half of the shadow stack the backtrace was built for:
the frame chain gives the addresses, [Tast.fn] gives the types and the
names, and a thunk compiled here renders those types at those addresses
inside the stopped program. Nothing is copied out — a Flan value has no
header, so bytes read from another process would be bytes with no
meaning.
Its own daemon and its own program, for the same reason the break block
has: the claims are about one frame of one program. *)
let lsock = tmp "locals.sock" and lout = tmp "locals.out" in
(try Sys.remove lsock with Sys_error _ -> ());
let lfd = Unix.openfile lout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let lpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-locals.flan"; "-s"; lsock |]
Unix.stdin lfd Unix.stderr
in
Unix.close lfd;
if not (await (fun () -> Sys.file_exists lsock)) then begin
fail "the locals daemon never listened";
(try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect lsock in
let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
fail "the locals program never stopped"
else begin
let pairs r key =
match Wire.field r key 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 a; _ }
:: { Form.v = Form.Str b; _ } :: rest) ->
Some (a, b,
match rest with
| { Form.v = Form.Str c; _ } :: _ -> c
| _ -> "")
| _ -> None)
l
| _ -> []
in
let r = ask "(:op \"locals\" :frame 0)" in
if status r <> "ok" then
fail "locals: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"))
else begin
(* One of each shape the structural printer has an arm for, rendered
in the program and read back as text. The values are the ones
[look] was called with, which is the claim: this is the frame's
own storage and not a guess from the source. *)
let got =
List.map (fun (n, ty, v) -> (n, ty, v)) (pairs r "locals")
in
let want =
[ ("n", "i64", "3");
("label", "string", "\"hello\"");
("p", "Point", "(Point {:x 1.5 :y 2.5})");
("xs", "[3 i32]", "[ 10 20 30]");
("flag", "bool", "true") ]
in
if got <> want then
fail "locals of the stopped frame: %s"
(String.concat ", "
(List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) got));
(* 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
printed it would dereference that null on the game thread of a
program that is already stopped. Refused by name, with the
reason, rather than left off the list — a local that is missing
and a local that could not be read are different facts. *)
match List.filter (fun (n, _, _) -> n = "after") (pairs r "refused") with
| [ (_, why, _) ] when why <> "" -> ()
| _ ->
fail "a slot bound after the error was not refused by name: %s"
(String.concat ", "
(List.map (fun (n, w, _) -> n ^ ": " ^ w) (pairs r "refused")))
end;
(* A frame whose every slot the compiler invented is not an error and
is not an empty answer either: it says which it is. *)
let r = ask "(:op \"locals\" :frame 1)" in
if status r <> "ok" then fail "locals of main: %s" (status r);
(* Out of range is refused with the depth, so a client can tell a bad
index from a frame with nothing in it. *)
let r = ask "(:op \"locals\" :frame 9)" in
if status r <> "error" then fail "a frame index past the end answered"
end;
(* Running again, and then the locals verb is refused: a frame that is
still executing does not hold still long enough to be read. *)
let r = ask "(:op \"restart\" :name \"carry-on\")" in
if status r <> "ok" then
fail "resuming the locals program: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "the locals program never resumed"
else begin
let r = ask "(:op \"locals\" :frame 0)" in
if status r <> "error" then
fail "a running program answered with its locals"
end;
ignore (ask "(:op \"close\")");
Unix.close c;
if not
(await ~ms:5000 (fun () ->
match Unix.waitpid [ Unix.WNOHANG ] lpid with
| 0, _ -> false
| _ -> true
| exception Unix.Unix_error _ -> true))
then begin
(try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] lpid) with Unix.Unix_error _ -> ())
end
end;
(* ── Disassembly ───────────────────────────────────────────────── *)
(* A third daemon, over a program that keeps running, because the two

63
vendor/agent/flan_agent.c vendored
View File

@ -155,6 +155,7 @@ extern void *flan_dev_frame_at(int32_t i);
extern const char *flan_dev_frame_name(const void *frame, int64_t *len);
extern const char *flan_dev_frame_loc(const void *frame, int64_t *len);
extern int32_t flan_dev_frame_nslots(const void *frame);
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);
@ -270,6 +271,33 @@ typedef struct {
static snapshot snaps[BREAK_MAX];
static _Atomic int snap_depth; /* published last; 0 = none */
static snapshot *snap_top(void);
/* Where slot [slot] of frame [frame] lives, resolved against the snapshot this
* break took and not against the live chain.
*
* This is what a locals thunk calls. The thunk runs on the stopped game
* thread, from inside this break loop's own poll, and it pushes frames of its
* own while it runs — so "frame 2" means the third frame of the backtrace the
* daemon was shown, not the third frame of whatever the stack looks like by
* the time the thunk is executing. Resolving against the snapshot is the whole
* of the difference, and it is the same reason the restarts are answered from
* there.
*
* NULL for anything it cannot place, and the thunk is built to ask only about
* slots the same snapshot already reported as bound. A NULL would be
* dereferenced, so this is the one place that must not answer optimistically:
* an index that is out of range, a frame that is not in this snapshot, or a
* slot the binding for which had not run, are each a null here and a refusal
* before the thunk is ever built. */
void *flan_agent_frame_slot(int64_t frame, int64_t slot) {
snapshot *s = snap_top();
if (s == NULL) return NULL;
if (frame < 0 || frame >= s->fn) return NULL;
if (slot < 0 || slot > 0x7fffffff) return NULL;
return flan_dev_frame_slot(s->fframe[frame], (int32_t)slot);
}
static snapshot *snap_top(void) {
int d = atomic_load(&snap_depth);
return d <= 0 ? NULL : &snaps[d - 1];
@ -658,6 +686,41 @@ static void serve(int fd) {
reply(fd, ".\n");
return;
}
/* Which of a frame's slots have been bound at the point it stopped. One
* line per slot: the index and [+] or [-].
*
* The daemon asks this before it builds a thunk, and that order is the
* safety: an unbound slot is a null address, a thunk that rendered one
* would dereference it, and a program stopped in a break loop is the last
* place to take a fault. It is answered from the snapshot, so the set the
* daemon is told about is the set the thunk will resolve against.
*
* It says nothing about *what* a slot holds, or what it is called. Those
* are facts about the build, and the daemon owns the build — [Tast.fn]
* carries [slots] and [snames] beside each other. Sending them from here
* would be a second copy of them that could drift. */
if (strncmp(line, "locals ", 7) == 0) {
if (!(atomic_load(&depth) > 0)) { reply(fd, "err not stopped\n"); return; }
snapshot *s = snap_top();
if (s == NULL) { reply(fd, "err no frame snapshot\n"); return; }
char *end = NULL;
long at = strtol(line + 7, &end, 10);
if (end == line + 7) { reply(fd, "err locals wants a frame index\n"); return; }
if (at < 0 || at >= s->fn) { reply(fd, "err no frame at that index\n"); return; }
if (s->fslots[at] == 0) {
reply(fd, "err that frame records no slots; it has no named local, or "
"this build does not record them\n");
return;
}
for (int32_t i = 0; i < s->fslots[at]; i++) {
char l[32];
int k = snprintf(l, sizeof l, "%d %c\n", i,
flan_dev_frame_slot(s->fframe[at], i) ? '+' : '-');
if (k > 0) send(fd, l, (size_t)k, MSG_NOSIGNAL);
}
reply(fd, ".\n");
return;
}
/* Take the i'th, optionally checking that the caller and this snapshot
* still agree on what the i'th is called. The name is not the lookup -
* that is the bug - it is a receipt: a client that listed, prompted, and