From 0d629d791f1ba62bf240d06c8690907b766a3f75 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 09:30:41 +0700 Subject: [PATCH] The array an index or a slice is taken of is rooted while its index runs, when it is a temporary --- TODO.org | 7 ++-- docs/BUILT.md | 25 +++++++---- lib/emit.ml | 64 ++++++++++++++++++++--------- test/programs/dyn-held-operand.flan | 18 +++++++- test/test_acceptance.ml | 25 +++++++---- 5 files changed, 99 insertions(+), 40 deletions(-) diff --git a/TODO.org b/TODO.org index 2f2f83bd..bd9d836f 100644 --- a/TODO.org +++ b/TODO.org @@ -1226,9 +1226,10 @@ redefinition emitters. The stopgap refusal on a dyn field in a struct is lifted. ** DONE A dyn read out of a place is rooted while a sibling operand runs CLOSED: [2026-09-25] -An operand holding a dyn word — a call's or runtime call's argument, a struct, -case or array literal's element — is spilled into a pushed root slot as soon as -it is computed, whenever another operand in the same list does not settle. Same +An operand holding a dyn word — a call's, runtime call's or primitive's +argument, a struct or array literal's element, the temporary array an =at= or +=slice= indexes — is spilled into a pushed root slot as soon as it is computed, +whenever another operand in the same list does not settle. Same explicit-slot root stack on both backends and on wasm32; rules out anything that scans the native stack or registers. See docs/BUILT.md, "Operands held beside a sibling". diff --git a/docs/BUILT.md b/docs/BUILT.md index 40812239..7f2f86a2 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -7200,9 +7200,10 @@ freed block's contents on LLVM, LLVM `-O0`, `--x86` and wasm32 alike, and valgri block `gc_sweep` had freed. The positions that hold a value while more code runs are the ordered operand lists — a call's arguments, a runtime -call's, a struct, case or array literal's fields. Everything else consumes its operand at once: a `let` stores it into -a rooted slot, a `set` into its place (both backends compute the place before the value), a branch tests it, a -`return` hands it back. So `Emit.held_operands` looks only at those lists, and pins an operand when: +call's, a primitive's, a struct or array literal's fields. The positions outside a list each have one operand and +nothing beside it to run: a `let` stores it into a rooted slot, a `set` into its place (both backends compute the +place before the value), a branch tests it, a `return` hands it back. So `Emit.held_operands` looks only at those +lists, and pins an operand when: - its type holds a dyn word, as a bare dyn or through a descriptor; - nothing roots it already — a call's result has its own slot from the rule above; @@ -7213,6 +7214,15 @@ same question the x86 backend asks before building an aggregate in place. A sibl nor overwrite a place, so a value beside it is safe where it is. Asking about every other operand, not only the later ones, means the plan does not depend on the order a backend evaluates operands in. +Some operands are taken by address rather than by value: the array `at` and `slice` index, and an array handed to the +runtime. What such an operand holds is whatever its address was taken of. A place needs nothing, being rooted where it +was declared. Anything else — `(at [(.d other) (.d other)] (clobber-idx))`, or the same array reached through a field +of a struct literal — is copied into a temporary first, and that temporary sits unrooted while the index runs. +`addr_base` walks down through fields and elements to that temporary, and it is the node pinned. + +A dyn inside a `defdata` payload and an `(Option dyn)` are both refused before code generation, so a case literal and +`some` are not positions this covers today. + A pinned operand is spilled into a root slot as soon as it is computed, in `Emit.value` and in `X86.lower`, which is the same move a call's result gets and uses the same slots. The pinned nodes are keyed by physical identity. The checker occasionally shares one node between two positions, and a node pinned in one position is then spilled from @@ -7227,7 +7237,8 @@ What it costs is a store per pinned operand and a slot per pin in the entry bloc and `edn-read.flan` the emitted root pushes went up by roughly a quarter to a half. Typed code is unaffected: nothing without a dyn word in it is ever pinned. -`programs/dyn-held-operand.flan` is the fixture, eight cases on three rows: a call's argument, a struct literal's -field, an array literal's element, a runtime call's argument (dyn `=`), a local overwritten by the sibling, a whole -struct passed by value, a struct nested in a literal, and a call through a function value. Without the pins every -line prints freed memory. +`programs/dyn-held-operand.flan` is the fixture, ten cases on LLVM, `-O0`, `--x86` and wasm32: a call's argument, a +struct literal's field, an array literal's element, a runtime call's argument (dyn `=`), a local overwritten by the +sibling, a whole struct passed by value, a struct nested in a literal, a call through a function value, and an array +literal indexed while the index runs, directly and through a struct literal's field. Without the pins every line +prints freed memory. diff --git a/lib/emit.ml b/lib/emit.ml index 53f2de04..c81415ed 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1228,11 +1228,14 @@ type rootplan = { missing is a root for the value between being produced and being consumed. The positions that hold a value while more code runs are the ordered - operand lists: a call's arguments, a runtime call's, a struct, case or - array literal's fields. Every other position consumes its operand at once - — a [let] stores it into a rooted slot, a [set] into its place (both + operand lists: a call's arguments, a runtime call's, a primitive's, a + struct or array literal's fields. An operand taken by address — the array + [at] and [slice] index, an array handed to the runtime — holds whatever its + address was taken of, which is a temporary when that is not a place. The + positions outside a list each have one operand and nothing beside it to + run: a [let] stores it into a rooted slot, a [set] into its place (both backends compute the place first), a branch tests it, a [return] hands it - back — so these lists are the whole of it. + back. An operand is pinned when its type holds a dyn word, when nothing already roots it — a call's result and a dyn-producing runtime call's are spilled @@ -1244,11 +1247,9 @@ type rootplan = { The node itself is the key, by physical identity, and the backends spill its value after computing it — [value] in this file, [lower] in the other — - exactly as they spill a call's result. An array argument to a runtime call - is not a candidate: it crosses by address, which the x86 backend takes - without lowering it and this file takes by way of [value] only when it is - not a place, so pinning it would draw a slot on one backend and not the - other. *) + exactly as they spill a call's result. For an operand taken by address the + node pinned is the temporary under it, found by [addr_base]; a place under + it needs nothing, and neither backend evaluates one through either hook. *) let held_operands m (e : Tast.expr) : Tast.expr list = let holds (x : Tast.expr) = (x.Tast.ty = Types.Dyn || dyn_offsets m x.Tast.ty <> []) @@ -1258,19 +1259,42 @@ let held_operands m (e : Tast.expr) : Tast.expr list = | Tast.Zero _ | Tast.Uninit _ | Tast.None_ | Tast.Unit -> false | _ -> true) in - let pick ?(by_addr = false) siblings candidates = - List.filter - (fun (x : Tast.expr) -> - holds x - && (not (by_addr && (match x.Tast.ty with Types.Array _ -> true | _ -> false))) - && List.exists (fun s -> s != x && not (settles s)) siblings) - candidates + (* An operand taken by address holds the value its address is taken of. + A place holds nothing new: its storage is rooted where it was declared. + A field or an element of something else is an address into that + something, and a value that is not a place is copied into a temporary — + which is the value held, and the node both backends evaluate. *) + let rec addr_base (x : Tast.expr) = + match x.Tast.e with + | Tast.Local _ | Tast.Global _ | Tast.Deref _ | Tast.CaseField _ -> None + | Tast.Field (t, _) -> addr_base t + | Tast.Prim (Tast.At, t :: _ :: _) -> addr_base t + | _ -> Some x + in + (* [ops] is the list with, for each operand, whether it crosses by address. *) + let pick ops = + List.filter_map + (fun ((x : Tast.expr), by_addr) -> + let held = if by_addr then addr_base x else Some x in + match held with + | Some h when holds h + && List.exists + (fun ((s : Tast.expr), _) -> s != x && not (settles s)) + ops -> Some h + | _ -> None) + ops + in + let by_value es = List.map (fun x -> (x, false)) es in + let is_array (x : Tast.expr) = + match x.Tast.ty with Types.Array _ -> true | _ -> false in match e.Tast.e with - | Tast.Prim (Tast.Rt _, es) -> pick ~by_addr:true es es - | Tast.Call (_, es) | Tast.Make (_, es) | Tast.MakeCase (_, _, es) - | Tast.Arr es -> pick es es - | Tast.CallPtr (c, es) -> pick (c :: es) es + | Tast.Prim (Tast.Rt _, es) -> pick (List.map (fun x -> (x, is_array x)) es) + | Tast.Prim ((Tast.At | Tast.Slice), t :: rest) -> + pick ((t, true) :: by_value rest) + | Tast.Prim (_, es) | Tast.Call (_, es) | Tast.Make (_, es) + | Tast.MakeCase (_, _, es) | Tast.Arr es -> pick (by_value es) + | Tast.CallPtr (c, es) -> pick (by_value (c :: es)) | _ -> [] let root_plan m (fn : Tast.fn) : rootplan = diff --git a/test/programs/dyn-held-operand.flan b/test/programs/dyn-held-operand.flan index 981baf34..dfefc044 100644 --- a/test/programs/dyn-held-operand.flan +++ b/test/programs/dyn-held-operand.flan @@ -2,7 +2,8 @@ ;;;; ;;;; Every line below reads the vector in [other] into an operand position — ;;;; a call's argument, a struct literal's field, an array literal's element, -;;;; a runtime call's argument, a function value's argument — and then runs a +;;;; a runtime call's argument, a function value's argument, the array an +;;;; index is taken of — and then runs a ;;;; sibling that overwrites [other] and allocates enough to collect. Once ;;;; [other] is overwritten, the only reference to the vector is the operand ;;;; being held, so unless that operand has a root of its own the collection @@ -13,6 +14,7 @@ (defstruct T [d dyn n i64]) (defstruct W [t T k i64]) +(defstruct A2 [xs [2 dyn]]) (declare gc-collect [] () "flan_gc_collect") (defonce other T) @@ -38,6 +40,7 @@ ;;; Overwrite [other], then allocate and collect. (defn clobber [] i64 (set other (T {.n 0})) (churn)) (defn clobber-dyn [] dyn (clobber) (vec-new dyn)) +(defn clobber-idx [] i32 (clobber) 0) (defn pick [x dyn n i64] dyn x) (defn pick-t [t T n i64] dyn (.d t)) @@ -87,4 +90,15 @@ (fill) (let [g pick] (set (.d dst) (g (.d other) (clobber))) - (show "fn value:" (.d dst)))) + (show "fn value:" (.d dst))) + + ;; An array literal indexed while the index runs: the array is a temporary + ;; taken by address, and the temporary is what is held. + (fill) + (set (.d dst) (at [(.d other) (.d other)] (clobber-idx))) + (show "index:" (.d dst)) + + ;; The same through a field of a struct literal. + (fill) + (set (.d dst) (at (.xs (A2 {.xs [(.d other) (.d other)]})) (clobber-idx))) + (show "field index:" (.d dst))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 143633f5..e19a43c2 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -3142,6 +3142,14 @@ let () = refuses "a Vec crossing to C" "programs/vec-to-c.flan" "is a Vec, which owns its storage"; + (* What [programs/dyn-held-operand.flan] prints, here rather than beside its + three native rows further down because the wasm32 case below runs it + too. *) + let dyn_held_out = + "call: kept 42\nstruct: kept 42\narray: kept 42\nruntime: true\n\ + local: kept 42\naggregate: kept 42\nnested: kept 42\n\ + fn value: kept 42\nindex: kept 42\nfield index: kept 42\n" + in (* ── wasm32 ──────────────────────────────────────────────────────── TODO.org, "The web target does not reach four things". @@ -3256,7 +3264,12 @@ let () = wasm_case "an imported package nothing calls, wasm32" "programs/pkg-unused.flan" "ok\n"; wasm_case "an imported package nothing calls, wasm32, -O0" - ~opt:"-O0" "programs/pkg-unused.flan" "ok\n")); + ~opt:"-O0" "programs/pkg-unused.flan" "ok\n"; + (* The dyn roots, on the target that cannot scan its own stack: a + value held beside a sibling that collects is rooted through the + same explicit slots there as natively. *) + wasm_case "dyn: an operand held while a sibling collects, wasm32" + "programs/dyn-held-operand.flan" dyn_held_out)); (* The EDN tokenizer, and the struct reader written by hand against it (vendor/edn, test/programs/edn.flan). The expected output is a raw @@ -4440,15 +4453,11 @@ level "1" (* A dyn read out of a place and held in an operand position while a sibling overwrites the place and collects: a call's argument, a struct and an array literal's element, a runtime call's argument, a local, a - whole struct passed by value, a struct nested in a literal, and a call - through a function value. [Emit.held_operands] roots each of them. With + whole struct passed by value, a struct nested in a literal, a call + through a function value, and an array literal indexed — directly and + through a struct literal's field — while the index runs. [Emit.held_operands] roots each of them. With that function answering nothing, every line comes out as a freed block's contents and the runtime line as false, on all three rows. *) - let dyn_held_out = - "call: kept 42\nstruct: kept 42\narray: kept 42\nruntime: true\n\ - local: kept 42\naggregate: kept 42\nnested: kept 42\n\ - fn value: kept 42\n" - in outputs "dyn: an operand held while a sibling collects" "programs/dyn-held-operand.flan" dyn_held_out; outputs ~opt:"-O0" "dyn: an operand held while a sibling collects, -O0"