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

The park's root reset stops at the globals' watermark

Browse Source 
# Conflicts:
#	test/test_dyn.ml
This commit is contained in:
Joseph Ferano 2026-09-20 11:24:46 +07:00
commit 4f060d07db
10 changed files with 311 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lib/dev.ml
View File

@ -3700,7 +3700,15 @@ extern void flan_dev_frames_reset(void) __attribute__((weak));
* no frame, so every root the last run pushed still names an address the next
* run is about to write over — and the next mark would follow whatever it put
* there. Weak for the reason the frames reset is weak; runtime/flan_dyn.h
* exports this for this one caller. */
* exports this for this one caller.
*
* The frames' roots and not the globals': this drops everything above the line
* the emitted main's global pushes left behind. The globals are the thing the
* banner below promises are still there, and a park is not quiet — it runs
* evaluated thunks, which allocate, which collect. Dropping their roots too
* meant a thunk of any size swept every dyn global the run had stored, and the
* read afterwards was a read of freed memory that happened to answer nil.
* runtime/flan_dyn.h's [flan_dyn_root_reset] holds the whole of it. */
extern void flan_dyn_root_reset(void) __attribute__((weak));
/* The agent's ring, drained on whatever thread calls this. Weak for the reason

21
lib/emit.ml
View File

@ -3402,6 +3402,8 @@ declare i64 @flan_dyn_view_flat(ptr, i64, i32)
declare void @flan_dyn_root_push(ptr)
declare void @flan_dyn_root_push_desc(ptr, ptr)
declare void @flan_dyn_root_pop(i64)
declare void @flan_dyn_root_globals_begin()
declare void @flan_dyn_root_globals_end()
declare void @flan_gc_init()
declare void @flan_dev_reg_enable()
declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64)
@ -3531,7 +3533,22 @@ let emit_main m ?(startup = false) ?(gc = false) ?(dyn_globals = []) (fn : Tast.
Zero is what a global holds until its initialiser has run: BSS gives that
for free, and runtime/flan_dyn.h says a rooted slot holding 0 is not a
value. *)
value.
Bracketed, and the bracket is what tells the collector which entries at
the bottom of its stack are these. It buys two things. A merged dev
build's [main] is re-entered — the dev daemon's [rerun] — and [begin]
empties the stack first, so the second entry re-roots these globals rather
than pushing a second copy of each. And a run that finishes parks with
every frame's roots dropped but these kept, which is what makes a global
still readable, and still collectable-through, in a park that runs
evaluated thunks. runtime/flan_dyn.h's [flan_dyn_root_reset] has the rest.
Nothing between the two may allocate: the globals are unrooted in that
window while still holding what a previous run left. Only the pushes are
in it. *)
if dyn_globals <> [] then
Buffer.add_string b " call void @flan_dyn_root_globals_begin()\n";
List.iter
(fun (g, ty) ->
match (if ty = Types.Dyn then None else desc_of m ty) with
@ -3546,6 +3563,8 @@ let emit_main m ?(startup = false) ?(gc = false) ?(dyn_globals = []) (fn : Tast.
" call void @flan_dyn_root_push_desc(ptr %s, ptr @\"%s\")\n"
(gname g) sym))
dyn_globals;
if dyn_globals <> [] then
Buffer.add_string b " call void @flan_dyn_root_globals_end()\n";
(* The program's own end of the transfer channel. Nothing can be transferring
when [main] returns: a restart is found by name on the restart stack, and
an [invoke-restart] that finds none fails at the invoke site rather than

17
lib/x86.ml
View File

@ -3893,7 +3893,18 @@ let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false)
Zero is what a global holds until its initialiser has run: [.bss] gives
that for free, and a zero word is not a pointer the collector will
follow — see the entry-block roots in [emit_fn] for why that is a fact
about runtime/flan_dyn.c and not a convention. *)
about runtime/flan_dyn.c and not a convention.
Bracketed for the reasons [Emit.emit_main] gives at its own copy of this
push: [begin] empties the root stack, so a [main] the dev daemon re-enters
re-roots these globals instead of pushing a second copy of each, and [end]
records where the globals stop and the frames begin, which is the line a
park resets to. Nothing between the two may allocate, and only the pushes
are between them. *)
if dyn_globals <> [] then begin
xor_rr b ~dst:rax ~src:rax;
call_sym b "flan_dyn_root_globals_begin"
end;
List.iter
(fun (g, ty) ->
(* Pc-relative and not through the GOT: [emit_main] is only ever a
@ -3910,6 +3921,10 @@ let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) ?(gc = false)
xor_rr b ~dst:rax ~src:rax;
call_sym b "flan_dyn_root_push_desc")
dyn_globals;
if dyn_globals <> [] then begin
xor_rr b ~dst:rax ~src:rax;
call_sym b "flan_dyn_root_globals_end"
end;
(* The computed globals, after the runtime is up and before a line of the
program's own code — [emit.ml]'s [emit_startup] says why this is a call
from here rather than a second constructor. It takes no channel: no caller

37
runtime/flan_dyn.c
View File

@ -303,6 +303,14 @@ typedef struct {
static flan_root *roots;
static int64_t roots_n, roots_cap;
/* How much of the bottom of that stack belongs to the globals rather than to
* any frame. The globals are pushed once, before the first frame runs, and
* never popped — so they are exactly the entries below this line, and every
* frame's roots are exactly the entries above it. Zero until a [main] says
* otherwise, which is also the right answer for a program that has no dyn
* globals to push. See [flan_dyn_root_globals_begin]. */
static int64_t roots_base;
/* ── The temporaries ring ──────────────────────────────────────────────
*
* The hazard this exists for, plainly: mark-sweep frees what is unreachable,
@ -926,17 +934,34 @@ void flan_dyn_root_push_desc(void *base, const flan_desc *d) {
root_add(base, d == NULL ? &desc_empty : d);
}
/* Clamped at empty rather than refused. A pop that outruns its pushes means
* the frame machinery is already out of step, and the useful thing at that
* point is a heap that still collects, not a second failure on top of the
/* Clamped at the globals rather than refused. A pop that outruns its pushes
* means the frame machinery is already out of step, and the useful thing at
* that point is a heap that still collects, not a second failure on top of the
* first. flan_rt.c's [flan_handler_pop] takes the same line for the same
* reason, by frame rather than by count. */
* reason, by frame rather than by count. The floor is [roots_base] and not
* zero because the globals under it were never any frame's to pop: an
* over-popping frame taking them with it is the one way this clamp could turn
* a miscount into a use-after-free. */
void flan_dyn_root_pop(int64_t n) {
if (n <= 0) return;
roots_n = n < roots_n ? roots_n - n : 0;
roots_n = roots_n - n > roots_base ? roots_n - n : roots_base;
}
void flan_dyn_root_reset(void) { roots_n = 0; }
/* The two halves of "the globals are the bottom of this stack".
*
* [begin] empties it outright, because a re-entered [main] is about to push
* the same globals again and the entries the previous run left are the ones
* that would be duplicated. [end] records how many of them there are.
*
* Nothing between the two may allocate: between them the globals hold whatever
* the previous run left in them and are not rooted, so a collection there
* would sweep values the slots still point at. The emitted [main] calls
* [begin] immediately before the pushes and [end] immediately after, with only
* the pushes in between, which is what makes that hold. */
void flan_dyn_root_globals_begin(void) { roots_n = 0; roots_base = 0; }
void flan_dyn_root_globals_end(void) { roots_base = roots_n; }
void flan_dyn_root_reset(void) { roots_n = roots_base; }
/* ── Constructors ──────────────────────────────────────────────────────*/

