JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

An evaluation that signals can be abandoned, and the program keeps running

Browse Source 
A C-x C-e that blew up took the session with it. The expression's break offered
either nothing at all — a bad index establishes no restart, and the program's
own are below the thunk boundary where a transfer has nowhere to land — or a
list on which every entry was refused. That left abort, and abort is _exit(134)
over a mistyped index.

So the boundary offers a restart of its own. The agent pushes a real frame
around every evaluation, after the floor is read so that it lands above it;
taking it unwinds to the thunk, flan_reload_call drops the channel it holds,
and the poll returns to the game loop. It abandons and does not undo, which is
said in the agent's line, the daemon's note, the buffer's row and the manual.

The other half was a silence. The break buffer drew every restart as takeable
and ignored the :unreachable the wire already carried, so a digit on one went
out to be refused and nothing came back. Those rows now carry the reason and
are refused where they are read, and :abandon names the position that drops the
evaluation — a position, because a program may establish a restart of that name
itself.

Not the threading, which is what the report suspected. The thunk does run on
the game thread; a thunk on a thread of its own would have had the same empty
list and the same abort.
This commit is contained in:
Joseph Ferano 2026-09-21 07:52:51 +07:00
parent 190fdadcb8
commit fe6744ae41
10 changed files with 746 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
FIX.org
View File

@ -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 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 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. 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.

17
emacs/MANUAL.md
View File

