diff --git a/docs/handoffs/HANDOFF-dyn-m1.md b/docs/handoffs/HANDOFF-dyn-m1.md index d9063a7..5220e97 100644 --- a/docs/handoffs/HANDOFF-dyn-m1.md +++ b/docs/handoffs/HANDOFF-dyn-m1.md @@ -111,9 +111,23 @@ that count, and `dyn_tmp` only hands them out. **The stub verifies none of this.** `flan_dyn_stub.c` mallocs and never frees, so a program with entirely wrong root discipline passes every test that runs -against it. What is checked instead is the IR: an early-return function pops on -both paths, and a function with a defer pops on the transfer path. When the real -collector lands, that is the area to re-examine first. +against it. What is checked instead is the IR, and that check earned its keep — +it found a real hole. A defer appears twice in the typed IR, spliced into `body` +for the normal path and again in `fdefers` for the path a transfer leaves +through, so a dyn temporary inside one is emitted twice; `dyn_roots` counted +only the body's, and the second copy went into slots the collector had never +been told about. + +Nothing failed, which is the point. `dyn_tmp` falls back to a plain unrooted +slot rather than unbalancing the stack, so the pushes and the pops still +matched, the program ran and printed the right answer, and four dyn values were +simply invisible. Under a stub that never collects there is no symptom at all. + +The assertion that caught it is in `test_acceptance.ml`: a rooted slot is +spelled `%dr` and the fallback `%dx`, and no dyn program in the corpus may emit +the latter. When the real collector lands, that is the check to extend rather +than replace — it is the only one that can see a missing root before there is a +collector to lose one by. Cost: a rooted alloca has its address escape through `flan_dyn_root_push`, so mem2reg cannot promote it. Every dyn local and every dyn temporary is a real diff --git a/lib/emit.ml b/lib/emit.ml index 55b98b5..0a704ba 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -719,6 +719,15 @@ let dyn_roots (fn : Tast.fn) = | _ -> () in List.iter (Tast.walk count) fn.Tast.body; + (* And the transfer path's copy of the defers, which is a second list of the + same expressions and is emitted as well — so it mints a second set of + temporaries, and counting only [body] left every one of them in a slot the + collector never heard of. The fallback in [dyn_tmp] meant that was silent: + the pushes and the pops still balanced, and four dyn values in a defer + reached on a handled condition were simply invisible. Found by emitting + one and counting [%dx] in the IR, which is the only thing that can see it + while the runtime is a stub that never collects. *) + List.iter (Tast.walk count) fn.Tast.fdefers; slots + !temps (* The next pre-made root slot for a dyn temporary. They are all minted, zeroed diff --git a/spike/x86/survey.sh b/spike/x86/survey.sh index 919ae80..1b2cc7d 100755 --- a/spike/x86/survey.sh +++ b/spike/x86/survey.sh @@ -85,7 +85,7 @@ forever="dev-loop dev-watch dev-chatty" # which is a regression, and this is the opposite -- a lane that has not # started. Take a name off this list when the backend grows the lowering, and # the survey will say whether it works. -llvmonly="dyn-basic dyn-vec dyn-global dyn-boundary" +llvmonly="dyn-basic dyn-vec dyn-global dyn-boundary dyn-defer" TIMEOUT=${TIMEOUT:-20} diff --git a/test/programs/dyn-defer.flan b/test/programs/dyn-defer.flan new file mode 100644 index 0000000..af4e495 --- /dev/null +++ b/test/programs/dyn-defer.flan @@ -0,0 +1,28 @@ +;;;; A dyn value produced inside a defer, on a function a transfer leaves +;;;; through rather than returns from. +;;;; +;;;; This is here for the root count and not for the arithmetic. A defer appears +;;;; twice in the typed IR — spliced into the body for the normal path, and +;;;; again in fdefers for the path a handled condition unwinds along — so the +;;;; emitter produces two copies of every dyn temporary inside one. Counting +;;;; only the body left the second copy's temporaries in slots the collector had +;;;; never been told about: the pushes and the pops still balanced, so nothing +;;;; failed, and the values were simply invisible. +;;;; +;;;; Nothing the stub does can show that, because it never collects. What shows +;;;; it is the emitted IR — a fallback slot is spelled %dx and a rooted one %dr, +;;;; and the fix is the absence of the former. + +(defstruct Boom [n i64]) + +(defn inner [x] dyn + (defer (print (+ x 1000)) (print "\n")) + (restart-case + (error (Boom {.n 1})) + (give [] 0)) + (+ x 1)) + +(defn main [] () + (handler-bind [(Boom [b] (invoke-restart 'give))] + (print (inner 5)) + (print "\n"))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 69f2e82..b697342 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -3035,6 +3035,43 @@ level "1" dyn_boundary (); dyn_boundary ~opt:"-O0" (); + (* The root count, which is the one part of this feature no run can check: + the stub never collects, so a program whose roots are entirely wrong + passes every test above. What can be checked is the IR, and this is the + assertion that found a real hole — a defer appears twice in the typed IR, + spliced into the body for the normal path and again in [fdefers] for the + path a transfer leaves through, so a dyn temporary inside one is emitted + twice. Counting only the body left the second copy unrooted, silently: + the pushes and the pops balanced because [dyn_tmp] falls back to a plain + slot rather than unbalancing them, and four dyn values were invisible. + + [%dr] is a rooted slot and [%dx] is the fallback, so the claim is that + the emitted IR contains none of the latter. It is worth stating as a + property of the whole corpus and not only of this file: any dyn program + that mints one has a temporary the collector cannot see. *) + let no_fallback_slots path = + let l = Load.program ~file:path (Reader.read_file path) in + let ir = Emit.program (Check.program_all l.Load.decls) in + if contains ir "%dx" then begin + incr failures; + Printf.printf + "FAIL %s emits an unrooted dyn temporary (%%dx) — dyn_roots counted \ + fewer than the emission minted\n" + path + end + in + List.iter no_fallback_slots + [ "programs/dyn-basic.flan"; "programs/dyn-vec.flan"; + "programs/dyn-global.flan"; "programs/dyn-boundary.flan"; + "programs/dyn-defer.flan" ]; + (* And that the defer program still runs and still runs its defer: the + count being right is not much use if the transfer path broke getting + there. 1005 is the defer, 6 is the value the restart produced. *) + outputs "dyn: a defer on the transfer path" "programs/dyn-defer.flan" + "1005\n6\n"; + outputs ~opt:"-O0" "dyn: a defer on the transfer path, -O0" + "programs/dyn-defer.flan" "1005\n6\n"; + (* ── --no-gc ───────────────────────────────────────────────────── The flag is a pass between checking and emission that answers unit or refuses, and these are its two halves.