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

A dyn value held beside a sibling that can allocate is rooted until it is used, on every backend

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 09:32:34 +07:00
commit 795ba945d9
6 changed files with 455 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
TODO.org
View File

@ -1075,16 +1075,12 @@ predicates, not one: =settles= is about leaving part-way, =reads= about a value
reading itself, and a read through a pointer counts as reading everything.
=test/programs/self-read.flan= runs on both backends.
** TODO A dyn value read out of a place is unrooted until it is stored, on both backends
First filed as the x86 aggregate temporary being unrooted. It is wider than
that: a dyn loaded from a place and held while a later sibling allocates is
unrooted on LLVM -O0 as well, in an aggregate literal or an argument list alike.
=(pick (.d other) (do (set other (T {.n 0})) (churn)))= prints a different
object's contents on both backends. =Emit.root_plan= roots dyn call results
only. Decision for the author: root such intermediates on both backends (a
=root_plan= change, plus LLVM spilling them to rooted allocas), or declare the
shape unsupported. Rooting only the x86 temporary would fork the backends and
leave the argument case open.
** DONE The aggregate temporary is an unrooted buffer while it is filled
CLOSED: [2026-09-25]
The buffer stays unrooted. Every dyn word written into it while a sibling field
may allocate is also in a root slot of its own, pinned as that field was
computed, so the collector sees what has been built so far without a root for
the buffer.
** TODO Marking through a descriptor an x86 reload module emitted
The module links and runs. What is not proved is a collection running while a live
@ -1265,6 +1261,16 @@ A struct or a condition holding a =dyn= carries a descriptor naming the byte
offsets the collector must follow, emitted by both backends and by both
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, 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".
** DONE A redefined defclass migrates its instances lazily
CLOSED: [2026-09-20]
CLHS 4.3.6 minus the user hook. Nothing is enumerated and no heap is walked — the

71
docs/BUILT.md
View File

@ -7074,3 +7074,74 @@ default x86 and `--llvm`. `programs/dev-rerun.flan` keeps the other half.
The `defconst` there is an `f64`, deliberately: the checker folds *integer* constants on the way in, and a folded one
is refused by name rather than published, so an `i64` would have pinned the refusal instead of the store.
## How a dyn value is rooted, and operands held beside a sibling
The collector in `runtime/flan_dyn.c` is precise and finds its roots by address. `gc_mark_all` reads two things: the
root stack, which is an array of addresses pushed through `flan_dyn_root_push` (a bare dyn word) and
`flan_dyn_root_push_desc` (an aggregate, with the descriptor naming its dyn offsets), and a ring of the last 64
allocations. It never scans the machine stack or registers. That is what lets the same scheme run on wasm32, where a
program cannot read its own stack: every root is a slot the compiled code told the runtime about.
What gets a slot is decided once per function by `Emit.root_plan`, and both backends read that one plan rather than
each deriving it. Before this section's change it named three kinds of root: every frame slot whose type holds a dyn
word, the result of every call or runtime call that answers one (spilled into its own slot the instant it returns,
because the callee popped its roots on the way out), and the few non-place expressions whose *address* is handed to
something that can allocate. All the slots are made, zeroed and pushed at entry and popped by count at every exit.
### Operands held beside a sibling
A dyn read out of a place is rooted by the place, and only for as long as the place still holds it. In
```
(set (.d dst) (pick (.d other) (do (set other (T {.n 0})) (churn))))
```
the first argument is loaded, the second overwrites `other` and allocates, and between the two the only copy of the
first is a register or a scratch temporary that no root names. A collection there freed it: the program printed a
freed block's contents on LLVM, LLVM `-O0`, `--x86` and wasm32 alike, and valgrind showed `gc_mark_all` reading a
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 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;
- some *other* operand in the same list does not settle.
`Emit.settles` is the closed list of expressions that cannot reach a call, a signal, a check, a store or a return — the
same question the x86 backend asks before building an aggregate in place. A sibling that settles can neither allocate
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
both, so the count of slots is taken per visit of a pinned node rather than per position that asked for it —
otherwise the supply runs short and the backends fall back to an unrooted temporary. The acceptance suite's
`%dx`/`%ax` check sees that fallback on LLVM; it caught exactly this during the change.
The x86 backend's aggregate temporary, which builds a struct literal field by field, needs no root of its own for the
same reason: every dyn word written into it while a sibling field may allocate is also in a pinned slot.
What it costs is a store per pinned operand and a slot per pin in the entry block. Over `dyn-class.flan`, `dyn-map.flan`
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, 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.

