diff --git a/FIX.org b/FIX.org index 3c704b7..881f627 100644 --- a/FIX.org +++ b/FIX.org @@ -4495,3 +4495,107 @@ 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. 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..47233bd 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -104,22 +104,32 @@ 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) "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' 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 other two come off the reply, because nothing here can work them out. +UNREACHABLE is the positions the program will refuse: a restart below the +evaluation this break is inside has nowhere for a transfer to land. 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." (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 ((eql i abandon) 'abandon) + ((memq i unreachable) 'unreachable))))) names))) ;;; Drawing @@ -267,7 +277,9 @@ 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)))) (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 +287,47 @@ 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 (eq kind 'unreachable)) " " "[") (propertize name 'face - (if owner 'shadow 'font-lock-keyword-face)) - (if owner " " "]"))) + (cond ((eq kind 'unreachable) 'shadow) + ((eq kind 'abandon) 'warning) + (owner 'shadow) + (t 'font-lock-keyword-face))) + (if (or owner (eq kind 'unreachable)) " " "]"))) (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))) + (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 +474,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 +495,14 @@ 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. + ((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 +694,13 @@ 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) ;; 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..c760ad6 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -1121,17 +1121,24 @@ 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) "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. + 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 + ((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 +1243,18 @@ 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)) + (table (flan--restart-candidates restarts unreachable abandon)) + ;; 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..937fac8 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -951,6 +951,24 @@ 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))))) + +;; 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 +1074,67 @@ 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)))))) + ;; 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..8352083 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -995,6 +995,21 @@ 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 "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..52c2637 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -354,10 +354,19 @@ 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, not two. [+] is an ordinary restart that can be + taken; [-] is one that cannot, because it is below the evaluation this break + is inside or because a trap has no channel to transfer through. [*] is the + boundary restart the agent itself establishes around an evaluation: it can + be taken 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. *) let restarts t = match ask t "restarts" with | text -> @@ -377,7 +386,8 @@ let restarts t = else Some ( idx, - rest.[0] = '+', + rest.[0] = '+' || rest.[0] = '*', + rest.[0] = '*', String.sub rest 2 (String.length rest - 2) )) in Ok @@ -1589,12 +1599,23 @@ let break t = rather than filtered, because a client that quietly dropped them would leave someone asking where their restart went. *) ok - ([ ":restarts " ^ Wire.strings (List.map (fun (_, _, n) -> n) rs); + ([ ":restarts " ^ Wire.strings (List.map (fun (_, _, _, n) -> n) rs); ":unreachable " ^ Wire.ints (List.filter_map - (fun (i, ok, _) -> if ok then None else Some i) - rs) ] + (fun (i, ok, _, _) -> if ok 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 (_, _, b, _) -> b) rs with + | Some (i, _, _, _) -> string_of_int i + | None -> "nil") ] @ site_fields t) | Error m -> error ("the program refused to list its restarts: " ^ m)) @@ -2868,6 +2889,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. Asked of the program rather + than guessed from the name, because the name is not proof: nothing stops a + program establishing a restart called [abandon-evaluation], and only the + agent knows which frame is really the boundary. + + [None] where the list cannot be read, and then the ordinary note stands. + That is the safe direction: the boundary is the entry a client had to be + told about to offer, so a client that got this far already knows. *) +let boundary_index t : int option = + match restarts t with + | Ok rs -> + (match List.find_opt (fun (_, _, b, _) -> b) rs with + | Some (i, _, _, _) -> Some i + | None -> None) + | Error _ -> None + +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") + let choose_at t ~index ~name = match liveness t with | Gone -> error gone @@ -2892,14 +2942,15 @@ let choose_at t ~index ~name = "restart-at " ^ string_of_int index ^ match name with Some n -> " " ^ n | None -> "" in + (* Read before the choice is sent, not after: once the take is accepted the + stopped thread resumes, the snapshot goes, and there is nothing left to + ask which entry the boundary was. *) + let boundary = boundary_index t in match ask t verb with | reply when String.trim reply = "ok" -> ok [ ":index " ^ string_of_int index; - ":note " - ^ Wire.quote - "accepted; the program resumes at its next pass of the break loop" - ] + ":note " ^ taken_note ~abandoned:(boundary = Some index) ] | reply -> error (String.trim reply) | exception Unix.Unix_error (e, _, _) -> error ("cannot reach the program: " ^ Unix.error_message e) @@ -2920,12 +2971,22 @@ 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, so this end resolves it the same way to find out whether the + frame it will reach is the boundary. Read first, for [choose_at]'s + reason: after the take there is no snapshot left to ask. *) + let abandoned = + match restarts t with + | Ok rs -> + (match List.find_opt (fun (_, _, _, n) -> n = name) rs with + | Some (_, _, b, _) -> b + | None -> false) + | Error _ -> false + in match ask t ("restart " ^ name) with | reply when String.trim reply = "ok" -> ok - [ ":restart " ^ Wire.quote name; - ":note " - ^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ] + [ ":restart " ^ Wire.quote name; ":note " ^ taken_note ~abandoned ] | reply -> error (String.trim reply) | exception Unix.Unix_error (e, _, _) -> error ("cannot reach the program: " ^ Unix.error_message e) diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 62cb370..8514e11 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--; +} + +/* What the break loop calls to resume: look a restart up by the name someone + * typed and aim the channel at it. 0 if no frame offers it, and then the loop + * says so rather than resuming into nothing. */ +int32_t flan_break_resume(const uint8_t *name, int64_t namelen, void *xfer) { + void *r = flan_find_restart(flan_name_id(name, namelen)); + if (r == NULL) return 0; + *(void **)xfer = r; + return 1; +} + 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..543113e 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,79 @@ 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"); + (* 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 +1523,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 +1579,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 +1675,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 = @@ -1676,6 +1824,49 @@ 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") + 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 +1898,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..84db631 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,47 @@ 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"; + +/* 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 +472,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,6 +603,7 @@ static int snap_push(int resumable, void *cond) { s->total = n; s->used = 0; s->n = 0; + s->boundary = -1; for (int32_t i = 0; i < n && s->n < SNAP_MAX; i++) { int64_t len = 0; const uint8_t *nm = flan_restart_name(i, &len); @@ -557,6 +616,7 @@ static int snap_push(int resumable, void *cond) { 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; @@ -739,6 +799,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 +852,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 +971,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; } @@ -1099,9 +1180,18 @@ static void handle_line(char *line, sink *o) { /* 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");