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

Aborting an expression that trapped in the park abandons it by a jump back to the poll that called it, and the session stays

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 13:28:16 +07:00
parent 1998f57ca8
commit 639ff1859c
7 changed files with 210 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lib/dev.ml
View File

@ -3450,12 +3450,12 @@ let abort t =
(* A thunk stopped in the break loop on the parked thread. Aborting it is
abandoning the expression, not ending the process: the program had
already finished, and the break loop offers the thunk's own boundary as a
restart, so that is what is taken and the session stays parked. A trap
offers nothing that can be taken, and there abort still ends the
process. *)
restart, so that is what is taken and the session stays parked. At a
trap the boundary is left by a jump rather than a transfer (the agent's
[eval_escape]), and it is offered the same way. *)
| Parked
when match restarts t with
| Ok (rs, false) -> List.exists (fun (_, f, _) -> f = Boundary) rs
| Ok (rs, _) -> List.exists (fun (_, f, _) -> f = Boundary) rs
| _ -> false ->
(match restarts t with
| Ok (rs, _) ->
@ -3465,7 +3465,9 @@ let abort t =
ok
[ ":note "
^ Wire.quote
"the evaluation is abandoned; the program is still parked, and anything the expression changed before it stopped stays changed" ]
"the evaluation is abandoned; the program is still parked, \
and anything the expression changed before it stopped \
stays changed" ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) -> error (unreachable t e))
| Error m -> error m)

5
runtime/flan_dev.c
View File

