diff --git a/FIX.org b/FIX.org index 3c704b7..6ad9039 100644 --- a/FIX.org +++ b/FIX.org @@ -4495,3 +4495,162 @@ two walks — the Ast rename and the Form-level one at load.ml:503 — learn to walk more than one bound. The Form walk matched Vec [n; count] exactly, so it had to grow; before this, a three-bound dotimes was a parse error long before that walk could see it, so nothing was ever miscompiled by it. +* 2026-09-21 — a restart that abandons the evaluation +The report, in the author's words: + + I got an error evaluating the insertion-sort, but it killed the whole flan + program, the "continue" restart didn't work, I kept pressing 0 and nothing + would happen, there's a design problem here, likely because it's running on + the same thread as the game loop? What's going on? It should just be able to + ignore that whole call + +The last sentence is the requirement, and it was the one thing the break loop +could not do. + +** What was actually wrong +Reproduced headless, both backends, on a running program: evaluate an +expression that indexes past the end, and the break it lands in offers + + restarts () + +or, over a program whose own loop holds a [restart-case], a single entry below +the thunk boundary and marked unreachable. Nothing takeable either way. A bad +index establishes no restart of its own — nothing a handler could do would make +index 9 valid for a length-4 array — and the program's own [continue] is below +[flan_reload_call], which holds its own transfer channel and drops it on +return, so a transfer to it has nowhere to land. Which left [abort], and abort +is [_exit(134)]: in a merged [flan dev] that is the compiler, the session and +the game, over a mistyped index. + +So the floors were right and the list they produced was empty. Everything the +agent knew how to say about that break was a refusal. + +** Not the threading, and the question deserves a straight answer +The thunk does run on the game thread. That is the design and not an accident: +the break loop *is* the poll loop, which is the only reason C-x C-e works at +the moment anyone wants it to, and [restart_floor] is documented game-thread- +only for it. But it is not the cause. A thunk on a thread of its own would have +had exactly the same empty list and exactly the same [abort]. What was missing +was a restart, not a thread. + +** The decision +The agent establishes one restart of its own around every evaluation: + + 0. restart: abandon-evaluation (stop running the expression; the program + carries on) + +It is a real frame on the real restart list, pushed by [flan_agent_poll] +immediately after the floor is read — which is what puts it *above* the floor +and makes it reachable, where pushing it first would have marked it as the +program's and refused it. Taking it aims the transfer at that frame; nothing +compares against it, so the unwind runs to the top of the thunk, +[flan_reload_call] drops the channel it holds, and the poll returns to whatever +called it. That is the same path a below-the-floor restart used to take by +accident. The difference is that this one is what was asked for, and is +reported as what happened. + +The frames live in flan_rt.c ([flan_restart_push_c]/[flan_restart_pop_c]), +because the struct is declared there and two files each declaring it is how the +two stop agreeing. A fixed array of sixteen, not malloc: this is pushed on the +game thread at a frame boundary. + +No codegen. Both backends unwind by the same convention, and both were driven +end to end. + +** What it does not promise +Abandoning drops the expression. It does not undo it. The thunk ran until it +signalled, and every global it set and every byte it allocated on the way is +still set and still allocated. Said in the agent's line, in the daemon's reply +note, in the break buffer's row and in MANUAL.md, because an editor that said +only "abandoned" would let someone believe the program is where it was before +they pressed C-x C-e. + +** The other half: "I kept pressing 0 and nothing would happen" +A choice a reader makes has to do something or say why it cannot. + +[:unreachable] was already on the wire and the break buffer was not reading it: +it drew every restart as an ordinary takeable row, and a digit on one sent it +to the daemon to be refused. The row now loses its bracket, carries the reason +beside it, and is refused *here*, out loud, with the sentence the daemon would +have given. [:abandon] is new beside it — the position that abandons, [nil] +when the break is not inside an evaluation — and it is a position rather than a +name on purpose: a program is free to establish a restart called +[abandon-evaluation] of its own, and matching on the name would offer the +program's restart as the way out of an evaluation. The agent identifies it by +frame address; the wire carries it as a third value of the flag [restarts] +already had, [*] beside [+] and [-]. + +Point in the break buffer starts on that row, and [C-c C-M-b]'s prompt takes it +as the default. The list is not reordered — the number beside a restart is the +program's own index, and moving rows would make the numbers lie. [abort] stays +last and stays not-the-default. + +** What still cannot be abandoned, and correctly +A trap has no transfer channel at all — [rt_trap] calls the hook with nothing +to write a frame into — so at a trap every restart is refused, the boundary's +included, and [:abandon] is [nil]. There is nothing to unwind through. The +break is still a place to stand and read; fix and reload is the way out. That +is the one case where "it should just ignore that whole call" cannot hold. + +** Open: nothing counts abandonments +An earlier draft had the agent count them and a [abandoned] verb to read the +count, so a daemon waiting on a value could end its wait. It is not needed: the +wait already ends the moment the thunk breaks (see "an evaluated expression +that signals says so at once" above), +and the restart's own reply says what taking it did. A third telling read by +nobody is how a wire grows a verb whose answer drifts from what happened. + +** Review follow-ups +Five things the review found, and one it asked me to judge rather than take. + +*Two refusals, not one.* At a trap nothing on the list can be taken — the +break has no transfer channel at all — and the daemon was folding that into +the same [:unreachable] it uses for "below the evaluation this break is +inside". The break buffer then captioned a segfault's restarts with a sentence +about an evaluation that was not there, and offered no way out of one. The +terminal listing had always said the two apart; the wire had not, which is +exactly the divergence the [restarts] comment says must never happen. + +The trap now rides on the break reply as [:trap], and both the caption and the +refusal branch on it. It is a bare [!] line ahead of the entries rather than a +fourth flag value, because it is a fact about the *break*: a trap with an empty +restart list — dev-trap-null-alloc is one — has no entry to carry a flag, and +that is the case that has to be able to say so. It is *not* inferred from +[:abandon] being nil: a break the program took on its own has a nil there too, +and so does a truncated list. + +*The escape hatch survives truncation.* [snap_push] walks innermost first and +stops at SNAP_MAX or SNAP_NAMES, so the outermost entries are what truncation +drops — and the boundary is the outermost entry of an evaluation, which made it +the first casualty. A thunk establishing 64 restarts of its own reproduced the +original bug exactly. One slot and one name's worth of bytes are now kept back +and the boundary is placed in them when the walk does not reach it. The cost is +one listed restart out of sixty-four while an evaluation is in progress. + +*[flan_break_resume] is gone.* Nothing has called it since the break loop +started choosing by position instead of by name; NEXT.md already said there was +no such function. Two ways to resolve a restart that can only ever disagree is +one too many. + +*[eval_boundary] is cleared between runs.* [flan_agent_run_reset], called +beside [flan_condition_stacks_reset] and [flan_dev_frames_reset] from the park. +Harmless today — a program's restart frames are allocas and can never compare +equal to a stale one — and the floors go with it, because emptying two thirds +of the same state is stranger than emptying none. + +*Nested boundaries are tested rather than reasoned about.* Two evaluations, the +second run from inside the first one's break, on one list: six restarts, the +inner boundary at 2 and takeable, the outer one at 5 with the frames it belongs +to below the floor. Abandoning the inner leaves the outer with its three +restarts and its own boundary still on offer. That is the claim the save-and- +restore around [j.call] exists for. + +*The round trip, judged and removed.* [choose_at] and [choose] each asked +[restarts] before sending, only to word their note — doubling the traffic of +the verb somebody is actually waiting on, to learn something the other end had +in front of it. The agent now answers [ok abandon] for the boundary and [ok] +otherwise. It could not simply be read off the [break] reply the client had: +the daemon words the note and the daemon had not seen that reply. Saying it on +the acceptance also closes the window — after a take the stopped thread +resumes and the snapshot it was resolved against is popped, so there is nothing +left to ask. diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index a793866..e7c686e 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -360,6 +360,23 @@ and cannot be reached by name. The numbers are how you reach it. Restarts that genuinely cannot be taken are shown and refused with a reason rather than silently omitted. +**When the break came from a `C-x C-e`.** If the expression you evaluated is +what stopped, the list carries one more restart than the program established: +`abandon-evaluation`. Taking it drops the expression and returns the program to +where it was called from, still running. Point starts on it, because after an +evaluation goes wrong that is usually the answer — and because the alternative +used to be `abort`, which ends the session over a mistyped index. + +It abandons, it does not undo. The expression ran until it stopped, and every +global it set and every byte it allocated on the way is still set and still +allocated. + +The program's own restarts are still on the list below it, marked and refused: +a transfer to a frame below the evaluation has nowhere to land. They become +takeable only when the program itself was already stopped — abandon the +evaluation and the program's own break comes back with them on offer. If the +program was running, abandon and call the code again. + **`C-c C-M-b`** is the same choice as a quick one-key prompt, when you already know which restart you want and do not need the buffer. diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 51e6b76..72b3dbc 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -104,22 +104,41 @@ from fixtures, and so `flan.el' is named in one place.") ;;; Restarts, and which of them can actually be chosen -(defun flan-cnr-annotate-restarts (names) +(defun flan-cnr-annotate-restarts (names &optional unreachable abandon trap) "Turn NAMES — innermost first — into what the buffer draws. -Each entry is (INDEX NAME SHADOWED-BY), where SHADOWED-BY is the index of the -earlier entry that owns the name, or nil. +Each entry is (INDEX NAME SHADOWED-BY KIND), where SHADOWED-BY is the index of +the earlier entry that owns the name, or nil, and KIND is one of nil, +`unreachable', `trapped' or `abandon'. -This is §4's walk, computed here because it can be: `restart NAME' resolves -through `flan_find_restart', which returns the first frame whose hash matches, -so a name's second appearance is unreachable through the only verb there is. -Nothing new has to be asked of the program to know that — the order of the -list already says it." +Shadowing is §4's walk, computed here because it can be: `restart NAME' +resolves through `flan_find_restart', which returns the first frame whose hash +matches, so a name's second appearance is unreachable through the only verb +there is. Nothing new has to be asked of the program to know that — the order +of the list already says it. + +The rest come off the reply, because nothing here can work them out. +UNREACHABLE is the positions the program will refuse. ABANDON is the position +that drops the evaluation, and it is a position rather than a name on purpose — +a program may establish a restart called `abandon-evaluation' of its own, and +only the agent knows which frame is really the boundary. + +TRAP says *why* they are refused, which is a different question from which they +are. A break taken by a trap — a segfault, a null allocator — has no transfer +channel at all: every restart on it is refused, the boundary included, and +there is no evaluation to abandon your way out of. Captioning those rows +\"below this evaluation\" would send someone looking for an evaluation that is +not there, so the two refusals are drawn apart. It cannot be inferred from +ABANDON being nil: a break the program took on its own has a nil there too, and +so does a list long enough to have been truncated." (let ((seen nil) (i -1)) (mapcar (lambda (name) (setq i (1+ i)) (let ((owner (cdr (assoc name seen)))) (unless owner (push (cons name i) seen)) - (list i name owner))) + (list i name owner + (cond (trap 'trapped) + ((eql i abandon) 'abandon) + ((memq i unreachable) 'unreachable))))) names))) ;;; Drawing @@ -267,7 +286,10 @@ indexing or the division itself, so it sits directly under the headline." (defun flan-cnr--insert-restarts (state) (flan-cnr--section "Restarts (innermost first) — RET or a digit takes one:") (let* ((names (plist-get state :restarts)) - (rows (flan-cnr-annotate-restarts names))) + (rows (flan-cnr-annotate-restarts names + (plist-get state :unreachable) + (plist-get state :abandon) + (plist-get state :trap)))) (if (null rows) (insert (propertize " none are active. Nothing between the error and the top offered one; abort, or fix a body and reload\n" @@ -275,26 +297,58 @@ indexing or the division itself, so it sits directly under the headline." (let ((w (apply #'max 4 (mapcar (lambda (r) (length (nth 1 r))) rows)))) (dolist (r rows) (let* ((i (nth 0 r)) (name (nth 1 r)) (owner (nth 2 r)) + (kind (nth 3 r)) (start (point))) ;; SBCL's bracket: it is there when the name reaches this frame and ;; gone when it does not. A shadowed entry is still takeable — the ;; choice goes out by number, not by name — so the missing bracket ;; says only that typing the name at a prompt would reach the - ;; inner one. + ;; inner one. A row the program will refuse loses the bracket for + ;; a different reason, and says which in its own words. (insert (format " %2d: %s%s%s " i - (if owner " " "[") + (if (or owner (memq kind '(unreachable trapped))) + " " "[") (propertize name 'face - (if owner 'shadow 'font-lock-keyword-face)) - (if owner " " "]"))) + (cond ((memq kind '(unreachable trapped)) + 'shadow) + ((eq kind 'abandon) 'warning) + (owner 'shadow) + (t 'font-lock-keyword-face))) + (if (or owner (memq kind '(unreachable trapped))) + " " "]"))) (insert (make-string (- w (length name)) ?\s)) - (when owner + (cond + ;; What the reader wants nine times in ten after a C-x C-e went + ;; wrong, so it says what it does *and* what it does not: nothing + ;; here can undo the part of the expression that already ran. + ((eq kind 'abandon) + (insert (propertize + "stop running this expression and carry on; what it already changed stays changed" + 'face 'font-lock-comment-face))) + ;; Shown rather than hidden, because "where did my restart go" is + ;; a fair question — and taking it says why instead of nothing, + ;; which is how this went wrong the first time. + ((eq kind 'unreachable) + (insert (propertize + "below this evaluation; a transfer to it has nowhere to land" + 'face 'shadow))) + ;; The other refusal, and it is not the same one. A trap has no + ;; transfer channel anywhere in the call, so nothing on this list + ;; can be taken — there is no evaluation to be below, and none to + ;; abandon. Fixing the body and reloading is the way out. + ((eq kind 'trapped) + (insert (propertize + "the trap has no transfer channel; nothing here can be resumed into" + 'face 'shadow))) + (owner (insert (propertize (format "same name as %d; taken by its number" owner) - 'face 'shadow))) + 'face 'shadow)))) (insert "\n") (add-text-properties start (point) (list 'flan-cnr-restart name 'flan-cnr-shadowed owner + 'flan-cnr-kind kind 'flan-cnr-index i 'mouse-face 'highlight)))))) ;; Last, and on the same list, because it is the same decision: what you @@ -441,7 +495,19 @@ puts the likely culprit on top." (insert (propertize "RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n" 'face 'shadow)) - (goto-char (point-min)))) + (goto-char (point-min)) + ;; Point starts on the restart that abandons the evaluation, when there is + ;; one. Not a reordering of the list — the number beside a restart is the + ;; program's index and moving rows would make the numbers lie — but this is + ;; what a reader wants nine times in ten after a C-x C-e went wrong, and + ;; RET should land on it rather than on the top of the buffer. + (when (plist-get state :abandon) + (let ((found nil)) + (while (and (not found) (not (eobp))) + (if (eq (get-text-property (point) 'flan-cnr-kind) 'abandon) + (setq found t) + (forward-line 1))) + (unless found (goto-char (point-min))))))) ;;; Commands @@ -450,6 +516,22 @@ puts the likely culprit on top." (interactive) (cond ((get-text-property (point) 'flan-cnr-abort) (flan-cnr-abort)) + ;; Refused here, with the reason, rather than sent and refused there. Both + ;; answers are the same sentence; this one arrives without a round trip, and + ;; either way something is *said* — a choice that quietly does nothing is + ;; the defect this whole line exists to close. + ;; + ;; Two refusals, because there are two reasons and the wrong one is worse + ;; than none: a segfault's break is not inside an evaluation, and telling + ;; someone to abandon one sends them looking for something that is not + ;; there. + ((eq (get-text-property (point) 'flan-cnr-kind) 'trapped) + (user-error + "flan: this break was taken by a trap with no transfer channel, so no restart can be taken from it. Read the frame, then fix a body and reload, or abort")) + ((eq (get-text-property (point) 'flan-cnr-kind) 'unreachable) + (user-error + "flan: restart %d is below the evaluation this break is inside, so a transfer to it has nowhere to land. Take one offered above it, or abandon the evaluation" + (get-text-property (point) 'flan-cnr-index))) ((get-text-property (point) 'flan-cnr-restart) (flan-cnr--invoke (get-text-property (point) 'flan-cnr-index) (get-text-property (point) 'flan-cnr-restart))) @@ -641,6 +723,17 @@ Takes the layout rather than fetching it, so this stays a function from data to data and the fixture-driven tests can drive it without a socket." (list :condition (plist-get reply :condition) :restarts (plist-get reply :restarts) + ;; The two facts about that list nothing here could work out. A + ;; position is on `:unreachable' when the program will refuse it, and + ;; `:abandon' is the position that drops the evaluation this break is + ;; inside — nil when it is not inside one, which is a break the program + ;; took on its own. + :unreachable (plist-get reply :unreachable) + :abandon (plist-get reply :abandon) + ;; And why they are refused, which `:abandon' being nil cannot say: a + ;; trap refuses every one of them, an evaluation that is not there + ;; refuses none. + :trap (plist-get reply :trap) ;; Where the expression that trapped is written, and that line's text. ;; `break' carries both when the stop has a site; a user (error ...) ;; has none, and then the headline simply has no line to point at. diff --git a/emacs/flan.el b/emacs/flan.el index 121ee36..f36fd6c 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -1121,17 +1121,30 @@ the state with something to answer in it." ;; same decision: it is what you pick when none of the restarts is the answer. ;; It is last, and it is not the default. -(defun flan--restart-candidates (restarts unreachable) +(defun flan--restart-candidates (restarts unreachable &optional abandon trap) "Label each of RESTARTS by its position, marking those in UNREACHABLE. +ABANDON is the position that drops the evaluation this break is inside, and +nil when it is not inside one; it is marked too, because what it does is not +what any other entry on the list does. + +TRAP says why the refused ones are refused. A break taken by a trap has no +transfer channel, so every entry is refused and none of them is below an +evaluation — the break-buffer's rows draw the same distinction, and the two +must not describe different programs. + An alist of label to index. The index leads the label because it is the identity: two entries may read the same and mean different frames." (let ((i -1)) (mapcar (lambda (name) (setq i (1+ i)) (cons (format "%d. %s%s" i name - (if (memq i unreachable) - " (below this break; cannot be taken)" - "")) + (cond + (trap " (cannot be taken from this trap)") + ((eql i abandon) + " (stop running this expression; the program carries on)") + ((memq i unreachable) + " (below this break; cannot be taken)") + (t ""))) i)) restarts))) @@ -1236,12 +1249,19 @@ than being told so." (user-error "flan: the program is running; nothing is stopped")) (let* ((restarts (plist-get r :restarts)) (unreachable (append (plist-get r :unreachable) nil)) - (table (flan--restart-candidates restarts unreachable)) + (abandon (plist-get r :abandon)) + (trap (plist-get r :trap)) + (table (flan--restart-candidates restarts unreachable abandon trap)) + ;; The default, when the break is inside an evaluation. RET on an + ;; empty prompt is the answer nine times in ten after a C-x C-e went + ;; wrong: drop the expression, keep the program. `abort' is still + ;; last and still not the default — it ends the session. + (default (and abandon (car (rassq abandon table)))) (choice (completing-read (format "flan: stopped on %s%s — " flan--stopped (if restarts "" " (no restarts are active)")) - (append (mapcar #'car table) '("abort")) nil t)) + (append (mapcar #'car table) '("abort")) nil t nil nil default)) (index (cdr (assoc choice table)))) (cond ((equal choice "abort") (flan-abort)) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 9808867..bf9717f 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -951,6 +951,35 @@ would be overwritten. Look again and re-do the edit") (test-flan--check "no restarts is a list of no rows" (null (flan-cnr-annotate-restarts nil))) +;; The other two facts about a row, which nothing here can work out and both +;; come off the reply. +(let ((rows (flan-cnr-annotate-restarts + '("retry" "abandon-evaluation" "continue") '(2) 1))) + (test-flan--check "the position the reply named is the one that abandons" + (eq (nth 3 (nth 1 rows)) 'abandon)) + (test-flan--check "a position the program will refuse is marked unreachable" + (eq (nth 3 (nth 2 rows)) 'unreachable)) + (test-flan--check "and an ordinary restart is neither" + (null (nth 3 (nth 0 rows))))) + +;; At a trap the reason is a different reason, and it is the break's rather +;; than any entry's: there is no transfer channel, so nothing can be taken and +;; there is no evaluation to be below. +(let ((rows (flan-cnr-annotate-restarts '("continue" "abandon-evaluation") + '(0 1) nil t))) + (test-flan--check "a trap marks every row with the trap's own reason" + (equal (mapcar (lambda (r) (nth 3 r)) rows) + '(trapped trapped))) + (test-flan--check "and the boundary is not exempt from it" + (eq (nth 3 (nth 1 rows)) 'trapped))) + +;; By position, never by name. A program may establish a restart called +;; `abandon-evaluation' of its own, and offering that as the way out of an +;; evaluation would promise an unwind nobody can make. +(let ((rows (flan-cnr-annotate-restarts '("abandon-evaluation") nil nil))) + (test-flan--check "a program's own restart of that name is not the boundary" + (null (nth 3 (nth 0 rows))))) + ;;; The break buffer @@ -1056,6 +1085,102 @@ would be overwritten. Look again and re-do the edit") (test-flan--check "and the number past the last is abort" (equal sent '(:op "abort")))))) +;; A break inside an evaluation: one restart drops the expression, one belongs +;; to the program below and cannot be taken. Both are drawn, and each says +;; which it is — a row that cannot be taken is shown rather than hidden, +;; because "where did my restart go" is a fair question. +(let ((text (with-current-buffer + (test-flan--cnr + (list :condition "BoundsError" + :restarts '("abandon-evaluation" "continue") + :unreachable '(1) + :abandon 0)) + (buffer-string)))) + (test-flan--check "the way out of an evaluation says what it does" + (string-match-p "0: \\[abandon-evaluation\\] *stop running this expression" + text)) + (test-flan--check "and says what it does not undo" + (string-match-p "already changed stays changed" text)) + (test-flan--check "a restart below the evaluation loses its bracket" + (string-match-p " 1: continue " text)) + (test-flan--check "and says why it cannot be taken" + (string-match-p "nowhere to land" text)) + (test-flan--check "abort is still last, and still one past the restarts" + (string-match-p " 2: \\[abort\\]" text))) + +;; Point starts on it, because after a C-x C-e that went wrong this is the +;; answer nine times in ten. The list itself is not reordered: the number +;; beside a restart is the program's own index. +(let ((sent nil)) + (let ((flan-cnr-request-function + (lambda (form) (setq sent form) (list :status "ok" :note "accepted")))) + (with-current-buffer (test-flan--cnr + (list :condition "BoundsError" + :restarts '("retry" "abandon-evaluation") + :abandon 1)) + (save-window-excursion (flan-cnr-take)) + (test-flan--check "RET with point where it was left abandons the evaluation" + (equal sent + '(:op "restart-at" :index 1 + :name "abandon-evaluation")))))) + +;; And the half of the report that was a silence: a choice that cannot be +;; taken has to *say* so. Refused here rather than sent and refused there, +;; with the same sentence either way. +(let ((sent nil)) + (let ((flan-cnr-request-function + (lambda (form) (setq sent form) (list :status "ok" :note "accepted")))) + (with-current-buffer (test-flan--cnr + (list :condition "BoundsError" + :restarts '("abandon-evaluation" "continue") + :unreachable '(1) + :abandon 0)) + ;; `let*': the digit is read out of `last-command-event' by the command + ;; itself, so it has to be bound before the thunk runs and not beside it. + (let* ((last-command-event ?1) + (msg (test-flan--caught + (lambda () + (call-interactively #'flan-cnr-take-number))))) + (test-flan--check "a digit on an unreachable restart is refused out loud" + (and msg (string-match-p "nowhere to land" msg))) + (test-flan--check "and nothing was sent for it" + (null sent)))))) + +;; And the same break drawn at a trap: every row refused, and refused for the +;; trap's reason. The wrong reason here is the one a user meets first in the +;; segfault break — "below this evaluation" about a break that is not inside +;; one, with nothing offered to abandon. +(let ((text (with-current-buffer + (test-flan--cnr + (list :condition "SIGSEGV" + :restarts '("continue") + :unreachable '(0) + :abandon nil + :trap t)) + (buffer-string)))) + (test-flan--check "a trap's rows say the trap has no transfer channel" + (string-match-p "no transfer channel" text)) + (test-flan--check "and say nothing about an evaluation that is not there" + (not (string-match-p "below this evaluation" text)))) + +(let ((sent nil)) + (let ((flan-cnr-request-function + (lambda (form) (setq sent form) (list :status "ok" :note "accepted")))) + (with-current-buffer (test-flan--cnr + (list :condition "SIGSEGV" + :restarts '("continue") + :unreachable '(0) + :trap t)) + (let* ((last-command-event ?0) + (msg (test-flan--caught + (lambda () + (call-interactively #'flan-cnr-take-number))))) + (test-flan--check "a digit at a trap is refused with the trap's reason" + (and msg (string-match-p "no transfer channel" msg))) + (test-flan--check "and not with the evaluation's" + (and msg (not (string-match-p "abandon" msg)))) + (test-flan--check "nothing was sent for it either" (null sent)))))) + ;; The stack and its locals. The fixture is the shape `backtrace' and `locals' ;; answer with, and both frames carry `:fetched t' because their locals are ;; already here: without it `flan-cnr-toggle-frame' goes and asks the daemon diff --git a/emacs/test-flan.el b/emacs/test-flan.el index e925d8a..e269e96 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -995,6 +995,27 @@ already rely on it — so nothing here is a stand-in for the real thing." (and (not (string-match-p "cannot be taken" (caar table))) (string-match-p "cannot be taken" (car (nth 1 table))) (equal (cdr (nth 1 table)) 1)))) + ;; The one entry that is neither "resume this" nor "kill the program", and + ;; it is marked by its position: a program may establish a restart called + ;; `abandon-evaluation' of its own, and only the agent knows which frame is + ;; really the boundary. + (test-flan--check "the way out of an evaluation says what taking it does" + (let ((table (flan--restart-candidates + '("abandon-evaluation" "continue") '(1) 0))) + (and (string-match-p "stop running this expression" + (caar table)) + (string-match-p "cannot be taken" (car (nth 1 table)))))) + (test-flan--check "at a trap the prompt says the trap, not the evaluation" + (let ((table (flan--restart-candidates + '("continue") '(0) nil t))) + (and (string-match-p "from this trap" (caar table)) + (not (string-match-p "below this break" + (caar table)))))) + (test-flan--check "and a restart of that name that is not the boundary is not marked" + (not (string-match-p + "stop running" + (caar (flan--restart-candidates + '("abandon-evaluation") nil nil))))) ;; The payoff. The break loop *is* the poll loop, so an expression sent now ;; runs on the stopped thread and comes back — which is the one moment diff --git a/lib/dev.ml b/lib/dev.ml index ac7a9e9..ab8f649 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -354,10 +354,36 @@ let state t = is passed on rather than turned into an empty list: no restarts and cannot say are different answers. - Each line is [I ± NAME]: the index it is taken by, whether it can be taken, - and the name. The index is the identity — two frames may offer [retry] and - a name cannot say which — and it is the program's number, not this end's - position in a list, so it is carried rather than recomputed. *) + Each line is [I F NAME]: the index it is taken by, a flag, and the name. The + index is the identity — two frames may offer [retry] and a name cannot say + which — and it is the program's number, not this end's position in a list, + so it is carried rather than recomputed. + + The flag has three values. [+] is an ordinary restart that can be taken; + [-] is one that cannot, because it is below the evaluation this break is + inside or because the break has no transfer channel at all. [*] is the + boundary restart the agent establishes around an evaluation: takeable like + a [+], and taking it abandons the expression. It is carried apart from the + name because the name is not proof — a program may establish a restart + called [abandon-evaluation] of its own, and only the agent knows which + frame is really the boundary. + + A line that is a bare [!] before the entries says the break was taken by a + trap, and that is a fact about the break rather than about any entry: at a + trap nothing can be taken, the boundary included, and a trap with an empty + restart list still has to be able to say so. Which is why it is not folded + into the flag — there would be no row to put it on. The two refusals are + kept apart because an editor shows the *reason*, and "below this + evaluation" in front of somebody looking at a segfault sends them hunting + for an evaluation that is not there. *) +type restart_flag = + | Takeable (* [+] *) + | Boundary (* [*] takeable, and it abandons *) + | Below (* [-] nothing for a transfer to land in *) + +let takeable = function Takeable | Boundary -> true | Below -> false + +(* The rows, and whether the break they came from was taken by a trap. *) let restarts t = match ask t "restarts" with | text -> @@ -365,6 +391,8 @@ let restarts t = if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines then Error (String.trim text) else begin + let trimmed = List.map String.trim lines in + let trap = List.mem "!" trimmed in let parse line = match String.index_opt line ' ' with | None -> None @@ -377,14 +405,20 @@ let restarts t = else Some ( idx, - rest.[0] = '+', + (* An unknown character is read as [Below] rather than as + takeable: a flag this end does not recognise is a program + newer than the daemon, and refusing a restart that could + have been taken is the survivable half of that. *) + (match rest.[0] with + | '+' -> Takeable + | '*' -> Boundary + | _ -> Below), String.sub rest 2 (String.length rest - 2) )) in Ok - (List.filter_map parse - (List.filter - (fun l -> l <> "" && l <> ".") - (List.map String.trim lines))) + ( List.filter_map parse + (List.filter (fun l -> l <> "" && l <> "." && l <> "!") trimmed), + trap ) end | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) @@ -1580,7 +1614,7 @@ let break t = | Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m) | Stopped _ -> (match restarts t with - | Ok rs -> + | Ok (rs, trap) -> (* [:restarts] stays a list of names, positional and innermost first, with duplicates kept — the position *is* the index, which is what [restart-at] takes. [:unreachable] names the positions that are on @@ -1593,8 +1627,30 @@ let break t = ":unreachable " ^ Wire.ints (List.filter_map - (fun (i, ok, _) -> if ok then None else Some i) - rs) ] + (fun (i, f, _) -> if takeable f then None else Some i) + rs); + (* Which position abandons the evaluation this break is inside, + and [nil] when it is not inside one. A position and not the + name, for the reason the agent identifies it by address: a + program is free to establish a restart called + [abandon-evaluation] of its own, and a client that matched on + the name would offer the program's restart as the way out of + an evaluation. *) + ":abandon " + ^ (match List.find_opt (fun (_, f, _) -> f = Boundary) rs with + | Some (i, _, _) -> string_of_int i + | None -> "nil"); + (* Why those positions are refused, which is not the same + question as which they are. A break taken by a trap has no + transfer channel at all: every restart on it is refused, the + boundary included, so [:abandon] is nil here for a reason that + has nothing to do with there being no evaluation. A client + that inferred the reason from [:abandon] being nil would + caption a segfault with a sentence about an evaluation, and + there are two other ways to get a nil there — a break the + program took on its own, and a list so long it was + truncated. *) + ":trap " ^ (if trap then "t" else "nil") ] @ site_fields t) | Error m -> error ("the program refused to list its restarts: " ^ m)) @@ -2868,6 +2924,35 @@ let globals_op t = stopped thread next comes round its loop, which is microseconds away and still not now. An editor that read [ok] as "running again" would poll once, find it stopped, and re-open the prompt it had just answered. *) +(* The two sentences a taken restart can come back with, and which one this + take earns. + + Taking the boundary restart does not resume anything — it drops the + expression and puts the program back where it was called from — so the + ordinary note would be false in both halves. + + Which of the two it was comes back *on the acceptance*: the agent answers + [ok abandon] for the boundary and [ok] for everything else. An earlier draft + asked [restarts] first and matched the index, which doubled the traffic of + the one verb somebody is sitting there waiting on, to learn a fact the other + end already had in front of it. A client that had to be told which entry + abandons — it is [:abandon] on the break reply — was never the problem; this + end was. *) +let taken_note ~abandoned = + Wire.quote + (if abandoned then + "accepted; the evaluation is abandoned. The program carries on from \ + where it was called, and anything the expression changed before it \ + stopped is still changed" + else "accepted; the program resumes at its next pass of the break loop") + +(* [ok] or [ok abandon], and anything else is not an acceptance. *) +let accepted reply = + match String.trim reply with + | "ok" -> Some false + | "ok abandon" -> Some true + | _ -> None + let choose_at t ~index ~name = match liveness t with | Gone -> error gone @@ -2893,13 +2978,11 @@ let choose_at t ~index ~name = ^ match name with Some n -> " " ^ n | None -> "" in match ask t verb with - | reply when String.trim reply = "ok" -> + | reply when accepted reply <> None -> ok [ ":index " ^ string_of_int index; ":note " - ^ Wire.quote - "accepted; the program resumes at its next pass of the break loop" - ] + ^ taken_note ~abandoned:(accepted reply = Some true) ] | reply -> error (String.trim reply) | exception Unix.Unix_error (e, _, _) -> error ("cannot reach the program: " ^ Unix.error_message e) @@ -2920,12 +3003,14 @@ let choose t ~name = speak to it. *) error "a restart name cannot contain a control character" else + (* [restart NAME] is defined as [restart-at] on the first index offering + the name, and it reports the same two acceptances for the same reason: + two verbs that resolve to one frame must not describe it differently. *) match ask t ("restart " ^ name) with - | reply when String.trim reply = "ok" -> + | reply when accepted reply <> None -> ok [ ":restart " ^ Wire.quote name; - ":note " - ^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ] + ":note " ^ taken_note ~abandoned:(accepted reply = Some true) ] | reply -> error (String.trim reply) | exception Unix.Unix_error (e, _, _) -> error ("cannot reach the program: " ^ Unix.error_message e) @@ -4184,6 +4269,12 @@ extern void (*flan_exit_hook)(int32_t status); extern void flan_condition_stacks_reset(void); extern void flan_dev_frames_reset(void) __attribute__((weak)); +/* And the agent's own two floors and the boundary between them, which name + * counts and an address from a thunk the finished run was in the middle of. + * Weak because the agent is a package a program chooses to import, where the + * two above are linked into every dev build. */ +extern void flan_agent_run_reset(void) __attribute__((weak)); + /* And the collector's roots, which are the third stack threaded through stack * the finished run no longer owns. main is re-entered by longjmp, which pops * no frame, so every root the last run pushed still names an address the next @@ -4349,6 +4440,7 @@ static void flan_merged_exit(int32_t status) { static void flan_merged_park(void) { flan_condition_stacks_reset(); if (flan_dev_frames_reset) flan_dev_frames_reset(); + if (flan_agent_run_reset) flan_agent_run_reset(); if (flan_dyn_root_reset) flan_dyn_root_reset(); pthread_mutex_lock(&program_lock); program_state = PROGRAM_PARKED; diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 62cb370..0e8a99d 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -88,6 +88,13 @@ typedef struct flan_restart { static flan_restart *restarts; +/* The frames a C caller pushes; see [flan_restart_push_c] below, which is + * where the argument for them is. Declared up here with the stack they go on, + * because [flan_condition_stacks_reset] empties all three together. */ +#define C_RESTARTS 16 +static flan_restart c_restarts[C_RESTARTS]; +static int32_t c_restart_depth; + void flan_restart_push(flan_restart *r) { r->prev = restarts; restarts = r; @@ -241,6 +248,11 @@ void flan_exit(int32_t status) { void flan_condition_stacks_reset(void) { handlers = NULL; restarts = NULL; + /* The C-pushed frames below go with them. Their storage is static rather + than stack, so a second run would not scribble over it — but a depth left + where the first run stopped is a leak of the only thing that is finite + here, and a re-run that starts sixteen deep offers no restart at all. */ + c_restart_depth = 0; } /* The conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it. @@ -631,6 +643,61 @@ static uint32_t flan_name_id(const uint8_t *s, int64_t n) { return h; } +/* -- A restart frame pushed from C ----------------------------------- */ + +/* Every restart above is an alloca in the Flan function that established it. + * This is the one that is not: the agent runs an evaluated expression through + * a C frame of its own, and it wants a restart *at that frame* — one whose + * transfer unwinds the evaluation and leaves the program where it was called + * from. There is no Flan function there to hold the alloca, so the frames live + * here, where the struct does. Two files each declaring the shape is how the + * two stop agreeing, and the agent must not be the second one. + * + * A fixed array rather than malloc: this is pushed on the game thread at a + * frame boundary, and an allocation there is the thing the dev runtime exists + * to keep out. Sixteen is deeper than the break loop's own nesting limit, so + * running out means the nesting guard has already fired. + * + * [name] is not copied. Every caller passes a string constant that outlives + * the program, which is the same promise a Flan restart-case makes about the + * name it points at. + * + * NULL when there is no room, and then the caller simply has no restart to + * offer — an evaluation that cannot be abandoned is worse than one that can, + * and better than a scribble past the end of this array. */ +void *flan_restart_push_c(const uint8_t *name, int64_t namelen) { + if (c_restart_depth >= C_RESTARTS) return NULL; + flan_restart *r = &c_restarts[c_restart_depth++]; + r->name_id = flan_name_id(name, namelen); + r->name = name; + r->namelen = namelen; + flan_restart_push(r); + return r; +} + +/* The pop, and it is deliberately not [flan_restart_pop]'s caller's business + * whether the stack still looks the way it did. A transfer that unwound past + * this frame has already popped everything above it — each restart-case pad + * pops its own before forwarding — but a frame that died some other way would + * leave the head pointing at rubbish on a stack that has gone. Assigning + * [r->prev] repairs both: the head goes back to what it was when this frame + * was pushed, which is true in either case. */ +void flan_restart_pop_c(void *frame) { + if (frame == NULL) return; + flan_restart_pop((flan_restart *)frame); + if (c_restart_depth > 0) c_restart_depth--; +} + +/* [flan_break_resume] stood here: look a restart up by the name someone typed + * and aim the channel at it. It was what the break loop resumed through when a + * choice was a *name*, and nothing has called it since the loop started + * choosing by position — a name cannot say which of two [retry] frames was + * meant, which is the whole reason the snapshot hands out indices. The last + * caller went with that change; the definition did not, and it sat here + * exporting a second way to resolve a restart that could only ever disagree + * with the one in use. NEXT.md already says there is no such function. Now + * there is not. */ + void flan_error(uint32_t type_id, void *condition, void *xfer, const uint8_t *name, int64_t namelen) { flan_signal(type_id, condition, xfer); diff --git a/test/test_dev.ml b/test/test_dev.ml index f05bc34..a3afad9 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -990,7 +990,11 @@ let () = fail "an expression that stopped inside a break answered anyway"; let r = ask "(:op \"break\")" in if status r <> "ok" then fail "break inside a thunk: %s" (status r); - (* Four now: the thunk's own [fetch] frame over the one below it. *) + (* Five now: the thunk's own [fetch] frame, the boundary the agent + establishes around every evaluation, and the frame below it. The + boundary sits between the two groups by construction — it is pushed + after the floor is read and before the thunk runs — so its position + is also the line the floor draws. *) let names = match Wire.field r "restarts" with | Some { Form.v = Form.List l; _ } -> @@ -1000,9 +1004,18 @@ let () = l | _ -> [] in - if names <> [ "retry"; "use-placeholder"; "retry"; "use-placeholder" ] + if + names + <> [ "retry"; "use-placeholder"; "abandon-evaluation"; "retry"; + "use-placeholder" ] then fail "restarts at a break inside a thunk: %s" (String.concat ", " names); + (* And it is named by position, not by spelling. A program may + establish a restart called [abandon-evaluation] of its own; [:abandon] + is the agent's own frame, identified by address. *) + (match Wire.field r "abandon" with + | Some { Form.v = Form.Int 2L; _ } -> () + | _ -> fail "the break inside a thunk did not say which restart abandons it"); let unreachable = match Wire.field r "unreachable" with | Some { Form.v = Form.List l; _ } -> @@ -1014,7 +1027,7 @@ let () = l | _ -> [] in - if unreachable <> [ 2; 3 ] then + if unreachable <> [ 3; 4 ] then fail "positions below the thunk: %s" (String.concat ", " (List.map string_of_int unreachable)); (* And the backtrace says the same thing the restart list does, in its @@ -1031,7 +1044,7 @@ let () = (String.concat ", " (List.map (fun (n, _, o) -> n ^ "/" ^ o) fs))); (* Refused, and refused *here* — not accepted and dropped. *) - let r = ask "(:op \"restart-at\" :index 2 :name \"retry\")" in + let r = ask "(:op \"restart-at\" :index 3 :name \"retry\")" in if status r <> "error" then fail "a restart below the thunk boundary was accepted"; (* The ones above it still work, so this refuses a case rather than @@ -1099,6 +1112,162 @@ let () = fail "an expression after the break: %s" (Option.value ~default:(status r) (Wire.string_field r "message")); + (* The way out the floors used to leave missing, which is the report + this whole thing came from: a C-x C-e that signals must cost the + evaluation and not the session. The agent establishes a restart + at the thunk boundary, so every break reached from inside an + evaluation has one choice that is neither "resume this expression" + nor "kill the program". + + Offered *beside* the thunk's own restarts rather than instead of + them: [fetch] establishes two, they are above the boundary and + takeable, and the boundary is last because it is the outermost + frame of the evaluation. *) + (let r = + ask + "(:op \"eval-expr\" :code \"(i64 (fetch 3))\" :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "an expression that stopped the program answered anyway"; + let r = ask "(:op \"break\")" in + let names = + match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with Form.Str x -> Some x | _ -> None) + l + | _ -> [] + in + if names <> [ "retry"; "use-placeholder"; "abandon-evaluation" ] + then + fail "restarts at a break inside an evaluation: %s" + (String.concat ", " names); + (* Nothing on this list is below anything: the program itself was + running, so the evaluation is the whole stack above it. *) + (match Wire.field r "unreachable" with + | Some { Form.v = Form.List []; _ } -> () + | _ -> + fail "a break inside an evaluation over a running program \ + refused one of its own restarts"); + (match Wire.field r "abandon" with + | Some { Form.v = Form.Int 2L; _ } -> () + | _ -> + fail "the break did not say which restart abandons the \ + evaluation"); + (* And it says *why* nothing is refused, which is a different fact + from which entries are: this break has a transfer channel. *) + (match Wire.field r "trap" with + | Some { Form.v = Form.Sym "nil"; _ } -> () + | _ -> fail "a signalled break reported itself as a trap"); + + (* -- Two evaluations, and two boundaries ------------------- *) + + (* The claim the save-and-restore is for: a second evaluation run + from inside the first one's break gets a boundary of its own, and + abandoning it leaves the first one exactly as it was. Both are on + one list — the inner one above the floor and takeable, the outer + one below it with the frames it belongs to — which is also what + proves they are two frames and not one reused. *) + let r = + ask + "(:op \"eval-expr\" :code \"(i64 (fetch 4))\" :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "a second evaluation stopped inside the first answered anyway"; + let r = ask "(:op \"break\")" in + let names = + match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with Form.Str x -> Some x | _ -> None) + l + | _ -> [] + in + if + names + <> [ "retry"; "use-placeholder"; "abandon-evaluation"; "retry"; + "use-placeholder"; "abandon-evaluation" ] + then + fail "restarts at a break inside a nested evaluation: %s" + (String.concat ", " names); + let unreachable = + match Wire.field r "unreachable" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with + | Form.Int i -> Some (Int64.to_int i) + | _ -> None) + l + | _ -> [] + in + (* The outer evaluation's own restarts, its boundary included: from + in here they are below a C frame that holds its own channel, so a + transfer to any of them lands nowhere. The inner boundary is the + only way out of the inner evaluation, which is the point. *) + if unreachable <> [ 3; 4; 5 ] then + fail "positions below the inner evaluation: %s" + (String.concat ", " (List.map string_of_int unreachable)); + (match Wire.field r "abandon" with + | Some { Form.v = Form.Int 2L; _ } -> () + | _ -> + fail "a nested evaluation did not name its own boundary as the \ + one that abandons it"); + let r = + ask "(:op \"restart-at\" :index 2 :name \"abandon-evaluation\")" + in + if status r <> "ok" then + fail "the inner boundary was refused: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + (* And the outer evaluation is back, with its three restarts and its + own boundary still on offer — an inner abandon must not have been + read as the outer one. *) + if not + (await (fun () -> + let r = ask "(:op \"break\")" in + status r = "ok" + && (match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> List.length l = 3 + | _ -> false) + && (match Wire.field r "abandon" with + | Some { Form.v = Form.Int 2L; _ } -> true + | _ -> false))) + then + fail "the outer evaluation did not come back intact after the \ + inner one was abandoned"; + + (* Taken by index with the name as the receipt, which is what an + editor sends: the position is the identity and the name is what + makes a stale position wrong out loud. *) + let r = + ask "(:op \"restart-at\" :index 2 :name \"abandon-evaluation\")" + in + if status r <> "ok" then + fail "the boundary restart was refused: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + (* And the note says what taking it did, because "resumes at its + next pass of the break loop" would be false in both halves — + nothing is resumed and there is no value coming. *) + (match Wire.string_field r "note" with + | Some n + when contains_sub n "the evaluation is abandoned" + && contains_sub n "is still changed" -> () + | n -> + fail "abandoning reported itself as %S" (Option.value ~default:"" n)); + (* The whole claim, in one line: the program is running again. *) + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) + then + fail "the program did not carry on after its evaluation was \ + abandoned"; + let r = + ask "(:op \"eval-expr\" :code \"(+ 3 4)\" :file \"/tmp/buf.flan\")" + in + if Wire.string_field r "value" <> Some "7" then + fail "an expression after an abandoned one: %s" + (Option.value ~default:(status r) (Wire.string_field r "message"))); + (* An expression that stops *itself*. The thunk runs on the game thread from inside a poll, and the break loop it lands in polls again from inside that very call — so the agent's poll has to be @@ -1437,6 +1606,14 @@ let () = if names <> [ "continue" ] then fail "restarts at a bad index: %s" (String.concat ", " names) | _ -> fail "break over a bad index listed no restarts"); + (* And no way to abandon an evaluation, because there is no evaluation + to abandon: this program stopped on its own frame. Offering one here + would promise to unwind something nobody asked for. *) + (match Wire.field r "abandon" with + | Some { Form.v = Form.Sym "nil"; _ } -> () + | _ -> + fail "a break the program took on its own offered to abandon an \ + evaluation"); (* A break nested inside this one must not inherit the trap's site. The fix-it-and-retry flow evaluates code *at* the bounds stop; if that code raises its own error, its break has no trap behind it, @@ -1485,6 +1662,60 @@ let () = in if Wire.string_field r "value" <> Some "4" then fail "an expression after a bad index: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")); + (* The report, reproduced on x86 and then answered. + + The program is running its loop. An expression evaluated into it + indexes past the end, and nothing above the boundary establishes a + restart — a bad index establishes none, and the [continue] the + program's own frame offers is below the boundary, where a transfer + has nowhere to land. That list used to be empty of anything + takeable, which left abort as the only live choice, and abort ends + the process: a mistyped index cost the session. + + The index is computed from a global so the compiler cannot decide + it at build time — a constant one is a compile error, which is the + right answer to a different question. *) + let r = + ask + "(:op \"eval-expr\" :code \"(at grid (i32 (+ ticks 100)))\" :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "an out-of-bounds expression answered instead of stopping"; + let r = ask "(:op \"break\")" in + let names = + match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with Form.Str x -> Some x | _ -> None) + l + | _ -> [] + in + if names <> [ "abandon-evaluation" ] then + fail "restarts at a bad index inside an evaluation: %s" + (String.concat ", " names); + (match Wire.field r "abandon" with + | Some { Form.v = Form.Int 0L; _ } -> () + | _ -> + fail "the only restart on offer did not say it abandons the \ + evaluation"); + let r = + ask "(:op \"restart-at\" :index 0 :name \"abandon-evaluation\")" + in + if status r <> "ok" then + fail "abandoning an evaluation on x86: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the x86 program did not carry on after its evaluation was \ + abandoned"; + (* Still the same program, with the globals it had: abandoning drops + the expression, it does not restart anything. *) + let r = + ask "(:op \"eval-expr\" :code \"(+ 5 5)\" :file \"/tmp/buf.flan\")" + in + if Wire.string_field r "value" <> Some "10" then + fail "an expression after an abandoned one on x86: %s" (Option.value ~default:(status r) (Wire.string_field r "message")) end; ignore (ask "(:op \"close\")"); @@ -1527,7 +1758,7 @@ let () = standalone half of the same claim is test_acceptance.ml's free-all-refused, which still exits 134: nothing installs the hook in a program that did not import the agent. *) - let trap_park ?(refault = false) what prog cond restarts = + let trap_park ?(refault = false) ?(trapping = "") what prog cond restarts = let tsock = tmp (prog ^ ".sock") and tout = tmp (prog ^ ".out") in (try Sys.remove tsock with Sys_error _ -> ()); let tfd = @@ -1621,6 +1852,15 @@ let () = | _ -> if restarts <> [] then fail "break at the %s trap named no unreachable restarts" what); + (* Why they are refused, and it has to be answerable with *no* + restarts on the list at all — which is the shape the null + allocator has, and the reason this is a fact about the break + rather than a flag on an entry. An editor captions the rows from + it, and "below this evaluation" in front of somebody looking at a + trap sends them hunting for an evaluation that is not there. *) + (match Wire.field r "trap" with + | Some { Form.v = Form.Sym "t"; _ } -> () + | _ -> fail "the %s trap did not say the break was taken by one" what); (* And the refusal, where there is a name to refuse. Answered [err] with the reason rather than [ok] and then dropped, which is the shape that would tell an editor the program had resumed when it @@ -1676,6 +1916,58 @@ let () = is only as good as SA_NODEFER: %s" what (status r) end; + (* The one case where "just ignore that whole call" cannot hold, and + it is the same reason every other refusal at a trap has: an + evaluation that *traps* stops with no transfer channel anywhere in + the call, so there is nothing for the boundary restart to unwind + through either. It is listed — it is a live frame, and hiding it + would make the one break where it does not work the one break that + never mentions it — and it is listed as untakeable, with + [:abandon] saying there is no position to offer. Fix the + expression and evaluate it again; that is the whole of the way + out. *) + if trapping <> "" then begin + let r = + ask + (Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")" + (Wire.quote trapping)) + in + if status r <> "error" then + fail "an expression that trapped at the %s break answered anyway" + what; + let r = ask "(:op \"break\")" in + (match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> + let names = + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with Form.Str x -> Some x | _ -> None) + l + in + if names <> [ "abandon-evaluation" ] then + fail "restarts at a trap inside an evaluation: %s" + (String.concat ", " names) + | _ -> fail "break at a trap inside an evaluation listed nothing"); + (match Wire.field r "unreachable" with + | Some { Form.v = Form.List [ { Form.v = Form.Int 0L; _ } ]; _ } -> () + | _ -> + fail "the boundary restart was offered at a trap, where nothing \ + can be taken"); + (match Wire.field r "abandon" with + | Some { Form.v = Form.Sym "nil"; _ } -> () + | _ -> + fail "a trap inside an evaluation named a position that abandons \ + it"); + (* And the reason those positions are refused, which is the half an + editor puts in front of somebody. [:abandon] being nil cannot + carry it: a break the program took on its own has a nil there + too, and captioning a segfault "below this evaluation" sends the + reader looking for an evaluation that is not there. *) + (match Wire.field r "trap" with + | Some { Form.v = Form.Sym "t"; _ } -> () + | _ -> + fail "a break at a trap did not say it was taken by one") + end; (* Torn down by [abort], not by [close]: a trap parks for good, so there is no resume to wait for and nothing to gain by waiting. @@ -1707,7 +1999,8 @@ let () = end in trap_park "free-all" "dev-trap-free-all.flan" "NoFreeAll" [ "continue" ]; - trap_park "null allocator" "dev-trap-null-alloc.flan" "NullAllocator" []; + trap_park ~trapping:"(do (free-all nowhere) 0)" "null allocator" + "dev-trap-null-alloc.flan" "NullAllocator" []; (* And the one that used to be a silent death rather than an exit code: SIGSEGV. The author's dogfooding session sorted (bytes "INSERTIONSORT") in place — the old aliasing bytes — and the session vanished without a diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 1cd3509..6f13371 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -331,6 +331,11 @@ extern void flan_restart_take(void *frame, void *xfer); * thread the trap stopped. */ extern const uint8_t *flan_break_site; extern int64_t flan_break_site_len; +/* A restart frame with no Flan function under it, which is what the boundary + * below is made of. The storage belongs to flan_rt.c for the reason the + * shadow-stack frame's shape does: the struct is declared in one file. */ +extern void *flan_restart_push_c(const uint8_t *name, int64_t namelen); +extern void flan_restart_pop_c(void *frame); /* -- How far down a transfer can actually land ----------------------- */ @@ -363,6 +368,66 @@ static int32_t restart_floor; * none of them are. So "not inside a thunk" gets a value of its own. */ static int32_t frame_floor = -1; +/* -- The way out that the floors left missing ------------------------- */ + +/* Everything above says which restarts a break inside a thunk cannot take. It + * took a report from someone whose game died to notice what that leaves when + * the answer is *all of them*: an expression evaluated with C-x C-e signals, + * nothing above the boundary established a restart — a bad index establishes + * none — and the whole list is either empty or below the floor. Then the only + * live choice at the break is [abort], and abort ends the process. A mistyped + * index cost a session that had been running for an hour. + * + * So the boundary offers a restart of its own. It is a real restart frame, on + * the real restart list, pushed by the agent immediately *after* the floor is + * read — which is what puts it above the floor and makes it reachable, where + * pushing it first would have marked it as the program's and refused it. + * + * Taking it aims the transfer at this frame. Nothing compares against it, so + * the unwind runs to the top of the thunk, [flan_reload_call] drops the + * channel it holds, and [flan_agent_poll] returns to whatever called it — the + * game loop, or an outer break. That is the same path a below-the-floor + * restart used to take by accident; the difference is that this one is what + * was asked for, and is reported as what happened. + * + * What it does not do, and nothing at this boundary could: undo. The thunk + * ran until it signalled, and every global it set and every byte it allocated + * on the way is still set and still allocated. Abandoning is "stop running + * this expression", not "unmake what it did". + * + * NULL when no thunk is in progress, which is also the answer to "is there an + * evaluation to abandon": a program that broke on its own is not inside one, + * and a break there must not offer this. Game thread only, saved and restored + * around the call like the floors, so nesting names the innermost. */ +static void *eval_boundary; +static const uint8_t abandon_name[] = "abandon-evaluation"; + +/* The three of them, dropped between two runs of [main]. The counterpart of + * flan_rt.c's [flan_condition_stacks_reset] and flan_dev.c's + * [flan_dev_frames_reset], called from the same one place and for the same + * reason: a merged dev build re-enters [main] by longjmp, which pops no frame, + * so a thunk that was in progress when the run ended leaves a floor counting + * frames that are gone and a boundary naming a [c_restarts] slot the runtime + * has just released. + * + * Harmless today — a program's restart frames are allocas and can never + * compare equal to that address, so a stale boundary marks nothing — and left + * in that state it is one changed representation away from marking the wrong + * entry. The floors go with it because they are the same kind of state and it + * would be strange to empty two thirds of it. */ +void flan_agent_run_reset(void) { + eval_boundary = NULL; + restart_floor = 0; + frame_floor = -1; +} + +/* Nothing counts how many evaluations have been abandoned, and that is a + * decision rather than an omission. The editor is told twice already: the + * reply to the evaluation says the expression stopped before it produced a + * value, and the reply to the restart says taking that one abandoned it. A + * counter here would be a third telling, read by nobody, which is how a wire + * grows a verb whose answer drifts from what happened. */ + /* What the listener thread hands the stopped game thread. One slot, because * only one thread is ever stopped. */ /* A *depth*, not a flag. A thunk this loop runs may itself error, and the @@ -426,6 +491,18 @@ typedef struct { void *frame[SNAP_MAX]; int32_t off[SNAP_MAX], len[SNAP_MAX]; int32_t reachable[SNAP_MAX]; + /* Which entry is [eval_boundary]'s, or -1 when this break is not inside an + * evaluation. An index rather than a per-entry flag, because there is at + * most one on any list: the outer thunk's boundary is below this one's + * floor and is already marked unreachable. Recorded here rather than + * recomputed at reply time for the reason everything else is — the listener + * answers from the snapshot and never reads the live stack. + * + * A reader must not look for the *name* instead. Nothing stops a program + * establishing a restart called [abandon-evaluation] of its own, and a + * client that matched on the name would offer the program's restart as the + * way out of an evaluation. The address is what makes it this one. */ + int32_t boundary; int32_t used; char names[SNAP_NAMES]; /* Where the stopped thread is, taken at the same moment and for the same @@ -545,23 +622,61 @@ static int snap_push(int resumable, void *cond) { s->total = n; s->used = 0; s->n = 0; - for (int32_t i = 0; i < n && s->n < SNAP_MAX; i++) { + s->boundary = -1; + /* One slot and one name's worth of bytes kept back for the boundary, and the + * arithmetic below is the whole of why. + * + * The walk runs innermost first and stops at the first limit it meets, so the + * *outermost* entries are the ones truncation drops — and the boundary is the + * outermost entry of the evaluation, which makes it the first casualty. A + * thunk that established 64 restarts of its own would therefore reproduce the + * bug this change exists to fix, exactly: a full list, nothing on it that + * leaves the evaluation, and abort as the only live choice. + * + * So it is placed rather than found when the walk does not reach it. The cost + * is one listed restart out of sixty-four whenever an evaluation is in + * progress, which is a straight trade against losing the way out. */ + const int32_t held = (eval_boundary != NULL) ? 1 : 0; + const int32_t held_bytes = held ? (int32_t)sizeof abandon_name : 0; + for (int32_t i = 0; i < n && s->n < SNAP_MAX - held; i++) { int64_t len = 0; const uint8_t *nm = flan_restart_name(i, &len); void *fr = flan_restart_frame(i); if (nm == NULL || fr == NULL) continue; if (len < 0) len = 0; - if ((int64_t)s->used + len + 1 > SNAP_NAMES) break; + if ((int64_t)s->used + len + 1 > SNAP_NAMES - held_bytes) break; s->frame[s->n] = fr; s->off[s->n] = s->used; s->len[s->n] = (int32_t)len; /* The outermost [restart_floor] frames are below the thunk boundary. */ s->reachable[s->n] = (i < n - restart_floor); + if (fr == eval_boundary && eval_boundary != NULL) s->boundary = s->n; memcpy(s->names + s->used, nm, (size_t)len); s->used += (int32_t)len; s->names[s->used++] = 0; s->n++; } + /* The slot kept back, used only when the walk ran out before reaching it. + * Appended rather than inserted at its live position: every index that + * crosses the wire is a position in *this* array — [restart-at] resolves + * through [s->frame] — so the snapshot's order is the only order there is, + * and the entry is the same frame wherever it sits. The name is the one this + * file pushed; the runtime is not asked for it back. */ + if (held && s->boundary < 0 && s->n < SNAP_MAX + && (int32_t)s->used + held_bytes <= SNAP_NAMES) { + int32_t len = (int32_t)sizeof abandon_name - 1; + s->frame[s->n] = eval_boundary; + s->off[s->n] = s->used; + s->len[s->n] = len; + /* Reachable by construction: it is pushed above the floor, and the floor + * is what [reachable] is measured against. */ + s->reachable[s->n] = 1; + s->boundary = s->n; + memcpy(s->names + s->used, abandon_name, (size_t)len); + s->used += len; + s->names[s->used++] = 0; + s->n++; + } /* And the frames, from the same held-still stack. A deep recursion is * truncated rather than followed: the innermost frames are the ones the * question is about, and the count says how many were left out. */ @@ -739,6 +854,8 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition, * and silence is how this went wrong the first time. */ fprintf(stderr, " %2d. restart: %s%s\n", i, s->names + s->off[i], !s->resumable ? " (cannot be taken from this trap)" + : i == s->boundary + ? " (stop running the expression; the program carries on)" : s->reachable[i] ? "" : " (below this break; cannot be taken)"); if (s->total > s->n) @@ -790,9 +907,19 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition, int ok = s != NULL && s->gen == my_gen && take >= 0 && take < s->n && s->resumable && s->reachable[take]; if (ok) { + /* Which of the two things a take is, decided here because this is the + * only place that holds both the choice and the boundary. The transfer + * itself is identical — a frame address into the channel — and only + * the sentence differs. */ flan_restart_take(s->frame[take], xfer); - fprintf(stderr, "flan: resuming at restart %d. %s\n", take, - s->names + s->off[take]); + if (take == s->boundary) + fprintf(stderr, + "flan: the evaluation is abandoned; the program carries on " + "from where it was called. Anything it changed before it " + "stopped stays changed.\n"); + else + fprintf(stderr, "flan: resuming at restart %d. %s\n", take, + s->names + s->off[take]); fflush(stderr); memcpy(condition_name, outer_name, sizeof condition_name); /* Cleared with the resume: an abort that passed its check just as the @@ -899,9 +1026,18 @@ int32_t flan_agent_poll(void) { if (j.call != NULL) { int32_t outer = restart_floor; int32_t oframe = frame_floor; + void *obound = eval_boundary; restart_floor = flan_restart_count(); frame_floor = flan_dev_frame_count(); + /* After the floor is read and not before: the floor counts the frames + * that were there when the thunk started, and this one is the thunk's. + * Pushed first it would be below its own boundary and refused. */ + eval_boundary = flan_restart_push_c(abandon_name, sizeof abandon_name - 1); j.call(); + /* Popped whichever way the thunk left — returning with a value, or + * unwinding past this frame because someone abandoned it. */ + flan_restart_pop_c(eval_boundary); + eval_boundary = obound; restart_floor = outer; frame_floor = oframe; } @@ -1094,14 +1230,38 @@ static void handle_line(char *line, sink *o) { if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; } snapshot *s = snap_top(); if (s == NULL) { reply(o, "err no restart snapshot\n"); return; } + /* Ahead of the entries, and only at a trap: [!] on a line of its own says + * that this break has no transfer channel, so nothing below can be taken + * whatever its flag says. + * + * A line rather than a fourth flag value, because it is a fact about the + * *break* and not about any entry — and because a trap with an empty + * restart list has no entry to carry it, which is exactly the shape + * [dev-trap-null-alloc] has. The terminal listing says the same thing in + * words above its own list; an editor that had to infer the reason from + * the absence of a boundary would caption a segfault with a sentence about + * an evaluation that is not there. + * + * Safely ignored by a client that does not know it: the line does not + * start with an index, so a parser looking for [I F NAME] drops it. */ + if (!s->resumable) reply(o, "!\n"); for (int32_t i = 0; i < s->n; i++) { char hdr[32]; /* Both facts fold into the one flag, because the flag answers one * question — can this be taken — and a break taken by a trap can take * none of them. The terminal listing above says the same thing in - * words; the two must not describe different programs. */ + * words; the two must not describe different programs. + * + * [*] is a third value of that same flag and not a fourth column: the + * boundary restart is takeable, so it answers the flag's question with + * yes, and the extra thing it says is what taking it means. A client + * that only knows [+] and [-] gets it wrong in the safe direction — it + * reads a takeable restart as takeable, and only misses that this one + * is the way out. */ int k = snprintf(hdr, sizeof hdr, "%d %c ", i, - (s->resumable && s->reachable[i]) ? '+' : '-'); + !(s->resumable && s->reachable[i]) ? '-' + : i == s->boundary ? '*' + : '+'); if (k > 0) emit(o, hdr, (size_t)k); emit(o, s->names + s->off[i], (size_t)s->len[i]); reply(o, "\n"); @@ -1244,7 +1404,13 @@ static void handle_line(char *line, sink *o) { /* Published last, so the game thread never reads an index that is about * to change, or one whose generation has not arrived yet. */ atomic_store(&chosen_ready, 1); - reply(o, "ok\n"); + /* "ok", and for the boundary "ok abandon". Said on the acceptance rather + * than looked up afterwards, because afterwards there is nothing to look + * it up in: the take resumes the stopped thread and the snapshot it was + * resolved against is popped. The daemon used to re-ask [restarts] before + * sending, purely to word its note — a second round trip on the verb a + * person is waiting on, for a fact this end already holds. */ + reply(o, idx == s->boundary ? "ok abandon\n" : "ok\n"); return; } /* By name, still, for a person at a raw socket - and now defined as @@ -1284,7 +1450,10 @@ static void handle_line(char *line, sink *o) { atomic_store(&chosen_index, at); atomic_store(&chosen_gen, s->gen); atomic_store(&chosen_ready, 1); - reply(o, "ok\n"); + /* The same two answers as [restart-at], because this verb is defined as + * that one on the first index offering the name. Two verbs that resolve to + * the same frame must not report it differently. */ + reply(o, at == s->boundary ? "ok abandon\n" : "ok\n"); return; } if (strcmp(line, "abort") == 0) {