diff --git a/lib/dev.ml b/lib/dev.ml index a3bba1a..715b0e7 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 diff --git a/lib/emit.ml b/lib/emit.ml index 08afc7c..c0cb53d 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3391,6 +3391,8 @@ declare i32 @flan_dyn_truthy(i64) 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) @@ -3520,7 +3522,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 @@ -3535,6 +3552,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 diff --git a/lib/x86.ml b/lib/x86.ml index ecfae3c..a3d1477 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -3886,7 +3886,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 @@ -3903,6 +3914,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 diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 0aadc59..bd1eab0 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -229,6 +229,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, @@ -822,17 +830,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 ──────────────────────────────────────────────────────*/ diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 390599a..2004e40 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -227,14 +227,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 — diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 2c0360a..4127310 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -565,6 +565,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 @@ -747,6 +809,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 (strncmp(argv[1], "refuse:", 7) == 0) { refuse(argv[1] + 7); return 0; } printf("no such mode: %s\n", argv[1]); diff --git a/test/programs/dev-dyn-global.flan b/test/programs/dev-dyn-global.flan new file mode 100644 index 0000000..f129547 --- /dev/null +++ b/test/programs/dev-dyn-global.flan @@ -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) diff --git a/test/test_dev.ml b/test/test_dev.ml index 7d8e3f4..ec3d175 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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 diff --git a/test/test_dyn.ml b/test/test_dyn.ml index 394cb83..3db3a83 100644 --- a/test/test_dyn.ml +++ b/test/test_dyn.ml @@ -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 @@ -24,7 +27,7 @@ as well as on the status: a process that died some other way is not the guard firing, and the exit code cannot tell them apart - One binary, built once, run twenty-nine times. The build is the expensive + One binary, built once, run thirty 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. *) @@ -98,6 +101,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. @@ -180,7 +197,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 six runs\n" + Printf.printf " ok the dyn runtime: %d refusals and seven runs\n" (List.length refusals) else exit 1 | _ -> print_endline "SKIP test_dyn: no clang" diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index dab72f8..e1c2e10 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -296,7 +296,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