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
This commit is contained in:
parent
a0a86d0b80
commit
46a89aac0c
2
TODO.org
2
TODO.org
@ -1252,7 +1252,7 @@ at disassembly time.
|
|||||||
** DONE A temporary allocator, wiped each frame
|
** DONE A temporary allocator, wiped each frame
|
||||||
CLOSED: [2026-09-25]
|
CLOSED: [2026-09-25]
|
||||||
=i64->bytes= and =f64->bytes= allocate from context/temp, which grows rather than failing. A
|
=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
|
* Runtime
|
||||||
|
|
||||||
|
|||||||
@ -1672,6 +1672,68 @@ void flan_free_temp(void) {
|
|||||||
a->epoch++;
|
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
|
/* 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
|
* 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 —
|
* passes it to restore — on the normal path and on the transfer path both —
|
||||||
|
|||||||
27
test/programs/dev-temp-stop.flan
Normal file
27
test/programs/dev-temp-stop.flan
Normal file
@ -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)
|
||||||
@ -7540,6 +7540,77 @@ let () =
|
|||||||
[ asock; aout ])
|
[ asock; aout ])
|
||||||
[ "--llvm"; "--x86" ];
|
[ "--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 ══════════════════
|
(* ══ The agent socket is not the editor protocol ══════════════════
|
||||||
|
|
||||||
Two daemons of their own, both about what a session owes an editor
|
Two daemons of their own, both about what a session owes an editor
|
||||||
|
|||||||
17
vendor/agent/flan_agent.c
vendored
17
vendor/agent/flan_agent.c
vendored
@ -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_enabled(void);
|
||||||
int flan_dev_reg_overflowed(void);
|
int flan_dev_reg_overflowed(void);
|
||||||
void flan_free_temp(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
|
/* 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
|
* 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 outer = restart_floor;
|
||||||
int32_t oframe = frame_floor;
|
int32_t oframe = frame_floor;
|
||||||
void *obound = eval_boundary;
|
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();
|
restart_floor = flan_restart_count();
|
||||||
frame_floor = flan_dev_frame_count();
|
frame_floor = flan_dev_frame_count();
|
||||||
/* After the floor is read and not before: the floor counts the frames
|
/* 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;
|
eval_boundary = obound;
|
||||||
restart_floor = outer;
|
restart_floor = outer;
|
||||||
frame_floor = oframe;
|
frame_floor = oframe;
|
||||||
/* An expression run while the program is parked has no frame boundary
|
if (roll) flan_temp_rollback(mark);
|
||||||
* 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 (j.handle != NULL) { dlclose(j.handle); }
|
if (j.handle != NULL) { dlclose(j.handle); }
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user