From 6ce428233763665f993fef83180f4192828dee32 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 11:49:25 +0700 Subject: [PATCH 1/3] A frame per call in a dev build, and a stopped program can say where it is plan.org has specified a shadow stack in the dev column since the beginning and nothing had ever built it. A frame is four words on the calling function's own stack: the one it displaced, a pointer to a static description of the function, and two words reserved for its locals. The name and the location travel on the frame, so a backtrace needs no debug information, no symbol table, and nothing from the platform unwinder that plan.org deliberately does not use. The pop is at every ret, the landing block a transfer leaves through included. That is the half that is easy to get wrong: a pop written only on the normal path leaves a dead frame behind every handled error, and the test takes five breaks and resumes all of them by transfer before asking for two frames. (:op "backtrace") answers from a snapshot the stopped thread takes, beside the restarts and for the same reason, and marks which frames belong to the program and which to the evaluation the break is inside. It is refused while the program runs. Measured, interleaved, three pairs of binaries: 29% on 600 frames of sand, 7.6% on a benchmark that is nothing but calls -- 32us per frame of sand, a fifth of a percent of a frame at 60fps. An array with a stack pointer was built and timed as the alternative and is worse on both. --- BUILT.md | 74 ++++++++++++++++++++++++ NEXT.md | 10 ++-- lib/dev.ml | 92 +++++++++++++++++++++++++++++ lib/emit.ml | 113 ++++++++++++++++++++++++++++++++++-- runtime/flan_dev.c | 92 +++++++++++++++++++++++++++++ test/test_dev.ml | 91 +++++++++++++++++++++++++++++ vendor/agent/flan_agent.c | 119 ++++++++++++++++++++++++++++++++++++++ 7 files changed, 581 insertions(+), 10 deletions(-) diff --git a/BUILT.md b/BUILT.md index 98d63c6..42a597b 100644 --- a/BUILT.md +++ b/BUILT.md @@ -1094,6 +1094,80 @@ a socket. A refusal is nil, not an error: the buffer already draws a section exp turning `C-c C-b` into an error would take away the restarts — the decision the buffer exists for — over a missing annotation. +### The shadow stack, and `backtrace` + +plan.org's "Dev vs release builds" table has had **Frames: shadow stack** in the dev column since the project began and +nothing had ever built it. This is it. It is what `(:op "backtrace")` is made of, and it is dev-only, so a shipped game +pays nothing — the same bargain the indirection cells already make. + +Chosen over the DWARF route deliberately, and the author's reason is the one that decides it: **the more a break loop +can show, the less often a real debugger is needed.** DWARF buys frames in lldb; this buys them in the break loop, +where someone already is when they want them. + +A frame is four words on the calling function's own stack — the frame it displaced, a pointer to a static description +of the function, and two words reserved for locals. The description is per function and not per call, because nothing +about a function changes between two calls to it: the qualified name, `file:line:col` as `Loc` spells it, and how many +slots the frame has. So the name in a backtrace comes off the frame itself and needs no debug information, no symbol +table and no agreement with the optimiser about what a stack frame looks like. It is the same mechanism on wasm32, +which is the other reason it is not `.eh_frame`: plan.org lowers every non-local exit explicitly rather than through +platform unwinding, so there is no unwinder here to borrow. + +The compiler emits the push and the pop **inline** rather than calling into the runtime. This is on every call in a dev +build, and a call made to record a call would be most of what it costs. + +**The pop is at every `ret`, and the transfer path is the one that matters.** There are five: an explicit `return` with +a value and without, the `none` arm of `(some x)`, the tail of the body, and the landing block a transfer leaves +through. `emit.ml` funnels all five through one `ret`, because the way to get this wrong is to write the pop on the +normal path and not on the other one — and then every *handled* error leaves a dead frame behind, and the backtrace +after the fifth one is five frames of fiction. `test_dev.ml` takes five breaks and resumes all of them by condition +transfer before asking for a backtrace, and the answer has to be two frames. Same lesson `with-allocator` learned about +restoring at the pad. + +**A plain global, not a thread-local.** It matches what the handler stack and the restart stack in `flan_rt.c` already +assume: one thread runs Flan, and the listener thread runs C and the loader and never enters a Flan body. If the +language grows threads this becomes thread-local and the compiler's two stores become TLS-relative, which is the whole +of the change. + +**The chain is snapshotted on the stopped thread**, into the same `snapshot` the restarts are copied into, at the same +moment and for exactly the same reason: the break loop *polls*, a poll runs Flan, and a chain read by the listener +thread is a chain that can be popped underneath the reader. Names are copied as bytes rather than kept as pointers, +because a transient `C-x C-e` module does get `dlclose`d and its rodata with it. Frame *addresses* are kept beside the +text, because reading a frame's locals means going back to that frame and not to whatever is at index 2 by then. + +``` +(:op "backtrace") → (:status "ok" :frames (("fetch" "/game.flan:15:7" "program" 0) + ("main" "/game.flan:27:7" "program" 0)) + :more 0 :stopped t :condition "Missing") +``` + +Innermost first. `:more` is how many frames deep recursion left off the end — the innermost ones are what the question +is about. **`origin` is `"program"` or `"eval"`**: a break inside a `C-x C-e` thunk has that thunk's frames on top of +the program's, and "where is my program" answered with `eval/7` is true and not the question. The boundary is recorded +at the call, in `flan_agent_poll`, exactly where `restart_floor` is and for the same reason — except that its +out-of-a-thunk value is `-1` rather than `0`, because zero restarts on the stack is a real answer and zero frames +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: + +| 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%) | + +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. + +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. + ### Conditions — step 2: `restart-case` and `invoke-restart` `spec-conditions.md` §3 to §6: the transfer. A handler runs where the signal was, decides, and control resumes at a diff --git a/NEXT.md b/NEXT.md index d9f4901..69f7e7e 100644 --- a/NEXT.md +++ b/NEXT.md @@ -689,10 +689,12 @@ sanitized sweep (`@sanitize`) is under the same watchdog but has never been obse it for free: the string the break loop already reports *is* that name, because `Emit.struct_name_of` writes `Types.Named` into `flan_error`. It is still open for **locals**, where DWARF gives a name and the name a debugger reads is not qualified by anything. -- **`(:op "backtrace")` is blocked** on frame metadata — unlocked by the DWARF work, then a new agent verb. Locals are - blocked twice: DWARF for the frame layout, *and* the pointer-rooted render thunk. Restart source locations and - arity are blocked too — `flan_restart` carries `prev`, `name_id`, `name` and `namelen`, so both need a new field in - the frame, which means the compiler emitting it. +- ~~**`(: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 + field in the frame, which means the compiler emitting it. ### One line away diff --git a/lib/dev.ml b/lib/dev.ml index 8e921a2..20ce419 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -231,6 +231,55 @@ let restarts t = end | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) +(* 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. + + Each line is [I ± NSLOTS LOC NAME]. The flag says whether the frame belongs + to the program or to the C-x C-e thunk the break happens to be inside: a + break inside an evaluation has that evaluation's frames on top, and + answering "where is my program" with [eval/7] would be true and useless. + [LOC] is the frame's own — it travels in the module that defined the body, + so a redefined function reports where the *installed* body is written and + not where the one this daemon first built was. A frame with none says [?]. + + A truncated backtrace ends [... N] before the dot; deep recursion is the + case, and the innermost frames are the ones the question is about. *) +let backtrace t = + match ask t "backtrace" 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 begin + let more = ref 0 in + let parse line = + if String.length line > 4 && String.sub line 0 4 = "... " then begin + (match int_of_string_opt (String.sub line 4 (String.length line - 4)) with + | Some n -> more := n + | None -> ()); + None + end + else + match String.split_on_char ' ' line with + | idx :: flag :: nslots :: loc :: rest when rest <> [] -> + (match int_of_string_opt idx, int_of_string_opt nslots with + | Some _, Some k -> + Some (String.concat " " rest, (if loc = "?" then "" else loc), + flag = "+", k) + | _ -> None) + | _ -> None + in + let frames = + List.filter_map parse + (List.filter (fun l -> l <> "" && l <> ".") lines) + in + Ok (frames, !more) + end + | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) + let alive t = match Unix.waitpid [ Unix.WNOHANG ] t.child with | 0, _ -> true @@ -594,6 +643,48 @@ let break t = rs) ] | Error m -> error ("the program refused to list its restarts: " ^ m)) +(* [(:op "backtrace")] — the frames of a stopped program, innermost first. + NEXT.md's "Asked for by the editor lanes" had this blocked on exactly the + frame metadata the shadow stack now carries. + + Refused while the program is running, and that is not a gap in the feature: + the chain is the game thread's, it is pushed and popped on every call, and + a walk of it from this end while that thread runs would produce a plausibly + shaped answer that was never true. Stopped, the thread is parked in the + break loop and the program itself takes the snapshot. + + Each frame is [(name loc origin nslots)] — four fields in the shape [defs] + already uses, so an editor reads it with [read] and nothing else. [origin] + is "program" or "eval": a break inside a C-x C-e thunk has the thunk's + frames above the program's, and they are shown and labelled rather than + hidden, the same decision [:unreachable] makes for the restarts under one. + [nslots] is how many slots the frame has, which is what a client asks about + before asking for any of them. *) +let backtrace_op t = + if not (alive t) then error "the program exited; restart flan dev" + else + match state t with + | Running -> + error + "the program is running; a backtrace is only taken while it is stopped, \ + because the frame chain is the game thread's and it is changing" + | Unreachable m -> error ("cannot ask the program where it is: " ^ m) + | Stopped _ -> + (match backtrace t with + | Ok (frames, more) -> + ok + [ ":frames " + ^ Wire.list + (List.map + (fun (name, loc, mine, nslots) -> + Wire.list + [ Wire.quote name; Wire.quote loc; + Wire.quote (if mine then "program" else "eval"); + string_of_int nslots ]) + frames); + Printf.sprintf ":more %d" more ] + | Error m -> error ("the program refused to say where it is: " ^ 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 @@ -982,6 +1073,7 @@ let handle t req = | Some "describe" -> describe t | Some "defs" -> defs t | Some "break" -> break t + | Some "backtrace" -> backtrace_op t | Some "layout" -> (match Wire.string_field req "type" with | Some ty -> layout t ~ty diff --git a/lib/emit.ml b/lib/emit.ml index f5194cf..cb3246c 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -216,6 +216,15 @@ type m = { and nothing else. *) sanitize : bool; mutable nstr : int; + (* The frame descriptors a dev build's shadow stack points at, counted apart + from [nstr] deliberately. [nstr] is the test [redefinition] uses to decide + whether an expression thunk's module may be unloaded — a string literal in + the module image is something the program may still be pointing at after + the thunk returns. A frame descriptor is not: the frames that named it + were popped on the way out, and the break loop copies the bytes it shows + rather than keeping the pointer. Counting these in [nstr] would silently + stop every C-x C-e module from ever being unloaded. *) + mutable nfi : int; } (* The attribute group every emitted function names, empty unless sanitizing. @@ -400,6 +409,11 @@ type f = { declared on -- the fallback for a node the checker made up. *) dsub : int option; dline : int; + (* The value the shadow-stack head held when this function was entered, in a + dev build: [Some %fprev]. Every [ret] restores it — see [ret] — which is + 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; (* 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 @@ -429,6 +443,20 @@ let label f name = Buffer.add_string f.b (Printf.sprintf "\n%s:\n" name); f.live <- true +(* Every [ret] in a function body goes through here, which is the whole of how + the shadow stack's pop is got right. There are five of them — an explicit + [return] with a value and without, the [none] arm of [(some x)], the tail of + the body, and the landing block a transfer leaves through — and the last of + those is the one that matters: a condition handled further out unwinds past + this frame, so a pop written only on the normal path leaves a dead frame on + the stack after every handled error, and the next backtrace is a lie. Same + lesson [emit_with_alloc] learned about the context allocator. *) +let ret f v = + (match f.frame with + | Some prev -> ins f "store ptr %s, ptr @flan_frame_head" prev + | None -> ()); + term f "ret %s %s" (ll f.ret) v + let alloca f ty = let name = fresh f in Buffer.add_string f.allocas (Printf.sprintf " %s = alloca %s\n" name (ll ty)); @@ -485,6 +513,34 @@ let cstring m s = id (String.length s + 1) (escape s)); id +(* ── The shadow stack's descriptors ──────────────────────────────────── *) + +(* One [flan_fninfo] per function in a dev build: the name and the location, + as bytes and lengths, plus how many slots the frame has. It is static data — + nothing about a function changes between two calls to it — so a frame stores + a pointer to this and not six fields of its own. + + The strings go through [m.nfi] rather than [string_bytes], which is the + whole of why that counter exists; see [m.nfi]. *) +let fi_bytes m s = + let id = Printf.sprintf "@\".fi.%d\"" m.nfi in + m.nfi <- m.nfi + 1; + Buffer.add_string m.strs + (Printf.sprintf "%s = private unnamed_addr constant [%d x i8] c\"%s\"\n" + id (String.length s) (escape s)); + id, String.length s + +let fninfo m (fn : Tast.fn) ~nslots = + let nid, nlen = fi_bytes m fn.Tast.name in + let lid, llen = fi_bytes m (Loc.to_string fn.Tast.floc) in + let id = Printf.sprintf "@\".fi.%d\"" m.nfi in + m.nfi <- m.nfi + 1; + Buffer.add_string m.strs + (Printf.sprintf + "%s = private unnamed_addr constant %%fninfo { ptr %s, i64 %d, ptr %s, i64 %d, i32 %d, i32 0 }\n" + id nid nlen lid llen nslots); + id + (* ── Bounds checks ───────────────────────────────────────────────────── *) (* A failure is a branch to a [noreturn] call and then [unreachable] — the same @@ -616,10 +672,10 @@ and value_at f (e : Tast.expr) : string = | Tast.While (c, body) -> emit_while f c body; "zeroinitializer" | Tast.Return v -> (match v with - | None -> term f "ret %s zeroinitializer" (ll f.ret) + | None -> ret f "zeroinitializer" | Some v -> let v' = value f v in - term f "ret %s %s" (ll f.ret) v'); + ret f v'); "zeroinitializer" | Tast.Set (p, v) -> let ptr, ty = place f p in @@ -1264,7 +1320,7 @@ and emit_unwrap f ty v = let ln = fresh_label f "none" and lc = fresh_label f "some" in term f "br i1 %s, label %%%s, label %%%s" isnone ln lc; label f ln; - term f "ret %s zeroinitializer" (ll f.ret); + ret f "zeroinitializer"; label f lc; let out = fresh f in ins f "%s = extractvalue %s %s, 1" out oty ov; @@ -1590,6 +1646,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; dsub; dline = (if fn.Tast.floc.Loc.line = 0 then 1 else fn.Tast.floc.Loc.line); dloc = ""; @@ -1608,6 +1665,43 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = Buffer.add_string f.allocas (Printf.sprintf " store %s %%p%d, ptr %s\n" (ll ty) i f.slots.(i))) fn.Tast.params; + (* The shadow stack's push, in the entry block, and the pop is at every + [ret] (see [ret]). plan.org has had *Frames: shadow stack* in the dev + column since the beginning; this is it, and it is dev-only, so a shipped + game pays nothing for it. + + Inline rather than a call in either direction: this is on every call in a + dev build, and a call to record a call would be most of what it costs. The + record is four words on this frame's own stack, of which two are stored + from static data and two are reserved for the slots [locals] needs -- they + are written, not left as whatever the stack held, because a frame with a + garbage [slots] pointer is one the break loop could follow. + + A lifted handler-bind clause pushes one like any other function, which is + 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 + let prev = fresh f in + Buffer.add_string f.allocas " %frame = alloca %flanframe +"; + Buffer.add_string f.allocas + (Printf.sprintf " %s = load ptr, ptr @flan_frame_head +" prev); + Buffer.add_string f.allocas + (Printf.sprintf " store ptr %s, ptr %%frame +" prev); + List.iter + (fun line -> Buffer.add_string f.allocas (" " ^ line ^ "\n")) + [ "%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"; + "store ptr %frame, ptr @flan_frame_head" ]; + f.frame <- Some prev + 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 is ordinary stack storage of an ordinary machine type, so there is no @@ -1668,7 +1762,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = (* A Unit function's body may end on a form of any type — the value is discarded, so the return is the Unit constant rather than that value. *) if Types.equal fn.Tast.ret Types.Unit then last := "zeroinitializer"; - term f "ret %s %s" (ll fn.Tast.ret) !last; + ret f !last; (* The transfer exit, spec-conditions.md §5 and §6. A transfer that reached the top of this function without a restart-case to catch it leaves the same way a [return] does — which is what reuses the existing return path, @@ -1689,7 +1783,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = f.pads <- []; ins f "store ptr %s, ptr %s" tgt xfer_param end; - term f "ret %s zeroinitializer" (ll fn.Tast.ret); + ret f "zeroinitializer"; (* A defer that starts a *second* transfer while the first is unwinding. §6's per-frame slot nests, but nothing here does: the first transfer's target is in hand and the defers are half run. Refused loudly rather @@ -1769,6 +1863,13 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher ; ends disagree. The first four fields are what the runtime's own ; [flan_restart] declares and their offsets do not move. %restart = type { ptr, i32, ptr, i64, ptr, i32, i32, i32, ptr, i64 } +; A shadow-stack frame and the static description of the function that pushed +; it (runtime/flan_dev.c). Dev builds only: [emit_fn] pushes one on entry and +; 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 } +@flan_frame_head = external global ptr declare void @flan_rt_init(i32, ptr) declare void @flan_argv(ptr) @@ -1892,7 +1993,7 @@ let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false) out = Buffer.create 8192; strs = Buffer.create 512; structs = Hashtbl.create 16; globals = Hashtbl.create 16; externs = Hashtbl.create 32; - checks; dev; known; nstr = 0; sanitize; + checks; dev; known; nstr = 0; nfi = 0; sanitize; dbg = (if debug then Some (new_dbg p) else None); } in List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s) diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 8438c1d..bc5533a 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -297,3 +297,95 @@ int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen, *len = 0; return 0; } + +/* ── The shadow stack ───────────────────────────────────────────────── */ + +/* plan.org's "Dev vs release builds" has had *Frames: shadow stack* in the dev + * column since the beginning. This is it, and it exists for one reason: the + * more a break loop can show, the less often a real debugger is needed. A + * stopped program that cannot say where it is sends someone to lldb. + * + * Native unwinding would be the other route and is deliberately not taken: + * plan.org lowers every non-local exit explicitly rather than through platform + * unwinding, so there is no .eh_frame walk to borrow, and a frame pointer walk + * gives addresses that only DWARF can turn back into names. A pushed record + * carries the name itself, is the same on wasm32 as it is here, and needs no + * agreement with the optimiser about what a frame looks like. + * + * The compiler emits the push and the pop inline (emit.ml, [emit_fn]) rather + * than calling in here: this is on every call in a dev build, and a call to + * record a call would double the thing being measured. + * + * A plain global, not a _Thread_local. It matches what the handler stack and + * the restart stack in flan_rt.c already assume — one thread runs Flan; the + * listener thread runs C and the loader and never enters a Flan body. If the + * language ever grows threads this becomes thread-local and the compiler's + * two stores become TLS-relative, which is the only change. + * + * Nothing in here walks the chain while the game thread is running. The break + * loop snapshots it on the stopped thread, exactly as it snapshots the restart + * list and for exactly the same reason: a chain read by another thread is a + * chain that can be popped underneath the reader. The accessors below are the + * snapshot's, and take the frame they were given rather than re-reading the + * head. */ + +typedef struct { + const char *name; /* the Flan name, qualified; not NUL-terminated */ + int64_t namelen; + const char *loc; /* file:line:col, as Loc spells it */ + int64_t loclen; + int32_t nslots; + int32_t spare; +} flan_fninfo; + +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. */ + void **slots; + uint64_t init; +} flan_frame; + +/* The compiler names this symbol directly. A redefinition module reaches it + * the same way it reaches any other host global — through the dynamic symbol + * table, which [--dev] links with -rdynamic. */ +flan_frame *flan_frame_head; + +/* [i] counts from the innermost. NULL past the end, which is how a caller + * learns the depth without a second walk. */ +void *flan_dev_frame_at(int32_t i) { + flan_frame *f = flan_frame_head; + while (f != NULL && i > 0) { f = f->prev; i--; } + return f; +} + +int32_t flan_dev_frame_count(void) { + int32_t n = 0; + for (flan_frame *f = flan_frame_head; f != NULL; f = f->prev) { + n++; + if (n > 100000) break; /* a corrupt chain says so rather than hanging */ + } + return n; +} + +const char *flan_dev_frame_name(const void *frame, int64_t *len) { + const flan_frame *f = frame; + if (f == NULL || f->info == NULL) { *len = 0; return NULL; } + *len = f->info->namelen; + return f->info->name; +} + +const char *flan_dev_frame_loc(const void *frame, int64_t *len) { + const flan_frame *f = frame; + if (f == NULL || f->info == NULL) { *len = 0; return NULL; } + *len = f->info->loclen; + return f->info->loc; +} + +int32_t flan_dev_frame_nslots(const void *frame) { + const flan_frame *f = frame; + return (f == NULL || f->info == NULL) ? 0 : f->info->nslots; +} + diff --git a/test/test_dev.ml b/test/test_dev.ml index 44ac2e2..dfa9766 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -416,6 +416,49 @@ let () = fail "restarts on offer: %s" (String.concat ", " names) | _ -> fail "break did not list the restarts"); + (* Where it is, which is the other half of what a stopped program can + be asked. The shadow stack is dev-only and the daemon owns the + build, so a frame per Flan call is there to be walked; the names + come off the frames themselves rather than out of any DWARF, which + is what makes this work in the break loop rather than in lldb. + + Innermost first, [main] last, and both marked as the program's: + nothing is being evaluated here, so nothing is the evaluation's. *) + let frames r = + match Wire.field r "frames" 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 loc; _ } + :: { Form.v = Form.Str origin; _ } :: _) -> + Some (n, loc, origin) + | _ -> None) + l + | _ -> [] + in + let r = ask "(:op \"backtrace\")" in + if status r <> "ok" then + fail "backtrace: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")) + else begin + match frames r with + | [ ("fetch", floc, "program"); ("main", _, "program") ] -> + (* Absolute and pointing into the program's own source, for the + same reason [defs] is: an editor is not in this process's + working directory. It comes off the frame, not off this end's + session, so a redefined body reports where the *installed* one + is written. *) + if String.length floc = 0 || floc.[0] <> '/' then + fail "a frame's location is not absolute: %s" floc + | fs -> + fail "backtrace of a stopped program: %s" + (String.concat ", " + (List.map (fun (n, _, o) -> n ^ "/" ^ o) fs)) + end; + (* The payoff. The break loop is the poll loop, so an expression evaluated here is a module the listener queues and the *stopped* thread runs — which is the only reason C-x C-e works at the one @@ -483,6 +526,19 @@ let () = if unreachable <> [ 2; 3 ] then fail "positions below the thunk: %s" (String.concat ", " (List.map string_of_int unreachable)); + (* And the backtrace says the same thing the restart list does, in its + own words: the two frames on top belong to the evaluation, the two + below them to the program. A backtrace that did not draw that line + would answer "where is my program" with [eval/1], which is true and + not the question. *) + (match frames (ask "(:op \"backtrace\")") with + | [ ("fetch", _, "eval"); (thunk, _, "eval"); ("fetch", _, "program"); + ("main", _, "program") ] + when String.length thunk > 5 && String.sub thunk 0 5 = "eval/" -> () + | fs -> + fail "backtrace at a break inside a thunk: %s" + (String.concat ", " + (List.map (fun (n, _, o) -> n ^ "/" ^ o) fs))); (* Refused, and refused *here* — not accepted and dropped. *) let r = ask "(:op \"restart-at\" :index 2 :name \"retry\")" in if status r <> "error" then @@ -537,6 +593,13 @@ let () = let r = ask "(:op \"abort\")" in if status r <> "error" then fail "an abort was accepted by a running program"; + (* Refused for the same reason, and it is not a missing feature: the + frame chain is the game thread's and it is pushed and popped on + every call, so a walk from this end would have the shape of a + backtrace and the contents of a race. *) + let r = ask "(:op \"backtrace\")" in + if status r <> "error" then + fail "a running program answered with a backtrace"; (* ...and an ordinary evaluation works again on the far side of it. *) let r = ask "(:op \"eval-expr\" :code \"(+ 1 1)\" :file \"/tmp/buf.flan\")" @@ -596,6 +659,34 @@ let () = if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then fail "the program never stopped on the body that errors" else begin + (* The claim this test exists for, and the one thing about a shadow + stack that is easy to get wrong: **the pop happens on the + transfer path too**. Five breaks have been taken and resumed by + now, every one of them by a condition transfer that unwound past + the frame that erred. A pop written only on the normal return + path would have left one dead frame behind each time, and this + backtrace would be [step, main] with a pile of stale [fetch]es + under it. It is two frames or the feature is a liar. *) + (match + List.map (fun (n, _, o) -> (n, o)) + (match Wire.field (ask "(:op \"backtrace\")") "frames" 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 loc; _ } + :: { Form.v = Form.Str o; _ } :: _) -> + Some (n, loc, o) + | _ -> None) + l + | _ -> []) + with + | [ ("step", "program"); ("main", "program") ] -> () + | fs -> + fail "frames left on the shadow stack by five handled errors: %s" + (String.concat ", " (List.map (fun (n, o) -> n ^ "/" ^ o) fs))); let r = ask "(:op \"abort\")" in if status r <> "ok" then fail "abort was refused by a stopped program: %s" diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index fedb300..3df25fc 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -146,6 +146,15 @@ extern void (*flan_break_hook)(const uint8_t *name, int64_t namelen, extern int32_t flan_break_resume(const uint8_t *name, int64_t namelen, void *xfer); extern int32_t flan_restart_count(void); +/* The shadow stack (runtime/flan_dev.c). The compiler pushes a frame per Flan + * call in a dev build; these read one, and only ever on the thread that owns + * it. The frame is opaque here on purpose: its shape belongs to flan_dev.c, + * and two files each declaring the struct is how the two stop agreeing. */ +extern int32_t flan_dev_frame_count(void); +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 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); @@ -169,6 +178,18 @@ extern void flan_restart_take(void *frame, void *xfer); * breaks and whose break runs another thunk nests correctly. */ static int32_t restart_floor; +/* The same boundary, counted in shadow-stack frames. A break inside a C-x C-e + * thunk has that thunk's frames on top of the program's, and "where is my + * program" answered with [eval/7] is not the question anyone asked. Recorded + * at the call for the same reason [restart_floor] is: the frames below it are + * exactly the ones that were already on the stack when the thunk started. */ +/* -1, not 0, and the distinction is the whole of it: [restart_floor] can be + * zero meaning "no restarts were on the stack when the thunk started", and + * outside a thunk zero is also the right answer. Frames are the other way + * round — outside a thunk *every* frame is the program's, and zero would say + * none of them are. So "not inside a thunk" gets a value of its own. */ +static int32_t frame_floor = -1; + /* What the listener thread hands the stopped game thread. One slot, because * only one thread is ever stopped. */ /* A *depth*, not a flag. A thunk this loop runs may itself error, and the @@ -213,6 +234,8 @@ static _Atomic int aborting; * comes from here and nothing re-reads the live stack. */ #define SNAP_MAX 64 /* restarts offered at one break */ #define SNAP_NAMES 4096 /* bytes of names behind them */ +#define FRAME_MAX 64 /* frames listed in a backtrace */ +#define FRAME_TEXT 8192 /* bytes of names and locations */ typedef struct { int32_t gen; /* never reused, never 0 */ @@ -223,6 +246,21 @@ typedef struct { int32_t reachable[SNAP_MAX]; int32_t used; char names[SNAP_NAMES]; + /* Where the stopped thread is, taken at the same moment and for the same + * reason: the chain is the game thread's, and it is holding still only + * because it is parked in this loop. [fframe] is kept as well as the text, + * because reading a frame's locals means going back to that frame — and to + * that frame rather than to whatever is at index 2 by then. */ + int32_t fn; /* frames listed */ + int32_t ftotal; /* before FRAME_MAX truncated it */ + int32_t fused; + void *fframe[FRAME_MAX]; + int32_t fnoff[FRAME_MAX], fnlen[FRAME_MAX]; + int32_t floff[FRAME_MAX], fllen[FRAME_MAX]; + int32_t fslots[FRAME_MAX]; + int32_t fmine[FRAME_MAX]; /* 0 = the evaluation's, not the + * program's */ + char ftext[FRAME_TEXT]; } snapshot; /* One per nested break loop, because an inner break must not answer with the @@ -267,6 +305,42 @@ static int snap_push(void) { s->names[s->used++] = 0; s->n++; } + /* And the frames, from the same held-still stack. A deep recursion is + * truncated rather than followed: the innermost frames are the ones the + * question is about, and the count says how many were left out. */ + { + int32_t fn = flan_dev_frame_count(); + s->ftotal = fn; + s->fused = 0; + s->fn = 0; + for (int32_t i = 0; i < fn && s->fn < FRAME_MAX; i++) { + void *fr = flan_dev_frame_at(i); + int64_t nl = 0, ll = 0; + const char *nm, *lc; + if (fr == NULL) break; + nm = flan_dev_frame_name(fr, &nl); + lc = flan_dev_frame_loc(fr, &ll); + if (nl < 0) nl = 0; + if (ll < 0) ll = 0; + if ((int64_t)s->fused + nl + ll + 2 > FRAME_TEXT) break; + s->fframe[s->fn] = fr; + s->fnoff[s->fn] = s->fused; + s->fnlen[s->fn] = (int32_t)nl; + if (nm != NULL && nl > 0) memcpy(s->ftext + s->fused, nm, (size_t)nl); + s->fused += (int32_t)nl; + s->ftext[s->fused++] = 0; + s->floff[s->fn] = s->fused; + s->fllen[s->fn] = (int32_t)ll; + if (lc != NULL && ll > 0) memcpy(s->ftext + s->fused, lc, (size_t)ll); + s->fused += (int32_t)ll; + s->ftext[s->fused++] = 0; + s->fslots[s->fn] = flan_dev_frame_nslots(fr); + /* The outermost [frame_floor] frames are the program's; anything above + * them belongs to the evaluation this break is inside. */ + s->fmine[s->fn] = (frame_floor < 0) || (i >= fn - frame_floor); + s->fn++; + } + } atomic_store(&snap_depth, d + 1); return 1; } @@ -434,9 +508,12 @@ int32_t flan_agent_poll(void) { * inside break loops, which run from inside thunks. */ if (j.call != NULL) { int32_t outer = restart_floor; + int32_t oframe = frame_floor; restart_floor = flan_restart_count(); + frame_floor = flan_dev_frame_count(); j.call(); restart_floor = outer; + frame_floor = oframe; } if (j.handle != NULL) { dlclose(j.handle); } } @@ -539,6 +616,48 @@ static void serve(int fd) { reply(fd, ".\n"); return; } + /* Where the stopped thread is. One line per frame, innermost first: + * the index, whether the frame is the program's or the evaluation's, how + * many slots it has, where it is written, and its name. Served from the + * snapshot, never from the live chain — the game thread is parked in the + * break loop, but the loop polls, and a poll runs Flan. + * + * Refused while running, like every other break verb and for the same + * reason: a chain read by one thread while another pushes and pops it is + * not a backtrace, it is a race with a plausible shape. */ + if (strcmp(line, "backtrace") == 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; } + if (s->fn == 0 && s->ftotal == 0) { + /* Not "no frames": a release build has no shadow stack at all, and + * answering with an empty backtrace would read as a program with an + * empty stack, which is not a thing that can be stopped. */ + reply(fd, "err this program was not built with --dev, so it has no " + "shadow stack to walk\n"); + return; + } + for (int32_t i = 0; i < s->fn; i++) { + char hdr[64]; + int k = snprintf(hdr, sizeof hdr, "%d %c %d ", i, + s->fmine[i] ? '+' : '-', s->fslots[i]); + if (k > 0) send(fd, hdr, (size_t)k, MSG_NOSIGNAL); + if (s->fllen[i] > 0) + send(fd, s->ftext + s->floff[i], (size_t)s->fllen[i], MSG_NOSIGNAL); + else + reply(fd, "?"); + reply(fd, " "); + send(fd, s->ftext + s->fnoff[i], (size_t)s->fnlen[i], MSG_NOSIGNAL); + reply(fd, "\n"); + } + if (s->ftotal > s->fn) { + char more[64]; + int k = snprintf(more, sizeof more, "... %d\n", s->ftotal - s->fn); + if (k > 0) send(fd, more, (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 From 0ff4ce56a57aaf94390756d2b079d1c4a7d8ee68 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 12:00:29 +0700 Subject: [PATCH 2/3] The locals of a stopped frame, read where they live 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. --- BUILT.md | 86 +++++++++++++++---- NEXT.md | 17 ++-- lib/dev.ml | 151 ++++++++++++++++++++++++++++++++++ lib/emit.ml | 100 +++++++++++++++++++--- lib/session.ml | 132 +++++++++++++++++++++++++++++ runtime/flan_dev.c | 21 ++++- test/programs/dev-locals.flan | 34 ++++++++ test/test_dev.ml | 125 ++++++++++++++++++++++++++++ vendor/agent/flan_agent.c | 63 ++++++++++++++ 9 files changed, 696 insertions(+), 33 deletions(-) create mode 100644 test/programs/dev-locals.flan diff --git a/BUILT.md b/BUILT.md index 42a597b..5a864a9 100644 --- a/BUILT.md +++ b/BUILT.md @@ -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 `` and a `(Ptr T)` as ``**, 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` diff --git a/NEXT.md b/NEXT.md index 69f7e7e..3e31d9b 100644 --- a/NEXT.md +++ b/NEXT.md @@ -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 diff --git a/lib/dev.ml b/lib/dev.ml index 20ce419..0f2be53 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 diff --git a/lib/emit.ml b/lib/emit.ml index cb3246c..2cc0f96 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -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) diff --git a/lib/session.ml b/lib/session.ml index 7c4eb88..90565b5 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -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 = "") 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 = "") t src : change = let form = match Reader.read_all ~file:origin src with diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index bc5533a..0be0ba9 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -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]; +} + diff --git a/test/programs/dev-locals.flan b/test/programs/dev-locals.flan new file mode 100644 index 0000000..da27e79 --- /dev/null +++ b/test/programs/dev-locals.flan @@ -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) diff --git a/test/test_dev.ml b/test/test_dev.ml index dfa9766..3f6b086 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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 diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 3df25fc..24f3e54 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -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 From 53d49570ec1809b5f493cd4d19cfb066d2f349b2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 12:07:33 +0700 Subject: [PATCH 3/3] A slot fingerprint per frame, which does not yet catch what it is for locals compares the frame on the stack against the body the session holds: installing while stopped is allowed, so the two can be different bodies of one function, and a rename that keeps the slot count pairs every name with the wrong value. Emit.slot_fingerprint hashes each slot's name and type, emit_fn puts it in the frame's static description, the agent reports it on the backtrace line and Dev.locals compares it. It does not fire. The test that drives it -- a redefinition that renames every local of a function that is on the stack -- fails, and is committed failing rather than deleted, because it is the only record of what is wrong. Everything else in the suite is green; this one check is red. It builds. See NEXT.md's handoff for where to look first. --- NEXT.md | 35 +++++++++++++++++++++++++++++++++++ lib/dev.ml | 10 +++++----- lib/emit.ml | 44 ++++++++++++++++++++++++++++++++++++++++---- test/test_dev.ml | 22 +++++++++++++++++++++- 4 files changed, 101 insertions(+), 10 deletions(-) diff --git a/NEXT.md b/NEXT.md index 3e31d9b..19214f1 100644 --- a/NEXT.md +++ b/NEXT.md @@ -884,3 +884,38 @@ tests assert on the reason, not just on the failure. `old-ocaml/` — the pre-rewrite menhir/ocamllex frontend, kept as reference and excluded from the build by the root `dune` file. Its contents are also in git history at `2c232dd`. + +## Handoff: the shadow stack lane, stopped mid-repair + +Two commits landed and are green: the shadow stack with `(:op "backtrace")`, and `(:op "locals" :frame N)`. See +BUILT.md's two new sections for the design and the measurements. A third commit is **half-built and its own test is +red**, deliberately left that way rather than deleted. + +**What is broken, exactly.** `locals` compares the frame on the stack against the body this session holds, and the +comparison is not firing. Installing while stopped is deliberately allowed, so the two can be different bodies of one +function — and a redefinition that renames the locals while keeping their count and types shows every *new* name +against the *old* body's values, with nothing refused. `test_dev.ml`'s "the frame of a superseded body answered with +the new body's names" fails on exactly that, and reproducing it takes one run of that test. + +The fix that is in the tree and does not work yet: `Emit.slot_fingerprint` hashes each slot's name and the spelling of +its type; `emit_fn` stores it in the `flan_fninfo` the frame points at; `flan_dev_frame_slotsig` reads it; the agent +puts it on the `backtrace` line as a fifth field; `Dev.locals` compares it with `Emit.slot_fingerprint fn`. Every piece +is written and the refusal does not happen, so **one of those five hand-offs is dropping the number** — the next person +should print both sides of that comparison first, which is a two-line change in `Dev.locals`, rather than re-deriving +the design. The likeliest suspects in order: `Dev.backtrace`'s line parse silently falling through to `None` for the +new five-field line (it would drop the frame entirely, so probably not); `find_fn` handing back a stale `Tast.fn`; the +hash being computed over a `snames` array that the redefinition path fills in differently. + +Until it is fixed, `locals` is trustworthy for a frame whose body has not been redefined since it was entered — which +is every frame in a program that has not been edited while stopped — and silently wrong for one that has. + +**Not obvious from the diff.** Two things cost a day between them. The linked-list frame beat an array-with-a-stack- +pointer on both benchmarks, which is the opposite of what the escaping-alloca argument predicts, and the measurement +that first said otherwise was comparing a 40-frame binary with a 600-frame one; every number in BUILT.md is now a +minimum of nine runs for that reason. And `redefinition`'s transient rule (`m.nstr = 0`) silently stops every module +carrying a string literal from ever being unloaded — the frame descriptors go through their own counter, `m.nfi`, for +that reason, and a locals thunk passes `~retains:false` because everything it emits is memcpy'd into the result buffer. + +**No Emacs surface.** `backtrace` and `locals` are daemon ops; nothing in `emacs/` calls them yet. One command showing +the backtrace with the selected frame's locals is the whole of what is missing, and `flan-cnr.el`'s +fixture-driven shape is the model. diff --git a/lib/dev.ml b/lib/dev.ml index 0f2be53..bdf2443 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -756,24 +756,24 @@ let locals t ~frame = 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") + ^ " 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") + ^ " 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" ] + "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" + "%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 @@ -882,7 +882,7 @@ let choose t ~name = ok [ ":restart " ^ Wire.quote name; ":note " - ^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ] + ^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ] | reply -> error (String.trim reply) | exception Unix.Unix_error (e, _, _) -> error ("cannot reach the program: " ^ Unix.error_message e) diff --git a/lib/emit.ml b/lib/emit.ml index 2cc0f96..7eb9bbb 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -558,6 +558,33 @@ let fi_bytes m s = id (String.length s) (escape s)); id, String.length s +(* What the two ends compare about a frame's slots, since neither can see the + other. Same idea as a restart frame's [rsig_id], and for the same reason: a + frame on the stack was compiled from *some* body, the session holds + whatever body it last accepted, and installing while stopped is deliberately + allowed — so the two can be different bodies of the same function, and a + slot count alone does not notice a rename or a reordering. Pairing [q] with + [p]'s value and saying nothing is exactly the "visible rather than correct" + failure this project has already named once. + + Over the names *and* the spellings of the types, because either can change + on its own. Computed here and read from here by [Dev], so there is one + definition of it and it cannot drift. *) +let slot_fingerprint (fn : Tast.fn) = + let b = Buffer.create 128 in + Array.iteri + (fun i ty -> + (match + if i < Array.length fn.Tast.snames then fn.Tast.snames.(i) else None + with + | Some n -> Buffer.add_string b n + | None -> ()); + Buffer.add_char b ':'; + Buffer.add_string b (Types.to_string ty); + Buffer.add_char b ';') + fn.Tast.slots; + Hashtbl.hash (Buffer.contents b) land 0x3fffffff + let fninfo m (fn : Tast.fn) ~nslots = let nid, nlen = fi_bytes m fn.Tast.name in let lid, llen = fi_bytes m (Loc.to_string fn.Tast.floc) in @@ -565,8 +592,8 @@ let fninfo m (fn : Tast.fn) ~nslots = m.nfi <- m.nfi + 1; Buffer.add_string m.strs (Printf.sprintf - "%s = private unnamed_addr constant %%fninfo { ptr %s, i64 %d, ptr %s, i64 %d, i32 %d, i32 0 }\n" - id nid nlen lid llen nslots); + "%s = private unnamed_addr constant %%fninfo { ptr %s, i64 %d, ptr %s, i64 %d, i32 %d, i32 %d }\n" + id nid nlen lid llen nslots (slot_fingerprint fn)); id (* ── Bounds checks ───────────────────────────────────────────────────── *) @@ -2187,7 +2214,7 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) String literals still have to come along: they are this module's own constants, and omitting them is an undefined [@.str.N] at link time. *) let redefinition ?(checks = true) ?(dev = false) ?(debug = false) - ?(known = fun _ -> true) + ?(known = fun _ -> true) ?(retains = true) ?call ?(consts = []) (p : Tast.program) ~fns : string = let target name = match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = name) p.Tast.fns with @@ -2371,7 +2398,16 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false) string constants has nothing in its image anyone could still be pointing at; one with any keeps its mapping, which costs a page and is the same bargain every redefinition already makes. *) - if fns = [ fn ] && consts = [] && m.nstr = 0 then + (* [retains = false] is a caller saying it knows where every literal in + this module goes. The [m.nstr] test below is a conservative stand-in + for that — an expression may store a string literal anywhere it likes, + and a global left pointing into an unmapped image is silent garbage + rather than a fault. A locals thunk is the case where the answer is + known: every literal it emits goes to [flan_dev_emit], which memcpys + into the result buffer, so nothing outside the module holds an address + inside it once the call has returned. Without this, clicking through + the frames of a break loop costs a permanent mapping per click. *) + if fns = [ fn ] && consts = [] && ((not retains) || m.nstr = 0) then Buffer.add_string m.out "\n@flan_reload_transient = global i8 1\n" | None -> () end; diff --git a/test/test_dev.ml b/test/test_dev.ml index 3f6b086..84a8662 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -804,7 +804,27 @@ let () = (* 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" + if status r <> "error" then fail "a frame index past the end answered"; + + (* And the case that makes this a fingerprint rather than a slot + count. Installing while stopped is deliberately allowed — it is the + fix-it-and-retry loop — so the body on the stack and the body the + session holds can be two different bodies of one function. This one + renames every local and keeps the count and the types, which a + count comparison cannot see: without the hash, [q] would be shown + 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\")" + in + if status r <> "ok" then + fail "installing a renamed body while stopped: %s" + (Option.value ~default:"" (Wire.string_field r "message")) + else begin + let r = ask "(:op \"locals\" :frame 0)" in + if status r <> "error" then + fail "the frame of a superseded body answered with the new body's names" + end 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. *)