223
lib/emit.ml
View File

@ -954,6 +954,10 @@ type f = {
within a pool never matters. See [root_plan] for why this is by type and
not a single positional list. *)
mutable aroot_ns : (string * string list) list;
(* The operands [root_plan] found held beside a sibling that may allocate,
by physical identity. [value] spills each of them into a root slot the
moment it is computed. See [held_operands]. *)
mutable pins : Tast.expr list;
(* Where a dev build records each slot's address, so that a stopped frame's
locals can be read. [None] in a release build and in a function with no
named slot at all. Only *named* slots are recorded: a slot the compiler
@ -1087,6 +1091,93 @@ let label f name =
count below is still the number the epilogue takes off; what changed is that
the plan has to say, per entry, which kind it is. *)
(* Whether lowering this expression into a destination is bound to reach the
end of it.
Asked first by the x86 backend. Nothing there holds a value in a register
across a statement, so an aggregate is built *in the destination*: field by field, element by
element, each one stored as it is computed. That is the cheapest thing that
works, and it works right up until the middle of the construction leaves.
A condition signalled while the third of four elements is being computed
transfers out of the assignment with two elements written and two not, and
what is left behind is a variable that is half its old value and half its
new one. The LLVM backend cannot have that shape — it builds the whole
aggregate as one value and stores it once — and where the two disagree,
the x86 one is the one that is wrong.
So an x86 assignment whose right-hand side might leave part-way builds into a
frame temporary and copies the finished value over in a single block move.
The copy is not free, which is what this question is for: it buys nothing
for [(set grid [1 2 3 4])], where nothing between the first store and the
last can go anywhere at all.
The answer is yes only for shapes spelled out below, none of which can
reach a call, a signal, a bounds or arithmetic check, or a return. Anything
else answers no and pays for the copy — a node added to the IR later
included, since being wrong this way costs a block copy and being wrong the
other way costs a corrupted variable.
[root_plan] asks the same question for a different reason: a sibling
operand that settles can neither allocate nor overwrite a place, so a dyn
value held beside it needs no root of its own. See [held_operands]. *)
let settled_prim (p : Tast.prim) =
match p with
(* Arithmetic that cannot fail. Division and remainder are absent on
purpose: both are checked, and a check signals. *)
| Tast.Add | Tast.Sub | Tast.Mul
| Tast.Eq | Tast.Ne | Tast.Lt | Tast.Le | Tast.Gt | Tast.Ge | Tast.Not
| Tast.BitAnd | Tast.BitOr | Tast.BitXor | Tast.Shl | Tast.Shr
(* Questions about a value's shape, answered from the layout tables. *)
| Tast.Len | Tast.SizeOf _ | Tast.AlignOf _ | Tast.AddrOf -> true
(* Everything else reaches C, signals, or both: an index and a slice are
bounds-checked and [Rt] is a call by definition. [Cast] is not here
because it is only sometimes checked; see [cast_checks]. *)
| _ -> false
(* Which conversions can signal, and it is one of them. [cvttsd2si] answers a
fixed "integer indefinite" for a value out of range, which is a number
rather than an answer, so a float narrowed to an integer is tested against
the destination's range first and the failure signals ArithError — see
[cast], which is where the test is emitted. Every other conversion is a
move, a widen or one SSE instruction, and cannot go anywhere. That matters
here because an array of the language's own literals is usually written
[(u32 1)] and not [1], and refusing every cast would have made the most
ordinary aggregate literal there is pay for a copy. *)
let cast_checks (src : Types.t) (target : Types.t) =
let concrete (t : Types.t) =
match t with Types.Enum _ -> Types.Int Types.I32 | t -> t
in
match concrete src, concrete target with
| Types.Float _, Types.Int _ -> true
| _ -> false
let rec settles (e : Tast.expr) =
match e.Tast.e with
(* Values with no code in them to leave from. *)
| Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit
| Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.Global _ | Tast.None_
| Tast.FnAddr _ -> true
(* Building an aggregate, and running a sequence: as settled as the parts. *)
| Tast.Make (_, es) | Tast.MakeCase (_, _, es) | Tast.Arr es | Tast.Do es ->
List.for_all settles es
| Tast.Some_ x | Tast.Field (x, _) | Tast.CaseField (x, _, _)
| Tast.Deref x -> settles x
| Tast.If (c, a, b) -> settles c && settles a && settles b
| Tast.Addr p -> settles_place p
| Tast.Prim (Tast.Cast target, [ a ]) ->
(not (cast_checks a.Tast.ty target)) && settles a
| Tast.Prim (p, es) -> settled_prim p && List.for_all settles es
(* A call, a signal, an invoke, an unwrap that returns early, a loop, a
[return], a [break] — and anything this list has not heard of. *)
| _ -> false
and settles_place (p : Tast.place) =
match p with
| Tast.Plocal _ | Tast.Pglobal _ -> true
| Tast.Pfield (x, _) | Tast.Pderef x -> settles x
(* An index is bounds-checked, and the check signals. *)
| Tast.Pindex _ -> false
(* Which expressions [addr] can answer without copying. Shared with [addr]
itself rather than repeated, because the counter below has to make exactly
the same call: a place has an address already and needs no root, and
@ -1122,8 +1213,90 @@ type rootplan = {
rslots : (int * Types.t) list; (* slot index and its type, in slot order *)
rdyn : int;
ragg : Types.t list; (* sorted, with multiplicity *)
rpins : Tast.expr list; (* see [held_operands] *)
}
(* The operands whose value is held while one of their siblings runs, and which
therefore need a root of their own from the moment they are computed.
A dyn read out of a place — a local, a global, a field — is rooted only by
the place, and only for as long as the place still holds it. In
[(pick (.d other) (do (set other ...) (churn)))] the first argument is
loaded, the second overwrites [other] and allocates, and between the two
the only copy of the first is a register or a temporary no root points at,
so a collection there frees it. Nothing about the place was wrong; what was
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 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.
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
into their own slot where they are made — and when some *other* operand in
the same list does not settle. A sibling that settles cannot allocate and
cannot write a place, so a value beside it is safe where it is. Any other
sibling, before or after, counts: which order the operands run in is then
not a question this plan has to agree with a backend about.
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. 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 <> [])
&& (match x.Tast.e with
| Tast.Call _ | Tast.CallPtr _ -> false
| Tast.Prim (Tast.Rt _, _) -> x.Tast.ty <> Types.Dyn
| Tast.Zero _ | Tast.Uninit _ | Tast.None_ | Tast.Unit -> false
| _ -> true)
in
(* 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 (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 =
let rslots = ref [] in
Array.iteri
@ -1133,7 +1306,24 @@ let root_plan m (fn : Tast.fn) : rootplan =
fn.Tast.slots;
let dyn = ref 0 and agg = ref [] in
let want (t : Types.t) = t <> Types.Dyn && dyn_offsets m t <> [] in
(* The pinned operands first, as a set of nodes. The checker shares a node
between two positions now and then — the same [Local] read in two places
— and the backends spill by identity, so a node pinned in one position is
spilled in every position it is emitted from. The count below is
therefore taken per visit of a pinned node, which is per emission, and
not per position that asked for the pin. *)
let pins = ref [] in
let collect (e : Tast.expr) =
List.iter
(fun x -> if not (List.memq x !pins) then pins := x :: !pins)
(held_operands m e)
in
List.iter (Tast.walk collect) fn.Tast.body;
List.iter (Tast.walk collect) fn.Tast.fdefers;
let count (e : Tast.expr) =
if !pins <> [] && List.memq e !pins then begin
if e.Tast.ty = Types.Dyn then incr dyn else agg := e.Tast.ty :: !agg
end;
match e.Tast.e with
| Tast.Prim (Tast.Rt _, _) when e.Tast.ty = Types.Dyn -> incr dyn
(* A Flan call answering a dyn, which wants the same slot a dyn-producing
@ -1177,7 +1367,8 @@ let root_plan m (fn : Tast.fn) : rootplan =
asm listing and an IR listing put the same value at the same depth. *)
ragg =
List.sort (fun a b -> String.compare (Types.to_string a) (Types.to_string b))
!agg }
!agg;
rpins = !pins }
let dyn_roots m (fn : Tast.fn) =
let p = root_plan m fn in
@ -1770,14 +1961,25 @@ let fcmp_op = function
a child -- the branch at the end of an [if], the store of a [set] -- are
attributed to the parent and not to whatever ran last inside it. *)
let rec value f (e : Tast.expr) : string =
match f.dsub with
| None -> value_at f e
| Some _ ->
let saved = f.dloc in
at_loc f e.Tast.loc;
let v = value_at f e in
f.dloc <- saved;
v
let v =
match f.dsub with
| None -> value_at f e
| Some _ ->
let saved = f.dloc in
at_loc f e.Tast.loc;
let v = value_at f e in
f.dloc <- saved;
v
in
(* An operand held while a sibling may allocate: spilled into a root slot the
instant it exists, the same move a call's result gets in [call_through].
The value carries on being used as a register; the store is what the
collector reads. *)
if f.pins <> [] && List.memq e f.pins then begin
if e.Tast.ty = Types.Dyn then ins f "store i64 %s, ptr %s" v (dyn_tmp f)
else ins f "store %s %s, ptr %s" (ll e.Tast.ty) v (agg_tmp f e.Tast.ty)
end;
v
(* The [!DILocation] for a position, memoised: a loop body emits the same few
lines over and over and each would otherwise make its own node. *)
@ -3341,7 +3543,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
pads = []; loops = []; unwind = "unwind"; unwound = false;
defers = fn.Tast.fdefers;
frame = None; slotv = None; snames = fn.Tast.snames;
droots = 0; droot_ns = []; aroot_ns = [];
droots = 0; droot_ns = []; aroot_ns = []; pins = [];
dsub;
dline = (if fn.Tast.floc.Loc.line = 0 then 1 else fn.Tast.floc.Loc.line);
dloc = "";
@ -3453,6 +3655,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
List.iter (fun (ty, n) -> push n ty) atemps;
f.droots <- nroots;
f.droot_ns <- dtemps;
f.pins <- plan.rpins;
f.aroot_ns <-
List.fold_left
(fun acc (ty, n) ->

108
lib/x86.ml
View File

@ -708,6 +708,10 @@ type fnctx = {
type is interchangeable, so a supply that drifted from the emission can
only run out and never pair an address with another type's descriptor. *)
mutable aroot_ns : (string * int list) list;
(* [emit.ml]'s [pins]: the operands [Emit.root_plan] found held beside a
sibling that may allocate, spilled by [lower] into a root slot as soon as
each is computed. *)
mutable pins : Tast.expr list;
(* [fn.snames], carried so [bind_slot] can ask whether a slot has a name to
show without the whole [Tast.fn] being threaded to every binding site. *)
snames : string option array;
@ -1594,88 +1598,8 @@ let emit_args f (args : arg list) =
point is that the store has somewhere legal to go. *)
let sink = Lf 0
(* Whether lowering this expression into a destination is bound to reach the
end of it.
Nothing in this backend holds a value in a register across a statement, so
an aggregate is built *in the destination*: field by field, element by
element, each one stored as it is computed. That is the cheapest thing that
works, and it works right up until the middle of the construction leaves.
A condition signalled while the third of four elements is being computed
transfers out of the assignment with two elements written and two not, and
what is left behind is a variable that is half its old value and half its
new one. The LLVM backend cannot have that shape — it builds the whole
aggregate as one value and stores it once — and where the two disagree,
this one is the one that is wrong.
So an assignment whose right-hand side might leave part-way builds into a
frame temporary and copies the finished value over in a single block move.
The copy is not free, which is what this question is for: it buys nothing
for [(set grid [1 2 3 4])], where nothing between the first store and the
last can go anywhere at all.
The answer is yes only for shapes spelled out below, none of which can
reach a call, a signal, a bounds or arithmetic check, or a return. Anything
else answers no and pays for the copy — a node added to the IR later
included, since being wrong this way costs a block copy and being wrong the
other way costs a corrupted variable. *)
let settled_prim (p : Tast.prim) =
match p with
(* Arithmetic that cannot fail. Division and remainder are absent on
purpose: both are checked, and a check signals. *)
| Tast.Add | Tast.Sub | Tast.Mul
| Tast.Eq | Tast.Ne | Tast.Lt | Tast.Le | Tast.Gt | Tast.Ge | Tast.Not
| Tast.BitAnd | Tast.BitOr | Tast.BitXor | Tast.Shl | Tast.Shr
(* Questions about a value's shape, answered from the layout tables. *)
| Tast.Len | Tast.SizeOf _ | Tast.AlignOf _ | Tast.AddrOf -> true
(* Everything else reaches C, signals, or both: an index and a slice are
bounds-checked and [Rt] is a call by definition. [Cast] is not here
because it is only sometimes checked; see [cast_checks]. *)
| _ -> false
(* Which conversions can signal, and it is one of them. [cvttsd2si] answers a
fixed "integer indefinite" for a value out of range, which is a number
rather than an answer, so a float narrowed to an integer is tested against
the destination's range first and the failure signals ArithError — see
[cast], which is where the test is emitted. Every other conversion is a
move, a widen or one SSE instruction, and cannot go anywhere. That matters
here because an array of the language's own literals is usually written
[(u32 1)] and not [1], and refusing every cast would have made the most
ordinary aggregate literal there is pay for a copy. *)
let cast_checks (src : Types.t) (target : Types.t) =
let concrete (t : Types.t) =
match t with Types.Enum _ -> Types.Int Types.I32 | t -> t
in
match concrete src, concrete target with
| Types.Float _, Types.Int _ -> true
| _ -> false
let rec settles (e : Tast.expr) =
match e.Tast.e with
(* Values with no code in them to leave from. *)
| Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit
| Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.Global _ | Tast.None_
| Tast.FnAddr _ -> true
(* Building an aggregate, and running a sequence: as settled as the parts. *)
| Tast.Make (_, es) | Tast.MakeCase (_, _, es) | Tast.Arr es | Tast.Do es ->
List.for_all settles es
| Tast.Some_ x | Tast.Field (x, _) | Tast.CaseField (x, _, _)
| Tast.Deref x -> settles x
| Tast.If (c, a, b) -> settles c && settles a && settles b
| Tast.Addr p -> settles_place p
| Tast.Prim (Tast.Cast target, [ a ]) ->
(not (cast_checks a.Tast.ty target)) && settles a
| Tast.Prim (p, es) -> settled_prim p && List.for_all settles es
(* A call, a signal, an invoke, an unwrap that returns early, a loop, a
[return], a [break] — and anything this list has not heard of. *)
| _ -> false
and settles_place (p : Tast.place) =
match p with
| Tast.Plocal _ | Tast.Pglobal _ -> true
| Tast.Pfield (x, _) | Tast.Pderef x -> settles x
(* An index is bounds-checked, and the check signals. *)
| Tast.Pindex _ -> false
(* [Emit.settles], whose comment gives this backend's reason for asking. *)
let settles = Emit.settles
(* The storage a destination lies in, as far as it can be named without
running anything: one local's slot, one global, or somewhere behind a
@ -1764,7 +1688,7 @@ let rec lower f (e : Tast.expr) (dst : loc) : unit =
scoped f (fun () ->
let o = tmp f e.Tast.ty in
lower f e (Lf o))
else if not f.ann then lower_at f e dst
else if not f.ann then (lower_at f e dst; pin f e dst)
else begin
(* The second hook, and it hangs off the same recursion for the same
reason: a heading queued here spans exactly the bytes this form and
@ -1779,6 +1703,7 @@ let rec lower f (e : Tast.expr) (dst : loc) : unit =
let s = annot f e in
f.adepth <- d + 1;
lower_at f e dst;
pin f e dst;
f.adepth <- d;
set_ind f.b ind;
match s with
@ -1786,6 +1711,16 @@ let rec lower f (e : Tast.expr) (dst : loc) : unit =
| None -> ()
end
(* An operand held while a sibling may allocate, copied into a root slot the
moment it has been lowered — [Emit.held_operands] for which ones and why.
[dst] is not enough: it is usually a [scoped] temporary, or a field of an
aggregate being built in one, and never a slot anything was pushed for. *)
and pin f (e : Tast.expr) (dst : loc) =
if f.pins <> [] && List.memq e f.pins then begin
let o = if e.Tast.ty = Types.Dyn then dyn_tmp f else agg_tmp f e.Tast.ty in
move f ~dst:(Lf o) ~src:dst e.Tast.ty
end
and lower_at f (e : Tast.expr) (dst : loc) : unit =
let t = e.Tast.ty in
match e.Tast.e with
@ -3761,7 +3696,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
{ b; md; fnname = fn.Tast.name; retlbl = "";
fret = fn.Tast.ret; slots = Array.make nslots 0;
xfer_off = 0; sret_off = 0; retval = 0;
dframe = None; dslotv = None; droots = 0; droot_ns = []; aroot_ns = [];
dframe = None; dslotv = None; droots = 0; droot_ns = []; aroot_ns = []; pins = [];
snames = fn.Tast.snames;
frame = 0; maxframe = 0; outgoing = 0;
loops = []; pads = []; xfer_lbl = ""; unwound = false;
@ -3876,6 +3811,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
droot_zero := zeros @ List.map (fun o -> (o, Types.Dyn)) dtemps @ atemps;
f.droots <- nroots;
f.droot_ns <- dtemps;
f.pins <- plan.Emit.rpins;
f.aroot_ns <-
List.fold_left
(fun acc (o, ty) ->
@ -4479,7 +4415,7 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~ex
let f =
{ b; md; fnname = "<globals>"; retlbl = new_label () "ginit";
fret = Types.Unit; slots = [||]; xfer_off = 0; sret_off = 0; retval = 0;
dframe = None; dslotv = None; droots = 0; droot_ns = []; aroot_ns = [];
dframe = None; dslotv = None; droots = 0; droot_ns = []; aroot_ns = []; pins = [];
snames = [||];
frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = [];
xfer_lbl = ""; unwound = false;
@ -5175,7 +5111,7 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
let f =
{ b = ib; md; fnname = "<install>"; retlbl = new_label () "install";
fret = Types.Unit; slots = [||]; xfer_off = 0; sret_off = 0; retval = 0;
dframe = None; dslotv = None; droots = 0; droot_ns = []; aroot_ns = [];
dframe = None; dslotv = None; droots = 0; droot_ns = []; aroot_ns = []; pins = [];
snames = [||];
frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = [];
xfer_lbl = ""; unwound = false;

104
test/programs/dyn-held-operand.flan Normal file
View File

@ -0,0 +1,104 @@
;;;; A dyn value read out of a place, held while a sibling operand runs.
;;;;
;;;; 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, 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
;;;; frees it and the line prints whatever the freed block holds next.
;;;;
;;;; [churn] ends in an explicit collection, so each line is tested against a
;;;; collection that certainly ran and not against the trigger's timing.
(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)
(defonce dst T)
(defonce pair [2 dyn])
(defonce w W)
(defn churn [] i64
(let [i 0]
(while (< i 2000)
(let [v (vec-new dyn)] (push v i) (push v "junk"))
(set i (+ i 1)))
(gc-collect)
7))
(defn kept [] dyn
(let [v (vec-new dyn)] (push v "kept") (push v 42) v))
;;; A fresh vector in [other], old enough that it is no longer among the
;;; collector's most recent allocations.
(defn fill [] () (set (.d other) (kept)) (churn))
;;; 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))
(defn show [label string v dyn] ()
(churn)
(println label (at v 0) (at v 1)))
(defn main [] ()
;; A call's argument.
(fill)
(set (.d dst) (pick (.d other) (clobber)))
(show "call:" (.d dst))
;; A struct literal's field.
(fill)
(set dst (T {.d (.d other) .n (clobber)}))
(show "struct:" (.d dst))
;; An array literal's element.
(fill)
(set pair [(.d other) (clobber-dyn)])
(show "array:" (at pair 0))
;; A runtime call's argument: dyn equality is a call into the runtime, and
;; its first operand is held while the second is computed.
(fill)
(println "runtime:" (= (.d other) (do (clobber) (kept))))
;; A local, overwritten by the sibling rather than a global.
(fill)
(let [x (.d other)]
(set (.d dst) (pick x (do (set x 0) (clobber))))
(show "local:" (.d dst)))
;; A whole struct with a dyn field in it, passed by value.
(fill)
(set (.d dst) (pick-t other (clobber)))
(show "aggregate:" (.d dst))
;; The same struct as a field of a struct literal.
(fill)
(set w (W {.t other .k (clobber)}))
(show "nested:" (.d (.t w)))
;; Through a function value.
(fill)
(let [g pick]
(set (.d dst) (g (.d other) (clobber)))
(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)))

30
test/test_acceptance.ml
View File

@ -3231,6 +3231,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".
@ -3345,7 +3353,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
@ -4556,6 +4569,20 @@ level "1"
"programs/dyn-struct.flan" dyn_struct_out;
outputs ~x86:true "dyn: a struct with dyn fields, under collection, --x86"
"programs/dyn-struct.flan" dyn_struct_out;
(* 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, 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. *)
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"
"programs/dyn-held-operand.flan" dyn_held_out;
outputs ~x86:true "dyn: an operand held while a sibling collects, --x86"
"programs/dyn-held-operand.flan" dyn_held_out;
(* Two struct spellings the checker decides: a bare {.field v} typed by
the position it stands in, and (Cell 1 2) positional. Three rows
because that is the house rule, not because the backends could differ
@ -4964,6 +4991,7 @@ level "1"
"programs/dyn-struct.flan";
"programs/dyn-global.flan"; "programs/dyn-boundary.flan";
"programs/dyn-defer.flan"; "programs/dyn-view.flan";
"programs/dyn-held-operand.flan";
(* Included for the same reason every dyn program is, though this
check cannot see the slot M2 item 4 actually added: [%dx]/[%ax]
are the pool-ran-dry fallback for a temporary [root_plan] COUNTED