diff --git a/lib/dev.ml b/lib/dev.ml index efb8e50c..2346f35d 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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) diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index b31cf16b..a7d99675 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -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) { diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index fb76e66e..0743bfc8 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -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); } diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 8e119e57..de2a3ae7 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -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 diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 5ed878ed..7746b3ad 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -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. */ diff --git a/test/test_dev.ml b/test/test_dev.ml index 55925846..cc7c1d9e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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 \"\")" + 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 \"\")") + "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 diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 65e14c7e..54c5d5a6 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -41,6 +41,7 @@ #include #include #include +#include #include #include #include @@ -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 "