Joseph Ferano
f6ab3b62fc
The crux was never where to put a descriptor; it was how an instance finds one. A bare struct on the stack has no header to hang a pointer off, and giving it one would change the layout C interop agrees on, change the stride of an array and change what embedding a struct in another costs. So it has none. The instance never carries a pointer to its type and the collector never derives one from the bytes: the pairing of an address with a descriptor is made at the *push*, by the code that put the value there and therefore knows its static type. That is the same trick the shadow stack has always used, and it makes the stack case the easy one rather than the impossible one. A descriptor is the size of an instance, a count, and a table of byte offsets, emitted once per type as private static data. Flattened, not a graph — a struct held by value contributes its offsets shifted by where it sits, and a fixed array contributes its element's once per element — so nesting costs nothing at run time and there is no recursion in the marker. The offsets of a big array would be a big table, and that is capped with a sentence rather than half of the repeat form item 3 will bring. Four places a value of such a type can live, and all four are rooted: a frame slot, a global, the temporary a call's by-value return is spilled into, and the slot a condition that is not a place is evaluated into. The last two are new and are the ones that were not obvious. A callee roots its dyn words and pops them in its epilogue, so between the return and the caller's store the only copy is a register, which a collector that finds its roots by address cannot see; the same hole was open for a Flan call answering a bare dyn and is closed here too. And a condition crosses as a pointer into the signalling frame while a handler allocates, which is exactly what the original refusal said could not be made safe. dyn_roots grows into root_plan and both backends read it, which is what the older note about one counter deciding both ends was always for. The aggregate temporaries are pooled by type rather than handed out in mint order: a positional supply that drifted would pair an address with another type's descriptor, and marking arbitrary offsets off a base is corruption where a missed root is only a bug. Pooled, the worst a drift can do is run out. What is still refused is a dyn no static offset can reach — inside a typed container, in a data type's payload or a union's members where the cases overlay, or under an Option where the payload exists only beneath the tag. A (Ptr S) and a [S] are deliberately not on that list: neither owns storage, and the only storage this compiler hands out for such a type is a frame slot, a global or a fixed array in one, all of them already rooted. That is what lets a handler clause take its (Ptr Cond) and read a dyn payload. test/programs/dyn-struct.flan is the evidence. It runs forty thousand rows past flan_dyn.c's one-megabyte floor, so marks and sweeps really happen, and it holds live values through them in all four places at once. It has teeth: with the descriptor walk stubbed out of the marker, the kept vector's length comes back 24 instead of 628 and its first element is a stale word. Clean under ASan and UBSan, same output at -O2, -O0 and --x86. dyn_ops.c grows an aggregate-root mode so the runtime half can be wrong on its own, with a header word holding a bit pattern that looks boxed and is not a dyn slot. --no-gc still refuses, and had to be told how: a struct with a dyn field is a collected value even when no expression in the program ever has the type dyn, because a zeroed one still has a word the collector is asked to mark. dune test --force: green, 0 failures across every suite.
183 lines
8.0 KiB
OCaml
183 lines
8.0 KiB
OCaml
(* The dynamic-value runtime, driven from C.
|
|
|
|
runtime/flan_dyn.c is a C ABI with no Flan spelling yet — the compiler lane
|
|
is what gives it one — so the only way to reach every operation, and every
|
|
way each one refuses, is a C main. test/dyn_ops.c is that main and
|
|
programs/dyn-host.flan is the program it is linked against, which has no
|
|
[main] of its own for the same reason programs/reload.flan does not.
|
|
|
|
What is asserted here, and why each is its own thing:
|
|
|
|
ops every operation's happy path, the tags, the printed form of
|
|
each, text identity against text equality, and a vec that
|
|
contains itself
|
|
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.
|
|
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
|
|
nested a chain of vecs sixty-four deep, traced through one root
|
|
sharing one object held three times — written through one path and read
|
|
through another, and swept once when the last goes
|
|
refuse:* twenty-four refusals, one process each, asserted on the sentence
|
|
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
|
|
part and the runs are milliseconds, which is what keeps this inside
|
|
`dune test` rather than behind an alias. *)
|
|
|
|
open Flan
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports nothing at
|
|
all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:600 "test_dyn"
|
|
|
|
let failures = ref 0
|
|
let fail fmt =
|
|
Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt
|
|
|
|
let scratch = Filename.get_temp_dir_name ()
|
|
let tmp name = Filename.concat scratch ("flan-dyn-" ^ name)
|
|
|
|
let has hay needle =
|
|
let n = String.length needle and h = String.length hay in
|
|
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
|
|
go 0
|
|
|
|
let () =
|
|
match Sys.command "command -v clang > /dev/null 2>&1" with
|
|
| 0 ->
|
|
let p =
|
|
Check.program
|
|
(Load.program ~file:"programs/dyn-host.flan"
|
|
(Reader.read_file "programs/dyn-host.flan")).Load.decls
|
|
in
|
|
let exe = tmp "ops" in
|
|
ignore (Build.executable ~csrcs:[ "dyn_ops.c" ] p ~out:exe);
|
|
|
|
let run mode =
|
|
let o = tmp (mode ^ ".out") and e = tmp (mode ^ ".err") in
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf "%s %s > %s 2> %s" (Filename.quote exe)
|
|
(Filename.quote mode) (Filename.quote o) (Filename.quote e))
|
|
in
|
|
let out = In_channel.with_open_bin o In_channel.input_all in
|
|
let err = In_channel.with_open_bin e In_channel.input_all in
|
|
List.iter (fun x -> try Sys.remove x with Sys_error _ -> ()) [ o; e ];
|
|
(code, out, err)
|
|
in
|
|
|
|
(* The happy paths. Each assertion inside prints its own FAIL line, so the
|
|
output is the report and this only has to notice that there was one. *)
|
|
let code, out, err = run "ops" in
|
|
if code <> 0 || out <> "ops ok\n" then
|
|
fail "the operations\n got: %S (exit %d, err %S)" out code err;
|
|
|
|
(* The collector. Four sentences, each a yes: the high-water mark stayed
|
|
under half a megabyte across forty megabytes of allocation, the heap
|
|
settled small, the object count stayed bounded, and the hundred rooted
|
|
values were all still what they were set to. *)
|
|
let code, out, err = run "gc" in
|
|
let want_gc =
|
|
"peak under 512K: yes\nsettled under 32K: yes\n\
|
|
live objects bounded: yes\nlive set intact: yes\n"
|
|
in
|
|
if code <> 0 || out <> want_gc then
|
|
fail "a million allocations against a hundred live\n\
|
|
\ got: %S (exit %d, err %S)\n wanted: %S"
|
|
out code err want_gc;
|
|
|
|
(* And the control. A collector that never freed anything would pass every
|
|
other case in this file; this is the one it cannot. *)
|
|
let code, out, _ = run "unrooted" in
|
|
let want_un = "allocated: yes\nreclaimed all but the ring: yes\n" in
|
|
if code <> 0 || out <> want_un then
|
|
fail "an unrooted object\n got: %S (exit %d)\n wanted: %S"
|
|
out code want_un;
|
|
|
|
(* 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. The second line is the
|
|
one that would catch a marker walking the struct as a run of words: the
|
|
header holds a bit pattern that looks boxed and is not a dyn slot. *)
|
|
let code, out, _ = run "desc" in
|
|
let want_desc =
|
|
"aggregate root survives collection: yes\n\
|
|
the word at a non-dyn offset is untouched: yes\n\
|
|
and is reclaimed once dropped: yes\n"
|
|
in
|
|
if code <> 0 || out <> want_desc then
|
|
fail "an aggregate root\n got: %S (exit %d)\n wanted: %S"
|
|
out code want_desc;
|
|
|
|
let code, out, _ = run "nested" in
|
|
if code <> 0 || out <> "chain of 64 intact: yes\n" then
|
|
fail "a chain of nested vecs\n got: %S (exit %d)" out code;
|
|
|
|
let code, out, _ = run "sharing" in
|
|
let want_sh =
|
|
"three slots hold one object: yes\n\
|
|
write through one path is seen through another: yes\n\
|
|
shared object survives on the holder alone: yes\n\
|
|
still reachable: yes\n\
|
|
live bytes after dropping everything: ok\n"
|
|
in
|
|
if code <> 0 || out <> want_sh then
|
|
fail "interior sharing\n got: %S (exit %d)\n wanted: %S"
|
|
out code want_sh;
|
|
|
|
(* Every refusal. The pair is (mode, a phrase the sentence must contain);
|
|
the phrase is chosen to be the part that says *which* mistake it was,
|
|
so a message that named the wrong operation or the wrong tag would not
|
|
pass by accident.
|
|
|
|
The tag names are asserted here too, as words: "int" and "text" and not
|
|
2 and 4. A message with a number in it is a puzzle, and the rule is
|
|
written down in flan_dyn.c beside the table the words come from. *)
|
|
let refusals =
|
|
[ ("add", "dyn +: int and text");
|
|
("sub", "dyn -: nil and int");
|
|
("mul", "dyn *: bool and int");
|
|
("div", "dyn /: vec and int");
|
|
("rem", "dyn %: int and nil");
|
|
("divzero", "does not divide by zero");
|
|
("remzero", "does not divide by zero");
|
|
("divover", "one past the largest i64");
|
|
("lt", "dyn <: int and text");
|
|
("le", "dyn <=: text and nil");
|
|
("gt", "dyn >: vec and vec");
|
|
("ge", "dyn >=: bool and bool");
|
|
("len", "dyn len: int");
|
|
("at", "dyn at: int and int");
|
|
("atindex", "an index must be an int");
|
|
("atrange", "index 9 is out of bounds for text of length 2");
|
|
("atnegative", "index -1 is out of bounds");
|
|
("setattext", "a text is immutable");
|
|
("setatnotvec", "only a vec is assigned into");
|
|
("setatrange", "index 0 is out of bounds for vec of length 0");
|
|
("push", "only a vec is pushed to");
|
|
("needi64", "dyn i64: text");
|
|
("needf64", "dyn f64: int");
|
|
("needbool", "dyn bool: nil") ]
|
|
in
|
|
List.iter
|
|
(fun (mode, phrase) ->
|
|
let code, out, err = run ("refuse:" ^ mode) in
|
|
if code = 0 then
|
|
fail "%s returned rather than trapping: %S" mode out
|
|
else if not (has err phrase) then
|
|
fail "%s did not say %S; it said %S" mode phrase err)
|
|
refusals;
|
|
|
|
(try Sys.remove exe with Sys_error _ -> ());
|
|
(* 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"
|
|
(List.length refusals)
|
|
else exit 1
|
|
| _ -> print_endline "SKIP test_dyn: no clang"
|