diff --git a/BUILT.md b/BUILT.md index 0200b33..4b0cc7b 100644 --- a/BUILT.md +++ b/BUILT.md @@ -1408,6 +1408,59 @@ Each slot is rendered **from its address** rather than copied into the thunk fir 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. +### Globals of a stopped stack + +The other half, and in this language arguably the more useful one: a game keeps most of its state in top-level +`defvar`s and `sand.flan` holds its entire grid that way, so "what is this program's state right now" was a question +with nowhere to ask it. + +``` +(:op "globals") → (:status "ok" + :globals (("grid" "[4 i32]" "[ 7 5 0 0]" (0 1)) + ("pressure" "i64" "12" (0)) + ("label" "string" "\"running\"" (1))) + :refused () :skipped ()) +``` + +**Not per frame, and that is the design rather than a layout preference.** A global is not part of a frame — it is +program state the frame happened to touch — so nesting it under one implies an ownership that is not there and repeats +the name once per frame that reads it. So: one section, whose contents are the **union of the globals every frame on +the current stack references**. + +**The compiler does the choosing.** `Reach.expr_refs` is the walk that already computes what a function refers to — it +is how the link drops a package nothing calls — and pointed at one body it answers that body's reference set. Listing +*all* of a program's globals instead would bury the one that matters under the prelude's PRNG state; taking only what +the stack reaches is a filter the compiler can apply and a person cannot. Direct references only, with no transitive +closure through calls: a callee that reads a global is either on this stack, contributing its own references already, +or it is not on it and is not part of where the program stopped. + +**Each entry carries the frames that touch it, by index**, which is what the conditions buffer already numbers frames +by. That recovers what per-frame nesting would have told you — "the whole chain is reading this" reads differently from +"only the innermost does" — at no cost in duplication. **Ordered by the innermost frame that touches it**, because a +deep stack makes the union large and proximity to the error is what puts the likely culprit on top; ties keep +declaration order. + +**The mechanism is one step simpler than `locals`.** A local is reached by *address*, and only the stopped program +knows where its frame is — hence `flan/dev-slot`, hence the `bound_slots` round trip, hence the null-until-bound +refusal. A global is reached by *name*: `Emit.redefinition` writes a global the host already has as `external`, so the +dlopened thunk binds to the program's own storage and the dynamic linker does the work. Nothing is asked of the stopped +thread at all, and there is no not-yet-bound case, because a global's storage exists from the moment the process +started. It is `Render.render` over `(Global n)` — the same root `C-x C-e` uses when you type a global's name at it. + +**A frame that cannot be attributed contributes nothing and says so.** An `eval` frame has no declaration in this +session; a lifted handler clause has none of its own; a frame whose body was redefined since it was entered holds a +body whose reference set is a claim about different code. All three go into `:skipped` with the reason, because "the +union is incomplete and here is why" and "these are all of them" are different answers and the second one is the lie. + +**And the hole in that, which is narrow and is not closed.** `Emit.slot_fingerprint` hashes a body's *slots*. For +`locals` that is exactly the right cut: identical slots means the names still describe the storage, so the answer is +still true. Here it is not, because a body can change which globals it names without touching a single slot — and then +this section shows the *new* body's reference set attributed to the *old* frame. The values stay correct; they are read +from the program's storage by name. What can be wrong is one frame's membership in the union and the frame numbers +beside an entry. Closing it needs a second fingerprint over the reference set itself, in `%fninfo` and in the agent +that reads it. It is written down here and in `dev.ml` rather than papered over with a check that does not check it, +and `test_dev.ml` drives the redefinition case that *is* caught rather than asserting the one that is not. + ### 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 56c6663..e0b204e 100644 --- a/NEXT.md +++ b/NEXT.md @@ -369,21 +369,11 @@ reason there is no collector. ## Decided in discussion, queued -**Globals in the break buffer — one section, scoped to the stack.** Locals are readable; globals are not shown anywhere, -and in this language they are arguably the more useful half: a game keeps most of its state in top-level `defvar`s and -`sand.flan` holds its entire grid that way. - -Not per frame. A global is not part of a frame — it is program state the frame happened to touch — so nesting it under -one implies an ownership that is not there and repeats the name once per frame that reads it. Instead: its own section, -whose contents are the **union of the globals every frame on the current stack references**, which keeps the compiler -doing the choosing (the per-function reference set is already known) without listing all of a program's globals. - -Two refinements decided with it: **annotate each entry with which frames touch it**, which recovers what per-frame would -have told you at no cost in duplication; and **order by the innermost frame that touches it**, since a deep stack makes -the union large and proximity to the error is the ordering that puts the likely culprit on top. - -The daemon already has the pieces — `describe` returns the globals, `Session.render` walks a concrete type to a printed -value, and the `layout` op established that a qualified name is an identity the daemon can resolve. +**Globals in the break buffer — built.** One section under the stack, holding the union of the globals every frame on +the current stack references, each entry annotated with the frames that touch it and ordered by the innermost one. It +is `(:op "globals")` in `dev.ml` and `flan-cnr--insert-globals` in the break buffer. See BUILT.md, "Globals of a +stopped stack" — including the one hole left open, which is that the redefinition check is a fingerprint over a body's +*slots* and so does not catch a new body that names different globals while binding the same locals. **The break buffer opens by itself when the program stops.** Today a condition stops the program and the buffer appears only when `C-c C-b` is typed. `flan-dev--absorb` already inspects every reply for `:stopped` and a poll covers the case diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index e12fc0d..4540b02 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -427,11 +427,58 @@ rather than left blank: - a `Vec` or a pointer, which render as `` and `` here exactly as they do everywhere else. -**One known wrong answer.** If a function's body is redefined while the program -is stopped inside it, and the new body happens to have the same number of slots -of the same types, the frame will show the *new* names against the *old* -values. The check that should catch this does not fire. There is a failing test -pinned to it, so this is recorded rather than lurking. +**A redefined body is refused, not guessed at.** Installing a fix while the +program is stopped is deliberately allowed — it is the fix-it-and-retry loop — +so the frame on the stack and the body the daemon holds can be two bodies of +one function. A redefinition that renames a local changes neither the slot +count nor the types, and showing the new names against the old storage would be +a confident wrong answer in the one place someone is working out what went +wrong. Each frame therefore carries a fingerprint of its body's slots, and a +frame whose fingerprint no longer matches is refused by name with that reason. +Redefining one function says nothing about the others, so every untouched frame +still answers. + +## The globals the stack is working on + +Under the stack there is one more section: the globals this stopped stack +reaches. In this language that is often the more useful half — a game keeps +most of its state in top-level `defvar`s, and `sand.flan` holds its entire grid +that way. + +It is **one section, not a fold under each frame**. A global is not part of a +frame; it is program state the frame happened to touch. Nesting it under one +would imply an ownership that is not there and would repeat the name once per +frame that reads it. + +It is **scoped to the stack, not to the program**. The contents are the union +of the globals every frame on the stack references — the compiler already knows +each function's reference set, so it does the choosing. Listing all of a +program's globals instead would bury the one you want under the prelude's PRNG +state. + +Each entry says **which frames touch it**, by the same number the Stack section +labels them with. That recovers what per-frame nesting would have told you — +"the whole chain is reading this" reads differently from "only the innermost +does" — at no cost in duplication. And the order is **by the innermost frame +that touches it**, because a deep stack makes the union large and proximity to +the error is what puts the likely culprit on top. + +`i` works on a global line exactly as it does on a local: a global's name is an +expression, so the inspector can be pointed at it with nothing new. + +Two things are said rather than left out. A global whose type the structural +printer has no arm for is refused by name with the reason. And a frame the +daemon could not attribute — one belonging to an expression you evaluated in +the break loop, a lifted handler clause, or a body redefined since it was +entered — is listed under "the union is incomplete", because a short list and a +complete list look identical if nothing says which it is. + +**One hole worth knowing.** The redefinition check is a fingerprint over a +body's *slots*. A new body that names different globals while binding exactly +the same locals is not caught, and that frame's contribution will be the new +body's reference set. The values shown are still read from the program's own +storage and are still correct; what can be wrong is which frames an entry is +annotated with. ## Stopping on purpose diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 8272755..953cf79 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -80,7 +80,9 @@ from fixtures, and so `flan-dev.el' is named in one place.") (stack . "the program is running. A backtrace is the game thread's frame chain and it is changing while it runs, so the daemon refuses to take one [not a missing feature: ask again once it has stopped]") (locals - . "this frame has no named locals the daemon can read. A slot the compiler invented is refused by name rather than shown as `s4', and a slot whose binding had not run when the error happened has no address yet [both are refusals with reasons, not gaps — the frame's own line says how many slots it has]")) + . "this frame has no named locals the daemon can read. A slot the compiler invented is refused by name rather than shown as `s4', and a slot whose binding had not run when the error happened has no address yet [both are refusals with reasons, not gaps — the frame's own line says how many slots it has]") + (globals + . "no frame on this stack references a global [not a gap: the section is the *union of what the frames reach*, not a listing of everything the program has, so an empty one means the state this stack is working on is all in its locals]")) "Why a section of this buffer is empty, by name.") (defun flan-cnr--why (key) @@ -260,6 +262,70 @@ its use, because it is a fact about the prelude.") 'mouse-face 'highlight))))))))))) (insert "\n")) +(defun flan-cnr--insert-globals (state) + "Draw the globals the stopped stack reaches. + +One section rather than a fold under each frame, and that is the design rather +than a layout choice. A global is not part of a frame — it is program state +the frame happened to touch — so nesting it under one implies an ownership that +is not there, and repeats the name once per frame that reads it. + +What recovers the useful half of per-frame nesting is the annotation: each +entry says which frames touch it, by the same index the stack section numbers +them with. \"the whole chain is reading this\" and \"only the innermost is\" +are different facts and they read differently here. + +The order is the daemon's, and it is by the innermost frame that touches each +one: a deep stack makes the union large, and proximity to the error is what +puts the likely culprit on top." + (flan-cnr--section "Globals this stack reaches — innermost frame first:") + (let ((globals (plist-get state :globals)) + (refused (plist-get state :globals-refused)) + (skipped (plist-get state :globals-skipped))) + (if (and (null globals) (null refused) (null skipped)) + (insert (flan-cnr--unavailable 'globals)) + (let ((w (apply #'max 1 (mapcar (lambda (g) (length (nth 0 g))) globals)))) + (dolist (g globals) + (let ((start (point)) + (frames (nth 3 g))) + (insert (format " %s%s %s = %s" + (nth 0 g) + (make-string (- w (length (nth 0 g))) ?\s) + (propertize (nth 1 g) 'face 'font-lock-type-face) + (nth 2 g))) + ;; No frames at all should not be reachable — the daemon chooses + ;; these *by* the frames that touch them — but "frame" followed by + ;; nothing would be the one shape here that reads as a bug in the + ;; program rather than in this line, so it says so instead. + (insert (propertize + (if (null frames) " (no frame recorded)\n" + (format " %s %s\n" + (if (cdr frames) "frames" "frame") + (mapconcat #'number-to-string frames ", "))) + 'face 'shadow)) + ;; The same property the locals lines carry, so `i' reaches a + ;; global exactly as it reaches a local: a global *is* an + ;; expression in the source, which is what the inspector needs. + (add-text-properties start (point) + (list 'flan-cnr-inspect (nth 0 g) + 'mouse-face 'highlight))))) + (dolist (r refused) + (insert (format " %s%s\n" + (if (string-empty-p (nth 0 r)) "" + (propertize (format "%s: " (nth 0 r)) 'face 'shadow)) + (propertize (nth 1 r) 'face 'shadow)))) + ;; A frame the daemon could not attribute means the union above is not + ;; the whole union. Said, rather than left to look like a complete + ;; answer with fewer entries in it. + (when skipped + (insert (propertize + " the union is incomplete; these frames could not be attributed:\n" + 'face 'font-lock-warning-face)) + (dolist (s skipped) + (insert (propertize (format " %s — %s\n" (nth 0 s) (nth 1 s)) + 'face 'shadow)))))) + (insert "\n")) + (defun flan-cnr--render (state) "Draw STATE, a plist, into the current buffer." (let ((inhibit-read-only t)) @@ -269,6 +335,9 @@ its use, because it is a fact about the prelude.") (flan-cnr--insert-condition state) (flan-cnr--insert-restarts state) (flan-cnr--insert-stack state) + ;; After the stack, because it is scoped *by* the stack: the frame numbers + ;; an entry is annotated with have to be on screen above it to read. + (flan-cnr--insert-globals state) (insert (propertize "RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n" 'face 'shadow)) @@ -372,7 +441,7 @@ its use, because it is a fact about the prelude.") (user-error (if (get-text-property (point) 'flan-cnr-frame) "flan: this is the frame's own line; TAB opens it, then i on a local" - "flan: point is not on a local — TAB opens a frame, i inspects a local in it"))) + "flan: point is not on a local or a global — TAB opens a frame, i inspects a local in it or a global below"))) (require 'flan-inspect) (flan-inspect expr))) @@ -442,12 +511,14 @@ anyone who would rather TAB always moved." "What a stopped Flan program is offering." (setq buffer-read-only t)) -(defun flan-cnr-state-from-reply (reply &optional fields stack) +(defun flan-cnr-state-from-reply (reply &optional fields stack globals) "The buffer's state, out of a `break' REPLY. FIELDS is the condition's layout, if it was asked for and answered — a list of (NAME TYPE VALUE), where VALUE is nil because no running program was consulted to get it. +GLOBALS is what `flan-cnr-globals' returned, or nil. + Everything this cannot fill in is left nil deliberately: the renderer draws a section saying why rather than leaving one out, and a section that is absent cannot be told from one that is empty. @@ -462,7 +533,14 @@ data and the fixture-driven tests can drive it without a socket." ;; drive it with no socket. Nil is still a legitimate answer — the ;; renderer draws the reason rather than leaving the section out. :stack stack - :locals nil)) + :locals nil + ;; Three keys rather than one nested structure: the renderer draws the + ;; entries, the per-global refusals and the unattributable frames in + ;; three different shapes, and a plist it can `plist-get' each of is + ;; what keeps `flan-cnr--insert-globals' a function of its argument. + :globals (nth 0 globals) + :globals-refused (nth 1 globals) + :globals-skipped (nth 2 globals))) (defun flan-cnr-layout (type) "The fields of TYPE, as the renderer wants them, or nil. @@ -530,6 +608,30 @@ why this works at all while the thread is stopped." (list (plist-get r :locals) (plist-get r :refused)) (list nil (list (list "" (or (plist-get r :message) "refused"))))))) +(defun flan-cnr-globals () + "The globals the stopped stack reaches: (ENTRIES REFUSED SKIPPED). + +ENTRIES are (NAME TYPE VALUE FRAMES) rows, ordered by the innermost frame that +touches each one, with FRAMES the indices of every frame that does. + +Unlike the locals, this is fetched once for the whole buffer rather than per +frame when one is opened, and that follows from what it is: a section scoped to +the stack has one answer, and asking per frame would be asking the same +question as many times as there are frames and then unioning the results here. + +REFUSED is a global the structural printer had no arm for, by name and with the +reason. SKIPPED is a *frame* the daemon could not attribute — an expression's +own frame, a lifted handler clause, or a body redefined since it was entered — +which matters because it means the union is smaller than the real one. Both +are drawn rather than dropped, for the reason the whole buffer is built on: a +list that is missing something and a list that is complete look identical if +nothing says which it is." + (let ((r (funcall flan-cnr-request-function '(:op "globals")))) + (when (equal (plist-get r :status) "ok") + (list (plist-get r :globals) + (plist-get r :refused) + (plist-get r :skipped))))) + ;;;###autoload (defun flan-cnr-show () "Show what the stopped program is offering, in a buffer. @@ -547,7 +649,8 @@ walk from a running program." (flan-cnr--render (flan-cnr-state-from-reply r (flan-cnr-layout (plist-get r :condition)) - (flan-cnr-backtrace)))) + (flan-cnr-backtrace) + (flan-cnr-globals)))) (pop-to-buffer buf) buf))) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index bb1bdfd..50390e3 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -603,6 +603,89 @@ (test-flan--check "and the restarts are drawn anyway" (string-match-p "\\[retry\\]" text)))) +;; The globals section. One section rather than a fold under each frame, and +;; the fixtures below are what makes that visible: `grid' is touched by two +;; frames and appears once. +(let* ((state (list :condition "Boom" + :restarts '("retry") + :stack (list (list :fn "sim/inner" :loc "g.flan:12:1") + (list :fn "main" :loc "g.flan:30:1")) + ;; Ordered as the daemon orders it: by the innermost frame + ;; that touches each one. + :globals '(("grid" "[4 i32]" "[ 7 5 0 0]" (0 1)) + ("pressure" "i64" "12" (0)) + ("label" "string" "\"running\"" (1))))) + (buf (test-flan--cnr state)) + (text (with-current-buffer buf (buffer-string)))) + (test-flan--check "a global is named, typed and valued" + (string-match-p "pressure +i64 = 12" text)) + (test-flan--check "and it is one section, not one per frame" + (= 1 (seq-count (lambda (l) (string-match-p "grid" l)) + (split-string text "\n")))) + ;; The annotation is what recovers the half per-frame nesting would have + ;; told you, and it costs no duplication to say it. + (test-flan--check "a global two frames touch says both" + (string-match-p "frames 0, 1" text)) + (test-flan--check "and one only the innermost touches says one" + (string-match-p "frame 0\n" text)) + (test-flan--check "the innermost frame's globals come first" + (< (string-match "pressure" text) (string-match "label" text))) + ;; `i' reaches a global the same way it reaches a local: a global's name is + ;; an expression the program can be handed, which is the whole trick the + ;; inspector is built on. + (with-current-buffer buf + (goto-char (point-min)) + (test-flan--check "and a global line is inspectable" + (progn (search-forward "pressure") + (equal (get-text-property (point) 'flan-cnr-inspect) + "pressure"))))) + +;; Empty is a claim, not a gap: the section is the union of what the stack +;; reaches, so nothing in it means the state is all in the locals. +(let ((text (with-current-buffer + (test-flan--cnr (list :condition "Boom" :restarts '("retry") + :stack (list (list :fn "f")))) + (buffer-string)))) + (test-flan--check "an empty globals section says what empty means" + (string-match-p "not available.*union of what the frames reach" + text))) + +;; A frame the daemon could not attribute makes the union smaller than the real +;; one, and a list that is short without saying so is the failure this whole +;; buffer is built to avoid. +(let ((text (with-current-buffer + (test-flan--cnr + (list :condition "Boom" :restarts '("retry") + :stack (list (list :fn "f")) + :globals '(("label" "string" "\"x\"" (1))) + :globals-refused '(("weird" "no printer for (Map i64 i64)")) + :globals-skipped + '(("0: sim/inner" "this frame's body was redefined since it was entered")))) + (buffer-string)))) + (test-flan--check "a global with no printer is refused by name" + (string-match-p "weird: no printer" text)) + (test-flan--check "an unattributable frame says the union is incomplete" + (string-match-p "union is incomplete" text)) + (test-flan--check "and names the frame it lost" + (string-match-p "0: sim/inner" text))) + +;; The fetch is a function from a reply to data, like the other two, so it is +;; drivable with no socket. +(let ((flan-cnr-request-function + (lambda (_) '(:status "ok" + :globals (("g" "i64" "1" (0))) + :refused (("h" "no printer")) + :skipped (("1: m" "redefined")))))) + (let ((got (flan-cnr-globals))) + (test-flan--check "globals come back as entries, refusals and skipped frames" + (equal got '((("g" "i64" "1" (0))) + (("h" "no printer")) + (("1: m" "redefined"))))))) + +(let ((flan-cnr-request-function (lambda (_) '(:status "error" :message "running")))) + (test-flan--check "and a refusal is nil, not an error" + (null (flan-cnr-globals)))) + (let ((flan-cnr-request-function (lambda (_) '(:status "ok" :restarts nil :stopped nil)))) (test-flan--check "a running program is refused, by name" diff --git a/lib/dev.ml b/lib/dev.ml index 24b2c38..e164857 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -871,6 +871,236 @@ let locals t ~frame = error ("cannot reach the program: " ^ Unix.error_message e)) | exception Failure m -> error m))) +(* [(:op "globals")] — the globals the stopped stack reaches, in one section. + + Locals were the half the shadow stack was built for; these are arguably the + more useful half in this language. A game keeps most of its state in + top-level [defvar]s and sand.flan holds its entire grid that way, so "what + is the program's state right now" is a question about globals and there was + nowhere to ask it. + + **Not per frame, and that is the design.** A global is not part of a frame — + it is program state the frame happened to touch — so nesting it under one + implies an ownership that is not there, and repeats the name once per frame + that reads it. So: one section, whose contents are the union of the globals + every frame on the current stack references. + + **The compiler does the choosing.** [Reach.expr_refs] is the walk that + already computes what a function refers to — it is how the link drops a + package nothing calls — and pointed at one body it answers that body's + reference set. Listing *all* of a program's globals instead would bury the + one that matters under the prelude's PRNG state; taking only what the stack + reaches is the filter the compiler can apply and a person cannot. + + Direct references only, with no transitive closure through the calls a body + makes. A callee that reads a global is either on this stack — in which case + it is contributing its own references already — or it is not, in which case + it is not part of where the program stopped. + + **Each entry says which frames touch it**, by index, which is what the stack + section already numbers them by. That recovers what per-frame nesting would + have told you — "the whole chain is reading this" reads differently from + "only the innermost does" — at no cost in duplication. + + **Ordered by the innermost frame that touches it.** A deep stack makes the + union large, and proximity to the error is what puts the likely culprit on + top. Ties keep declaration order, which is the order the source has them in. + + **A frame that cannot be attributed contributes nothing and says so.** An + eval frame has no declaration in this session; a lifted handler clause has + none of its own; and a frame whose body has been redefined since it was + entered holds a body whose reference set is a claim about different code. + In every case the honest answer is that the union is incomplete and which + frame made it so — [:skipped] — rather than a list that silently is not the + union it says it is. The *values* would still have been right; the + attribution is what goes wrong, and attribution is what this op is for. + + **And the hole in that, stated rather than papered over.** + [Emit.slot_fingerprint] hashes a body's *slots* — every slot's name with the + spelling of its type — so it catches a redefinition that binds differently + and misses one that does not. For [locals] that is exactly the right cut: + if the slots are identical then the names still describe the storage and + the answer is still true. Here it is not, because a body can change which + globals it names without touching a single slot, and then this section + shows the *new* body's reference set attributed to the *old* frame. + + The values stay correct — they come from the program's storage by name — + and so does everything the other frames contribute. What can be wrong is + one frame's membership in the union and the frame numbers beside an entry. + Closing it means a second fingerprint over the reference set itself, which + is a change to [%fninfo] and to the agent that reads it; it is not done, + and the failure it leaves is narrow enough to name here rather than to + pretend away with a check that does not check it. + + Nothing is copied out of the program here either, and the mechanism is one + step simpler than [locals]: a global is reached by name rather than by + address, because [Emit.redefinition] writes a global the host already has as + [external] and the dynamic linker binds the thunk to the program's own + storage. So there is no [bound_slots] round trip and no not-yet-bound case — + a global's storage exists from the moment the process started. *) +let globals_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; globals are read against a stopped stack, and \ + the stack is what decides which of them to show" + | Unreachable m -> error ("cannot ask the program for its globals: " ^ m) + | Stopped _ -> + (match backtrace t with + | Error m -> error ("the program refused to say where it is: " ^ m) + | Ok (frames, _) -> + let all = t.session.Session.program.Tast.globals in + let is_global n = + List.exists (fun (g : Tast.global) -> String.equal g.Tast.gname n) all + in + (* name -> the frame indices that reference it, innermost lowest *) + let touched : (string, int list) Hashtbl.t = Hashtbl.create 32 in + let skipped = ref [] in + List.iteri + (fun i (name, _, mine, nslots, sig_) -> + let skip why = + skipped := (Printf.sprintf "%d: %s" i name, why) :: !skipped + in + if not mine then + skip + "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 it refers to" + else + match find_fn t name with + | None -> + skip + "not a function this session holds; a lifted handler clause \ + has no declaration of its own to read references from" + | Some fn -> + if nslots <> Array.length fn.Tast.slots then + skip + "the frame is running a body that has been redefined \ + since, so what this session holds is a different body's \ + reference set" + else if sig_ <> Emit.slot_fingerprint fn then + skip + "this frame's body was redefined since it was entered, so \ + what it refers to here is a claim about different code" + else begin + (* Once per frame per name: a body that reads the grid in + four places touches it once as far as this is + concerned. *) + let seen = Hashtbl.create 8 in + let note n = + if is_global n && not (Hashtbl.mem seen n) then begin + Hashtbl.add seen n (); + let prev = + try Hashtbl.find touched n with Not_found -> [] + in + Hashtbl.replace touched n (prev @ [ i ]) + end + in + List.iter (Reach.expr_refs note) fn.Tast.body; + List.iter (Reach.expr_refs note) fn.Tast.fdefers + end) + frames; + let skipped = List.rev !skipped in + let wanted = + (* Declaration order first, so a tie on the innermost frame breaks + the way the source reads. [stable_sort] then keeps it. *) + List.filter + (fun (g : Tast.global) -> Hashtbl.mem touched g.Tast.gname) + all + in + let innermost (g : Tast.global) = + List.fold_left min max_int (Hashtbl.find touched g.Tast.gname) + in + let ordered = + List.stable_sort + (fun a b -> compare (innermost a) (innermost b)) + wanted + in + let where (g : Tast.global) = + Wire.list + (List.map string_of_int + (List.sort_uniq compare (Hashtbl.find touched g.Tast.gname))) + in + let skipped_field = + ":skipped " + ^ Wire.list + (List.map + (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ]) + skipped) + in + if ordered = [] then + ok + [ ":globals ()"; ":refused ()"; skipped_field; + ":note " + ^ Wire.quote + "no frame on this stack references a global; there is \ + nothing here that is not already in the locals" ] + else begin + let c, refused = Session.render_globals t.session ~globals:ordered 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 "g%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 global, name and type and value, tab + separated — safe because every string the renderer emits + is escaped. The frames are added back here, from the + table above, because the thunk knows nothing about the + stack it was chosen for. *) + let by_name = Hashtbl.create 32 in + List.iter + (fun (g : Tast.global) -> + Hashtbl.replace by_name g.Tast.gname (where g)) + ordered; + 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; + (try Hashtbl.find by_name n + with Not_found -> Wire.list []) ]) + | _ -> None) + (String.split_on_char '\n' v) + in + ok + [ ":globals " ^ Wire.list entries; + ":refused " + ^ Wire.list + (List.map + (fun (n, why) -> + Wire.list [ Wire.quote n; Wire.quote why ]) + refused); + skipped_field ] + | 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 + end) + (* 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 @@ -1262,6 +1492,9 @@ let handle t req = | Some "backtrace" -> backtrace_op t | Some "locals" -> locals t ~frame:(match Wire.int_field req "frame" with Some n -> n | None -> 0) + (* No :frame, and that is the point: the section is the stack's, not a + frame's. See [globals_op]. *) + | Some "globals" -> globals_op t | Some "layout" -> (match Wire.string_field req "type" with | Some ty -> layout t ~ty diff --git a/lib/session.ml b/lib/session.ml index 90565b5..2658130 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -553,6 +553,90 @@ let render_locals ?(origin = "") t ~frame ~(fn : Tast.fn) ~bound ignore origin; ({ ir; names = []; fns = []; installs = true }, List.rev !refused) +(* ── The globals a stopped stack reaches ───────────────────────────── *) + +(* The other half of what a break loop can show, and in this language arguably + the more useful one: a game keeps most of its state in top-level [defvar]s, + and sand.flan holds its entire grid that way. + + Almost the same thunk as [render_locals] with a different root, and the + difference is the whole reason this is a second function rather than a + parameter. A local is reached by *address* — [flan/dev-slot] hands back + where the frame is, and only the stopped program knows that. A global is + reached by *name*: [Emit.redefinition] writes a global the host already has + as [external], so the loaded module binds to the program's own storage and + the dynamic linker does the work. Nothing has to be asked of the stopped + thread at all, which is also why there is no [bound] list here — a global's + storage exists from the moment the process started, so there is no + not-yet-bound case to refuse. + + [globals] is chosen by the caller and not here, because the choice is about + the *stack* and this function is about rendering. See [Dev.globals_op]. + + One line per global — name, type, value, tab separated — the same framing + [render_locals] uses, and safe for the same reason: every string the + renderer emits goes through [flan_dev_emit_str], which escapes both. *) +let render_globals ?(origin = "") t ~(globals : Tast.global list) + : change * (string * string) list = + let loc = Loc.unknown in + let extra = ref [] and nslots = ref 0 in + let c = + { Render.structs = t.program.Tast.structs; + 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 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 nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in + let refused = ref [] in + let one (g : Tast.global) = + let v = { Tast.e = Tast.Global g.Tast.gname; ty = g.Tast.gty; loc } in + match Render.render c 0 v with + | parts -> + Some + ((lit (g.Tast.gname ^ "\t" ^ Types.to_string g.Tast.gty ^ "\t") :: parts) + @ [ lit "\n" ]) + | exception Loc.Error (_, why) -> + (* A type the structural printer has no arm for. Named with its reason + rather than left out, for [render_locals]'s reason: a global that is + missing and a global that could not be printed are different facts, + and a list that showed neither would be the same lie twice. *) + refused := (g.Tast.gname, why) :: !refused; + None + in + let body = List.concat (List.filter_map one globals) in + t.thunks <- t.thunks + 1; + let name = Printf.sprintf "globals/%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: what is being shown is + the program's storage, which this thunk reaches by name. *) + 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/test/programs/dev-globals.flan b/test/programs/dev-globals.flan new file mode 100644 index 0000000..e4bfb97 --- /dev/null +++ b/test/programs/dev-globals.flan @@ -0,0 +1,39 @@ +;;;; A program that stops with state worth looking at *outside* the frame. +;;;; +;;;; dev-locals.flan is about what one frame holds. This is about what the +;;;; whole stopped stack is reading, which in this language is most of the +;;;; program: a game keeps its state in top-level defvars, and sand.flan holds +;;;; its entire grid that way. +;;;; +;;;; The globals are declared in an order the answer must *not* come back in. +;;;; [label] is written first and is touched only by [main], the outer frame, +;;;; so ordering by the innermost frame that touches it has to put it last; +;;;; [grid] and [pressure] are both innermost-touched and must keep the order +;;;; they are declared in. [untouched] is read by no frame on the stack and +;;;; must not appear at all — that is the whole claim of scoping the section to +;;;; the stack rather than listing everything the program has. +(import agent "vendor:agent") + +(defstruct Boom [why i32]) + +(defvar label string) +(defvar grid [4 i32]) +(defvar pressure i64) +(defvar untouched i64 99) + +;; The inner frame. It writes two globals and then errors with nothing +;; handling the condition, so the program stops here with [main] under it. +(defn inner [] i64 + (set pressure 12) + (set (at grid 0) 7) + (error (Boom {.why 3})) + 0) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-globals-fallback.sock") + (set label "running") + (set (at grid 1) 5) + (print (inner)) (println "") + (dotimes [i 4000] + (agent/wait 5)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index b708c94..6da70b6 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -884,6 +884,169 @@ let () = end end; + (* ── The globals a stopped stack reaches ───────────────────────── *) + + (* The other half of what a break loop can show. Locals are one frame's; + these are the program's, and the question is which of them to show: + all of a program's globals would bury the one that matters under the + prelude's PRNG state, and per-frame nesting would imply an ownership a + global does not have and repeat the name once per frame that reads it. + + So: one section, the union of what every frame on the stack references, + each entry saying which frames touch it, ordered by the innermost one + that does. [dev-globals.flan] is built so that all three of those + claims fail visibly if any of them is dropped. *) + let gsock = tmp "globals.sock" and gout = tmp "globals.out" in + (try Sys.remove gsock with Sys_error _ -> ()); + let gfd = Unix.openfile gout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let gpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-globals.flan"; "-s"; gsock |] + Unix.stdin gfd Unix.stderr + in + Unix.close gfd; + if not (await (fun () -> Sys.file_exists gsock)) then begin + fail "the globals daemon never listened"; + (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect gsock 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 globals program never stopped" + else begin + (* (name type value (frame ...)) — four fields, the fourth a list of + numbers, which is what makes the annotation readable against the + stack section's own numbering. *) + let rows r = + match Wire.field r "globals" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List [ { Form.v = Form.Str n; _ }; + { Form.v = Form.Str ty; _ }; + { Form.v = Form.Str v; _ }; + { Form.v = Form.List fs; _ } ] -> + Some + (n, ty, v, + List.filter_map + (fun (f : Form.t) -> + match f.Form.v with + | Form.Int i -> Some (Int64.to_int i) + | _ -> None) + fs) + | _ -> None) + l + | _ -> [] + in + let r = ask "(:op \"globals\")" in + if status r <> "ok" then + fail "globals: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")) + else begin + let want = + (* [grid] before [pressure] because that is the order they are + declared in and both are touched by frame 0; [label] last + because the innermost frame that touches it is 1, even though + it is declared before either. Ordering by proximity to the + error is what puts the likely culprit on top of a deep stack, + and declaring [label] first is how this notices that the sort + happened at all. + + [grid]'s two writes are the two frames: [main] set element 1 + before calling, [inner] set element 0 after. The value is read + out of the program's own storage, so both are in it. *) + [ ("grid", "[4 i32]", "[ 7 5 0 0]", [ 0; 1 ]); + ("pressure", "i64", "12", [ 0 ]); + ("label", "string", "\"running\"", [ 1 ]) ] + in + let got = rows r in + if got <> want then + fail "the globals of the stopped stack: %s" + (String.concat ", " + (List.map + (fun (n, ty, v, fs) -> + Printf.sprintf "%s %s = %s (%s)" n ty v + (String.concat " " (List.map string_of_int fs))) + got)); + (* And the one that must not be there. [untouched] is a global of + this program that no frame on this stack reads, and a section + that listed it would be the "all the globals" answer this op + exists instead of. The prelude's own globals are the same claim + at scale: [rand-state] is in the session too. *) + if List.exists (fun (n, _, _, _) -> n = "untouched") got then + fail "a global no frame on the stack references was listed anyway"; + if List.exists (fun (n, _, _, _) -> n = "rand-state") got then + fail "the prelude's globals were listed; the section is not scoped \ + to the stack" + end; + (* A frame whose body has been redefined since it was entered cannot + be attributed: what this session holds is a different body's + reference set. It is named in [:skipped] rather than dropped, + because "the union is incomplete and here is why" and "these are + all of them" are different answers. + + The redefinition binds a local, deliberately, because that is what + the detector can see. [Emit.slot_fingerprint] hashes a body's + *slots*, so a new body with the same slots and different global + references is not caught — the hole is stated in BUILT.md, and a + test that asserted otherwise would be asserting a mechanism that is + not there. *) + let r = + ask + "(:op \"eval\" :code \"(defn inner [] i64 (let [z (i64 1)] (set untouched z)) (error (Boom {.why 3})) 0)\" :file \"/tmp/buf.flan\")" + in + if status r <> "ok" then + fail "installing a new body while stopped: %s" + (Option.value ~default:"" (Wire.string_field r "message")) + else begin + let r = ask "(:op \"globals\")" in + if status r <> "ok" then + fail "globals after a redefinition: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")); + let skipped = + match Wire.field r "skipped" with + | Some { Form.v = Form.List l; _ } -> List.length l + | _ -> 0 + in + if skipped = 0 then + fail "the frame of a superseded body was attributed anyway"; + (* [main] is untouched by that redefinition and must still + contribute: a refusal that fired for every frame would pass the + check above and make the whole verb useless. *) + let got = rows r in + if not (List.exists (fun (n, _, _, _) -> n = "label") got) then + fail "redefining one function dropped an untouched frame's globals"; + (* And the new body's references must not have leaked in under the + old frame. [untouched] is what the installed body reads and the + frame on the stack does not. *) + if List.exists (fun (n, _, _, _) -> n = "untouched") got then + fail "a superseded frame contributed the *new* body's references" + end + end; + (* Nothing handled the condition, so there is no restart to resume by + and [abort] is the only way out. The daemon owns the program's + lifetime, so it comes down on its own. *) + ignore (ask "(:op \"abort\")"); + Unix.close c; + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] gpid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] gpid) with Unix.Unix_error _ -> ()) + end + end; + (* ── Disassembly ───────────────────────────────────────────────── *) (* A third daemon, over a program that keeps running, because the two