The globals a stopped stack reaches, in one section and not under a frame
A global is program state a frame happened to touch, not part of it, so nesting it under one implies an ownership that is not there and repeats the name once per frame that reads it. One section instead, holding the union of the globals every frame on the stack references — the compiler does the choosing, since Reach.expr_refs already answers a body's reference set, and listing every global a program has would bury the one that matters under the prelude's PRNG state. Each entry says which frames touch it, by the index the stack section already numbers them with, which recovers what per-frame nesting would have told you 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. Simpler than locals, because a global is reached by name rather than by address. Emit.redefinition writes a global the host has as external, so the thunk binds to the program's own storage and nothing is asked of the stopped thread — no dev-slot round trip and no not-yet-bound case to refuse. A frame that cannot be attributed contributes nothing and is named in :skipped; the union being incomplete and the union being complete are different answers. The hole in that is stated rather than papered over: slot_fingerprint hashes a body's slots, which is the right cut for locals and not for this, so a body that names different globals while binding the same locals is not caught. The test drives the case that is. MANUAL.md also loses a stale paragraph claiming the fingerprint check never fires with a failing test pinned to it. It fires, and test_dev covers it.
This commit is contained in:
parent
2179627593
commit
635d12782d
53
BUILT.md
53
BUILT.md
@ -1250,6 +1250,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
|
||||
|
||||
20
NEXT.md
20
NEXT.md
@ -317,21 +317,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
|
||||
|
||||
@ -427,11 +427,58 @@ rather than left blank:
|
||||
- a `Vec` or a pointer, which render as `<vec>` and `<ptr>` 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
|
||||
|
||||
|
||||
@ -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)))
|
||||
|
||||
|
||||
@ -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"
|
||||
|
||||
233
lib/dev.ml
233
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
|
||||
|
||||
@ -553,6 +553,90 @@ let render_locals ?(origin = "<locals>") 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 = "<globals>") 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 = "<eval>") t src : change =
|
||||
let form =
|
||||
match Reader.read_all ~file:origin src with
|
||||
|
||||
39
test/programs/dev-globals.flan
Normal file
39
test/programs/dev-globals.flan
Normal file
@ -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)
|
||||
163
test/test_dev.ml
163
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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user