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

Review follow-ups: a trap is not an evaluation, and the way out cannot be truncated away

Browse Source 
The break buffer captioned every refused restart "below this evaluation", which
is the wrong sentence at a trap: there is no transfer channel, nothing on the
list can be taken, and there is no evaluation to abandon. The terminal listing
had always said the two apart. The wire now does too — a bare ! line ahead of
the entries, because a trap with no restarts at all still has to be able to say
so, and because :abandon being nil means three different things.

The boundary was also the first entry truncation dropped: snap_push walks
innermost first, and the boundary is the outermost frame of the evaluation. A
slot and a name's worth of bytes are kept back for it.

flan_break_resume goes; nothing has called it since choices became positions,
and NEXT.md already said there was no such function. eval_boundary is cleared
between runs beside the two stacks that already were. And the note on a taken
restart stops costing a second round trip: the agent answers ok abandon for the
boundary, which is the end that knows.

Nested boundaries are tested rather than argued: two evaluations, six restarts,
and abandoning the inner leaves the outer with its own still on offer.
This commit is contained in:
Joseph Ferano 2026-09-21 09:04:35 +07:00
parent fe6744ae41
commit 41334b3a8f
9 changed files with 441 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
FIX.org
View File

@ -4599,3 +4599,58 @@ wait already ends the moment the thunk breaks (see "an evaluated expression
that signals says so at once" above), that signals says so at once" above),
and the restart's own reply says what taking it did. A third telling read by 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. 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.

59
emacs/flan-cnr.el
View File

