A dyn value held in an operand list is rooted while a sibling operand may allocate
This commit is contained in:
parent
5557594f31
commit
0653f341d0
20
TODO.org
20
TODO.org
@ -1041,11 +1041,12 @@ globals-init path was not converted and still writes in place.
|
||||
fix has a shape already — the same temporary, chosen by an aliasing question.
|
||||
Whether the two become one predicate or two is the lane to decide.
|
||||
|
||||
** TODO The aggregate temporary is an unrooted buffer while it is filled
|
||||
No root table names it. Harmless only while a dyn field in a struct was refused,
|
||||
and per-type descriptors have since lifted that. Whoever relies on a dyn field
|
||||
reaching this path has to root the buffer, or a collection running inside the
|
||||
construction will not see what has been built so far.
|
||||
** 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
|
||||
@ -1223,6 +1224,15 @@ 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 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
|
||||
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
|
||||
|
||||
@ -7171,3 +7171,63 @@ 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 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:
|
||||
|
||||
- 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.
|
||||
|
||||
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, 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.
|
||||
|
||||
199
lib/emit.ml
199
lib/emit.ml
@ -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,66 @@ 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 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
|
||||
backends compute the place first), a branch tests it, a [return] hands it
|
||||
back — so these lists are the whole of it.
|
||||
|
||||
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. 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. *)
|
||||
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
|
||||
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
|
||||
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
|
||||
| _ -> []
|
||||
|
||||
let root_plan m (fn : Tast.fn) : rootplan =
|
||||
let rslots = ref [] in
|
||||
Array.iteri
|
||||
@ -1133,7 +1282,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 +1343,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
|
||||
@ -1752,14 +1919,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. *)
|
||||
@ -3320,7 +3498,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 = "";
|
||||
@ -3432,6 +3610,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
108
lib/x86.ml
@ -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
|
||||
|
||||
let rec lower f (e : Tast.expr) (dst : loc) : unit =
|
||||
(* The one hook the line table needs, and it is here rather than at
|
||||
@ -1688,7 +1612,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
|
||||
@ -1703,6 +1627,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
|
||||
@ -1710,6 +1635,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
|
||||
@ -3654,7 +3589,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;
|
||||
@ -3769,6 +3704,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) ->
|
||||
@ -4372,7 +4308,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;
|
||||
@ -5068,7 +5004,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;
|
||||
|
||||
90
test/programs/dyn-held-operand.flan
Normal file
90
test/programs/dyn-held-operand.flan
Normal file
@ -0,0 +1,90 @@
|
||||
;;;; 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 — 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])
|
||||
(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 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))))
|
||||
@ -4437,6 +4437,24 @@ 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, and a call
|
||||
through a function value. [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"
|
||||
"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
|
||||
@ -4845,6 +4863,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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user