@ -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 genuinely cannot be taken are shown and refused with a reason rather than
silently omitted. 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 **`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. know which restart you want and do not need the buffer.

94
emacs/flan-cnr.el
View File

@ -104,22 +104,32 @@ from fixtures, and so `flan.el' is named in one place.")
;;; Restarts, and which of them can actually be chosen ;;; 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. "Turn NAMES — innermost first — into what the buffer draws.
Each entry is (INDEX NAME SHADOWED-BY), where SHADOWED-BY is the index of the Each entry is (INDEX NAME SHADOWED-BY KIND), where SHADOWED-BY is the index of
earlier entry that owns the name, or nil. 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 Shadowing is §4's walk, computed here because it can be: `restart NAME'
through `flan_find_restart', which returns the first frame whose hash matches, resolves through `flan_find_restart', which returns the first frame whose hash
so a name's second appearance is unreachable through the only verb there is. matches, so a name's second appearance is unreachable through the only verb
Nothing new has to be asked of the program to know that — the order of the there is. Nothing new has to be asked of the program to know that — the order
list already says it." 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)) (let ((seen nil) (i -1))
(mapcar (lambda (name) (mapcar (lambda (name)
(setq i (1+ i)) (setq i (1+ i))
(let ((owner (cdr (assoc name seen)))) (let ((owner (cdr (assoc name seen))))
(unless owner (push (cons name i) 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))) names)))
;;; Drawing ;;; Drawing
@ -267,7 +277,9 @@ indexing or the division itself, so it sits directly under the headline."
(defun flan-cnr--insert-restarts (state) (defun flan-cnr--insert-restarts (state)
(flan-cnr--section "Restarts (innermost first) — RET or a digit takes one:") (flan-cnr--section "Restarts (innermost first) — RET or a digit takes one:")
(let* ((names (plist-get state :restarts)) (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) (if (null rows)
(insert (propertize (insert (propertize
" none are active. Nothing between the error and the top offered one; abort, or fix a body and reload\n" " 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)))) (let ((w (apply #'max 4 (mapcar (lambda (r) (length (nth 1 r))) rows))))
(dolist (r rows) (dolist (r rows)
(let* ((i (nth 0 r)) (name (nth 1 r)) (owner (nth 2 r)) (let* ((i (nth 0 r)) (name (nth 1 r)) (owner (nth 2 r))
(kind (nth 3 r))
(start (point))) (start (point)))
;; SBCL's bracket: it is there when the name reaches this frame and ;; 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 ;; gone when it does not. A shadowed entry is still takeable — the
;; choice goes out by number, not by name — so the missing bracket ;; choice goes out by number, not by name — so the missing bracket
;; says only that typing the name at a prompt would reach the ;; 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 (insert (format " %2d: %s%s%s " i
(if owner " " "[") (if (or owner (eq kind 'unreachable)) " " "[")
(propertize name 'face (propertize name 'face
(if owner 'shadow 'font-lock-keyword-face)) (cond ((eq kind 'unreachable) 'shadow)
(if owner " " "]"))) ((eq kind 'abandon) 'warning)
(owner 'shadow)
(t 'font-lock-keyword-face)))
(if (or owner (eq kind 'unreachable)) " " "]")))
(insert (make-string (- w (length name)) ?\s)) (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 (insert (propertize
(format "same name as %d; taken by its number" owner) (format "same name as %d; taken by its number" owner)
'face 'shadow))) 'face 'shadow))))
(insert "\n") (insert "\n")
(add-text-properties start (point) (add-text-properties start (point)
(list 'flan-cnr-restart name (list 'flan-cnr-restart name
'flan-cnr-shadowed owner 'flan-cnr-shadowed owner
'flan-cnr-kind kind
'flan-cnr-index i 'flan-cnr-index i
'mouse-face 'highlight)))))) 'mouse-face 'highlight))))))
;; Last, and on the same list, because it is the same decision: what you ;; 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 (insert (propertize
"RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n" "RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n"
'face 'shadow)) '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 ;;; Commands
@ -450,6 +495,14 @@ puts the likely culprit on top."
(interactive) (interactive)
(cond (cond
((get-text-property (point) 'flan-cnr-abort) (flan-cnr-abort)) ((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) ((get-text-property (point) 'flan-cnr-restart)
(flan-cnr--invoke (get-text-property (point) 'flan-cnr-index) (flan-cnr--invoke (get-text-property (point) 'flan-cnr-index)
(get-text-property (point) 'flan-cnr-restart))) (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." data and the fixture-driven tests can drive it without a socket."
(list :condition (plist-get reply :condition) (list :condition (plist-get reply :condition)
:restarts (plist-get reply :restarts) :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. ;; Where the expression that trapped is written, and that line's text.
;; `break' carries both when the stop has a site; a user (error ...) ;; `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. ;; has none, and then the headline simply has no line to point at.

25
emacs/flan.el
View File

@ -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. ;; same decision: it is what you pick when none of the restarts is the answer.
;; It is last, and it is not the default. ;; 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. "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 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." identity: two entries may read the same and mean different frames."
(let ((i -1)) (let ((i -1))
(mapcar (lambda (name) (mapcar (lambda (name)
(setq i (1+ i)) (setq i (1+ i))
(cons (format "%d. %s%s" i name (cons (format "%d. %s%s" i name
(if (memq i unreachable) (cond
" (below this break; cannot be taken)" ((eql i abandon)
"")) " (stop running this expression; the program carries on)")
((memq i unreachable)
" (below this break; cannot be taken)")
(t "")))
i)) i))
restarts))) restarts)))
@ -1236,12 +1243,18 @@ than being told so."
(user-error "flan: the program is running; nothing is stopped")) (user-error "flan: the program is running; nothing is stopped"))
(let* ((restarts (plist-get r :restarts)) (let* ((restarts (plist-get r :restarts))
(unreachable (append (plist-get r :unreachable) nil)) (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 (choice
(completing-read (completing-read
(format "flan: stopped on %s%s — " flan--stopped (format "flan: stopped on %s%s — " flan--stopped
(if restarts "" " (no restarts are active)")) (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)))) (index (cdr (assoc choice table))))
(cond (cond
((equal choice "abort") (flan-abort)) ((equal choice "abort") (flan-abort))

79
emacs/test-flan-cider.el
View File

@ -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" (test-flan--check "no restarts is a list of no rows"
(null (flan-cnr-annotate-restarts nil))) (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 ;;; 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" (test-flan--check "and the number past the last is abort"
(equal sent '(:op "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' ;; 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 ;; 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 ;; already here: without it `flan-cnr-toggle-frame' goes and asks the daemon

15
emacs/test-flan.el
View File

@ -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))) (and (not (string-match-p "cannot be taken" (caar table)))
(string-match-p "cannot be taken" (car (nth 1 table))) (string-match-p "cannot be taken" (car (nth 1 table)))
(equal (cdr (nth 1 table)) 1)))) (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 ;; 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 ;; runs on the stopped thread and comes back — which is the one moment

91
lib/dev.ml
View File

@ -354,10 +354,19 @@ let state t =
is passed on rather than turned into an empty list: no restarts and cannot is passed on rather than turned into an empty list: no restarts and cannot
say are different answers. say are different answers.
Each line is [I ± NAME]: the index it is taken by, whether it can be taken, Each line is [I F NAME]: the index it is taken by, a flag, and the name. The
and the name. The index is the identity — two frames may offer [retry] and index is the identity — two frames may offer [retry] and a name cannot say
a name cannot say which — and it is the program's number, not this end's which — and it is the program's number, not this end's position in a list,
position in a list, so it is carried rather than recomputed. *) 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 = let restarts t =
match ask t "restarts" with match ask t "restarts" with
| text -> | text ->
@ -377,7 +386,8 @@ let restarts t =
else else
Some Some
( idx, ( idx,
rest.[0] = '+', rest.[0] = '+' || rest.[0] = '*',
rest.[0] = '*',
String.sub rest 2 (String.length rest - 2) )) String.sub rest 2 (String.length rest - 2) ))
in in
Ok Ok
@ -1589,12 +1599,23 @@ let break t =
rather than filtered, because a client that quietly dropped them rather than filtered, because a client that quietly dropped them
would leave someone asking where their restart went. *) would leave someone asking where their restart went. *)
ok ok
([ ":restarts " ^ Wire.strings (List.map (fun (_, _, n) -> n) rs); ([ ":restarts " ^ Wire.strings (List.map (fun (_, _, _, n) -> n) rs);
":unreachable " ":unreachable "
^ Wire.ints ^ Wire.ints
(List.filter_map (List.filter_map
(fun (i, ok, _) -> if ok then None else Some i) (fun (i, ok, _, _) -> if ok then None else Some i)
rs) ] 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) @ site_fields t)
| Error m -> error ("the program refused to list its restarts: " ^ m)) | 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 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, 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. *) 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 = let choose_at t ~index ~name =
match liveness t with match liveness t with
| Gone -> error gone | Gone -> error gone
@ -2892,14 +2942,15 @@ let choose_at t ~index ~name =
"restart-at " ^ string_of_int index "restart-at " ^ string_of_int index
^ match name with Some n -> " " ^ n | None -> "" ^ match name with Some n -> " " ^ n | None -> ""
in 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 match ask t verb with
| reply when String.trim reply = "ok" -> | reply when String.trim reply = "ok" ->
ok ok
[ ":index " ^ string_of_int index; [ ":index " ^ string_of_int index;
":note " ":note " ^ taken_note ~abandoned:(boundary = Some index) ]
^ Wire.quote
"accepted; the program resumes at its next pass of the break loop"
]
| reply -> error (String.trim reply) | reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) -> | exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e) error ("cannot reach the program: " ^ Unix.error_message e)
@ -2920,12 +2971,22 @@ let choose t ~name =
speak to it. *) speak to it. *)
error "a restart name cannot contain a control character" error "a restart name cannot contain a control character"
else 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 match ask t ("restart " ^ name) with
| reply when String.trim reply = "ok" -> | reply when String.trim reply = "ok" ->
ok ok
[ ":restart " ^ Wire.quote name; [ ":restart " ^ Wire.quote name; ":note " ^ taken_note ~abandoned ]
":note "
^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ]
| reply -> error (String.trim reply) | reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) -> | exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e) error ("cannot reach the program: " ^ Unix.error_message e)

67
runtime/flan_rt.c
View File

@ -88,6 +88,13 @@ typedef struct flan_restart {
static flan_restart *restarts; 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) { void flan_restart_push(flan_restart *r) {
r->prev = restarts; r->prev = restarts;
restarts = r; restarts = r;
@ -241,6 +248,11 @@ void flan_exit(int32_t status) {
void flan_condition_stacks_reset(void) { void flan_condition_stacks_reset(void) {
handlers = NULL; handlers = NULL;
restarts = 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. /* 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; 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, void flan_error(uint32_t type_id, void *condition, void *xfer,
const uint8_t *name, int64_t namelen) { const uint8_t *name, int64_t namelen) {
flan_signal(type_id, condition, xfer); flan_signal(type_id, condition, xfer);

204
test/test_dev.ml
View File

@ -990,7 +990,11 @@ let () =
fail "an expression that stopped inside a break answered anyway"; fail "an expression that stopped inside a break answered anyway";
let r = ask "(:op \"break\")" in let r = ask "(:op \"break\")" in
if status r <> "ok" then fail "break inside a thunk: %s" (status r); 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 = let names =
match Wire.field r "restarts" with match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } -> | Some { Form.v = Form.List l; _ } ->
@ -1000,9 +1004,18 @@ let () =
l l
| _ -> [] | _ -> []
in 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" then fail "restarts at a break inside a thunk: %s"
(String.concat ", " names); (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 = let unreachable =
match Wire.field r "unreachable" with match Wire.field r "unreachable" with
| Some { Form.v = Form.List l; _ } -> | Some { Form.v = Form.List l; _ } ->
@ -1014,7 +1027,7 @@ let () =
l l
| _ -> [] | _ -> []
in in
if unreachable <> [ 2; 3 ] then if unreachable <> [ 3; 4 ] then
fail "positions below the thunk: %s" fail "positions below the thunk: %s"
(String.concat ", " (List.map string_of_int unreachable)); (String.concat ", " (List.map string_of_int unreachable));
(* And the backtrace says the same thing the restart list does, in its (* And the backtrace says the same thing the restart list does, in its
@ -1031,7 +1044,7 @@ let () =
(String.concat ", " (String.concat ", "
(List.map (fun (n, _, o) -> n ^ "/" ^ o) fs))); (List.map (fun (n, _, o) -> n ^ "/" ^ o) fs)));
(* Refused, and refused *here* — not accepted and dropped. *) (* 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 if status r <> "error" then
fail "a restart below the thunk boundary was accepted"; fail "a restart below the thunk boundary was accepted";
(* The ones above it still work, so this refuses a case rather than (* 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" fail "an expression after the break: %s"
(Option.value ~default:(status r) (Wire.string_field r "message")); (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 (* An expression that stops *itself*. The thunk runs on the game
thread from inside a poll, and the break loop it lands in polls 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 again from inside that very call — so the agent's poll has to be
@ -1437,6 +1523,14 @@ let () =
if names <> [ "continue" ] then if names <> [ "continue" ] then
fail "restarts at a bad index: %s" (String.concat ", " names) fail "restarts at a bad index: %s" (String.concat ", " names)
| _ -> fail "break over a bad index listed no restarts"); | _ -> 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. (* 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 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, that code raises its own error, its break has no trap behind it,
@ -1485,6 +1579,60 @@ let () =
in in
if Wire.string_field r "value" <> Some "4" then if Wire.string_field r "value" <> Some "4" then
fail "an expression after a bad index: %s" 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")) (Option.value ~default:(status r) (Wire.string_field r "message"))
end; end;
ignore (ask "(:op \"close\")"); ignore (ask "(:op \"close\")");
@ -1527,7 +1675,7 @@ let () =
standalone half of the same claim is test_acceptance.ml's standalone half of the same claim is test_acceptance.ml's
free-all-refused, which still exits 134: nothing installs the hook in a free-all-refused, which still exits 134: nothing installs the hook in a
program that did not import the agent. *) 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 let tsock = tmp (prog ^ ".sock") and tout = tmp (prog ^ ".out") in
(try Sys.remove tsock with Sys_error _ -> ()); (try Sys.remove tsock with Sys_error _ -> ());
let tfd = let tfd =
@ -1676,6 +1824,49 @@ let () =
is only as good as SA_NODEFER: %s" is only as good as SA_NODEFER: %s"
what (status r) what (status r)
end; 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 (* 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. there is no resume to wait for and nothing to gain by waiting.
@ -1707,7 +1898,8 @@ let () =
end end
in in
trap_park "free-all" "dev-trap-free-all.flan" "NoFreeAll" [ "continue" ]; 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: (* And the one that used to be a silent death rather than an exit code:
SIGSEGV. The author's dogfooding session sorted (bytes "INSERTIONSORT") SIGSEGV. The author's dogfooding session sorted (bytes "INSERTIONSORT")
in place — the old aliasing bytes — and the session vanished without a in place — the old aliasing bytes — and the session vanished without a

94
vendor/agent/flan_agent.c vendored
View File

@ -331,6 +331,11 @@ extern void flan_restart_take(void *frame, void *xfer);
* thread the trap stopped. */ * thread the trap stopped. */
extern const uint8_t *flan_break_site; extern const uint8_t *flan_break_site;
extern int64_t flan_break_site_len; 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 ----------------------- */ /* -- 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. */ * none of them are. So "not inside a thunk" gets a value of its own. */
static int32_t frame_floor = -1; 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 /* What the listener thread hands the stopped game thread. One slot, because
* only one thread is ever stopped. */ * only one thread is ever stopped. */
/* A *depth*, not a flag. A thunk this loop runs may itself error, and the /* 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]; void *frame[SNAP_MAX];
int32_t off[SNAP_MAX], len[SNAP_MAX]; int32_t off[SNAP_MAX], len[SNAP_MAX];
int32_t reachable[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; int32_t used;
char names[SNAP_NAMES]; char names[SNAP_NAMES];
/* Where the stopped thread is, taken at the same moment and for the same /* 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->total = n;
s->used = 0; s->used = 0;
s->n = 0; s->n = 0;
s->boundary = -1;
for (int32_t i = 0; i < n && s->n < SNAP_MAX; i++) { for (int32_t i = 0; i < n && s->n < SNAP_MAX; i++) {
int64_t len = 0; int64_t len = 0;
const uint8_t *nm = flan_restart_name(i, &len); 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; s->len[s->n] = (int32_t)len;
/* The outermost [restart_floor] frames are below the thunk boundary. */ /* The outermost [restart_floor] frames are below the thunk boundary. */
s->reachable[s->n] = (i < n - restart_floor); 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); memcpy(s->names + s->used, nm, (size_t)len);
s->used += (int32_t)len; s->used += (int32_t)len;
s->names[s->used++] = 0; 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. */ * and silence is how this went wrong the first time. */
fprintf(stderr, " %2d. restart: %s%s\n", i, s->names + s->off[i], fprintf(stderr, " %2d. restart: %s%s\n", i, s->names + s->off[i],
!s->resumable ? " (cannot be taken from this trap)" !s->resumable ? " (cannot be taken from this trap)"
: i == s->boundary
? " (stop running the expression; the program carries on)"
: s->reachable[i] ? "" : s->reachable[i] ? ""
: " (below this break; cannot be taken)"); : " (below this break; cannot be taken)");
if (s->total > s->n) if (s->total > s->n)
@ -790,7 +852,17 @@ 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 int ok = s != NULL && s->gen == my_gen && take >= 0 && take < s->n
&& s->resumable && s->reachable[take]; && s->resumable && s->reachable[take];
if (ok) { 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); flan_restart_take(s->frame[take], xfer);
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, fprintf(stderr, "flan: resuming at restart %d. %s\n", take,
s->names + s->off[take]); s->names + s->off[take]);
fflush(stderr); fflush(stderr);
@ -899,9 +971,18 @@ int32_t flan_agent_poll(void) {
if (j.call != NULL) { if (j.call != NULL) {
int32_t outer = restart_floor; int32_t outer = restart_floor;
int32_t oframe = frame_floor; int32_t oframe = frame_floor;
void *obound = eval_boundary;
restart_floor = flan_restart_count(); restart_floor = flan_restart_count();
frame_floor = flan_dev_frame_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(); 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; restart_floor = outer;
frame_floor = oframe; 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 /* 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 * 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 * 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, 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); if (k > 0) emit(o, hdr, (size_t)k);
emit(o, s->names + s->off[i], (size_t)s->len[i]); emit(o, s->names + s->off[i], (size_t)s->len[i]);
reply(o, "\n"); reply(o, "\n");