i64->bytes and f64->bytes allocate from a growing temp allocator that (free-temp) releases once a frame and a dev build's agent poll wipes, so a number drawn every frame no longer leaks
This commit is contained in:
parent
042c969e30
commit
02e4fef830
12
TODO.org
12
TODO.org
@ -1271,12 +1271,10 @@ lowering buffer annotates all four sections, the two =llc= ones from a =--debug=
|
||||
copy of the IR. Rules out writing a disassembler, and reading the source off disk
|
||||
at disassembly time.
|
||||
|
||||
** NEXT A temporary allocator, wiped each frame
|
||||
Decided 2026-09-25: Odin's context.temp_allocator. i64->bytes, f64->bytes and
|
||||
other quick formatting allocate from it, so a number drawn every frame no longer
|
||||
leaks from the default allocator. A dev build wipes it at each frame boundary;
|
||||
otherwise the program calls (free-temp) once per frame. Text kept past the frame
|
||||
is cloned.
|
||||
** 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.
|
||||
|
||||
* Runtime
|
||||
|
||||
@ -1534,7 +1532,7 @@ cosmetic.
|
||||
|
||||
** DONE A formatted number outlives its frame
|
||||
CLOSED: [2026-09-25]
|
||||
=i64->bytes= and =f64->bytes= copy their text into the context allocator; the prelude and
|
||||
=i64->bytes= and =f64->bytes= copy their text into the temp allocator; the prelude and
|
||||
the printer keep the frame slot. Rules out refusing the escape, which needs flow tracking.
|
||||
|
||||
** DONE A shift count is bounded two different ways
|
||||
|
||||
@ -4178,7 +4178,7 @@ It takes a `(Ptr (Vec u8))` and not a `(Vec u8)`, and that is not style: a `Vec`
|
||||
builder would be consumed by its first append and refused on the second.
|
||||
|
||||
`append-i64` and `append-f64` append a number's text to a builder. `i64->bytes` and `f64->bytes` render into a frame
|
||||
slot and, outside the prelude, copy the text into the context allocator so it outlives the frame; inside the prelude
|
||||
slot and, outside the prelude, copy the text into the temp allocator so it outlives the frame; inside the prelude
|
||||
they answer the slot, and these two copy it into the builder, so appending a number allocates nothing beyond the
|
||||
builder's own growth. `strings.flan` puts two integers and a float on one line.
|
||||
|
||||
|
||||
@ -158,7 +158,7 @@ face says.")
|
||||
"zeroed" "filled" "dead-beef"
|
||||
;; allocators
|
||||
"make-allocator" "allocator-from" "allocator" "heap-allocator"
|
||||
"arena-new" "arena-destroy" "free-all" "can-free?" "can-free-all?"
|
||||
"arena-new" "arena-destroy" "free-all" "free-temp" "can-free?" "can-free-all?"
|
||||
"alloc-epoch" "alloc-id" "alloc-budget" "set-alloc-budget"
|
||||
"alloc-live-blocks" "with-allocator"
|
||||
;; Vec
|
||||
|
||||
@ -65,4 +65,8 @@
|
||||
rl/black))))
|
||||
|
||||
(rl/draw-text "touch the screen at multiple locations to get multiple balls"
|
||||
10 10 20 rl/darkgray)))))
|
||||
10 10 20 rl/darkgray))
|
||||
|
||||
;; The numbers drawn this frame were formatted into the temp allocator;
|
||||
;; this hands that memory back once the frame is drawn.
|
||||
(free-temp))))
|
||||
|
||||
@ -190,4 +190,8 @@
|
||||
(rl/draw-text "button: " 10 34 20 rl/lightgray)
|
||||
(rl/draw-text (string (i64->bytes (i64 pressed)))
|
||||
(+ 10 (rl/measure-text "button: " 20)) 34 20
|
||||
rl/lightgray)))))
|
||||
rl/lightgray))
|
||||
|
||||
;; The number drawn this frame was formatted into the temp allocator;
|
||||
;; this hands that memory back once the frame is drawn.
|
||||
(free-temp))))
|
||||
|
||||
@ -24,13 +24,10 @@
|
||||
;;;; a `char *` into a rotating static buffer, which `declare-c` refuses by
|
||||
;;;; name anyway.
|
||||
;;;;
|
||||
;;;; ONE TRAP, and it is the reason every function below is written as a strict
|
||||
;;;; sequence of format-draw-measure rather than as a let of several pieces:
|
||||
;;;; `i64->bytes` and `f64->bytes` both write into a single shared static
|
||||
;;;; buffer in the runtime, overwritten by the next such call. `(string ...)`
|
||||
;;;; does not copy it. So a number must be *drawn before the next one is
|
||||
;;;; formatted* — holding two at once is wrong pixels with no crash and no
|
||||
;;;; diagnostic.
|
||||
;;;; `i64->bytes` and `f64->bytes` put their text in the temp allocator, where
|
||||
;;;; it lasts until the next `(free-temp)`. A program drawing these every frame
|
||||
;;;; calls `(free-temp)` once per frame, after drawing, and clones any text it
|
||||
;;;; keeps longer.
|
||||
;;;;
|
||||
;;;; Everything here needs a window: `measure-text` answers 0 for every string
|
||||
;;;; until init-window has loaded the default font, and a zero advance would
|
||||
|
||||
26
lib/check.ml
26
lib/check.ml
@ -7868,6 +7868,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
(* One of spec-memory.md's two release points. It takes the source location
|
||||
as a string so that an allocator with no region to release names the site
|
||||
rather than the runtime. *)
|
||||
| "free-temp" ->
|
||||
arity ctx loc name 0 args;
|
||||
expect ctx loc ~want (rt loc Types.Unit "flan_free_temp" [])
|
||||
| "free-all" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
@ -9165,9 +9168,10 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
arity ctx loc name 1 args;
|
||||
prim Tast.BytesToI64 (Types.Int Types.I64) [ byte_slice ctx (List.hd args) ]
|
||||
(* The rendered text is copied out of the frame slot [to_bytes] renders into
|
||||
and into a block from the context allocator, so the slice outlives the
|
||||
frame: a function may return one and a Vec may hold one. The block lives
|
||||
until that allocator's free-all or destroy, the same as (bytes s)'s.
|
||||
and into the temp allocator, so the slice outlives the frame: a function
|
||||
may return one and a Vec may hold one, until the next (free-temp). A
|
||||
number drawn every frame is then reclaimed every frame rather than leaked
|
||||
from the context allocator; text kept longer is cloned.
|
||||
|
||||
The prelude is answered with the slot itself. Its callers — append-i64,
|
||||
append-f64, format-f64, gensym — each copy the bytes into a Vec before
|
||||
@ -9186,7 +9190,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
expect ctx loc ~want
|
||||
(if String.equal loc.Loc.file Prelude.file then slot
|
||||
else dup_elems ctx loc (Types.Int Types.U8) slot
|
||||
(allocator_arg ctx loc []))
|
||||
(rt loc raw_alloc "flan_context_temp" []))
|
||||
| "write-stdout" ->
|
||||
arity ctx loc name 1 args;
|
||||
prim Tast.WriteStdout Types.Unit [ byte_slice ctx (List.hd args) ]
|
||||
@ -10599,6 +10603,11 @@ let builtins : (string * string * string) list =
|
||||
("arena-destroy", "arena-destroy [Allocator] ()",
|
||||
"Hands the arena's pages back to the system, which free-all \
|
||||
deliberately does not.");
|
||||
("free-temp", "free-temp [] ()",
|
||||
"Releases everything in the temp allocator, context/temp — where \
|
||||
i64->bytes and f64->bytes put their text. Called once a frame; a dev \
|
||||
build also does it at every frame boundary the agent polls at. Text \
|
||||
kept past the frame is cloned out first.");
|
||||
("free-all", "free-all [Allocator] ()",
|
||||
"Releases everything the allocator holds and bumps its epoch, keeping \
|
||||
the capacity. It traps rather than quietly doing nothing when there is \
|
||||
@ -10773,12 +10782,11 @@ let builtins : (string * string * string) list =
|
||||
("bytes->i64", "bytes->i64 [[u8]] i64",
|
||||
"Parses an integer out of the bytes.");
|
||||
("f64->bytes", "f64->bytes [f64] [u8]",
|
||||
"The number's text, in a frame slot belonging to this call site — so \
|
||||
two of them can be held at once, and neither survives its frame. Copy \
|
||||
the bytes to keep one.");
|
||||
"The number's text, %g, in the temp allocator: it lasts until the next \
|
||||
(free-temp). Clone it to keep it longer.");
|
||||
("i64->bytes", "i64->bytes [i64] [u8]",
|
||||
"The number's text, in a frame slot belonging to this call site; it \
|
||||
does not survive the frame.");
|
||||
"The number's text, in the temp allocator: it lasts until the next \
|
||||
(free-temp). Clone it to keep it longer.");
|
||||
("write-stdout", "write-stdout [[u8]] ()",
|
||||
"Writes the bytes to standard output exactly as given: no newline and \
|
||||
no formatting.");
|
||||
|
||||
@ -4458,6 +4458,7 @@ declare void @flan_stale_call(ptr, ptr, ptr, ptr, ptr) cold
|
||||
declare ptr @flan_context_allocator()
|
||||
declare ptr @flan_context_use(ptr, i64)
|
||||
declare void @flan_context_value(ptr)
|
||||
declare void @flan_free_temp()
|
||||
declare void @flan_alloc_seal(ptr, ptr)
|
||||
declare ptr @flan_alloc_use(ptr, ptr, i64)
|
||||
declare ptr @flan_context_temp()
|
||||
|
||||
@ -1680,7 +1680,7 @@ let source = {flan|
|
||||
(push (deref b) (at s i))))
|
||||
|
||||
;; The two number appends. Outside the prelude i64->bytes and f64->bytes copy
|
||||
;; their text into the context allocator; inside it they answer a view of the
|
||||
;; their text into the temp allocator; inside it they answer a view of the
|
||||
;; frame slot they render into (check.ml, the "i64->bytes" arm), so these
|
||||
;; append the text without an allocation per number.
|
||||
(defn append-i64 [b (Ptr (Vec u8)) n i64] ()
|
||||
|
||||
@ -292,7 +292,7 @@ void flan_condition_stacks_reset(void) {
|
||||
* to see, because the read was inside a buffer that was perfectly alive.
|
||||
*
|
||||
* The slice points into the caller's frame, so the checker copies it into the
|
||||
* context allocator for i64->bytes and f64->bytes, whose results may outlive
|
||||
* temp allocator for i64->bytes and f64->bytes, whose results may outlive
|
||||
* the frame. The printer writes each one out at once and takes no copy. The
|
||||
* size is agreed with check.ml, which allocates the slot — grep
|
||||
* FLAN_NUM_BYTES there before changing it here. */
|
||||
@ -1433,13 +1433,65 @@ static flan_allocator flan_heap = {
|
||||
* The epoch is bumped either way: the pages are the same but every container
|
||||
* made before the reset is invalid, which is the whole point of the trap. */
|
||||
|
||||
/* A block the temp arena grew out of. It still holds what was allocated from
|
||||
* it before the growth, so it is kept until the next free-all. */
|
||||
typedef struct flan_chunk {
|
||||
struct flan_chunk *next;
|
||||
uint8_t *base;
|
||||
int64_t cap;
|
||||
} flan_chunk;
|
||||
|
||||
typedef struct flan_arena {
|
||||
uint8_t *base;
|
||||
int64_t cap;
|
||||
int64_t offset;
|
||||
int64_t peak;
|
||||
/* The temp arena only: a request that does not fit starts a bigger block
|
||||
* instead of failing, and [old] keeps the ones it outgrew until free-all,
|
||||
* which keeps the biggest. A program that formats more text between two
|
||||
* (free-temp)s than the first block holds gets more room rather than
|
||||
* StorageExhausted, and one that never calls it grows the way the heap
|
||||
* would. A program's own arena-new keeps its fixed capacity. */
|
||||
int grow;
|
||||
flan_chunk *old;
|
||||
} flan_arena;
|
||||
|
||||
/* Retire the current block and start one that fits [need]. */
|
||||
static int flan_arena_grow(flan_arena *ar, int64_t need) {
|
||||
flan_chunk *c;
|
||||
uint8_t *b;
|
||||
int64_t cap = ar->cap;
|
||||
while (cap < need) {
|
||||
if (cap > ((int64_t)1 << 40)) { cap = need; break; }
|
||||
cap *= 2;
|
||||
}
|
||||
if (cap == ar->cap) cap *= 2;
|
||||
c = (flan_chunk *)malloc(sizeof *c);
|
||||
if (!c) return 0;
|
||||
b = (uint8_t *)malloc((size_t)cap);
|
||||
if (!b) { free(c); return 0; }
|
||||
c->base = ar->base;
|
||||
c->cap = ar->cap;
|
||||
c->next = ar->old;
|
||||
ar->old = c;
|
||||
ar->base = b;
|
||||
ar->cap = cap;
|
||||
ar->offset = 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* The blocks the arena outgrew, handed back; the dev registry and memcheck
|
||||
* are told each one died, the same as the live block. */
|
||||
static void flan_arena_drop_old(flan_arena *ar) {
|
||||
while (ar->old) {
|
||||
flan_chunk *c = ar->old;
|
||||
ar->old = c->next;
|
||||
flan_dev_reg_dead_range(c->base, c->cap);
|
||||
free(c->base);
|
||||
free(c);
|
||||
}
|
||||
}
|
||||
|
||||
static int64_t flan_align_up(int64_t x, int64_t a) {
|
||||
if (a <= 1) return x;
|
||||
return (x + a - 1) / a * a;
|
||||
@ -1456,6 +1508,11 @@ static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
|
||||
if (align < 1) align = 1;
|
||||
start = flan_align_up(ar->offset, align);
|
||||
end = start + size;
|
||||
if ((end > ar->cap || end < start) && ar->grow && size < ((int64_t)1 << 40)
|
||||
&& flan_arena_grow(ar, size + align)) {
|
||||
start = flan_align_up(ar->offset, align);
|
||||
end = start + size;
|
||||
}
|
||||
if (end > ar->cap || end < start) return NULL; /* exhausted, or overflow */
|
||||
ar->offset = end;
|
||||
if (end > ar->peak) ar->peak = end;
|
||||
@ -1506,6 +1563,7 @@ static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
|
||||
The whole capacity rather than [0, offset): everything past the offset
|
||||
is equally reusable and equally stale, and two calls would only be
|
||||
cheaper if the second could be skipped. */
|
||||
flan_arena_drop_old(ar);
|
||||
flan_dev_reg_dead_range(ar->base, ar->cap);
|
||||
FLAN_VG_MAKE_MEM_UNDEFINED(ar->base, ar->cap);
|
||||
ar->offset = 0;
|
||||
@ -1563,11 +1621,29 @@ void flan_context_value(flan_alloc_value *out) { *out = flan_ctx; }
|
||||
* which never touches it has not paid for a heap. */
|
||||
#define FLAN_TEMP_DEFAULT (1 << 20)
|
||||
|
||||
/* Odin's context.temp_allocator: where i64->bytes and f64->bytes put their
|
||||
* text, and what context/temp names. It grows rather than failing (see
|
||||
* flan_arena's [grow]), and it is wiped by (free-temp), which a program calls
|
||||
* once a frame — and, in a dev build, by the agent at every frame boundary it
|
||||
* polls at. Text kept past the frame is cloned out of it first. */
|
||||
flan_allocator *flan_context_temp(void) {
|
||||
if (!flan_ctx_tmp) flan_ctx_tmp = flan_arena_new(FLAN_TEMP_DEFAULT);
|
||||
if (!flan_ctx_tmp) {
|
||||
flan_ctx_tmp = flan_arena_new(FLAN_TEMP_DEFAULT);
|
||||
if (flan_ctx_tmp) ((flan_arena *)flan_ctx_tmp->data)->grow = 1;
|
||||
}
|
||||
return flan_ctx_tmp;
|
||||
}
|
||||
|
||||
/* (free-temp): everything in the temp arena dies, the same release free-all
|
||||
* is, and a container made from it traps on its next use. Nothing to do when
|
||||
* nothing has made it yet. */
|
||||
void flan_free_temp(void) {
|
||||
flan_allocator *a = flan_ctx_tmp;
|
||||
if (!a) return;
|
||||
a->proc(a, FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0);
|
||||
a->epoch++;
|
||||
}
|
||||
|
||||
/* 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 —
|
||||
@ -1660,6 +1736,7 @@ void flan_arena_destroy(flan_allocator *a) {
|
||||
if (a == flan_ctx.rec) { flan_ctx.rec = &flan_heap; flan_ctx.inc = 0; }
|
||||
if (a == flan_ctx_tmp) flan_ctx_tmp = NULL;
|
||||
a->epoch++;
|
||||
flan_arena_drop_old(ar);
|
||||
flan_dev_reg_dead_range(ar->base, ar->cap);
|
||||
free(ar->base);
|
||||
free(ar);
|
||||
|
||||
@ -489,9 +489,11 @@ There are exactly two release points, and neither of them is a scope.
|
||||
error.
|
||||
2. **Region release** — `(free-all a)` on an allocator, which releases
|
||||
everything made from it at once, including storage reachable from bindings
|
||||
that are still in scope. The per-frame `(free-all context/temp)` at the top
|
||||
of a game loop *is* the frame arena, and it is the normal way arena-tier
|
||||
storage dies.
|
||||
that are still in scope. The per-frame `(free-temp)`, which is
|
||||
`(free-all context/temp)`, *is* the frame arena, and it is the normal way
|
||||
arena-tier storage dies. `i64->bytes` and `f64->bytes` put their text there,
|
||||
and a dev build also wipes it at every frame boundary the agent polls at.
|
||||
The temp allocator grows rather than running out.
|
||||
|
||||
**Nothing is released at scope exit.** Not at the end of a `let`, not at the end
|
||||
of a function, not at the end of a `with-allocator` body. `with-allocator`
|
||||
|
||||
18
test/programs/temp-agent.flan
Normal file
18
test/programs/temp-agent.flan
Normal file
@ -0,0 +1,18 @@
|
||||
;;;; The dev half of temp-frame.flan: a frame loop that polls the agent at the
|
||||
;;;; top of every frame and never calls (free-temp). In a dev build the poll is
|
||||
;;;; a frame boundary and wipes the temp allocator, so the registry does not
|
||||
;;;; fill; the last line is whether it overflowed.
|
||||
(import agent "vendor:agent")
|
||||
|
||||
(declare-c reg-overflowed [] i32 "flan_dev_reg_overflowed")
|
||||
|
||||
(defn main [args [string]] i32
|
||||
(let [n (bytes->i64 (bytes-view (at args 1)))
|
||||
total (i64 0)]
|
||||
(dotimes [i (i32 n)]
|
||||
(agent/poll)
|
||||
(let [s (string (i64->bytes (i64 i)))]
|
||||
(set total (+ total (i64 (length (bytes-view s)))))))
|
||||
(println total)
|
||||
(println (reg-overflowed)))
|
||||
0)
|
||||
30
test/programs/temp-frame.flan
Normal file
30
test/programs/temp-frame.flan
Normal file
@ -0,0 +1,30 @@
|
||||
;;;; A frame loop that formats numbers every frame and calls (free-temp) at the
|
||||
;;;; end of each. i64->bytes and f64->bytes put their text in the temp
|
||||
;;;; allocator, so the loop's memory stays flat however many frames it runs,
|
||||
;;;; and in a dev build the allocation registry does not fill: each frame's
|
||||
;;;; blocks die at the free-temp and their addresses are handed out again.
|
||||
;;;; Frame 7's text is kept past its free-temp by cloning it into the heap,
|
||||
;;;; which is how text outlives its frame.
|
||||
;;;;
|
||||
;;;; The argument is the frame count. A negative one runs that many frames and
|
||||
;;;; never calls free-temp, which is the control: memory grows and a dev
|
||||
;;;; build's registry fills. The last line is whether the registry overflowed.
|
||||
(declare-c reg-overflowed [] i32 "flan_dev_reg_overflowed")
|
||||
|
||||
(defn main [args [string]] i32
|
||||
(let [arg (bytes->i64 (bytes-view (at args 1)))
|
||||
n (if (< arg 0) (- 0 arg) arg)
|
||||
total (i64 0)
|
||||
kept (bytes-view "")]
|
||||
(dotimes [i (i32 n)]
|
||||
(let [s (string (i64->bytes (i64 i)))
|
||||
f (f64->bytes (+ (f64 i) 0.5))]
|
||||
(set total (+ total (i64 (+ (length (bytes-view s)) (length f)))))
|
||||
(when (= i 7)
|
||||
(set kept (clone f (heap-allocator)))))
|
||||
(when (> arg 0)
|
||||
(free-temp)))
|
||||
(println total)
|
||||
(println (string kept))
|
||||
(println (reg-overflowed)))
|
||||
0)
|
||||
@ -8,7 +8,7 @@
|
||||
;;;; No crash, no diagnostic, and nothing for a sanitizer to catch, because
|
||||
;;;; every byte read was inside an object that was alive. The wrong bytes.
|
||||
;;;;
|
||||
;;;; The conversion's bytes are now copied into the context allocator, so a
|
||||
;;;; The conversion's bytes are now copied into the temp allocator, so a
|
||||
;;;; result outlives the frame that made it: the last two cases return one from
|
||||
;;;; a function and push them into a Vec that outlives the loop that made them.
|
||||
(defn numstr [n i64] string
|
||||
|
||||
@ -908,6 +908,79 @@ let () =
|
||||
clone_slice_out;
|
||||
outputs ~x86:true "clone of a slice, --x86" "programs/clone-slice.flan"
|
||||
clone_slice_out;
|
||||
(* The temp allocator. A frame loop that formats numbers and calls
|
||||
(free-temp) each frame stays flat from a thousand frames to a million,
|
||||
and in a dev build the registry does not fill; frame 7's text survives
|
||||
because it was cloned. The negative count, which never frees, is the
|
||||
control that shows the check can fail. Every backend and a dev build. *)
|
||||
let peak exe arg =
|
||||
let o = Filename.concat scratch
|
||||
(Printf.sprintf "flan-temp-%d.rss" (Unix.getpid ())) in
|
||||
let code =
|
||||
Sys.command
|
||||
(Printf.sprintf "/usr/bin/time -f %%M -o %s %s %s > /dev/null 2>&1"
|
||||
(Filename.quote o) (Filename.quote exe) arg)
|
||||
in
|
||||
let kb =
|
||||
try int_of_string (String.trim (In_channel.with_open_bin o
|
||||
In_channel.input_all))
|
||||
with _ -> -1
|
||||
in
|
||||
(try Sys.remove o with Sys_error _ -> ());
|
||||
(code, kb)
|
||||
in
|
||||
List.iter
|
||||
(fun (x86, opt, dev, tag) ->
|
||||
let exe = compile ~x86 ~opt ~dev "programs/temp-frame.flan" in
|
||||
let code, text = run exe (Some "1000") in
|
||||
if code <> 0 || text <> "7780\n7.5\n0\n" then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL a frame loop over the temp allocator%s\n\
|
||||
\ got: %S (exit %d)\n" tag text code
|
||||
end;
|
||||
if Sys.file_exists "/usr/bin/time" then begin
|
||||
let c1, small = peak exe "1000" and c2, large = peak exe "1000000" in
|
||||
if c1 <> 0 || c2 <> 0 || small < 0 || large < 0
|
||||
|| large - small > 4_000 then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL free-temp keeps a frame loop flat%s\n\
|
||||
\ got: %d KB after 1000 frames, %d KB after 1000000\n"
|
||||
tag small large
|
||||
end;
|
||||
if dev then begin
|
||||
let _, text = run exe (Some "1000000") in
|
||||
if not (contains text "\n0\n") then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL the dev registry fills under free-temp%s\n\
|
||||
\ got: %S\n" tag text
|
||||
end;
|
||||
let _, text = run exe (Some "-10000") in
|
||||
if not (contains text "\n1\n") then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL the control: with no free-temp the dev \
|
||||
registry never filled%s\n got: %S\n" tag text
|
||||
end
|
||||
end
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ()))
|
||||
[ (false, "-O2", false, ""); (false, "-O0", false, ", -O0");
|
||||
(true, "-O2", false, ", --x86"); (false, "-O2", true, ", dev");
|
||||
(true, "-O2", true, ", dev --x86") ];
|
||||
(* A dev build's agent poll is a frame boundary and wipes the temp
|
||||
allocator itself: a loop that polls and never calls free-temp does not
|
||||
fill the registry. *)
|
||||
List.iter
|
||||
(fun (x86, tag) ->
|
||||
let exe = compile ~x86 ~dev:true "programs/temp-agent.flan" in
|
||||
let code, text = run exe (Some "20000") in
|
||||
if code <> 0 || text <> "88890\n0\n" then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL a dev agent poll wipes the temp allocator%s\n\
|
||||
\ got: %S (exit %d)\n" tag text code
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ()))
|
||||
[ (false, ""); (true, ", --x86") ];
|
||||
(* The context restored by with-allocator after its arena was destroyed and
|
||||
its record reused: the next use of the context, or of a value read
|
||||
from it, traps at its site. *)
|
||||
|
||||
7
vendor/agent/flan_agent.c
vendored
7
vendor/agent/flan_agent.c
vendored
@ -114,6 +114,7 @@ int64_t flan_dev_reg_by_type(int32_t live_only, int64_t *counts,
|
||||
int64_t *typelens, int64_t cap, int64_t *unread);
|
||||
int flan_dev_reg_enabled(void);
|
||||
int flan_dev_reg_overflowed(void);
|
||||
void flan_free_temp(void);
|
||||
|
||||
/* 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
|
||||
@ -985,6 +986,12 @@ static void trap_stop(const uint8_t *name, int64_t namelen) {
|
||||
* thread writes tail, nesting included. */
|
||||
int32_t flan_agent_poll(void) {
|
||||
int32_t n = 0;
|
||||
/* A poll the game loop makes is a frame boundary, and a dev build wipes the
|
||||
* temp allocator there, as the program's own (free-temp) would. Not a poll
|
||||
* from a break loop or from inside a thunk: the stopped frames below it,
|
||||
* or the thunk's own caller, may still be holding text from it. */
|
||||
if (atomic_load(&depth) <= 0 && eval_boundary == NULL && flan_dev_reg_enabled())
|
||||
flan_free_temp();
|
||||
for (;;) {
|
||||
unsigned t = atomic_load_explicit(&tail, memory_order_relaxed);
|
||||
unsigned h = atomic_load_explicit(&head, memory_order_acquire);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user