From 46a89aac0cf1560701231a03c2f84b6ddf5380f3 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 13:54:07 +0700 Subject: [PATCH] An expression evaluated at a stop rolls the temp allocator back to where it was, so its own text is reclaimed and the stopped frames' text survives --- TODO.org | 2 +- runtime/flan_rt.c | 62 ++++++++++++++++++++++++++++ test/programs/dev-temp-stop.flan | 27 ++++++++++++ test/test_dev.ml | 71 ++++++++++++++++++++++++++++++++ vendor/agent/flan_agent.c | 17 ++++++-- 5 files changed, 174 insertions(+), 5 deletions(-) create mode 100644 test/programs/dev-temp-stop.flan diff --git a/TODO.org b/TODO.org index 44cc6347..ce82f248 100644 --- a/TODO.org +++ b/TODO.org @@ -1252,7 +1252,7 @@ at disassembly time. ** DONE A temporary allocator, wiped each frame CLOSED: [2026-09-25] =i64->bytes= and =f64->bytes= allocate from context/temp, which grows rather than failing. A -dev build wipes it at a top-level agent poll, never while stopped or inside a thunk. +dev build wipes it at a top-level agent poll; an expression run at a stop is rolled back to a mark. * Runtime diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index c3ac37a0..dc0be985 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1672,6 +1672,68 @@ void flan_free_temp(void) { a->epoch++; } +/* A point in the temp arena to roll back to: the agent takes one before an + * expression it runs while the program is stopped and rolls back to it after, + * so the expression's own text is reclaimed and the text the stopped frames + * are holding is not. The caller holds the mark in FLAN_TEMP_MARK_WORDS words + * (flan_agent.c); its layout is private here. */ +typedef struct flan_temp_mark { + flan_allocator *a; /* the temp arena at the mark, or NULL for none */ + uint64_t epoch; + uint8_t *base; + int64_t offset; + int64_t live_blocks; + int64_t live_bytes; +} flan_temp_mark; +_Static_assert(sizeof(flan_temp_mark) <= 6 * sizeof(uint64_t), + "flan_agent.c reserves FLAN_TEMP_MARK_WORDS for a mark"); + +void flan_temp_mark_take(void *m) { + flan_temp_mark *k = (flan_temp_mark *)m; + flan_allocator *a = flan_ctx_tmp; + memset(k, 0, sizeof *k); + if (!a) return; + k->a = a; + k->epoch = a->epoch; + k->base = ((flan_arena *)a->data)->base; + k->offset = ((flan_arena *)a->data)->offset; + k->live_blocks = a->live_blocks; + k->live_bytes = a->live_bytes; +} + +void flan_temp_rollback(const void *m) { + const flan_temp_mark *k = (const flan_temp_mark *)m; + flan_allocator *a = flan_ctx_tmp; + flan_arena *ar; + if (!a) return; + /* No temp arena at the mark, or a different one, or one the expression + * released itself with (free-temp): nothing from before is left in it, so + * the whole of it is the expression's. */ + if (k->a != a || k->epoch != a->epoch) { flan_free_temp(); return; } + ar = (flan_arena *)a->data; + /* Blocks started since the mark are the expression's: dropped, newest + * first, until the block the mark was taken in is current again. */ + while (ar->base != k->base && ar->old) { + flan_chunk *c = ar->old; + flan_dev_reg_dead_range(ar->base, ar->cap); + flan_dev_poison(ar->base, ar->cap); + free(ar->base); + ar->base = c->base; + ar->cap = c->cap; + ar->offset = ar->cap; + ar->old = c->next; + free(c); + } + if (ar->base != k->base) { flan_free_temp(); return; } + if (ar->offset > k->offset) { + flan_dev_reg_dead_range(ar->base + k->offset, ar->offset - k->offset); + flan_dev_poison(ar->base + k->offset, ar->offset - k->offset); + ar->offset = k->offset; + } + a->live_blocks = k->live_blocks; + a->live_bytes = k->live_bytes; +} + /* with-allocator hands in two values in its own frame: [0] the one to install * and [1] where the displaced one is kept. It gets the same pointer back and * passes it to restore — on the normal path and on the transfer path both — diff --git a/test/programs/dev-temp-stop.flan b/test/programs/dev-temp-stop.flan new file mode 100644 index 00000000..34038748 --- /dev/null +++ b/test/programs/dev-temp-stop.flan @@ -0,0 +1,27 @@ +;;;; A program that stops while a live frame holds text in the temp allocator. +;;;; [hold] formats a number, then calls [fetch], which errors with nothing +;;;; handling it, so the program stops with [hold]'s text still in use. +;;;; Expressions evaluated at the stop format numbers of their own; after the +;;;; retry restart the program prints [hold]'s text, which has to be intact. +;;;; test_dev.ml drives it. +(import agent "vendor:agent") + +(defstruct Missing [id i32]) + +(defn fetch [] i32 + (restart-case + (do (error (Missing {.id 1})) 0) + (retry [] 7))) + +(defn hold [] i32 + (let [s (string (i64->bytes 4242)) + r (fetch)] + (println s) + r)) + +(defn main [] i32 + (agent/start) + (println (hold)) + (dotimes [i 4000] + (agent/wait 5)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index bad1346e..94b4bdbe 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -7540,6 +7540,77 @@ let () = [ asock; aout ]) [ "--llvm"; "--x86" ]; + (* ── Temp text held by a stopped frame ───────────────────────── + An expression evaluated at a stop rolls the temp allocator back to + where it was when it finishes: what it formatted is reclaimed, so the + live count does not grow across evaluations, and the text the stopped + frame formatted before the stop is intact when the program resumes. *) + List.iter + (fun mode -> + let tsock = tmp ("tstop" ^ mode ^ ".sock") in + (try Sys.remove tsock with Sys_error _ -> ()); + let tpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-temp-stop.flan"; "-s"; tsock; mode |] + Unix.stdin Unix.stdout Unix.stderr + in + if not (listening ~pid:tpid tsock) then begin + fail "the %s temp-stop daemon %s" mode !listen_why; + (try Unix.kill tpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect tsock in + let out = Buffer.create 64 in + let ask sexp = + let r = Wire.parse (Wire.send c sexp; Wire.recv c) in + (match Wire.string_field r "output" with + | Some t -> Buffer.add_string out t + | None -> ()); + r + in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + let eval code = + ask + (Printf.sprintf + "(:op \"eval-expr\" :code %S :file \"programs/dev-temp-stop.flan\")" + code) + in + let live () = + Option.value ~default:"?" + (Wire.string_field (eval "(alloc-live-blocks context/temp)") "value") + in + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "%s: the temp-stop program never stopped" mode + else begin + let before = live () in + for _ = 1 to 5 do + ignore (eval "(length (i64->bytes 123456789))") + done; + let after = live () in + if before <> "1" || after <> before then + fail "%s: evaluations at a stop changed the temp allocator's live blocks: %s then %s" + mode before after; + let r = ask "(:op \"restart\" :name \"retry\")" in + if status r <> "ok" then fail "%s: retry at the stop: %s" mode (status r) + else if not + (await (fun () -> + ignore (ask "(:op \"describe\")"); + contains_sub (Buffer.contents out) "4242\n7\n")) + then + fail "%s: the stopped frame's text did not survive: %S" mode + (Buffer.contents out) + end; + (try Unix.close c with Unix.Unix_error _ -> ()); + (try Unix.kill tpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] tpid) with Unix.Unix_error _ -> ()) + end; + (try Sys.remove tsock with Sys_error _ -> ())) + [ "--llvm"; "--x86" ]; + (* ══ The agent socket is not the editor protocol ══════════════════ Two daemons of their own, both about what a session owes an editor diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index ad5ed290..8ecc8878 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -115,6 +115,10 @@ int64_t flan_dev_reg_by_type(int32_t live_only, int64_t *counts, int flan_dev_reg_enabled(void); int flan_dev_reg_overflowed(void); void flan_free_temp(void); +/* A temp-arena mark: flan_rt.c's flan_temp_mark, six words, private there. */ +#define FLAN_TEMP_MARK_WORDS 6 +void flan_temp_mark_take(void *m); +void flan_temp_rollback(const void *m); /* A ring the listener writes and the game thread reads. One producer, one * consumer, so two atomics and no lock — the game thread must never block on @@ -1086,6 +1090,14 @@ int32_t flan_agent_poll(void) { int32_t outer = restart_floor; int32_t oframe = frame_floor; void *obound = eval_boundary; + /* An expression run while the program is stopped rolls the temp + * allocator back to where it was before, when it finishes: what it + * formatted is reclaimed, and the text the stopped frames hold — made + * before the stop — is kept for when the program resumes. A dev build + * only, like every other temp wipe. */ + uint64_t mark[FLAN_TEMP_MARK_WORDS]; + int roll = atomic_load(&depth) > 0 && flan_dev_reg_enabled(); + if (roll) flan_temp_mark_take(mark); restart_floor = flan_restart_count(); frame_floor = flan_dev_frame_count(); /* After the floor is read and not before: the floor counts the frames @@ -1099,10 +1111,7 @@ int32_t flan_agent_poll(void) { eval_boundary = obound; restart_floor = outer; frame_floor = oframe; - /* An expression run while the program is parked has no frame boundary - * after it until the program resumes, so a dev build wipes the temp - * allocator when it finishes, as the top of the next poll would. */ - if (atomic_load(&depth) > 0 && flan_dev_reg_enabled()) flan_free_temp(); + if (roll) flan_temp_rollback(mark); } if (j.handle != NULL) { dlclose(j.handle); } }