24
runtime/flan_dyn.h
View File

@ -285,14 +285,34 @@ void flan_dyn_root_push_desc(void *base, const flan_desc *d);
* They are here because something in this repository needs them; each says
* what. */
/* The root stack, emptied. The counterpart of flan_dev.c's
/* The *frames*' roots, dropped. The counterpart of flan_dev.c's
* [flan_dev_frames_reset] and there for its one caller: the merged dev build's
* [main] is re-entered by longjmp, which pops no frame, so every root the
* finished run pushed still points into stack the next run is about to write
* over. Marking through those addresses would decode whatever the new run put
* there. Called between runs, on the thread that runs them. */
* there. Called between runs, on the thread that runs them.
*
* The globals' roots are not dropped with them, and that is the whole of the
* distinction: a finished run's frames are gone but its globals are not — the
* dev daemon parks with them readable, and runs evaluated thunks against them
* that allocate and therefore collect. Emptying the stack outright unrooted
* 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);
/* Where that line comes from. The emitted [main] brackets its global pushes
* with these: [begin] immediately before the first, [end] immediately after
* the last, with nothing but the pushes in between — nothing there may
* allocate, because between the two the globals are unrooted and still hold
* whatever a previous run left in them. [begin] empties the stack rather than
* adding to it, so a [main] entered a second time re-roots the same globals
* instead of pushing a second copy of each.
*
* A program with no dyn globals need not call either: the line starts at zero,
* which is what an empty push list should leave it at. */
void flan_dyn_root_globals_begin(void);
void flan_dyn_root_globals_end(void);
/* The tag of a value, as a number and as the word that number is printed as.
* The numbers are FLAN_DYN_TAG_* below. The break loop and the inspector want
* both — a value's tag is the first thing anyone asks a stopped dyn program —

63
test/dyn_ops.c
View File

@ -765,6 +765,68 @@ static void unrooted(void) {
after <= before + 64 ? "yes" : "no");
}
/* The park, which is the one place a root stack is cut back without any frame
* having returned. The merged dev build's [main] is left by longjmp, so the
* finished run's frame roots name stack the next run will overwrite and have
* to go — and the globals, pushed once by [main] and never popped, have to
* stay, because the process parks with them readable and runs evaluated thunks
* against them. A thunk allocates, so a thunk collects.
*
* The bug this pins: [flan_dyn_root_reset] emptied the stack outright, which
* unrooted every dyn global for the whole of the park. The next collection
* swept what they held and the read afterwards answered whatever the freed
* words decoded as.
*
* So the shape here is a run and a park and another run, three times over,
* with a collection in every park. [config] stands in for a global in .bss;
* [frame] for a root the finished run left behind, holding enough objects to
* be measurable. The claims are both halves: the global's text is still its
* text, and the frame's objects are gone. */
static void park(void) {
enum { CYCLES = 3, HELD = 500 };
flan_dyn config = flan_dyn_nil();
flan_dyn frame = flan_dyn_nil();
int cycle, i, kept = 1, dropped = 1;
flan_gc_init();
flan_gc_set_floor(16 * 1024);
for (cycle = 0; cycle < CYCLES; cycle++) {
int64_t before, after;
/* The run. [main]'s bracket first, then a frame pushing its own root on
top of it — which is the order the emitted code has and the order that
makes the globals the bottom of the stack. */
flan_dyn_root_globals_begin();
flan_dyn_root_push(&config);
flan_dyn_root_globals_end();
config = text("hello");
flan_dyn_root_push(&frame);
frame = flan_dyn_vec_new();
for (i = 0; i < HELD; i++) flan_dyn_push(frame, text("frame"));
flan_gc_collect();
before = flan_gc_count();
/* The park. Nothing popped [frame]'s root: the run was left by longjmp. */
flan_dyn_root_reset();
/* And a thunk that allocates, which is what makes the park not a quiet
state. Well past the floor, so this collects several times over. */
for (i = 0; i < 20000; i++) (void)text("thunk");
flan_gc_collect();
after = flan_gc_count();
if (!flan_dyn_need_bool(flan_dyn_eq(config, text("hello")))) kept = 0;
/* The frame's five hundred are gone, which is the half that says the reset
still does the job it was written for. The ring's sixty-four and the
globals are the only things allowed to have survived. */
if (after > before - HELD + 64) dropped = 0;
}
printf("a dyn global survives a parked thunk: %s\n", kept ? "yes" : "no");
printf("a finished run's frame roots go: %s\n", dropped ? "yes" : "no");
}
/* An aggregate root: a struct with dyn fields somewhere inside it, rooted by
* its address and a descriptor rather than word by word. This is the runtime's
* half of the per-type descriptors, exercised with the descriptor written out
@ -947,6 +1009,7 @@ int main(int argc, char **argv) {
if (strcmp(argv[1], "nested") == 0) { nested(); return 0; }
if (strcmp(argv[1], "sharing") == 0) { sharing(); return 0; }
if (strcmp(argv[1], "unrooted") == 0) { unrooted(); return 0; }
if (strcmp(argv[1], "park") == 0) { park(); return 0; }
if (strcmp(argv[1], "desc") == 0) { desc(); return 0; }
if (strcmp(argv[1], "view") == 0) {
view();

24
test/programs/dev-dyn-global.flan Normal file
View File

@ -0,0 +1,24 @@
;;;; A dyn global that outlives the run that filled it.
;;;;
;;;; The park is not a quiet state: the daemon services evaluated thunks on
;;;; the parked thread, a thunk allocates, and an allocation collects. So the
;;;; question this program is built to ask is whether the roots the emitted
;;;; main pushed for its dyn globals are still on the collector's stack after
;;;; the run that pushed them has finished — because the park cuts that stack
;;;; back, and cutting it back to empty took the globals with the frames.
;;;;
;;;; [config] is a map rather than a number on purpose: a dyn number is an
;;;; immediate word and survives an unrooted heap by not being on it, so it
;;;; would answer the same whether or not the root was there. What is stored
;;;; is a heap object, and reading it back is a read of heap memory.
;;;;
;;;; main returns immediately: the run has nothing to do but fill the global,
;;;; and everything this fixture is for happens after it.
(import agent "vendor:agent")
(defvar config dyn)
(defn main [] i32
(agent/start "/tmp/flan-dev-dyn-global-fallback.sock")
(set config {:s "kept" :n 1})
0)

106
test/test_dev.ml
View File

@ -4644,6 +4644,112 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ xsock2; xout2; msock; mout ];
(* ── The dyn globals a park holds ─────────────────────────────────── *)
(* The banner a finished run prints says the globals are as it left them,
and for a dyn global that was not true. The park cuts three stacks back
— the conditions, the frame chain, and the collector's roots — and the
third one was emptied outright. But the dyn globals' roots are on it
too: the emitted main pushes them once and nothing ever pops them,
which is the whole of what a global's extent means to the collector. So
the park unrooted every one of them, and the first evaluated thunk to
allocate past the heap's floor swept what they held. The read
afterwards answered [nil] — by luck of what the freed words decoded as,
which is to say it was a read of freed memory and could as easily have
been a crash.
Both backends, because the daemon's own default is [--x86] and the fix
is two emitters agreeing: the bracket around the global pushes is
emitted by [Emit.emit_main] and by [X86]'s, and a session on either one
has to come back with the string.
The cycle is run three times over. Once would pass on a fix that kept
the globals rooted for the first park only; a re-entered main pushing a
second copy of every global rather than re-rooting the same ones is the
other way to get this wrong, and it needs a second and third run to
show at all. *)
List.iter
(fun backend ->
let dsock = tmp ("dynglobal" ^ backend ^ ".sock")
and dout = tmp ("dynglobal" ^ backend ^ ".out") in
(try Sys.remove dsock with Sys_error _ -> ());
let dfd =
Unix.openfile dout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
in
let dpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-dyn-global.flan"; "-s"; dsock;
"--" ^ backend |]
Unix.stdin dfd Unix.stderr
in
Unix.close dfd;
if not (listening ~pid:dpid dsock) then begin
fail "the dyn-global daemon (--%s) %s" backend !listen_why;
(try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect dsock in
let said r = Option.value ~default:(status r) (Wire.string_field r "message") in
let parked () =
match Wire.field (request c "(:op \"describe\")") "parked" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
(* What the expression answered, wherever it came back: a dyn value
is rendered into the reply's output rather than into [:value],
and which of the two carries it is not what is under test. *)
let answer r =
Option.value ~default:"" (Wire.string_field r "value")
^ Option.value ~default:"" (Wire.string_field r "output")
in
let read () =
answer
(request c
"(:op \"eval-expr\" :code \"(get config :s)\" \
:file \"programs/dev-dyn-global.flan\")")
in
(* A hundred thousand small maps: flan_dyn.c collects at a
one-megabyte floor, so this is several collections and not a
heap that merely grew. *)
let churn () =
request c
"(:op \"eval-expr\" :code \"(do (dotimes [i 100000] (let [m \
{:k i}] 0)) 1)\" :file \"programs/dev-dyn-global.flan\")"
in
if not (await ~ms:20000 parked) then
fail "the dyn-global program (--%s) never parked" backend
else begin
if not (contains_sub (read ()) "kept") then
fail "--%s: the global was not readable before any thunk ran: %S"
backend (read ());
for cycle = 1 to 3 do
let r = churn () in
if status r <> "ok" then
fail "--%s: the churning thunk (cycle %d): %s" backend cycle
(said r)
else if not (contains_sub (read ()) "kept") then
fail
"--%s: after a thunk that allocates (cycle %d) the parked \
program's dyn global reads %S"
backend cycle (read ());
(* And round main again, which re-enters the very code that
pushed those roots. *)
let r = request c "(:op \"rerun\")" in
if status r <> "ok" then
fail "--%s: rerun (cycle %d): %s" backend cycle (said r);
if not (await ~ms:20000 parked) then
fail "--%s: the program did not park again (cycle %d)" backend
cycle
done
end;
ignore (request c "(:op \"close\")");
(try Unix.close c with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] dpid) with Unix.Unix_error _ -> ())
end;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ dsock; dout ])
[ "llvm"; "x86" ];
(* ── A daemon whose editor was killed ─────────────────────────────── *)
(* The defect FIX.org recorded and PDEATHSIG does not reach: an editor that

21
test/test_dyn.ml
View File

@ -14,6 +14,9 @@
gc a million allocations against a hundred live, and the heap's
high-water mark bounded
unrooted the positive control: an object nothing points at is reclaimed.
park the root stack cut back to its globals with no frame having
returned, which is what the dev daemon's park does between one
run and the next: the globals stay rooted, the frames' go
desc an aggregate root: a struct whose dyn fields are named by a
descriptor rather than pushed one at a time.
Without it a collector that never freed would pass everything
@ -38,7 +41,7 @@
mismatched write on each of the three element kinds, and a
push against a flat (slice or array) view
One binary, built once, run thirty-six times. The build is the expensive
One binary, built once, run thirty-eight times. The build is the expensive
part and the runs are milliseconds, which is what keeps this inside
`dune test` rather than behind an alias. *)
@ -112,6 +115,20 @@ let () =
fail "an unrooted object\n got: %S (exit %d)\n wanted: %S"
out code want_un;
(* The park: a root stack cut back to its globals with no frame having
returned, which is what the merged dev build does between a run and the
next. Both halves are asserted, because each on its own is met by doing
nothing — a reset that dropped everything keeps no global, and a reset
that dropped nothing keeps every frame. *)
let code, out, _ = run "park" in
let want_park =
"a dyn global survives a parked thunk: yes\n\
a finished run's frame roots go: yes\n"
in
if code <> 0 || out <> want_park then
fail "the park's root reset\n got: %S (exit %d)\n wanted: %S"
out code want_park;
(* The aggregate roots the per-type descriptors added: a struct with dyn
fields at three offsets, one of them inside a nested struct, rooted by
address and descriptor rather than word by word.
@ -241,7 +258,7 @@ let () =
(* A line on the way out, because a test that says nothing when it passes
is a test nobody can tell from a test that did not run. *)
if !failures = 0 then
Printf.printf " ok the dyn runtime: %d refusals and eight runs\n"
Printf.printf " ok the dyn runtime: %d refusals and nine runs\n"
(List.length refusals + List.length view_refusals)
else exit 1
| _ -> print_endline "SKIP test_dyn: no clang"

2
test/test_sanitize.ml
View File

@ -307,7 +307,7 @@ let dyn_sweep () =
if reported text then fail "dyn %s: sanitizer report\n%s" mode text
else if code <> 0 then
fail "dyn %s: exit %d under the sanitizers\n%s" mode code text)
[ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing" ];
[ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing"; "park" ];
(try Sys.remove exe with Sys_error _ -> ())
(* The positive controls, which are the only evidence that a clean sweep means