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

Merge branch 'worktree-agent-a864e4baf08dc8a0e' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-21 09:04:59 +07:00
commit 0a0517f1d1
10 changed files with 1112 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

159
FIX.org
View File

@ -4495,3 +4495,162 @@ two walks — the Ast rename and the Form-level one at load.ml:503 — learn to
walk more than one bound. The Form walk matched Vec [n; count] exactly, so
it had to grow; before this, a three-bound dotimes was a parse error long
before that walk could see it, so nothing was ever miscompiled by it.
* 2026-09-21 — a restart that abandons the evaluation
The report, in the author's words:
I got an error evaluating the insertion-sort, but it killed the whole flan
program, the "continue" restart didn't work, I kept pressing 0 and nothing
would happen, there's a design problem here, likely because it's running on
the same thread as the game loop? What's going on? It should just be able to
ignore that whole call
The last sentence is the requirement, and it was the one thing the break loop
could not do.
** What was actually wrong
Reproduced headless, both backends, on a running program: evaluate an
expression that indexes past the end, and the break it lands in offers
restarts ()
or, over a program whose own loop holds a [restart-case], a single entry below
the thunk boundary and marked unreachable. Nothing takeable either way. A bad
index establishes no restart of its own — nothing a handler could do would make
index 9 valid for a length-4 array — and the program's own [continue] is below
[flan_reload_call], which holds its own transfer channel and drops it on
return, so a transfer to it has nowhere to land. Which left [abort], and abort
is [_exit(134)]: in a merged [flan dev] that is the compiler, the session and
the game, over a mistyped index.
So the floors were right and the list they produced was empty. Everything the
agent knew how to say about that break was a refusal.
** Not the threading, and the question deserves a straight answer
The thunk does run on the game thread. That is the design and not an accident:
the break loop *is* the poll loop, which is the only reason C-x C-e works at
the moment anyone wants it to, and [restart_floor] is documented game-thread-
only for it. But it is not the cause. A thunk on a thread of its own would have
had exactly the same empty list and exactly the same [abort]. What was missing
was a restart, not a thread.
** The decision
The agent establishes one restart of its own around every evaluation:
0. restart: abandon-evaluation (stop running the expression; the program
carries on)
It is a real frame on the real restart list, pushed by [flan_agent_poll]
immediately after the floor is read — which is what puts it *above* the floor
and makes it reachable, where pushing it first would have marked it as the
program's and refused it. Taking it aims the transfer at that frame; nothing
compares against it, so the unwind runs to the top of the thunk,
[flan_reload_call] drops the channel it holds, and the poll returns to whatever
called it. That is the same path a below-the-floor restart used to take by
accident. The difference is that this one is what was asked for, and is
reported as what happened.
The frames live in flan_rt.c ([flan_restart_push_c]/[flan_restart_pop_c]),
because the struct is declared there and two files each declaring it is how the
two stop agreeing. A fixed array of sixteen, not malloc: this is pushed on the
game thread at a frame boundary.
No codegen. Both backends unwind by the same convention, and both were driven
end to end.
** What it does not promise
Abandoning drops the expression. It does not undo it. The thunk ran until it
signalled, and every global it set and every byte it allocated on the way is
still set and still allocated. Said in the agent's line, in the daemon's reply
note, in the break buffer's row and in MANUAL.md, because an editor that said
only "abandoned" would let someone believe the program is where it was before
they pressed C-x C-e.
** The other half: "I kept pressing 0 and nothing would happen"
A choice a reader makes has to do something or say why it cannot.
[:unreachable] was already on the wire and the break buffer was not reading it:
it drew every restart as an ordinary takeable row, and a digit on one sent it
to the daemon to be refused. The row now loses its bracket, carries the reason
beside it, and is refused *here*, out loud, with the sentence the daemon would
have given. [:abandon] is new beside it — the position that abandons, [nil]
when the break is not inside an evaluation — and it is a position rather than a
name on purpose: a program is free to establish a restart called
[abandon-evaluation] of its own, and matching on the name would offer the
program's restart as the way out of an evaluation. The agent identifies it by
frame address; the wire carries it as a third value of the flag [restarts]
already had, [*] beside [+] and [-].
Point in the break buffer starts on that row, and [C-c C-M-b]'s prompt takes it
as the default. The list is not reordered — the number beside a restart is the
program's own index, and moving rows would make the numbers lie. [abort] stays
last and stays not-the-default.
** What still cannot be abandoned, and correctly
A trap has no transfer channel at all — [rt_trap] calls the hook with nothing
to write a frame into — so at a trap every restart is refused, the boundary's
included, and [:abandon] is [nil]. There is nothing to unwind through. The
break is still a place to stand and read; fix and reload is the way out. That
is the one case where "it should just ignore that whole call" cannot hold.
** Open: nothing counts abandonments
An earlier draft had the agent count them and a [abandoned] verb to read the
count, so a daemon waiting on a value could end its wait. It is not needed: the
wait already ends the moment the thunk breaks (see "an evaluated expression
that signals says so at once" above),
and the restart's own reply says what taking it did. A third telling read by
nobody is how a wire grows a verb whose answer drifts from what happened.
** Review follow-ups
Five things the review found, and one it asked me to judge rather than take.
*Two refusals, not one.* At a trap nothing on the list can be taken — the
break has no transfer channel at all — and the daemon was folding that into
the same [:unreachable] it uses for "below the evaluation this break is
inside". The break buffer then captioned a segfault's restarts with a sentence
about an evaluation that was not there, and offered no way out of one. The
terminal listing had always said the two apart; the wire had not, which is
exactly the divergence the [restarts] comment says must never happen.
The trap now rides on the break reply as [:trap], and both the caption and the
refusal branch on it. It is a bare [!] line ahead of the entries rather than a
fourth flag value, because it is a fact about the *break*: a trap with an empty
restart list — dev-trap-null-alloc is one — has no entry to carry a flag, and
that is the case that has to be able to say so. It is *not* inferred from
[:abandon] being nil: a break the program took on its own has a nil there too,
and so does a truncated list.
*The escape hatch survives truncation.* [snap_push] walks innermost first and
stops at SNAP_MAX or SNAP_NAMES, so the outermost entries are what truncation
drops — and the boundary is the outermost entry of an evaluation, which made it
the first casualty. A thunk establishing 64 restarts of its own reproduced the
original bug exactly. One slot and one name's worth of bytes are now kept back
and the boundary is placed in them when the walk does not reach it. The cost is
one listed restart out of sixty-four while an evaluation is in progress.
*[flan_break_resume] is gone.* Nothing has called it since the break loop
started choosing by position instead of by name; NEXT.md already said there was
no such function. Two ways to resolve a restart that can only ever disagree is
one too many.
*[eval_boundary] is cleared between runs.* [flan_agent_run_reset], called
beside [flan_condition_stacks_reset] and [flan_dev_frames_reset] from the park.
Harmless today — a program's restart frames are allocas and can never compare
equal to a stale one — and the floors go with it, because emptying two thirds
of the same state is stranger than emptying none.
*Nested boundaries are tested rather than reasoned about.* Two evaluations, the
second run from inside the first one's break, on one list: six restarts, the
inner boundary at 2 and takeable, the outer one at 5 with the frames it belongs
to below the floor. Abandoning the inner leaves the outer with its three
restarts and its own boundary still on offer. That is the claim the save-and-
restore around [j.call] exists for.
*The round trip, judged and removed.* [choose_at] and [choose] each asked
[restarts] before sending, only to word their note — doubling the traffic of
the verb somebody is actually waiting on, to learn something the other end had
in front of it. The agent now answers [ok abandon] for the boundary and [ok]
otherwise. It could not simply be read off the [break] reply the client had:
the daemon words the note and the daemon had not seen that reply. Saying it on
the acceptance also closes the window — after a take the stopped thread
resumes and the snapshot it was resolved against is popped, so there is nothing
left to ask.

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

127
emacs/flan-cnr.el
View File

@ -104,22 +104,41 @@ from fixtures, and so `flan.el' is named in one place.")
;;; Restarts, and which of them can actually be chosen
(defun flan-cnr-annotate-restarts (names)
(defun flan-cnr-annotate-restarts (names &optional unreachable abandon trap)
"Turn NAMES — innermost first — into what the buffer draws.
Each entry is (INDEX NAME SHADOWED-BY), where SHADOWED-BY is the index of the
earlier entry that owns the name, or nil.
Each entry is (INDEX NAME SHADOWED-BY KIND), where SHADOWED-BY is the index of
the earlier entry that owns the name, or nil, and KIND is one of nil,
`unreachable', `trapped' or `abandon'.
This is §4's walk, computed here because it can be: `restart NAME' resolves
through `flan_find_restart', which returns the first frame whose hash matches,
so a name's second appearance is unreachable through the only verb there is.
Nothing new has to be asked of the program to know that — the order of the
list already says it."
Shadowing is §4's walk, computed here because it can be: `restart NAME'
resolves through `flan_find_restart', which returns the first frame whose hash
matches, so a name's second appearance is unreachable through the only verb
there is. Nothing new has to be asked of the program to know that — the order
of the list already says it.
The rest come off the reply, because nothing here can work them out.
UNREACHABLE is the positions the program will refuse. ABANDON is the position
that drops the evaluation, and it is a position rather than a name on purpose —
a program may establish a restart called `abandon-evaluation' of its own, and
only the agent knows which frame is really the boundary.
TRAP says *why* they are refused, which is a different question from which they
are. A break taken by a trap — a segfault, a null allocator — has no transfer
channel at all: every restart on it is refused, the boundary included, and
there is no evaluation to abandon your way out of. Captioning those rows
\"below this evaluation\" would send someone looking for an evaluation that is
not there, so the two refusals are drawn apart. It cannot be inferred from
ABANDON being nil: a break the program took on its own has a nil there too, and
so does a list long enough to have been truncated."
(let ((seen nil) (i -1))
(mapcar (lambda (name)
(setq i (1+ i))
(let ((owner (cdr (assoc name seen))))
(unless owner (push (cons name i) seen))
(list i name owner)))
(list i name owner
(cond (trap 'trapped)
((eql i abandon) 'abandon)
((memq i unreachable) 'unreachable)))))
names)))
;;; Drawing
@ -267,7 +286,10 @@ indexing or the division itself, so it sits directly under the headline."
(defun flan-cnr--insert-restarts (state)
(flan-cnr--section "Restarts (innermost first) — RET or a digit takes one:")
(let* ((names (plist-get state :restarts))
(rows (flan-cnr-annotate-restarts names)))
(rows (flan-cnr-annotate-restarts names
(plist-get state :unreachable)
(plist-get state :abandon)
(plist-get state :trap))))
(if (null rows)
(insert (propertize
" none are active. Nothing between the error and the top offered one; abort, or fix a body and reload\n"
@ -275,26 +297,58 @@ indexing or the division itself, so it sits directly under the headline."
(let ((w (apply #'max 4 (mapcar (lambda (r) (length (nth 1 r))) rows))))
(dolist (r rows)
(let* ((i (nth 0 r)) (name (nth 1 r)) (owner (nth 2 r))
(kind (nth 3 r))
(start (point)))
;; SBCL's bracket: it is there when the name reaches this frame and
;; gone when it does not. A shadowed entry is still takeable — the
;; choice goes out by number, not by name — so the missing bracket
;; says only that typing the name at a prompt would reach the
;; inner one.
;; inner one. A row the program will refuse loses the bracket for
;; a different reason, and says which in its own words.
(insert (format " %2d: %s%s%s " i
(if owner " " "[")
(if (or owner (memq kind '(unreachable trapped)))
" " "[")
(propertize name 'face
(if owner 'shadow 'font-lock-keyword-face))
(if owner " " "]")))
(cond ((memq kind '(unreachable trapped))
'shadow)
((eq kind 'abandon) 'warning)
(owner 'shadow)
(t 'font-lock-keyword-face)))
(if (or owner (memq kind '(unreachable trapped)))
" " "]")))
(insert (make-string (- w (length name)) ?\s))
(when owner
(cond
;; What the reader wants nine times in ten after a C-x C-e went
;; wrong, so it says what it does *and* what it does not: nothing
;; here can undo the part of the expression that already ran.
((eq kind 'abandon)
(insert (propertize
"stop running this expression and carry on; what it already changed stays changed"
'face 'font-lock-comment-face)))
;; Shown rather than hidden, because "where did my restart go" is
;; a fair question — and taking it says why instead of nothing,
;; which is how this went wrong the first time.
((eq kind 'unreachable)
(insert (propertize
"below this evaluation; a transfer to it has nowhere to land"
'face 'shadow)))
;; The other refusal, and it is not the same one. A trap has no
;; transfer channel anywhere in the call, so nothing on this list
;; can be taken — there is no evaluation to be below, and none to
;; abandon. Fixing the body and reloading is the way out.
((eq kind 'trapped)
(insert (propertize
"the trap has no transfer channel; nothing here can be resumed into"
'face 'shadow)))
(owner
(insert (propertize
(format "same name as %d; taken by its number" owner)
'face 'shadow)))
'face 'shadow))))
(insert "\n")
(add-text-properties start (point)
(list 'flan-cnr-restart name
'flan-cnr-shadowed owner
'flan-cnr-kind kind
'flan-cnr-index i
'mouse-face 'highlight))))))
;; Last, and on the same list, because it is the same decision: what you
@ -441,7 +495,19 @@ puts the likely culprit on top."
(insert (propertize
"RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n"
'face 'shadow))
(goto-char (point-min))))
(goto-char (point-min))
;; Point starts on the restart that abandons the evaluation, when there is
;; one. Not a reordering of the list — the number beside a restart is the
;; program's index and moving rows would make the numbers lie — but this is
;; what a reader wants nine times in ten after a C-x C-e went wrong, and
;; RET should land on it rather than on the top of the buffer.
(when (plist-get state :abandon)
(let ((found nil))
(while (and (not found) (not (eobp)))
(if (eq (get-text-property (point) 'flan-cnr-kind) 'abandon)
(setq found t)
(forward-line 1)))
(unless found (goto-char (point-min)))))))
;;; Commands
@ -450,6 +516,22 @@ puts the likely culprit on top."
(interactive)
(cond
((get-text-property (point) 'flan-cnr-abort) (flan-cnr-abort))
;; Refused here, with the reason, rather than sent and refused there. Both
;; answers are the same sentence; this one arrives without a round trip, and
;; either way something is *said* — a choice that quietly does nothing is
;; the defect this whole line exists to close.
;;
;; Two refusals, because there are two reasons and the wrong one is worse
;; than none: a segfault's break is not inside an evaluation, and telling
;; someone to abandon one sends them looking for something that is not
;; there.
((eq (get-text-property (point) 'flan-cnr-kind) 'trapped)
(user-error
"flan: this break was taken by a trap with no transfer channel, so no restart can be taken from it. Read the frame, then fix a body and reload, or abort"))
((eq (get-text-property (point) 'flan-cnr-kind) 'unreachable)
(user-error
"flan: restart %d is below the evaluation this break is inside, so a transfer to it has nowhere to land. Take one offered above it, or abandon the evaluation"
(get-text-property (point) 'flan-cnr-index)))
((get-text-property (point) 'flan-cnr-restart)
(flan-cnr--invoke (get-text-property (point) 'flan-cnr-index)
(get-text-property (point) 'flan-cnr-restart)))
@ -641,6 +723,17 @@ Takes the layout rather than fetching it, so this stays a function from data to
data and the fixture-driven tests can drive it without a socket."
(list :condition (plist-get reply :condition)
:restarts (plist-get reply :restarts)
;; The two facts about that list nothing here could work out. A
;; position is on `:unreachable' when the program will refuse it, and
;; `:abandon' is the position that drops the evaluation this break is
;; inside — nil when it is not inside one, which is a break the program
;; took on its own.
:unreachable (plist-get reply :unreachable)
:abandon (plist-get reply :abandon)
;; And why they are refused, which `:abandon' being nil cannot say: a
;; trap refuses every one of them, an evaluation that is not there
;; refuses none.
:trap (plist-get reply :trap)
;; Where the expression that trapped is written, and that line's text.
;; `break' carries both when the stop has a site; a user (error ...)
;; has none, and then the headline simply has no line to point at.

32
emacs/flan.el
View File

@ -1121,17 +1121,30 @@ the state with something to answer in it."
;; same decision: it is what you pick when none of the restarts is the answer.
;; It is last, and it is not the default.
(defun flan--restart-candidates (restarts unreachable)
(defun flan--restart-candidates (restarts unreachable &optional abandon trap)
"Label each of RESTARTS by its position, marking those in UNREACHABLE.
ABANDON is the position that drops the evaluation this break is inside, and
nil when it is not inside one; it is marked too, because what it does is not
what any other entry on the list does.
TRAP says why the refused ones are refused. A break taken by a trap has no
transfer channel, so every entry is refused and none of them is below an
evaluation — the break-buffer's rows draw the same distinction, and the two
must not describe different programs.
An alist of label to index. The index leads the label because it is the
identity: two entries may read the same and mean different frames."
(let ((i -1))
(mapcar (lambda (name)
(setq i (1+ i))
(cons (format "%d. %s%s" i name
(if (memq i unreachable)
" (below this break; cannot be taken)"
""))
(cond
(trap " (cannot be taken from this trap)")
((eql i abandon)
" (stop running this expression; the program carries on)")
((memq i unreachable)
" (below this break; cannot be taken)")
(t "")))
i))
restarts)))
@ -1236,12 +1249,19 @@ than being told so."
(user-error "flan: the program is running; nothing is stopped"))
(let* ((restarts (plist-get r :restarts))
(unreachable (append (plist-get r :unreachable) nil))
(table (flan--restart-candidates restarts unreachable))
(abandon (plist-get r :abandon))
(trap (plist-get r :trap))
(table (flan--restart-candidates restarts unreachable abandon trap))
;; The default, when the break is inside an evaluation. RET on an
;; empty prompt is the answer nine times in ten after a C-x C-e went
;; wrong: drop the expression, keep the program. `abort' is still
;; last and still not the default — it ends the session.
(default (and abandon (car (rassq abandon table))))
(choice
(completing-read
(format "flan: stopped on %s%s — " flan--stopped
(if restarts "" " (no restarts are active)"))
(append (mapcar #'car table) '("abort")) nil t))
(append (mapcar #'car table) '("abort")) nil t nil nil default))
(index (cdr (assoc choice table))))
(cond
((equal choice "abort") (flan-abort))

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

@ -951,6 +951,35 @@ would be overwritten. Look again and re-do the edit")
(test-flan--check "no restarts is a list of no rows"
(null (flan-cnr-annotate-restarts nil)))
;; The other two facts about a row, which nothing here can work out and both
;; come off the reply.
(let ((rows (flan-cnr-annotate-restarts
'("retry" "abandon-evaluation" "continue") '(2) 1)))
(test-flan--check "the position the reply named is the one that abandons"
(eq (nth 3 (nth 1 rows)) 'abandon))
(test-flan--check "a position the program will refuse is marked unreachable"
(eq (nth 3 (nth 2 rows)) 'unreachable))
(test-flan--check "and an ordinary restart is neither"
(null (nth 3 (nth 0 rows)))))
;; At a trap the reason is a different reason, and it is the break's rather
;; than any entry's: there is no transfer channel, so nothing can be taken and
;; there is no evaluation to be below.
(let ((rows (flan-cnr-annotate-restarts '("continue" "abandon-evaluation")
'(0 1) nil t)))
(test-flan--check "a trap marks every row with the trap's own reason"
(equal (mapcar (lambda (r) (nth 3 r)) rows)
'(trapped trapped)))
(test-flan--check "and the boundary is not exempt from it"
(eq (nth 3 (nth 1 rows)) 'trapped)))
;; By position, never by name. A program may establish a restart called
;; `abandon-evaluation' of its own, and offering that as the way out of an
;; evaluation would promise an unwind nobody can make.
(let ((rows (flan-cnr-annotate-restarts '("abandon-evaluation") nil nil)))
(test-flan--check "a program's own restart of that name is not the boundary"
(null (nth 3 (nth 0 rows)))))
;;; The break buffer
@ -1056,6 +1085,102 @@ would be overwritten. Look again and re-do the edit")
(test-flan--check "and the number past the last is abort"
(equal sent '(:op "abort"))))))
;; A break inside an evaluation: one restart drops the expression, one belongs
;; to the program below and cannot be taken. Both are drawn, and each says
;; which it is — a row that cannot be taken is shown rather than hidden,
;; because "where did my restart go" is a fair question.
(let ((text (with-current-buffer
(test-flan--cnr
(list :condition "BoundsError"
:restarts '("abandon-evaluation" "continue")
:unreachable '(1)
:abandon 0))
(buffer-string))))
(test-flan--check "the way out of an evaluation says what it does"
(string-match-p "0: \\[abandon-evaluation\\] *stop running this expression"
text))
(test-flan--check "and says what it does not undo"
(string-match-p "already changed stays changed" text))
(test-flan--check "a restart below the evaluation loses its bracket"
(string-match-p " 1: continue " text))
(test-flan--check "and says why it cannot be taken"
(string-match-p "nowhere to land" text))
(test-flan--check "abort is still last, and still one past the restarts"
(string-match-p " 2: \\[abort\\]" text)))
;; Point starts on it, because after a C-x C-e that went wrong this is the
;; answer nine times in ten. The list itself is not reordered: the number
;; beside a restart is the program's own index.
(let ((sent nil))
(let ((flan-cnr-request-function
(lambda (form) (setq sent form) (list :status "ok" :note "accepted"))))
(with-current-buffer (test-flan--cnr
(list :condition "BoundsError"
:restarts '("retry" "abandon-evaluation")
:abandon 1))
(save-window-excursion (flan-cnr-take))
(test-flan--check "RET with point where it was left abandons the evaluation"
(equal sent
'(:op "restart-at" :index 1
:name "abandon-evaluation"))))))
;; And the half of the report that was a silence: a choice that cannot be
;; taken has to *say* so. Refused here rather than sent and refused there,
;; with the same sentence either way.
(let ((sent nil))
(let ((flan-cnr-request-function
(lambda (form) (setq sent form) (list :status "ok" :note "accepted"))))
(with-current-buffer (test-flan--cnr
(list :condition "BoundsError"
:restarts '("abandon-evaluation" "continue")
:unreachable '(1)
:abandon 0))
;; `let*': the digit is read out of `last-command-event' by the command
;; itself, so it has to be bound before the thunk runs and not beside it.
(let* ((last-command-event ?1)
(msg (test-flan--caught
(lambda ()
(call-interactively #'flan-cnr-take-number)))))
(test-flan--check "a digit on an unreachable restart is refused out loud"
(and msg (string-match-p "nowhere to land" msg)))
(test-flan--check "and nothing was sent for it"
(null sent))))))
;; And the same break drawn at a trap: every row refused, and refused for the
;; trap's reason. The wrong reason here is the one a user meets first in the
;; segfault break — "below this evaluation" about a break that is not inside
;; one, with nothing offered to abandon.
(let ((text (with-current-buffer
(test-flan--cnr
(list :condition "SIGSEGV"
:restarts '("continue")
:unreachable '(0)
:abandon nil
:trap t))
(buffer-string))))
(test-flan--check "a trap's rows say the trap has no transfer channel"
(string-match-p "no transfer channel" text))
(test-flan--check "and say nothing about an evaluation that is not there"
(not (string-match-p "below this evaluation" text))))
(let ((sent nil))
(let ((flan-cnr-request-function
(lambda (form) (setq sent form) (list :status "ok" :note "accepted"))))
(with-current-buffer (test-flan--cnr
(list :condition "SIGSEGV"
:restarts '("continue")
:unreachable '(0)
:trap t))
(let* ((last-command-event ?0)
(msg (test-flan--caught
(lambda ()
(call-interactively #'flan-cnr-take-number)))))
(test-flan--check "a digit at a trap is refused with the trap's reason"
(and msg (string-match-p "no transfer channel" msg)))
(test-flan--check "and not with the evaluation's"
(and msg (not (string-match-p "abandon" msg))))
(test-flan--check "nothing was sent for it either" (null sent))))))
;; The stack and its locals. The fixture is the shape `backtrace' and `locals'
;; answer with, and both frames carry `:fetched t' because their locals are
;; already here: without it `flan-cnr-toggle-frame' goes and asks the daemon

21
emacs/test-flan.el
View File

@ -995,6 +995,27 @@ already rely on it — so nothing here is a stand-in for the real thing."
(and (not (string-match-p "cannot be taken" (caar table)))
(string-match-p "cannot be taken" (car (nth 1 table)))
(equal (cdr (nth 1 table)) 1))))
;; The one entry that is neither "resume this" nor "kill the program", and
;; it is marked by its position: a program may establish a restart called
;; `abandon-evaluation' of its own, and only the agent knows which frame is
;; really the boundary.
(test-flan--check "the way out of an evaluation says what taking it does"
(let ((table (flan--restart-candidates
'("abandon-evaluation" "continue") '(1) 0)))
(and (string-match-p "stop running this expression"
(caar table))
(string-match-p "cannot be taken" (car (nth 1 table))))))
(test-flan--check "at a trap the prompt says the trap, not the evaluation"
(let ((table (flan--restart-candidates
'("continue") '(0) nil t)))
(and (string-match-p "from this trap" (caar table))
(not (string-match-p "below this break"
(caar table))))))
(test-flan--check "and a restart of that name that is not the boundary is not marked"
(not (string-match-p
"stop running"
(caar (flan--restart-candidates
'("abandon-evaluation") nil nil)))))
;; The payoff. The break loop *is* the poll loop, so an expression sent now
;; runs on the stopped thread and comes back — which is the one moment

128
lib/dev.ml
View File

@ -354,10 +354,36 @@ let state t =
is passed on rather than turned into an empty list: no restarts and cannot
say are different answers.
Each line is [I ± NAME]: the index it is taken by, whether it can be taken,
and the name. The index is the identity — two frames may offer [retry] and
a name cannot say which — and it is the program's number, not this end's
position in a list, so it is carried rather than recomputed. *)
Each line is [I F NAME]: the index it is taken by, a flag, and the name. The
index is the identity — two frames may offer [retry] and a name cannot say
which — and it is the program's number, not this end's position in a list,
so it is carried rather than recomputed.
The flag has three values. [+] is an ordinary restart that can be taken;
[-] is one that cannot, because it is below the evaluation this break is
inside or because the break has no transfer channel at all. [*] is the
boundary restart the agent establishes around an evaluation: takeable like
a [+], and taking it abandons the expression. It is carried apart from the
name because the name is not proof — a program may establish a restart
called [abandon-evaluation] of its own, and only the agent knows which
frame is really the boundary.
A line that is a bare [!] before the entries says the break was taken by a
trap, and that is a fact about the break rather than about any entry: at a
trap nothing can be taken, the boundary included, and a trap with an empty
restart list still has to be able to say so. Which is why it is not folded
into the flag — there would be no row to put it on. The two refusals are
kept apart because an editor shows the *reason*, and "below this
evaluation" in front of somebody looking at a segfault sends them hunting
for an evaluation that is not there. *)
type restart_flag =
| Takeable (* [+] *)
| Boundary (* [*] takeable, and it abandons *)
| Below (* [-] nothing for a transfer to land in *)
let takeable = function Takeable | Boundary -> true | Below -> false
(* The rows, and whether the break they came from was taken by a trap. *)
let restarts t =
match ask t "restarts" with
| text ->
@ -365,6 +391,8 @@ let restarts t =
if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines
then Error (String.trim text)
else begin
let trimmed = List.map String.trim lines in
let trap = List.mem "!" trimmed in
let parse line =
match String.index_opt line ' ' with
| None -> None
@ -377,14 +405,20 @@ let restarts t =
else
Some
( idx,
rest.[0] = '+',
(* An unknown character is read as [Below] rather than as
takeable: a flag this end does not recognise is a program
newer than the daemon, and refusing a restart that could
have been taken is the survivable half of that. *)
(match rest.[0] with
| '+' -> Takeable
| '*' -> Boundary
| _ -> Below),
String.sub rest 2 (String.length rest - 2) ))
in
Ok
( List.filter_map parse
(List.filter
(fun l -> l <> "" && l <> ".")
(List.map String.trim lines)))
(List.filter (fun l -> l <> "" && l <> "." && l <> "!") trimmed),
trap )
end
| exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)
@ -1580,7 +1614,7 @@ let break t =
| Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m)
| Stopped _ ->
(match restarts t with
| Ok rs ->
| Ok (rs, trap) ->
(* [:restarts] stays a list of names, positional and innermost first,
with duplicates kept — the position *is* the index, which is what
[restart-at] takes. [:unreachable] names the positions that are on
@ -1593,8 +1627,30 @@ let break t =
":unreachable "
^ Wire.ints
(List.filter_map
(fun (i, ok, _) -> if ok then None else Some i)
rs) ]
(fun (i, f, _) -> if takeable f then None else Some i)
rs);
(* Which position abandons the evaluation this break is inside,
and [nil] when it is not inside one. A position and not the
name, for the reason the agent identifies it by address: a
program is free to establish a restart called
[abandon-evaluation] of its own, and a client that matched on
the name would offer the program's restart as the way out of
an evaluation. *)
":abandon "
^ (match List.find_opt (fun (_, f, _) -> f = Boundary) rs with
| Some (i, _, _) -> string_of_int i
| None -> "nil");
(* Why those positions are refused, which is not the same
question as which they are. A break taken by a trap has no
transfer channel at all: every restart on it is refused, the
boundary included, so [:abandon] is nil here for a reason that
has nothing to do with there being no evaluation. A client
that inferred the reason from [:abandon] being nil would
caption a segfault with a sentence about an evaluation, and
there are two other ways to get a nil there — a break the
program took on its own, and a list so long it was
truncated. *)
":trap " ^ (if trap then "t" else "nil") ]
@ site_fields t)
| Error m -> error ("the program refused to list its restarts: " ^ m))
@ -2868,6 +2924,35 @@ let globals_op t =
stopped thread next comes round its loop, which is microseconds away and
still not now. An editor that read [ok] as "running again" would poll once,
find it stopped, and re-open the prompt it had just answered. *)
(* The two sentences a taken restart can come back with, and which one this
take earns.
Taking the boundary restart does not resume anything — it drops the
expression and puts the program back where it was called from — so the
ordinary note would be false in both halves.
Which of the two it was comes back *on the acceptance*: the agent answers
[ok abandon] for the boundary and [ok] for everything else. An earlier draft
asked [restarts] first and matched the index, which doubled the traffic of
the one verb somebody is sitting there waiting on, to learn a fact the other
end already had in front of it. A client that had to be told which entry
abandons — it is [:abandon] on the break reply — was never the problem; this
end was. *)
let taken_note ~abandoned =
Wire.quote
(if abandoned then
"accepted; the evaluation is abandoned. The program carries on from \
where it was called, and anything the expression changed before it \
stopped is still changed"
else "accepted; the program resumes at its next pass of the break loop")
(* [ok] or [ok abandon], and anything else is not an acceptance. *)
let accepted reply =
match String.trim reply with
| "ok" -> Some false
| "ok abandon" -> Some true
| _ -> None
let choose_at t ~index ~name =
match liveness t with
| Gone -> error gone
@ -2893,13 +2978,11 @@ let choose_at t ~index ~name =
^ match name with Some n -> " " ^ n | None -> ""
in
match ask t verb with
| reply when String.trim reply = "ok" ->
| reply when accepted reply <> None ->
ok
[ ":index " ^ string_of_int index;
":note "
^ Wire.quote
"accepted; the program resumes at its next pass of the break loop"
]
^ taken_note ~abandoned:(accepted reply = Some true) ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
@ -2920,12 +3003,14 @@ let choose t ~name =
speak to it. *)
error "a restart name cannot contain a control character"
else
(* [restart NAME] is defined as [restart-at] on the first index offering
the name, and it reports the same two acceptances for the same reason:
two verbs that resolve to one frame must not describe it differently. *)
match ask t ("restart " ^ name) with
| reply when String.trim reply = "ok" ->
| reply when accepted reply <> None ->
ok
[ ":restart " ^ Wire.quote name;
":note "
^ Wire.quote "accepted; the program resumes at its next pass of the break loop" ]
":note " ^ taken_note ~abandoned:(accepted reply = Some true) ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
@ -4184,6 +4269,12 @@ extern void (*flan_exit_hook)(int32_t status);
extern void flan_condition_stacks_reset(void);
extern void flan_dev_frames_reset(void) __attribute__((weak));
/* And the agent's own two floors and the boundary between them, which name
* counts and an address from a thunk the finished run was in the middle of.
* Weak because the agent is a package a program chooses to import, where the
* two above are linked into every dev build. */
extern void flan_agent_run_reset(void) __attribute__((weak));
/* And the collector's roots, which are the third stack threaded through stack
* the finished run no longer owns. main is re-entered by longjmp, which pops
* no frame, so every root the last run pushed still names an address the next
@ -4349,6 +4440,7 @@ static void flan_merged_exit(int32_t status) {
static void flan_merged_park(void) {
flan_condition_stacks_reset();
if (flan_dev_frames_reset) flan_dev_frames_reset();
if (flan_agent_run_reset) flan_agent_run_reset();
if (flan_dyn_root_reset) flan_dyn_root_reset();
pthread_mutex_lock(&program_lock);
program_state = PROGRAM_PARKED;

67
runtime/flan_rt.c
View File

@ -88,6 +88,13 @@ typedef struct flan_restart {
static flan_restart *restarts;
/* The frames a C caller pushes; see [flan_restart_push_c] below, which is
* where the argument for them is. Declared up here with the stack they go on,
* because [flan_condition_stacks_reset] empties all three together. */
#define C_RESTARTS 16
static flan_restart c_restarts[C_RESTARTS];
static int32_t c_restart_depth;
void flan_restart_push(flan_restart *r) {
r->prev = restarts;
restarts = r;
@ -241,6 +248,11 @@ void flan_exit(int32_t status) {
void flan_condition_stacks_reset(void) {
handlers = NULL;
restarts = NULL;
/* The C-pushed frames below go with them. Their storage is static rather
than stack, so a second run would not scribble over it — but a depth left
where the first run stopped is a leak of the only thing that is finite
here, and a re-run that starts sixteen deep offers no restart at all. */
c_restart_depth = 0;
}
/* The conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it.
@ -631,6 +643,61 @@ static uint32_t flan_name_id(const uint8_t *s, int64_t n) {
return h;
}
/* -- A restart frame pushed from C ----------------------------------- */
/* Every restart above is an alloca in the Flan function that established it.
* This is the one that is not: the agent runs an evaluated expression through
* a C frame of its own, and it wants a restart *at that frame* — one whose
* transfer unwinds the evaluation and leaves the program where it was called
* from. There is no Flan function there to hold the alloca, so the frames live
* here, where the struct does. Two files each declaring the shape is how the
* two stop agreeing, and the agent must not be the second one.
*
* A fixed array rather than malloc: this is pushed on the game thread at a
* frame boundary, and an allocation there is the thing the dev runtime exists
* to keep out. Sixteen is deeper than the break loop's own nesting limit, so
* running out means the nesting guard has already fired.
*
* [name] is not copied. Every caller passes a string constant that outlives
* the program, which is the same promise a Flan restart-case makes about the
* name it points at.
*
* NULL when there is no room, and then the caller simply has no restart to
* offer — an evaluation that cannot be abandoned is worse than one that can,
* and better than a scribble past the end of this array. */
void *flan_restart_push_c(const uint8_t *name, int64_t namelen) {
if (c_restart_depth >= C_RESTARTS) return NULL;
flan_restart *r = &c_restarts[c_restart_depth++];
r->name_id = flan_name_id(name, namelen);
r->name = name;
r->namelen = namelen;
flan_restart_push(r);
return r;
}
/* The pop, and it is deliberately not [flan_restart_pop]'s caller's business
* whether the stack still looks the way it did. A transfer that unwound past
* this frame has already popped everything above it — each restart-case pad
* pops its own before forwarding — but a frame that died some other way would
* leave the head pointing at rubbish on a stack that has gone. Assigning
* [r->prev] repairs both: the head goes back to what it was when this frame
* was pushed, which is true in either case. */
void flan_restart_pop_c(void *frame) {
if (frame == NULL) return;
flan_restart_pop((flan_restart *)frame);
if (c_restart_depth > 0) c_restart_depth--;
}
/* [flan_break_resume] stood here: look a restart up by the name someone typed
* and aim the channel at it. It was what the break loop resumed through when a
* choice was a *name*, and nothing has called it since the loop started
* choosing by position — a name cannot say which of two [retry] frames was
* meant, which is the whole reason the snapshot hands out indices. The last
* caller went with that change; the definition did not, and it sat here
* exporting a second way to resolve a restart that could only ever disagree
* with the one in use. NEXT.md already says there is no such function. Now
* there is not. */
void flan_error(uint32_t type_id, void *condition, void *xfer,
const uint8_t *name, int64_t namelen) {
flan_signal(type_id, condition, xfer);

305
test/test_dev.ml
View File

@ -990,7 +990,11 @@ let () =
fail "an expression that stopped inside a break answered anyway";
let r = ask "(:op \"break\")" in
if status r <> "ok" then fail "break inside a thunk: %s" (status r);
(* Four now: the thunk's own [fetch] frame over the one below it. *)
(* Five now: the thunk's own [fetch] frame, the boundary the agent
establishes around every evaluation, and the frame below it. The
boundary sits between the two groups by construction — it is pushed
after the floor is read and before the thunk runs — so its position
is also the line the floor draws. *)
let names =
match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } ->
@ -1000,9 +1004,18 @@ let () =
l
| _ -> []
in
if names <> [ "retry"; "use-placeholder"; "retry"; "use-placeholder" ]
if
names
<> [ "retry"; "use-placeholder"; "abandon-evaluation"; "retry";
"use-placeholder" ]
then fail "restarts at a break inside a thunk: %s"
(String.concat ", " names);
(* And it is named by position, not by spelling. A program may
establish a restart called [abandon-evaluation] of its own; [:abandon]
is the agent's own frame, identified by address. *)
(match Wire.field r "abandon" with
| Some { Form.v = Form.Int 2L; _ } -> ()
| _ -> fail "the break inside a thunk did not say which restart abandons it");
let unreachable =
match Wire.field r "unreachable" with
| Some { Form.v = Form.List l; _ } ->
@ -1014,7 +1027,7 @@ let () =
l
| _ -> []
in
if unreachable <> [ 2; 3 ] then
if unreachable <> [ 3; 4 ] then
fail "positions below the thunk: %s"
(String.concat ", " (List.map string_of_int unreachable));
(* And the backtrace says the same thing the restart list does, in its
@ -1031,7 +1044,7 @@ let () =
(String.concat ", "
(List.map (fun (n, _, o) -> n ^ "/" ^ o) fs)));
(* Refused, and refused *here* — not accepted and dropped. *)
let r = ask "(:op \"restart-at\" :index 2 :name \"retry\")" in
let r = ask "(:op \"restart-at\" :index 3 :name \"retry\")" in
if status r <> "error" then
fail "a restart below the thunk boundary was accepted";
(* The ones above it still work, so this refuses a case rather than
@ -1099,6 +1112,162 @@ let () =
fail "an expression after the break: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
(* The way out the floors used to leave missing, which is the report
this whole thing came from: a C-x C-e that signals must cost the
evaluation and not the session. The agent establishes a restart
at the thunk boundary, so every break reached from inside an
evaluation has one choice that is neither "resume this expression"
nor "kill the program".
Offered *beside* the thunk's own restarts rather than instead of
them: [fetch] establishes two, they are above the boundary and
takeable, and the boundary is last because it is the outermost
frame of the evaluation. *)
(let r =
ask
"(:op \"eval-expr\" :code \"(i64 (fetch 3))\" :file \"/tmp/buf.flan\")"
in
if status r <> "error" then
fail "an expression that stopped the program answered anyway";
let r = ask "(:op \"break\")" in
let names =
match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (n : Form.t) ->
match n.Form.v with Form.Str x -> Some x | _ -> None)
l
| _ -> []
in
if names <> [ "retry"; "use-placeholder"; "abandon-evaluation" ]
then
fail "restarts at a break inside an evaluation: %s"
(String.concat ", " names);
(* Nothing on this list is below anything: the program itself was
running, so the evaluation is the whole stack above it. *)
(match Wire.field r "unreachable" with
| Some { Form.v = Form.List []; _ } -> ()
| _ ->
fail "a break inside an evaluation over a running program \
refused one of its own restarts");
(match Wire.field r "abandon" with
| Some { Form.v = Form.Int 2L; _ } -> ()
| _ ->
fail "the break did not say which restart abandons the \
evaluation");
(* And it says *why* nothing is refused, which is a different fact
from which entries are: this break has a transfer channel. *)
(match Wire.field r "trap" with
| Some { Form.v = Form.Sym "nil"; _ } -> ()
| _ -> fail "a signalled break reported itself as a trap");
(* -- Two evaluations, and two boundaries ------------------- *)
(* The claim the save-and-restore is for: a second evaluation run
from inside the first one's break gets a boundary of its own, and
abandoning it leaves the first one exactly as it was. Both are on
one list — the inner one above the floor and takeable, the outer
one below it with the frames it belongs to — which is also what
proves they are two frames and not one reused. *)
let r =
ask
"(:op \"eval-expr\" :code \"(i64 (fetch 4))\" :file \"/tmp/buf.flan\")"
in
if status r <> "error" then
fail "a second evaluation stopped inside the first answered anyway";
let r = ask "(:op \"break\")" in
let names =
match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (n : Form.t) ->
match n.Form.v with Form.Str x -> Some x | _ -> None)
l
| _ -> []
in
if
names
<> [ "retry"; "use-placeholder"; "abandon-evaluation"; "retry";
"use-placeholder"; "abandon-evaluation" ]
then
fail "restarts at a break inside a nested evaluation: %s"
(String.concat ", " names);
let unreachable =
match Wire.field r "unreachable" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (n : Form.t) ->
match n.Form.v with
| Form.Int i -> Some (Int64.to_int i)
| _ -> None)
l
| _ -> []
in
(* The outer evaluation's own restarts, its boundary included: from
in here they are below a C frame that holds its own channel, so a
transfer to any of them lands nowhere. The inner boundary is the
only way out of the inner evaluation, which is the point. *)
if unreachable <> [ 3; 4; 5 ] then
fail "positions below the inner evaluation: %s"
(String.concat ", " (List.map string_of_int unreachable));
(match Wire.field r "abandon" with
| Some { Form.v = Form.Int 2L; _ } -> ()
| _ ->
fail "a nested evaluation did not name its own boundary as the \
one that abandons it");
let r =
ask "(:op \"restart-at\" :index 2 :name \"abandon-evaluation\")"
in
if status r <> "ok" then
fail "the inner boundary was refused: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
(* And the outer evaluation is back, with its three restarts and its
own boundary still on offer — an inner abandon must not have been
read as the outer one. *)
if not
(await (fun () ->
let r = ask "(:op \"break\")" in
status r = "ok"
&& (match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } -> List.length l = 3
| _ -> false)
&& (match Wire.field r "abandon" with
| Some { Form.v = Form.Int 2L; _ } -> true
| _ -> false)))
then
fail "the outer evaluation did not come back intact after the \
inner one was abandoned";
(* Taken by index with the name as the receipt, which is what an
editor sends: the position is the identity and the name is what
makes a stale position wrong out loud. *)
let r =
ask "(:op \"restart-at\" :index 2 :name \"abandon-evaluation\")"
in
if status r <> "ok" then
fail "the boundary restart was refused: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
(* And the note says what taking it did, because "resumes at its
next pass of the break loop" would be false in both halves —
nothing is resumed and there is no value coming. *)
(match Wire.string_field r "note" with
| Some n
when contains_sub n "the evaluation is abandoned"
&& contains_sub n "is still changed" -> ()
| n ->
fail "abandoning reported itself as %S" (Option.value ~default:"" n));
(* The whole claim, in one line: the program is running again. *)
if not (await (fun () -> not (stopped (ask "(:op \"describe\")"))))
then
fail "the program did not carry on after its evaluation was \
abandoned";
let r =
ask "(:op \"eval-expr\" :code \"(+ 3 4)\" :file \"/tmp/buf.flan\")"
in
if Wire.string_field r "value" <> Some "7" then
fail "an expression after an abandoned one: %s"
(Option.value ~default:(status r) (Wire.string_field r "message")));
(* An expression that stops *itself*. The thunk runs on the game
thread from inside a poll, and the break loop it lands in polls
again from inside that very call — so the agent's poll has to be
@ -1437,6 +1606,14 @@ let () =
if names <> [ "continue" ] then
fail "restarts at a bad index: %s" (String.concat ", " names)
| _ -> fail "break over a bad index listed no restarts");
(* And no way to abandon an evaluation, because there is no evaluation
to abandon: this program stopped on its own frame. Offering one here
would promise to unwind something nobody asked for. *)
(match Wire.field r "abandon" with
| Some { Form.v = Form.Sym "nil"; _ } -> ()
| _ ->
fail "a break the program took on its own offered to abandon an \
evaluation");
(* A break nested inside this one must not inherit the trap's site.
The fix-it-and-retry flow evaluates code *at* the bounds stop; if
that code raises its own error, its break has no trap behind it,
@ -1485,6 +1662,60 @@ let () =
in
if Wire.string_field r "value" <> Some "4" then
fail "an expression after a bad index: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
(* The report, reproduced on x86 and then answered.
The program is running its loop. An expression evaluated into it
indexes past the end, and nothing above the boundary establishes a
restart — a bad index establishes none, and the [continue] the
program's own frame offers is below the boundary, where a transfer
has nowhere to land. That list used to be empty of anything
takeable, which left abort as the only live choice, and abort ends
the process: a mistyped index cost the session.
The index is computed from a global so the compiler cannot decide
it at build time — a constant one is a compile error, which is the
right answer to a different question. *)
let r =
ask
"(:op \"eval-expr\" :code \"(at grid (i32 (+ ticks 100)))\" :file \"/tmp/buf.flan\")"
in
if status r <> "error" then
fail "an out-of-bounds expression answered instead of stopping";
let r = ask "(:op \"break\")" in
let names =
match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (n : Form.t) ->
match n.Form.v with Form.Str x -> Some x | _ -> None)
l
| _ -> []
in
if names <> [ "abandon-evaluation" ] then
fail "restarts at a bad index inside an evaluation: %s"
(String.concat ", " names);
(match Wire.field r "abandon" with
| Some { Form.v = Form.Int 0L; _ } -> ()
| _ ->
fail "the only restart on offer did not say it abandons the \
evaluation");
let r =
ask "(:op \"restart-at\" :index 0 :name \"abandon-evaluation\")"
in
if status r <> "ok" then
fail "abandoning an evaluation on x86: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "the x86 program did not carry on after its evaluation was \
abandoned";
(* Still the same program, with the globals it had: abandoning drops
the expression, it does not restart anything. *)
let r =
ask "(:op \"eval-expr\" :code \"(+ 5 5)\" :file \"/tmp/buf.flan\")"
in
if Wire.string_field r "value" <> Some "10" then
fail "an expression after an abandoned one on x86: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"))
end;
ignore (ask "(:op \"close\")");
@ -1527,7 +1758,7 @@ let () =
standalone half of the same claim is test_acceptance.ml's
free-all-refused, which still exits 134: nothing installs the hook in a
program that did not import the agent. *)
let trap_park ?(refault = false) what prog cond restarts =
let trap_park ?(refault = false) ?(trapping = "") what prog cond restarts =
let tsock = tmp (prog ^ ".sock") and tout = tmp (prog ^ ".out") in
(try Sys.remove tsock with Sys_error _ -> ());
let tfd =
@ -1621,6 +1852,15 @@ let () =
| _ ->
if restarts <> [] then
fail "break at the %s trap named no unreachable restarts" what);
(* Why they are refused, and it has to be answerable with *no*
restarts on the list at all — which is the shape the null
allocator has, and the reason this is a fact about the break
rather than a flag on an entry. An editor captions the rows from
it, and "below this evaluation" in front of somebody looking at a
trap sends them hunting for an evaluation that is not there. *)
(match Wire.field r "trap" with
| Some { Form.v = Form.Sym "t"; _ } -> ()
| _ -> fail "the %s trap did not say the break was taken by one" what);
(* And the refusal, where there is a name to refuse. Answered [err]
with the reason rather than [ok] and then dropped, which is the
shape that would tell an editor the program had resumed when it
@ -1676,6 +1916,58 @@ let () =
is only as good as SA_NODEFER: %s"
what (status r)
end;
(* The one case where "just ignore that whole call" cannot hold, and
it is the same reason every other refusal at a trap has: an
evaluation that *traps* stops with no transfer channel anywhere in
the call, so there is nothing for the boundary restart to unwind
through either. It is listed — it is a live frame, and hiding it
would make the one break where it does not work the one break that
never mentions it — and it is listed as untakeable, with
[:abandon] saying there is no position to offer. Fix the
expression and evaluate it again; that is the whole of the way
out. *)
if trapping <> "" then begin
let r =
ask
(Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")"
(Wire.quote trapping))
in
if status r <> "error" then
fail "an expression that trapped at the %s break answered anyway"
what;
let r = ask "(:op \"break\")" in
(match Wire.field r "restarts" with
| Some { Form.v = Form.List l; _ } ->
let names =
List.filter_map
(fun (n : Form.t) ->
match n.Form.v with Form.Str x -> Some x | _ -> None)
l
in
if names <> [ "abandon-evaluation" ] then
fail "restarts at a trap inside an evaluation: %s"
(String.concat ", " names)
| _ -> fail "break at a trap inside an evaluation listed nothing");
(match Wire.field r "unreachable" with
| Some { Form.v = Form.List [ { Form.v = Form.Int 0L; _ } ]; _ } -> ()
| _ ->
fail "the boundary restart was offered at a trap, where nothing \
can be taken");
(match Wire.field r "abandon" with
| Some { Form.v = Form.Sym "nil"; _ } -> ()
| _ ->
fail "a trap inside an evaluation named a position that abandons \
it");
(* And the reason those positions are refused, which is the half an
editor puts in front of somebody. [:abandon] being nil cannot
carry it: a break the program took on its own has a nil there
too, and captioning a segfault "below this evaluation" sends the
reader looking for an evaluation that is not there. *)
(match Wire.field r "trap" with
| Some { Form.v = Form.Sym "t"; _ } -> ()
| _ ->
fail "a break at a trap did not say it was taken by one")
end;
(* Torn down by [abort], not by [close]: a trap parks for good, so
there is no resume to wait for and nothing to gain by waiting.
@ -1707,7 +1999,8 @@ let () =
end
in
trap_park "free-all" "dev-trap-free-all.flan" "NoFreeAll" [ "continue" ];
trap_park "null allocator" "dev-trap-null-alloc.flan" "NullAllocator" [];
trap_park ~trapping:"(do (free-all nowhere) 0)" "null allocator"
"dev-trap-null-alloc.flan" "NullAllocator" [];
(* And the one that used to be a silent death rather than an exit code:
SIGSEGV. The author's dogfooding session sorted (bytes "INSERTIONSORT")
in place — the old aliasing bytes — and the session vanished without a

181
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. */
extern const uint8_t *flan_break_site;
extern int64_t flan_break_site_len;
/* A restart frame with no Flan function under it, which is what the boundary
* below is made of. The storage belongs to flan_rt.c for the reason the
* shadow-stack frame's shape does: the struct is declared in one file. */
extern void *flan_restart_push_c(const uint8_t *name, int64_t namelen);
extern void flan_restart_pop_c(void *frame);
/* -- How far down a transfer can actually land ----------------------- */
@ -363,6 +368,66 @@ static int32_t restart_floor;
* none of them are. So "not inside a thunk" gets a value of its own. */
static int32_t frame_floor = -1;
/* -- The way out that the floors left missing ------------------------- */
/* Everything above says which restarts a break inside a thunk cannot take. It
* took a report from someone whose game died to notice what that leaves when
* the answer is *all of them*: an expression evaluated with C-x C-e signals,
* nothing above the boundary established a restart — a bad index establishes
* none — and the whole list is either empty or below the floor. Then the only
* live choice at the break is [abort], and abort ends the process. A mistyped
* index cost a session that had been running for an hour.
*
* So the boundary offers a restart of its own. It is a real restart frame, on
* the real restart list, pushed by the agent immediately *after* the floor is
* read — which is what puts it above the floor and makes it reachable, where
* pushing it first would have marked it as the program's and refused it.
*
* Taking it aims the transfer at this frame. Nothing compares against it, so
* the unwind runs to the top of the thunk, [flan_reload_call] drops the
* channel it holds, and [flan_agent_poll] returns to whatever called it — the
* game loop, or an outer break. That is the same path a below-the-floor
* restart used to take by accident; the difference is that this one is what
* was asked for, and is reported as what happened.
*
* What it does not do, and nothing at this boundary could: undo. The thunk
* ran until it signalled, and every global it set and every byte it allocated
* on the way is still set and still allocated. Abandoning is "stop running
* this expression", not "unmake what it did".
*
* NULL when no thunk is in progress, which is also the answer to "is there an
* evaluation to abandon": a program that broke on its own is not inside one,
* and a break there must not offer this. Game thread only, saved and restored
* around the call like the floors, so nesting names the innermost. */
static void *eval_boundary;
static const uint8_t abandon_name[] = "abandon-evaluation";
/* The three of them, dropped between two runs of [main]. The counterpart of
* flan_rt.c's [flan_condition_stacks_reset] and flan_dev.c's
* [flan_dev_frames_reset], called from the same one place and for the same
* reason: a merged dev build re-enters [main] by longjmp, which pops no frame,
* so a thunk that was in progress when the run ended leaves a floor counting
* frames that are gone and a boundary naming a [c_restarts] slot the runtime
* has just released.
*
* Harmless today — a program's restart frames are allocas and can never
* compare equal to that address, so a stale boundary marks nothing — and left
* in that state it is one changed representation away from marking the wrong
* entry. The floors go with it because they are the same kind of state and it
* would be strange to empty two thirds of it. */
void flan_agent_run_reset(void) {
eval_boundary = NULL;
restart_floor = 0;
frame_floor = -1;
}
/* Nothing counts how many evaluations have been abandoned, and that is a
* decision rather than an omission. The editor is told twice already: the
* reply to the evaluation says the expression stopped before it produced a
* value, and the reply to the restart says taking that one abandoned it. A
* counter here would be a third telling, read by nobody, which is how a wire
* grows a verb whose answer drifts from what happened. */
/* What the listener thread hands the stopped game thread. One slot, because
* only one thread is ever stopped. */
/* A *depth*, not a flag. A thunk this loop runs may itself error, and the
@ -426,6 +491,18 @@ typedef struct {
void *frame[SNAP_MAX];
int32_t off[SNAP_MAX], len[SNAP_MAX];
int32_t reachable[SNAP_MAX];
/* Which entry is [eval_boundary]'s, or -1 when this break is not inside an
* evaluation. An index rather than a per-entry flag, because there is at
* most one on any list: the outer thunk's boundary is below this one's
* floor and is already marked unreachable. Recorded here rather than
* recomputed at reply time for the reason everything else is — the listener
* answers from the snapshot and never reads the live stack.
*
* A reader must not look for the *name* instead. Nothing stops a program
* establishing a restart called [abandon-evaluation] of its own, and a
* client that matched on the name would offer the program's restart as the
* way out of an evaluation. The address is what makes it this one. */
int32_t boundary;
int32_t used;
char names[SNAP_NAMES];
/* Where the stopped thread is, taken at the same moment and for the same
@ -545,23 +622,61 @@ static int snap_push(int resumable, void *cond) {
s->total = n;
s->used = 0;
s->n = 0;
for (int32_t i = 0; i < n && s->n < SNAP_MAX; i++) {
s->boundary = -1;
/* One slot and one name's worth of bytes kept back for the boundary, and the
* arithmetic below is the whole of why.
*
* The walk runs innermost first and stops at the first limit it meets, so the
* *outermost* entries are the ones truncation drops — and the boundary is the
* outermost entry of the evaluation, which makes it the first casualty. A
* thunk that established 64 restarts of its own would therefore reproduce the
* bug this change exists to fix, exactly: a full list, nothing on it that
* leaves the evaluation, and abort as the only live choice.
*
* So it is placed rather than found when the walk does not reach it. The cost
* is one listed restart out of sixty-four whenever an evaluation is in
* progress, which is a straight trade against losing the way out. */
const int32_t held = (eval_boundary != NULL) ? 1 : 0;
const int32_t held_bytes = held ? (int32_t)sizeof abandon_name : 0;
for (int32_t i = 0; i < n && s->n < SNAP_MAX - held; i++) {
int64_t len = 0;
const uint8_t *nm = flan_restart_name(i, &len);
void *fr = flan_restart_frame(i);
if (nm == NULL || fr == NULL) continue;
if (len < 0) len = 0;
if ((int64_t)s->used + len + 1 > SNAP_NAMES) break;
if ((int64_t)s->used + len + 1 > SNAP_NAMES - held_bytes) break;
s->frame[s->n] = fr;
s->off[s->n] = s->used;
s->len[s->n] = (int32_t)len;
/* The outermost [restart_floor] frames are below the thunk boundary. */
s->reachable[s->n] = (i < n - restart_floor);
if (fr == eval_boundary && eval_boundary != NULL) s->boundary = s->n;
memcpy(s->names + s->used, nm, (size_t)len);
s->used += (int32_t)len;
s->names[s->used++] = 0;
s->n++;
}
/* The slot kept back, used only when the walk ran out before reaching it.
* Appended rather than inserted at its live position: every index that
* crosses the wire is a position in *this* array — [restart-at] resolves
* through [s->frame] — so the snapshot's order is the only order there is,
* and the entry is the same frame wherever it sits. The name is the one this
* file pushed; the runtime is not asked for it back. */
if (held && s->boundary < 0 && s->n < SNAP_MAX
&& (int32_t)s->used + held_bytes <= SNAP_NAMES) {
int32_t len = (int32_t)sizeof abandon_name - 1;
s->frame[s->n] = eval_boundary;
s->off[s->n] = s->used;
s->len[s->n] = len;
/* Reachable by construction: it is pushed above the floor, and the floor
* is what [reachable] is measured against. */
s->reachable[s->n] = 1;
s->boundary = s->n;
memcpy(s->names + s->used, abandon_name, (size_t)len);
s->used += len;
s->names[s->used++] = 0;
s->n++;
}
/* And the frames, from the same held-still stack. A deep recursion is
* truncated rather than followed: the innermost frames are the ones the
* question is about, and the count says how many were left out. */
@ -739,6 +854,8 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition,
* and silence is how this went wrong the first time. */
fprintf(stderr, " %2d. restart: %s%s\n", i, s->names + s->off[i],
!s->resumable ? " (cannot be taken from this trap)"
: i == s->boundary
? " (stop running the expression; the program carries on)"
: s->reachable[i] ? ""
: " (below this break; cannot be taken)");
if (s->total > s->n)
@ -790,7 +907,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
&& 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);
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);
@ -899,9 +1026,18 @@ int32_t flan_agent_poll(void) {
if (j.call != NULL) {
int32_t outer = restart_floor;
int32_t oframe = frame_floor;
void *obound = eval_boundary;
restart_floor = flan_restart_count();
frame_floor = flan_dev_frame_count();
/* After the floor is read and not before: the floor counts the frames
* that were there when the thunk started, and this one is the thunk's.
* Pushed first it would be below its own boundary and refused. */
eval_boundary = flan_restart_push_c(abandon_name, sizeof abandon_name - 1);
j.call();
/* Popped whichever way the thunk left — returning with a value, or
* unwinding past this frame because someone abandoned it. */
flan_restart_pop_c(eval_boundary);
eval_boundary = obound;
restart_floor = outer;
frame_floor = oframe;
}
@ -1094,14 +1230,38 @@ static void handle_line(char *line, sink *o) {
if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; }
snapshot *s = snap_top();
if (s == NULL) { reply(o, "err no restart snapshot\n"); return; }
/* Ahead of the entries, and only at a trap: [!] on a line of its own says
* that this break has no transfer channel, so nothing below can be taken
* whatever its flag says.
*
* A line rather than a fourth flag value, because it is a fact about the
* *break* and not about any entry — and because a trap with an empty
* restart list has no entry to carry it, which is exactly the shape
* [dev-trap-null-alloc] has. The terminal listing says the same thing in
* words above its own list; an editor that had to infer the reason from
* the absence of a boundary would caption a segfault with a sentence about
* an evaluation that is not there.
*
* Safely ignored by a client that does not know it: the line does not
* start with an index, so a parser looking for [I F NAME] drops it. */
if (!s->resumable) reply(o, "!\n");
for (int32_t i = 0; i < s->n; i++) {
char hdr[32];
/* Both facts fold into the one flag, because the flag answers one
* question — can this be taken — and a break taken by a trap can take
* none of them. The terminal listing above says the same thing in
* words; the two must not describe different programs. */
* words; the two must not describe different programs.
*
* [*] is a third value of that same flag and not a fourth column: the
* boundary restart is takeable, so it answers the flag's question with
* yes, and the extra thing it says is what taking it means. A client
* that only knows [+] and [-] gets it wrong in the safe direction — it
* reads a takeable restart as takeable, and only misses that this one
* is the way out. */
int k = snprintf(hdr, sizeof hdr, "%d %c ", i,
(s->resumable && s->reachable[i]) ? '+' : '-');
!(s->resumable && s->reachable[i]) ? '-'
: i == s->boundary ? '*'
: '+');
if (k > 0) emit(o, hdr, (size_t)k);
emit(o, s->names + s->off[i], (size_t)s->len[i]);
reply(o, "\n");
@ -1244,7 +1404,13 @@ static void handle_line(char *line, sink *o) {
/* Published last, so the game thread never reads an index that is about
* to change, or one whose generation has not arrived yet. */
atomic_store(&chosen_ready, 1);
reply(o, "ok\n");
/* "ok", and for the boundary "ok abandon". Said on the acceptance rather
* than looked up afterwards, because afterwards there is nothing to look
* it up in: the take resumes the stopped thread and the snapshot it was
* resolved against is popped. The daemon used to re-ask [restarts] before
* sending, purely to word its note — a second round trip on the verb a
* person is waiting on, for a fact this end already holds. */
reply(o, idx == s->boundary ? "ok abandon\n" : "ok\n");
return;
}
/* By name, still, for a person at a raw socket - and now defined as
@ -1284,7 +1450,10 @@ static void handle_line(char *line, sink *o) {
atomic_store(&chosen_index, at);
atomic_store(&chosen_gen, s->gen);
atomic_store(&chosen_ready, 1);
reply(o, "ok\n");
/* The same two answers as [restart-at], because this verb is defined as
* that one on the first index offering the name. Two verbs that resolve to
* the same frame must not report it differently. */
reply(o, at == s->boundary ? "ok abandon\n" : "ok\n");
return;
}
if (strcmp(line, "abort") == 0) {