@ -104,11 +104,11 @@ 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 &optional unreachable abandon) (defun flan-cnr-annotate-restarts (names &optional unreachable abandon trap)
"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 KIND), where SHADOWED-BY is the index of 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, the earlier entry that owns the name, or nil, and KIND is one of nil,
`unreachable' or `abandon'. `unreachable', `trapped' or `abandon'.
Shadowing is §4's walk, computed here because it can be: `restart NAME' 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 resolves through `flan_find_restart', which returns the first frame whose hash
@ -116,19 +116,28 @@ 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 there is. Nothing new has to be asked of the program to know that — the order
of the list already says it. of the list already says it.
The other two come off the reply, because nothing here can work them out. The rest come off the reply, because nothing here can work them out.
UNREACHABLE is the positions the program will refuse: a restart below the UNREACHABLE is the positions the program will refuse. ABANDON is the position
evaluation this break is inside has nowhere for a transfer to land. ABANDON is that drops the evaluation, and it is a position rather than a name on purpose —
the position that drops the evaluation, and it is a position rather than a name a program may establish a restart called `abandon-evaluation' of its own, and
on purpose — a program may establish a restart called `abandon-evaluation' of only the agent knows which frame is really the boundary.
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)) (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) (cond (trap 'trapped)
((eql i abandon) 'abandon)
((memq i unreachable) 'unreachable))))) ((memq i unreachable) 'unreachable)))))
names))) names)))
@ -279,7 +288,8 @@ indexing or the division itself, so it sits directly under the headline."
(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 :unreachable)
(plist-get state :abandon)))) (plist-get state :abandon)
(plist-get state :trap))))
(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"
@ -296,13 +306,16 @@ indexing or the division itself, so it sits directly under the headline."
;; inner one. A row the program will refuse loses the bracket for ;; inner one. A row the program will refuse loses the bracket for
;; a different reason, and says which in its own words. ;; 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 (or owner (eq kind 'unreachable)) " " "[") (if (or owner (memq kind '(unreachable trapped)))
" " "[")
(propertize name 'face (propertize name 'face
(cond ((eq kind 'unreachable) 'shadow) (cond ((memq kind '(unreachable trapped))
'shadow)
((eq kind 'abandon) 'warning) ((eq kind 'abandon) 'warning)
(owner 'shadow) (owner 'shadow)
(t 'font-lock-keyword-face))) (t 'font-lock-keyword-face)))
(if (or owner (eq kind 'unreachable)) " " "]"))) (if (or owner (memq kind '(unreachable trapped)))
" " "]")))
(insert (make-string (- w (length name)) ?\s)) (insert (make-string (- w (length name)) ?\s))
(cond (cond
;; What the reader wants nine times in ten after a C-x C-e went ;; What the reader wants nine times in ten after a C-x C-e went
@ -319,6 +332,14 @@ indexing or the division itself, so it sits directly under the headline."
(insert (propertize (insert (propertize
"below this evaluation; a transfer to it has nowhere to land" "below this evaluation; a transfer to it has nowhere to land"
'face 'shadow))) '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 (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)
@ -499,6 +520,14 @@ puts the likely culprit on top."
;; answers are the same sentence; this one arrives without a round trip, and ;; 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 ;; either way something is *said* — a choice that quietly does nothing is
;; the defect this whole line exists to close. ;; 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) ((eq (get-text-property (point) 'flan-cnr-kind) 'unreachable)
(user-error (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" "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"
@ -701,6 +730,10 @@ data and the fixture-driven tests can drive it without a socket."
;; took on its own. ;; took on its own.
:unreachable (plist-get reply :unreachable) :unreachable (plist-get reply :unreachable)
:abandon (plist-get reply :abandon) :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. ;; 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.

11
emacs/flan.el
View File

@ -1121,12 +1121,17 @@ 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 &optional abandon) (defun flan--restart-candidates (restarts unreachable &optional abandon trap)
"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 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 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. 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 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))
@ -1134,6 +1139,7 @@ identity: two entries may read the same and mean different frames."
(setq i (1+ i)) (setq i (1+ i))
(cons (format "%d. %s%s" i name (cons (format "%d. %s%s" i name
(cond (cond
(trap " (cannot be taken from this trap)")
((eql i abandon) ((eql i abandon)
" (stop running this expression; the program carries on)") " (stop running this expression; the program carries on)")
((memq i unreachable) ((memq i unreachable)
@ -1244,7 +1250,8 @@ than being told so."
(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))
(abandon (plist-get r :abandon)) (abandon (plist-get r :abandon))
(table (flan--restart-candidates restarts unreachable 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 ;; 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 ;; 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 ;; wrong: drop the expression, keep the program. `abort' is still

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

@ -962,6 +962,17 @@ would be overwritten. Look again and re-do the edit")
(test-flan--check "and an ordinary restart is neither" (test-flan--check "and an ordinary restart is neither"
(null (nth 3 (nth 0 rows))))) (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 ;; 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 ;; `abandon-evaluation' of its own, and offering that as the way out of an
;; evaluation would promise an unwind nobody can make. ;; evaluation would promise an unwind nobody can make.
@ -1135,6 +1146,41 @@ would be overwritten. Look again and re-do the edit")
(test-flan--check "and nothing was sent for it" (test-flan--check "and nothing was sent for it"
(null sent)))))) (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' ;; 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

6
emacs/test-flan.el
View File

@ -1005,6 +1005,12 @@ already rely on it — so nothing here is a stand-in for the real thing."
(and (string-match-p "stop running this expression" (and (string-match-p "stop running this expression"
(caar table)) (caar table))
(string-match-p "cannot be taken" (car (nth 1 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" (test-flan--check "and a restart of that name that is not the boundary is not marked"
(not (string-match-p (not (string-match-p
"stop running" "stop running"

137
lib/dev.ml
View File

@ -359,14 +359,31 @@ let state t =
which — and it is the program's number, not this end's position in a list, which — and it is the program's number, not this end's 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 The flag has three values. [+] is an ordinary restart that can be taken;
taken; [-] is one that cannot, because it is below the evaluation this break [-] is one that cannot, because it is below the evaluation this break is
is inside or because a trap has no channel to transfer through. [*] is the inside or because the break has no transfer channel at all. [*] is the
boundary restart the agent itself establishes around an evaluation: it can boundary restart the agent establishes around an evaluation: takeable like
be taken like a [+], and taking it abandons the expression. It is carried a [+], and taking it abandons the expression. It is carried apart from the
apart from the name because the name is not proof — a program may establish name because the name is not proof — a program may establish a restart
a restart called [abandon-evaluation] of its own, and only the agent knows called [abandon-evaluation] of its own, and only the agent knows which
which frame is really the boundary. *) 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 = let restarts t =
match ask t "restarts" with match ask t "restarts" with
| text -> | text ->
@ -374,6 +391,8 @@ let restarts t =
if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines if List.exists (fun l -> String.length l >= 3 && String.sub l 0 3 = "err") lines
then Error (String.trim text) then Error (String.trim text)
else begin else begin
let trimmed = List.map String.trim lines in
let trap = List.mem "!" trimmed in
let parse line = let parse line =
match String.index_opt line ' ' with match String.index_opt line ' ' with
| None -> None | None -> None
@ -386,15 +405,20 @@ let restarts t =
else else
Some Some
( idx, ( idx,
rest.[0] = '+' || rest.[0] = '*', (* An unknown character is read as [Below] rather than as
rest.[0] = '*', 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) )) String.sub rest 2 (String.length rest - 2) ))
in in
Ok Ok
( List.filter_map parse ( List.filter_map parse
(List.filter (List.filter (fun l -> l <> "" && l <> "." && l <> "!") trimmed),
(fun l -> l <> "" && l <> ".") trap )
(List.map String.trim lines)))
end end
| exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)
@ -1590,7 +1614,7 @@ let break t =
| Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m) | Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m)
| Stopped _ -> | Stopped _ ->
(match restarts t with (match restarts t with
| Ok rs -> | Ok (rs, trap) ->
(* [:restarts] stays a list of names, positional and innermost first, (* [:restarts] stays a list of names, positional and innermost first,
with duplicates kept — the position *is* the index, which is what with duplicates kept — the position *is* the index, which is what
[restart-at] takes. [:unreachable] names the positions that are on [restart-at] takes. [:unreachable] names the positions that are on
@ -1599,11 +1623,11 @@ 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, f, _) -> if takeable f then None else Some i)
rs); rs);
(* Which position abandons the evaluation this break is inside, (* Which position abandons the evaluation this break is inside,
and [nil] when it is not inside one. A position and not the and [nil] when it is not inside one. A position and not the
@ -1613,9 +1637,20 @@ let break t =
the name would offer the program's restart as the way out of the name would offer the program's restart as the way out of
an evaluation. *) an evaluation. *)
":abandon " ":abandon "
^ (match List.find_opt (fun (_, _, b, _) -> b) rs with ^ (match List.find_opt (fun (_, f, _) -> f = Boundary) rs with
| Some (i, _, _, _) -> string_of_int i | Some (i, _, _) -> string_of_int i
| None -> "nil") ] | 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) @ 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))
@ -2894,22 +2929,15 @@ let globals_op t =
Taking the boundary restart does not resume anything — it drops the Taking the boundary restart does not resume anything — it drops the
expression and puts the program back where it was called from — so 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 ordinary note would be false in both halves.
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
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 = let taken_note ~abandoned =
Wire.quote Wire.quote
(if abandoned then (if abandoned then
@ -2918,6 +2946,13 @@ let taken_note ~abandoned =
stopped is still changed" stopped is still changed"
else "accepted; the program resumes at its next pass of the break loop") 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 = let choose_at t ~index ~name =
match liveness t with match liveness t with
| Gone -> error gone | Gone -> error gone
@ -2942,15 +2977,12 @@ 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 accepted reply <> None ->
ok ok
[ ":index " ^ string_of_int index; [ ":index " ^ string_of_int index;
":note " ^ taken_note ~abandoned:(boundary = Some index) ] ":note "
^ taken_note ~abandoned:(accepted reply = Some true) ]
| 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)
@ -2972,21 +3004,13 @@ let choose t ~name =
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 (* [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 the name, and it reports the same two acceptances for the same reason:
frame it will reach is the boundary. Read first, for [choose_at]'s two verbs that resolve to one frame must not describe it differently. *)
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 accepted reply <> None ->
ok ok
[ ":restart " ^ Wire.quote name; ":note " ^ taken_note ~abandoned ] [ ":restart " ^ Wire.quote name;
":note " ^ taken_note ~abandoned:(accepted reply = Some true) ]
| 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)
@ -4245,6 +4269,12 @@ extern void (*flan_exit_hook)(int32_t status);
extern void flan_condition_stacks_reset(void); extern void flan_condition_stacks_reset(void);
extern void flan_dev_frames_reset(void) __attribute__((weak)); 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 /* 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 * 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 * no frame, so every root the last run pushed still names an address the next
@ -4410,6 +4440,7 @@ static void flan_merged_exit(int32_t status) {
static void flan_merged_park(void) { static void flan_merged_park(void) {
flan_condition_stacks_reset(); flan_condition_stacks_reset();
if (flan_dev_frames_reset) flan_dev_frames_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(); if (flan_dyn_root_reset) flan_dyn_root_reset();
pthread_mutex_lock(&program_lock); pthread_mutex_lock(&program_lock);
program_state = PROGRAM_PARKED; program_state = PROGRAM_PARKED;

18
runtime/flan_rt.c
View File

@ -688,15 +688,15 @@ void flan_restart_pop_c(void *frame) {
if (c_restart_depth > 0) c_restart_depth--; if (c_restart_depth > 0) c_restart_depth--;
} }
/* What the break loop calls to resume: look a restart up by the name someone /* [flan_break_resume] stood here: look a restart up by the name someone typed
* typed and aim the channel at it. 0 if no frame offers it, and then the loop * and aim the channel at it. It was what the break loop resumed through when a
* says so rather than resuming into nothing. */ * choice was a *name*, and nothing has called it since the loop started
int32_t flan_break_resume(const uint8_t *name, int64_t namelen, void *xfer) { * choosing by position — a name cannot say which of two [retry] frames was
void *r = flan_find_restart(flan_name_id(name, namelen)); * meant, which is the whole reason the snapshot hands out indices. The last
if (r == NULL) return 0; * caller went with that change; the definition did not, and it sat here
*(void **)xfer = r; * exporting a second way to resolve a restart that could only ever disagree
return 1; * 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, 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) {

103
test/test_dev.ml
View File

@ -1155,6 +1155,89 @@ let () =
| _ -> | _ ->
fail "the break did not say which restart abandons the \ fail "the break did not say which restart abandons the \
evaluation"); 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 (* 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 editor sends: the position is the identity and the name is what
makes a stale position wrong out loud. *) makes a stale position wrong out loud. *)
@ -1769,6 +1852,15 @@ let () =
| _ -> | _ ->
if restarts <> [] then if restarts <> [] then
fail "break at the %s trap named no unreachable restarts" what); 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] (* And the refusal, where there is a name to refuse. Answered [err]
with the reason rather than [ok] and then dropped, which is the with the reason rather than [ok] and then dropped, which is the
shape that would tell an editor the program had resumed when it shape that would tell an editor the program had resumed when it
@ -1865,7 +1957,16 @@ let () =
| Some { Form.v = Form.Sym "nil"; _ } -> () | Some { Form.v = Form.Sym "nil"; _ } -> ()
| _ -> | _ ->
fail "a trap inside an evaluation named a position that abandons \ fail "a trap inside an evaluation named a position that abandons \
it") 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; 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.

87
vendor/agent/flan_agent.c vendored
View File

@ -402,6 +402,25 @@ static int32_t frame_floor = -1;
static void *eval_boundary; static void *eval_boundary;
static const uint8_t abandon_name[] = "abandon-evaluation"; 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 /* Nothing counts how many evaluations have been abandoned, and that is a
* decision rather than an omission. The editor is told twice already: the * decision rather than an omission. The editor is told twice already: the
* reply to the evaluation says the expression stopped before it produced a * reply to the evaluation says the expression stopped before it produced a
@ -604,13 +623,28 @@ static int snap_push(int resumable, void *cond) {
s->used = 0; s->used = 0;
s->n = 0; s->n = 0;
s->boundary = -1; s->boundary = -1;
for (int32_t i = 0; i < n && s->n < SNAP_MAX; i++) { /* 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; int64_t len = 0;
const uint8_t *nm = flan_restart_name(i, &len); const uint8_t *nm = flan_restart_name(i, &len);
void *fr = flan_restart_frame(i); void *fr = flan_restart_frame(i);
if (nm == NULL || fr == NULL) continue; if (nm == NULL || fr == NULL) continue;
if (len < 0) len = 0; 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->frame[s->n] = fr;
s->off[s->n] = s->used; s->off[s->n] = s->used;
s->len[s->n] = (int32_t)len; s->len[s->n] = (int32_t)len;
@ -622,6 +656,27 @@ static int snap_push(int resumable, void *cond) {
s->names[s->used++] = 0; s->names[s->used++] = 0;
s->n++; 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 /* And the frames, from the same held-still stack. A deep recursion is
* truncated rather than followed: the innermost frames are the ones the * truncated rather than followed: the innermost frames are the ones the
* question is about, and the count says how many were left out. */ * question is about, and the count says how many were left out. */
@ -1175,6 +1230,21 @@ static void handle_line(char *line, sink *o) {
if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; } if (!(atomic_load(&depth) > 0)) { reply(o, "err not stopped\n"); return; }
snapshot *s = snap_top(); snapshot *s = snap_top();
if (s == NULL) { reply(o, "err no restart snapshot\n"); return; } 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++) { for (int32_t i = 0; i < s->n; i++) {
char hdr[32]; char hdr[32];
/* Both facts fold into the one flag, because the flag answers one /* Both facts fold into the one flag, because the flag answers one
@ -1334,7 +1404,13 @@ static void handle_line(char *line, sink *o) {
/* Published last, so the game thread never reads an index that is about /* Published last, so the game thread never reads an index that is about
* to change, or one whose generation has not arrived yet. */ * to change, or one whose generation has not arrived yet. */
atomic_store(&chosen_ready, 1); 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; return;
} }
/* By name, still, for a person at a raw socket - and now defined as /* By name, still, for a person at a raw socket - and now defined as
@ -1374,7 +1450,10 @@ static void handle_line(char *line, sink *o) {
atomic_store(&chosen_index, at); atomic_store(&chosen_index, at);
atomic_store(&chosen_gen, s->gen); atomic_store(&chosen_gen, s->gen);
atomic_store(&chosen_ready, 1); 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; return;
} }
if (strcmp(line, "abort") == 0) { if (strcmp(line, "abort") == 0) {