@ -1064,6 +1064,11 @@ flan_frame *flan_frame_head;
* which is the failure this whole file exists to avoid. */
void flan_dev_frames_reset(void) { flan_frame_head = NULL; }
/* Where the chain stood, and putting it back there: the agent's way out of a
* trapped evaluation jumps past the frames the evaluation pushed. */
void *flan_dev_frames_mark(void) { return flan_frame_head; }
void flan_dev_frames_restore(void *head) { flan_frame_head = (flan_frame *)head; }
/* [i] counts from the innermost. NULL past the end, which is how a caller
* learns the depth without a second walk. */
void *flan_dev_frame_at(int32_t i) {

5
runtime/flan_dyn.c
View File

@ -1406,6 +1406,11 @@ void flan_dyn_root_globals_end(void) { roots_base = roots_n; }
void flan_dyn_root_reset(void) { roots_n = roots_base; }
/* The same for one evaluation that trapped: the roots its frames pushed are
* dropped, and the ones below it kept. */
int64_t flan_dyn_root_mark(void) { return roots_n; }
void flan_dyn_root_restore(int64_t n) { if (n <= roots_n) roots_n = n; }
/* ── Constructors ──────────────────────────────────────────────────────*/
flan_dyn flan_dyn_nil(void) { return dyn_make(BOX_NIL, 0); }

2
runtime/flan_dyn.h
View File

@ -416,6 +416,8 @@ void flan_dyn_track_vecs(void);
* every dyn global for the whole of the park. This resets to the line
* [flan_dyn_root_globals_end] recorded. */
void flan_dyn_root_reset(void);
int64_t flan_dyn_root_mark(void);
void flan_dyn_root_restore(int64_t n);
/* Where that line comes from. The emitted [main] brackets its global pushes
* with these: [begin] immediately before the first, [end] immediately after

15
runtime/flan_rt.c
View File

@ -278,6 +278,21 @@ void flan_condition_stacks_reset(void) {
c_restart_depth = 0;
}
/* The same three, marked and put back rather than emptied: an evaluation that
* trapped is left by a jump past every frame it pushed, so the chains are
* returned to where they stood when it was called (see the agent's poll). */
void flan_condition_stacks_mark(void **h, void **r, int32_t *d) {
*h = handlers;
*r = restarts;
*d = c_restart_depth;
}
void flan_condition_stacks_restore(void *h, void *r, int32_t d) {
handlers = (flan_handler *)h;
restarts = (flan_restart *)r;
c_restart_depth = d;
}
/* The conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it.
* calc-me's tokenizer needs the first, the prelude's printers the second. */

103
test/test_dev.ml
View File

@ -1937,16 +1937,10 @@ 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. *)
(* An evaluation that traps stops with no transfer channel anywhere
in the call, so no restart can be unwound to — but the evaluation's
own boundary is left by the agent's jump back to the poll that
called it, so it is listed as takeable and [:abandon] names it. *)
if trapping <> "" then begin
let r =
ask
@ -1970,15 +1964,16 @@ let () =
(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; _ } ]; _ } -> ()
| None | Some { Form.v = Form.Sym "nil"; _ }
| Some { Form.v = Form.List []; _ } -> ()
| _ ->
fail "the boundary restart was offered at a trap, where nothing \
can be taken");
fail "the boundary restart was refused at a trap inside an \
evaluation");
(match Wire.field r "abandon" with
| Some { Form.v = Form.Sym "nil"; _ } -> ()
| Some { Form.v = Form.Int 0L; _ } -> ()
| _ ->
fail "a trap inside an evaluation named a position that abandons \
it");
fail "a trap inside an evaluation did not name the 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
@ -7761,6 +7756,82 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ msock; mout ];
(* ── A trap in an expression evaluated in the park ──────────────────
A trap has no transfer channel, so no restart can be taken from it —
but the evaluation's own boundary can, by the agent's jump back to the
poll that called it. Abort takes it, and the session answers after.
A null allocator and a stack overflow, on both backends. *)
List.iter
(fun backend ->
let tsock = tmp "trap.sock" and tout = tmp "trap.out" in
(try Sys.remove tsock with Sys_error _ -> ());
let tfd =
Unix.openfile tout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
in
let tpid =
Unix.create_process flan
(Array.append
[| flan; "dev"; "programs/dev-nomain.flan"; "-s"; tsock |]
backend)
Unix.stdin tfd tfd
in
Unix.close tfd;
let shape = if backend = [||] then "x86" else "llvm" in
if not (listening ~pid:tpid tsock) then
fail "a trap daemon (%s) %s" shape !listen_why
else begin
let tc = connect tsock in
let said r = Option.value ~default:"" (Wire.string_field r "message") in
let r =
request tc
"(:op \"eval\" :code \"(defonce nowhere Allocator)\n\
(defn deep [n i64] i64 (+ 1 (deep (+ n 1))))\" \
:file \"programs/dev-nomain.flan\")"
in
if status r <> "ok" then fail "trap definitions (%s): %s" shape (said r);
List.iter
(fun code ->
ignore
(request tc
(Printf.sprintf "(:op \"eval-expr\" :code %S :file \"<test>\")"
code));
if not
(await (fun () ->
match Wire.field (request tc "(:op \"describe\")") "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false))
then fail "%s (%s) did not stop" code shape
else
match request tc "(:op \"abort\")" with
| r when status r <> "ok" ->
fail "aborting %s (%s): %s" code shape (said r)
| _ ->
(match
Wire.string_field
(request tc
"(:op \"eval-expr\" :code \"(helper)\" :file \"<test>\")")
"value"
with
| Some "1" -> ()
| v ->
fail "the session after aborting %s (%s): %s" code shape
(Option.value ~default:"no value" v)
| exception e ->
fail "aborting %s (%s) ended the session: %s" code shape
(Printexc.to_string e)))
[ "(free-all nowhere)"; "(deep 0)" ];
(try
ignore (Wire.send tc "(:op \"close\")");
ignore (Wire.recv tc)
with _ -> ());
(try Unix.close tc with Unix.Unix_error _ -> ())
end;
(try Unix.kill tpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] tpid) with Unix.Unix_error _ -> ());
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ tsock; tout ])
[ [||]; [| "--llvm" |] ];
(* ── A class redefined under its own instances ──────────────────
CLHS 4.3.6's update protocol, end to end, with a real editor at one
end and the running program's own heap at the other. "A method added

102
vendor/agent/flan_agent.c vendored
View File

@ -41,6 +41,7 @@
#include <errno.h>
#include <stdlib.h>
#include <pthread.h>
#include <setjmp.h>
#include <signal.h>
#include <stdatomic.h>
#include <stdint.h>
@ -402,6 +403,28 @@ static int32_t frame_floor = -1;
static void *eval_boundary;
static const uint8_t abandon_name[] = "abandon-evaluation";
/* The way out of the innermost evaluation for a break that has no transfer
* channel — a trap: a fault, a failed bounds check, a null allocator. A
* restart is a return that unwinds frame by frame, and a trap has nothing to
* return through, so abandoning the evaluation from one is a jump straight
* back to the poll that called it ([flan_agent_poll]), which puts the
* condition, frame and root chains back where they stood. The defers of the
* frames jumped over do not run. NULL when no evaluation is in progress;
* saved and restored around the call like [eval_boundary]. */
static sigjmp_buf *eval_escape;
/* What the chains looked like when the evaluation was called, weak for the
* reason the frame walk below is: the runtime is linked into every program
* that links this, but not every build carries the dev and dyn halves. */
extern void flan_condition_stacks_mark(void **h, void **r, int32_t *d)
__attribute__((weak));
extern void flan_condition_stacks_restore(void *h, void *r, int32_t d)
__attribute__((weak));
extern void *flan_dev_frames_mark(void) __attribute__((weak));
extern void flan_dev_frames_restore(void *head) __attribute__((weak));
extern int64_t flan_dyn_root_mark(void) __attribute__((weak));
extern void flan_dyn_root_restore(int64_t n) __attribute__((weak));
/* 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
@ -417,6 +440,7 @@ static const uint8_t abandon_name[] = "abandon-evaluation";
* would be strange to empty two thirds of it. */
void flan_agent_run_reset(void) {
eval_boundary = NULL;
eval_escape = NULL;
restart_floor = 0;
frame_floor = -1;
}
@ -503,6 +527,9 @@ typedef struct {
* 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;
/* A trap inside an evaluation: nothing on the list can be taken, except the
* boundary, which is left by [eval_escape] rather than by a transfer. */
int32_t escapable;
int32_t used;
char names[SNAP_NAMES];
/* Where the stopped thread is, taken at the same moment and for the same
@ -592,6 +619,12 @@ static snapshot *snap_top(void) {
* to nest, which the caller reports rather than serving a stale one. */
static int32_t snap_gen; /* monotone; 0 is "no snapshot" */
/* Whether entry [i] can be taken: any reachable one at a break that can
* resume, and the evaluation's boundary at a trap inside an evaluation. */
static int can_take(const snapshot *s, int32_t i) {
return (s->resumable && s->reachable[i]) || (s->escapable && i == s->boundary);
}
static int snap_push(int resumable, void *cond) {
int d = atomic_load(&snap_depth);
if (d >= BREAK_MAX) return 0;
@ -677,6 +710,7 @@ static int snap_push(int resumable, void *cond) {
s->names[s->used++] = 0;
s->n++;
}
s->escapable = !s->resumable && eval_escape != NULL && s->boundary >= 0;
/* 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. */
@ -849,7 +883,11 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition,
* when none of it can be taken — and because the same names come back
* from a `restarts' query, and the terminal and the socket must not be
* describing two different programs. */
if (!s->resumable)
if (s->escapable)
fprintf(stderr,
" nothing here can be resumed into; abandon the expression, "
"or read the frame, then fix and reload\n");
else if (!s->resumable)
fprintf(stderr,
" nothing here can be resumed into; read the frame, then fix "
"and reload, or abort\n");
@ -861,7 +899,9 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition,
* than hidden, since "why can I not have that one" is a fair question
* 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 && can_take(s, i)
? " (stop running the expression; the program carries on)"
: !s->resumable ? " (cannot be taken from this trap)"
: i == s->boundary
? " (stop running the expression; the program carries on)"
: s->reachable[i] ? ""
@ -914,7 +954,23 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition,
atomic_store(&chosen_ready, 0);
snapshot *s = snap_top();
int ok = s != NULL && s->gen == my_gen && take >= 0 && take < s->n
&& s->resumable && s->reachable[take];
&& can_take(s, take);
if (ok && !s->resumable) {
/* The boundary, at a trap: nothing to return through, so the way out
* is [eval_escape]. The break is unwound here, as a resume unwinds
* it below, and the poll that called the evaluation puts the chains
* back. */
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");
fflush(stderr);
memcpy(condition_name, outer_name, sizeof condition_name);
atomic_store(&aborting, 0);
snap_pop();
atomic_fetch_sub(&depth, 1);
siglongjmp(*eval_escape, 1);
}
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
@ -1042,7 +1098,27 @@ int32_t flan_agent_poll(void) {
* 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();
/* The marks are taken after the boundary is pushed, so a jump back
* here leaves it on the chain for the pop below, as a return does.
* [sigsetjmp] with the mask saved: a fault's break loop runs inside the
* signal handler, and the jump leaves the handler. */
sigjmp_buf escape;
sigjmp_buf *oescape = eval_escape;
void *mh = NULL, *mr = NULL, *mf = NULL;
int32_t md = 0;
int64_t mroots = 0;
if (flan_condition_stacks_mark) flan_condition_stacks_mark(&mh, &mr, &md);
if (flan_dev_frames_mark) mf = flan_dev_frames_mark();
if (flan_dyn_root_mark) mroots = flan_dyn_root_mark();
if (sigsetjmp(escape, 1) == 0) {
eval_escape = &escape;
j.call();
} else {
if (flan_condition_stacks_restore) flan_condition_stacks_restore(mh, mr, md);
if (flan_dev_frames_restore) flan_dev_frames_restore(mf);
if (flan_dyn_root_restore) flan_dyn_root_restore(mroots);
}
eval_escape = oescape;
/* 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);
@ -1278,7 +1354,7 @@ static void handle_line(char *line, sink *o) {
* 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]) ? '-'
!can_take(s, i) ? '-'
: i == s->boundary ? '*'
: '+');
if (k > 0) emit(o, hdr, (size_t)k);
@ -1400,13 +1476,13 @@ static void handle_line(char *line, sink *o) {
* with the better sentence: at a trap every restart is unreachable, and
* answering with the thunk-boundary reason would send the reader looking
* for an evaluation that is not there. */
if (!s->resumable) {
if (!s->resumable && !can_take(s, idx)) {
reply(o, "err this break was taken by a trap with no transfer channel, "
"so no restart can be taken from it; read the frame, then fix "
"and reload, or abort\n");
"so no restart can be taken from it but the evaluation's own; "
"read the frame, then fix and reload, or abort\n");
return;
}
if (!s->reachable[idx]) {
if (!can_take(s, idx)) {
/* Refused, with the reason, rather than accepted and dropped. The
* transfer would unwind to the thunk this break is inside and stop
* there, and the program would carry on as if nothing had been
@ -1452,13 +1528,13 @@ static void handle_line(char *line, sink *o) {
reply(o, " is active\n");
return;
}
if (!s->resumable) {
if (!s->resumable && !can_take(s, at)) {
reply(o, "err this break was taken by a trap with no transfer channel, "
"so no restart can be taken from it; read the frame, then fix "
"and reload, or abort\n");
"so no restart can be taken from it but the evaluation's own; "
"read the frame, then fix and reload, or abort\n");
return;
}
if (!s->reachable[at]) {
if (!can_take(s, at)) {
reply(o, "err restart ");
reply(o, line + 8);
reply(o, " is below the evaluation this break is inside, so a "