The collector walks a Map's full slots, so a Map may hold closures and dyn values and keeps them alive
This commit is contained in:
parent
0f0fbc68ef
commit
6e29c19097
@ -4575,8 +4575,13 @@ read of a local. So the prelude's `map`, `filter` and `reduce` are as cheap in a
|
||||
closure as in one that makes none: a map, filter and reduce loop measured 1.77G instructions at LLVM `-O2` with
|
||||
and without one unrelated escaping closure.
|
||||
|
||||
**What is refused.** A `Map` whose values hold a function value (`fn-in-map.flan`): a `Map`'s storage is not walked.
|
||||
A bare `Fn` field, global or array element is still refused for its zero; `(Option (Fn ...))` holds one.
|
||||
**A `Map`'s values are walked the same way** (`fn-in-map.flan`). A descriptor's `maps` table names each `Map` header
|
||||
and the value type's descriptor; `flan_rt.c` reports each `Map` block through the same hook, and the marker walks the
|
||||
full slots of a live block, reading the slot count from the header and the stride and value offset from the block's
|
||||
own head. It covers a dyn value as well as a closure, so `(Map K dyn)` holds dyn values the collector keeps. The hook
|
||||
is installed by any program holding a dyn, not only one making heap closures.
|
||||
|
||||
**What is refused.** A bare `Fn` field, global or array element, for its zero; `(Option (Fn ...))` holds one.
|
||||
|
||||
**A module that makes a heap closure is never unloaded**: the environment points at the module's descriptor and
|
||||
code, so making one counts toward the same gate a string literal does. A capturing `fn` typed at the dev prompt takes
|
||||
|
||||
50
lib/check.ml
50
lib/check.ml
@ -13639,8 +13639,11 @@ let rec hidden_dyn p seen (t : Types.t) : Types.t option =
|
||||
| Types.Dyn -> None
|
||||
| Types.Array (_, e) -> hidden_dyn p seen e
|
||||
| Types.Vec e | Types.Option e -> under e
|
||||
(* A Map's values are walked through the value type's own descriptor, so a
|
||||
dyn there is found wherever that descriptor finds one. A key never holds
|
||||
one: dyn is not a key type. *)
|
||||
| Types.Map (k, v) ->
|
||||
if dyn_anywhere p seen k || dyn_anywhere p seen v then Some t else None
|
||||
if dyn_anywhere p seen k then Some t else hidden_dyn p seen v
|
||||
(* A pointer and a slice are views of storage something else roots; see the
|
||||
note above. What they point at is checked where it is declared. *)
|
||||
| Types.Ptr (_, e) | Types.Slice (_, e) -> hidden_dyn p seen e
|
||||
@ -13760,53 +13763,8 @@ let rec holds_fn p seen (t : Types.t) =
|
||||
| None -> false)
|
||||
| _ -> false
|
||||
|
||||
(* The first Map under this type whose values hold a function value. A
|
||||
closure's environment is found by walking the storage a function value
|
||||
sits in, and a Map's storage is not walked — so an (Fn ...) there would be
|
||||
one the collector frees under it. A Vec's is, which is the container to
|
||||
use; and a (CFn ...) carries no environment and may go in a Map freely. *)
|
||||
let rec map_of_fn p seen (t : Types.t) : Types.t option =
|
||||
match t with
|
||||
| Types.Map (k, v) when holds_fn p [] k || holds_fn p [] v -> Some t
|
||||
| Types.Array (_, e) | Types.Vec e | Types.Option e
|
||||
| Types.Ptr (_, e) | Types.Slice (_, e) -> map_of_fn p seen e
|
||||
| Types.Map (_, v) -> map_of_fn p seen v
|
||||
| Types.Named n when not (List.mem n seen) ->
|
||||
let seen = n :: seen in
|
||||
let fields =
|
||||
match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
|
||||
p.Tast.structs with
|
||||
| Some s -> s.Tast.fields
|
||||
| None ->
|
||||
match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
|
||||
p.Tast.datas with
|
||||
| Some u -> List.concat_map (fun (c : Tast.variant) -> c.Tast.vfields) u.Tast.cases
|
||||
| None ->
|
||||
match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
|
||||
p.Tast.unions with
|
||||
| Some u -> u.Tast.fields
|
||||
| None -> []
|
||||
in
|
||||
List.fold_left
|
||||
(fun acc (fl : Tast.field) ->
|
||||
match acc with Some _ -> acc | None -> map_of_fn p seen fl.Tast.fty)
|
||||
None fields
|
||||
| _ -> None
|
||||
|
||||
let dyn_descriptors (p : Tast.program) =
|
||||
let check loc what (t : Types.t) =
|
||||
(match map_of_fn p [] t with
|
||||
| Some at ->
|
||||
Loc.failk "check/fn-in-map" loc
|
||||
"%s is %s%s, a Map whose values are function values. A function \
|
||||
value's environment is found by walking the storage it sits in, \
|
||||
and a Map's storage is not walked, so the collector would free an \
|
||||
environment still in use. Keep the function values in a Vec, or \
|
||||
make them (CFn ...) if they capture nothing"
|
||||
what (Types.to_string t)
|
||||
(if Types.equal t at then ""
|
||||
else Printf.sprintf ", and holds %s" (Types.to_string at))
|
||||
| None -> ());
|
||||
(match hidden_dyn p [] t with
|
||||
| Some at ->
|
||||
Loc.failk "check/dyn-descriptor" loc
|
||||
|
||||
125
lib/emit.ml
125
lib/emit.ml
@ -459,23 +459,26 @@ let align_up x a = if a <= 1 then x else ((x + a - 1) / a) * a
|
||||
pointer is four bytes and [goff] would name the wrong word. *)
|
||||
type gcword = { goff : int; gpath : (string * string list) list }
|
||||
|
||||
(* Every word of an instance the collector follows, by kind — the three
|
||||
(* Every word of an instance the collector follows, by kind — the four
|
||||
tables of runtime/flan_dyn.h's [flan_desc]. [gvec] carries each Vec's
|
||||
element type, whose own descriptor the entry points at. *)
|
||||
element type and [gmap] each Map's value type, whose own descriptor the
|
||||
entry points at. *)
|
||||
type gclayout = {
|
||||
gdyn : gcword list;
|
||||
genv : gcword list;
|
||||
gvec : (gcword * Types.t) list;
|
||||
gmap : (gcword * Types.t) list;
|
||||
}
|
||||
|
||||
(* A descriptor this module has to write out: its symbol, the words, the
|
||||
instance size, and the symbol of each Vec entry's element descriptor in
|
||||
[gvec]'s order. *)
|
||||
[gvec]'s order and of each Map entry's value descriptor in [gmap]'s. *)
|
||||
type desc = {
|
||||
dsym : string;
|
||||
dlay : gclayout;
|
||||
dsize : int;
|
||||
dvecs : string list;
|
||||
dmaps : string list;
|
||||
}
|
||||
|
||||
(* ── Module-level state ────────────────────────────────────────────── *)
|
||||
@ -741,16 +744,12 @@ and dyn_offsets m (t : Types.t) : int list =
|
||||
— which is a run-time question a static descriptor cannot answer.
|
||||
Refused in [Check] rather than described wrongly here. *)
|
||||
| None -> acc)
|
||||
(* [Types.Option], [Types.Vec] and [Types.Map] fall through here with no
|
||||
arm of their own and answer no offsets, which is correct only because
|
||||
nothing reaches this function holding one with a dyn inside it:
|
||||
(* [Types.Option] and [Types.Vec] fall through here with no arm of their
|
||||
own and answer no offsets, which is correct only because nothing
|
||||
reaches this function holding one with a dyn inside it:
|
||||
[Check.hidden_dyn] refuses that at every global, parameter, return and
|
||||
frame slot first. If that gate is ever relaxed — the typed-container
|
||||
view the M2 queue's item 3 is building is exactly the kind of change
|
||||
that would relax it for [Vec]/[Map] — this arm has to grow alongside
|
||||
it, the way the array and struct arms above already walk their own
|
||||
storage; until then a silent [] here would be an unrooted dyn, not a
|
||||
refusal. *)
|
||||
frame slot first. A [Types.Map]'s dyn values are not words of the
|
||||
instance at all; [gc_layout] names the header in its [gmap] table. *)
|
||||
| _ -> acc
|
||||
in
|
||||
List.sort_uniq compare (go [] 0 t [])
|
||||
@ -794,7 +793,7 @@ let desc_mangle (t : Types.t) =
|
||||
symbol. *)
|
||||
let rec desc_of m (t : Types.t) : string option =
|
||||
let l = gc_layout m t in
|
||||
if l.gdyn = [] && l.genv = [] && l.gvec = [] then None
|
||||
if l.gdyn = [] && l.genv = [] && l.gvec = [] && l.gmap = [] then None
|
||||
else
|
||||
let key = Types.to_string t in
|
||||
match Hashtbl.find_opt m.descs key with
|
||||
@ -806,17 +805,19 @@ let rec desc_of m (t : Types.t) : string option =
|
||||
(* Claimed before the elements are asked for, so the counter a nested
|
||||
element's symbol takes cannot be this one's. *)
|
||||
Hashtbl.replace m.descs key
|
||||
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs = [] };
|
||||
let dvecs =
|
||||
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs = []; dmaps = [] };
|
||||
let elems what l =
|
||||
List.map
|
||||
(fun (_, e) ->
|
||||
match desc_of m e with
|
||||
| Some s -> s
|
||||
| None -> internal "a Vec entry whose element has no words")
|
||||
l.gvec
|
||||
| None -> internal "a %s entry whose element has no words" what)
|
||||
l
|
||||
in
|
||||
let dvecs = elems "Vec" l.gvec in
|
||||
let dmaps = elems "Map" l.gmap in
|
||||
Hashtbl.replace m.descs key
|
||||
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs };
|
||||
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs; dmaps };
|
||||
Some sym
|
||||
|
||||
(* ── The words the collector follows ─────────────────────────────────
|
||||
@ -845,7 +846,7 @@ let rec desc_of m (t : Types.t) : string option =
|
||||
at the same x86-64 offset and at different wasm32 ones, and marking a word
|
||||
twice costs nothing. *)
|
||||
and gc_layout m (t : Types.t) : gclayout =
|
||||
let dyn = ref [] and env = ref [] and vec = ref [] in
|
||||
let dyn = ref [] and env = ref [] and vec = ref [] and map = ref [] in
|
||||
let step ty idx path = path @ [ (ty, idx) ] in
|
||||
let rec go ~full seen off path (t : Types.t) =
|
||||
match t with
|
||||
@ -858,6 +859,13 @@ and gc_layout m (t : Types.t) : gclayout =
|
||||
[desc_of] claims before it recurses, is what closes that loop. *)
|
||||
| Types.Vec e when m.gcfn ->
|
||||
if reaches_fn m [] e then vec := ({ goff = off; gpath = path }, e) :: !vec
|
||||
(* A Map's values, when they hold a function value's environment or a
|
||||
dyn. The key never does: neither is a key type. The value type's own
|
||||
descriptor is what the entry points at, so a Map of Maps is walked
|
||||
through the inner one's. *)
|
||||
| Types.Map (_, v) ->
|
||||
if (m.gcfn && reaches_fn m [] v) || reaches_dyn m [] v then
|
||||
map := ({ goff = off; gpath = path }, v) :: !map
|
||||
| Types.Array (n, e) ->
|
||||
let s, _ = lay m e in
|
||||
for i = 0 to Int64.to_int n - 1 do
|
||||
@ -924,7 +932,8 @@ and gc_layout m (t : Types.t) : gclayout =
|
||||
in
|
||||
let uniq l = List.sort_uniq order l in
|
||||
{ gdyn = uniq !dyn; genv = uniq !env;
|
||||
gvec = List.sort_uniq (fun (a, _) (b, _) -> order a b) !vec }
|
||||
gvec = List.sort_uniq (fun (a, _) (b, _) -> order a b) !vec;
|
||||
gmap = List.sort_uniq (fun (a, _) (b, _) -> order a b) !map }
|
||||
|
||||
(* Whether an [(Fn ...)] is anywhere in a value's storage, a Vec's elements
|
||||
included. A type met again on the way contributes nothing more, which
|
||||
@ -933,7 +942,8 @@ and gc_layout m (t : Types.t) : gclayout =
|
||||
and reaches_fn m seen (t : Types.t) =
|
||||
match t with
|
||||
| Types.Fn _ -> true
|
||||
| Types.Array (_, e) | Types.Vec e | Types.Option e -> reaches_fn m seen e
|
||||
| Types.Array (_, e) | Types.Vec e | Types.Option e | Types.Map (_, e) ->
|
||||
reaches_fn m seen e
|
||||
| Types.Named nm when not (List.mem nm seen) ->
|
||||
let seen = nm :: seen in
|
||||
let fields =
|
||||
@ -950,17 +960,35 @@ and reaches_fn m seen (t : Types.t) =
|
||||
List.exists (fun (fl : Tast.field) -> reaches_fn m seen fl.Tast.fty) fields
|
||||
| _ -> false
|
||||
|
||||
(* Whether a dyn word is anywhere [gc_layout] records one: directly, in a
|
||||
fixed array, in a struct field, or in a Map's values. The other places a
|
||||
dyn could sit are refused by [Check.hidden_dyn]. *)
|
||||
and reaches_dyn m seen (t : Types.t) =
|
||||
match t with
|
||||
| Types.Dyn -> true
|
||||
| Types.Array (_, e) | Types.Map (_, e) -> reaches_dyn m seen e
|
||||
| Types.Named nm when not (List.mem nm seen) ->
|
||||
(match Hashtbl.find_opt m.structs nm with
|
||||
| Some st ->
|
||||
List.exists
|
||||
(fun (fl : Tast.field) -> reaches_dyn m (nm :: seen) fl.Tast.fty)
|
||||
st.Tast.fields
|
||||
| None -> false)
|
||||
| _ -> false
|
||||
|
||||
(* Whether the collector has anything to follow in a value of this type —
|
||||
the question every rooting decision asks. [dyn_offsets <> []] was that
|
||||
question until an [Fn] could hold an environment. *)
|
||||
let traced m (t : Types.t) =
|
||||
t = Types.Dyn
|
||||
|| (let l = gc_layout m t in l.gdyn <> [] || l.genv <> [] || l.gvec <> [])
|
||||
|| (let l = gc_layout m t in
|
||||
l.gdyn <> [] || l.genv <> [] || l.gvec <> [] || l.gmap <> [])
|
||||
|
||||
(* The words to clear before an instance at a pushed root can be marked, as
|
||||
x86-64 byte offsets of eight-byte words: each dyn word, each environment
|
||||
word, and each Vec header's pointer and length. The LLVM backend walks
|
||||
[gpath] instead; see [zero_words]. *)
|
||||
word, each Vec header's pointer and length, and each Map header's block
|
||||
pointer and capacity. The LLVM backend walks [gpath] instead; see
|
||||
[zero_words]. *)
|
||||
let gc_zero_offsets m (t : Types.t) : int list =
|
||||
if t = Types.Dyn then [ 0 ]
|
||||
else
|
||||
@ -968,6 +996,7 @@ let gc_zero_offsets m (t : Types.t) : int list =
|
||||
List.map (fun w -> w.goff) l.gdyn
|
||||
@ List.map (fun w -> w.goff) l.genv
|
||||
@ List.concat_map (fun (w, _) -> [ w.goff; w.goff + 8 ]) l.gvec
|
||||
@ List.concat_map (fun (w, _) -> [ w.goff; w.goff + 16 ]) l.gmap
|
||||
|
||||
(* A [gpath] as an LLVM constant expression over [base]: nested constant
|
||||
[getelementptr]s, one per step. Over [ptr null] and through [ptrtoint] it
|
||||
@ -4273,7 +4302,12 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
|
||||
(fun ((w : gcword), _) ->
|
||||
store "ptr null" (w.gpath @ [ ("%vec", [ "i32 0"; "i32 0" ]) ]);
|
||||
store "i64 0" (w.gpath @ [ ("%vec", [ "i32 0"; "i32 1" ]) ]))
|
||||
l.gvec
|
||||
l.gvec;
|
||||
List.iter
|
||||
(fun ((w : gcword), _) ->
|
||||
store "ptr null" (w.gpath @ [ ("%map", [ "i32 0"; "i32 0" ]) ]);
|
||||
store "i64 0" (w.gpath @ [ ("%map", [ "i32 0"; "i32 2" ]) ]))
|
||||
l.gmap
|
||||
end
|
||||
in
|
||||
let push base (ty : Types.t) =
|
||||
@ -5130,12 +5164,13 @@ let emit_main m ?(startup = false) ?(gc = false) ?(dyn_globals = []) (fn : Tast.
|
||||
dyn global's initialiser runs in the startup function below, and the very
|
||||
first thing it does is allocate. *)
|
||||
if gc then Buffer.add_string b " call void @flan_gc_init()\n";
|
||||
(* Before anything can allocate a Vec block: a program that can make a
|
||||
collector-owned closure environment has flan_rt.c report every Vec block
|
||||
to the collector, which reads a Vec's elements only through a block it
|
||||
knows to be live (runtime/flan_dyn.c, "The Vec blocks a marker may
|
||||
read"). *)
|
||||
if m.gcfn then Buffer.add_string b " call void @flan_dyn_track_vecs()\n";
|
||||
(* Before anything can allocate a Vec or Map block: a program that can make
|
||||
a collector-owned closure environment, or that holds a dyn, has
|
||||
flan_rt.c report every such block to the collector, which reads a
|
||||
container's elements only through a block it knows to be live
|
||||
(runtime/flan_dyn.c, "The Vec blocks a marker may read"). *)
|
||||
if m.gcfn || gc then
|
||||
Buffer.add_string b " call void @flan_dyn_track_vecs()\n";
|
||||
(* The dyn globals, rooted here and never popped, which is the whole of what
|
||||
a global's extent means. They go on the stack *before* the startup
|
||||
function runs, because that function is what fills them and its first
|
||||
@ -5409,21 +5444,24 @@ let descriptors m =
|
||||
let l = d.dlay in
|
||||
let offs = table d.dsym "offs" "i64" (List.map word l.gdyn) in
|
||||
let envs = table d.dsym "envs" "i64" (List.map word l.genv) in
|
||||
let vecs =
|
||||
table d.dsym "vecs" "{ i64, ptr }"
|
||||
let pairs suffix words syms =
|
||||
table d.dsym suffix "{ i64, ptr }"
|
||||
(List.map2
|
||||
(fun ((w : gcword), _) e ->
|
||||
Printf.sprintf "{ i64, ptr } { i64 %s, ptr @\"%s\" }"
|
||||
(offset_const w) e)
|
||||
l.gvec d.dvecs)
|
||||
words syms)
|
||||
in
|
||||
let vecs = pairs "vecs" l.gvec d.dvecs in
|
||||
let maps = pairs "maps" l.gmap d.dmaps in
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
"@\"%s\" = private unnamed_addr constant \
|
||||
{ i64, i64, ptr, i64, ptr, i64, ptr } \
|
||||
{ i64 %d, i64 %d, ptr %s, i64 %d, ptr %s, i64 %d, ptr %s }\n"
|
||||
{ i64, i64, ptr, i64, ptr, i64, ptr, i64, ptr } \
|
||||
{ i64 %d, i64 %d, ptr %s, i64 %d, ptr %s, i64 %d, ptr %s, \
|
||||
i64 %d, ptr %s }\n"
|
||||
d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv)
|
||||
envs (List.length l.gvec) vecs));
|
||||
envs (List.length l.gvec) vecs (List.length l.gmap) maps));
|
||||
Buffer.contents b
|
||||
|
||||
(* The same table in the other backend's syntax. It lives here rather than in
|
||||
@ -5467,19 +5505,22 @@ let descriptors_asm m =
|
||||
in
|
||||
let offs = table "offs" (List.map (fun w -> string_of_int w.goff) l.gdyn) in
|
||||
let envs = table "envs" (List.map (fun w -> string_of_int w.goff) l.genv) in
|
||||
let vecs =
|
||||
table "vecs"
|
||||
let pairs suffix words syms =
|
||||
table suffix
|
||||
(List.concat
|
||||
(List.map2
|
||||
(fun ((w : gcword), _) e -> [ string_of_int w.goff; ".L" ^ e ])
|
||||
l.gvec d.dvecs))
|
||||
words syms))
|
||||
in
|
||||
let vecs = pairs "vecs" l.gvec d.dvecs in
|
||||
let maps = pairs "maps" l.gmap d.dmaps in
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
"\t.align\t8\n.L%s:\n\t.quad\t%d\n\t.quad\t%d\n\t.quad\t%s\n\
|
||||
\t.quad\t%d\n\t.quad\t%s\n\t.quad\t%d\n\t.quad\t%s\n"
|
||||
\t.quad\t%d\n\t.quad\t%s\n\t.quad\t%d\n\t.quad\t%s\n\
|
||||
\t.quad\t%d\n\t.quad\t%s\n"
|
||||
d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv) envs
|
||||
(List.length l.gvec) vecs))
|
||||
(List.length l.gvec) vecs (List.length l.gmap) maps))
|
||||
rows;
|
||||
Buffer.contents b
|
||||
|
||||
|
||||
@ -4512,9 +4512,10 @@ let emit_main ?(ann = false) ?(startup = false) ?(gc = false)
|
||||
xor_rr b ~dst:rax ~src:rax;
|
||||
call_sym b "flan_gc_init"
|
||||
end;
|
||||
(* A program that can make a collector-owned closure environment has the
|
||||
collector told of every Vec block from here on; see [Emit.emit_main]. *)
|
||||
if md.Emit.gcfn then begin
|
||||
(* A program that can make a collector-owned closure environment, or holds
|
||||
a dyn, has the collector told of every Vec and Map block from here on;
|
||||
see [Emit.emit_main]. *)
|
||||
if md.Emit.gcfn || gc then begin
|
||||
xor_rr b ~dst:rax ~src:rax;
|
||||
call_sym b "flan_dyn_track_vecs"
|
||||
end;
|
||||
|
||||
@ -131,6 +131,8 @@ typedef uint64_t flan_dyn;
|
||||
* - [vecs]: a (Vec T) header whose elements hold words of their own, with the
|
||||
* element's descriptor. The marker reads the header's pointer and length
|
||||
* where they are, so a push that reallocated is seen.
|
||||
* - [maps]: a (Map K V) header whose values hold words of their own, with the
|
||||
* value's descriptor. Read the same way, and walked over the full slots.
|
||||
*
|
||||
* [size] is the stride of one instance as the compiler's element-size
|
||||
* arithmetic counts it, which is what a Vec's elements are laid out at. The
|
||||
@ -149,6 +151,8 @@ typedef struct flan_desc {
|
||||
const int64_t *envs;
|
||||
int64_t nvec;
|
||||
const flan_desc_vec *vecs;
|
||||
int64_t nmap;
|
||||
const flan_desc_vec *maps;
|
||||
} flan_desc;
|
||||
|
||||
#define DYN_QNAN 0xFFF8000000000000ULL
|
||||
@ -248,6 +252,23 @@ void flan_dyn_vec_hdr_layout(int64_t out[6]) {
|
||||
out[5] = (int64_t)offsetof(flan_dyn_vec_hdr, epoch);
|
||||
}
|
||||
|
||||
/* flan_map, restated for the same reason and read the same way: only
|
||||
* [data], [log2cap], [alloc] and [epoch]. With it, the three numbers of the
|
||||
* block's geometry the marker needs — flan_rt.c's FLAN_MAP_HEAD, _GROUP and
|
||||
* _ALIGN. If either file's table changes, change both. */
|
||||
typedef struct flan_dyn_map_hdr {
|
||||
void *data;
|
||||
int64_t len;
|
||||
int64_t log2cap;
|
||||
void *alloc;
|
||||
int64_t epoch;
|
||||
} flan_dyn_map_hdr;
|
||||
|
||||
#define DYN_MAP_HEAD 24
|
||||
#define DYN_MAP_GROUP 8
|
||||
#define DYN_MAP_ALIGN 64
|
||||
#define DYN_MAP_FULL 0x80
|
||||
|
||||
/* flan_allocator's prefix, far enough to read the one word a stale-container
|
||||
* check needs. The struct has more fields after [epoch]; this file never
|
||||
* touches them; and the alignment of a leading same-typed prefix is the same
|
||||
@ -1259,6 +1280,64 @@ typedef struct { char *p; int64_t n; const flan_desc *e; } vec_work;
|
||||
static vec_work *vstack;
|
||||
static int64_t vstack_n, vstack_cap;
|
||||
|
||||
/* Maps still to walk: a live block's control run, its slots, the slot count,
|
||||
* the stride and value offset the block's own head records, and the value's
|
||||
* descriptor. Queued for the Vec queue's reason. */
|
||||
typedef struct {
|
||||
const uint8_t *ctrl; char *slots; int64_t cap, stride, voff;
|
||||
const flan_desc *e;
|
||||
} map_work;
|
||||
static map_work *mapstack;
|
||||
static int64_t mapstack_n, mapstack_cap;
|
||||
|
||||
/* A live block, not reset since it was made: the checks a Vec's block and a
|
||||
* Map's share. The allocator header is never freed, so its epoch is always
|
||||
* readable. */
|
||||
static vblock *live_block(void *p) {
|
||||
vblock *b = vblock_find((uintptr_t)p);
|
||||
if (b == NULL) return NULL;
|
||||
if (b->alloc != NULL
|
||||
&& (int64_t)((flan_dyn_alloc_hdr *)b->alloc)->epoch != b->epoch)
|
||||
return NULL;
|
||||
return b;
|
||||
}
|
||||
|
||||
/* Queue the map whose header is at [h]. The slot count comes from the
|
||||
* header and everything else from the block, and the walk is bounded by the
|
||||
* block's recorded size, so a stale header copy naming a block another map
|
||||
* now owns reads nothing outside that block. */
|
||||
static void queue_map(const flan_dyn_map_hdr *h, const flan_desc *e) {
|
||||
vblock *b;
|
||||
const int64_t *head;
|
||||
int64_t cap, ctrl, stride, voff;
|
||||
if (e == NULL || h->data == NULL || h->log2cap <= 0 || h->log2cap > 40)
|
||||
return;
|
||||
b = live_block(h->data);
|
||||
if (b == NULL || b->bytes < DYN_MAP_HEAD) return;
|
||||
cap = (int64_t)1 << h->log2cap;
|
||||
ctrl = (DYN_MAP_HEAD + cap + (DYN_MAP_GROUP - 1) + (DYN_MAP_ALIGN - 1))
|
||||
& ~(int64_t)(DYN_MAP_ALIGN - 1);
|
||||
head = (const int64_t *)h->data;
|
||||
stride = head[1];
|
||||
voff = head[2];
|
||||
if (stride <= 0 || voff < 0 || voff + e->size > stride) return;
|
||||
if (ctrl > b->bytes || (b->bytes - ctrl) / stride < cap) return;
|
||||
if (mapstack_n == mapstack_cap) {
|
||||
int64_t c = mapstack_cap ? mapstack_cap * 2 : 16;
|
||||
map_work *m = (map_work *)realloc(mapstack, (size_t)c * sizeof *m);
|
||||
if (m == NULL) trap_oom(NULL, 0, c * (int64_t)sizeof *m);
|
||||
mapstack = m;
|
||||
mapstack_cap = c;
|
||||
}
|
||||
mapstack[mapstack_n].ctrl = (const uint8_t *)h->data + DYN_MAP_HEAD;
|
||||
mapstack[mapstack_n].slots = (char *)h->data + ctrl;
|
||||
mapstack[mapstack_n].cap = cap;
|
||||
mapstack[mapstack_n].stride = stride;
|
||||
mapstack[mapstack_n].voff = voff;
|
||||
mapstack[mapstack_n].e = e;
|
||||
mapstack_n++;
|
||||
}
|
||||
|
||||
/* The words [d] names inside the instance at [base]. A Vec entry is checked
|
||||
* against the live blocks above and queued; [mark_desc] drains the queue
|
||||
* before it returns. */
|
||||
@ -1266,17 +1345,17 @@ static void mark_words(char *base, const flan_desc *d) {
|
||||
int64_t j;
|
||||
for (j = 0; j < d->n; j++) mark_value(*(flan_dyn *)(base + d->offs[j]));
|
||||
for (j = 0; j < d->nenv; j++) mark_env(*(uintptr_t *)(base + d->envs[j]));
|
||||
for (j = 0; j < d->nmap; j++)
|
||||
queue_map((const flan_dyn_map_hdr *)(base + d->maps[j].off),
|
||||
d->maps[j].elem);
|
||||
for (j = 0; j < d->nvec; j++) {
|
||||
flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)(base + d->vecs[j].off);
|
||||
const flan_desc *e = d->vecs[j].elem;
|
||||
vblock *b;
|
||||
int64_t n;
|
||||
if (e == NULL || e->size <= 0 || h->len <= 0) continue;
|
||||
b = vblock_find((uintptr_t)h->ptr);
|
||||
b = live_block(h->ptr);
|
||||
if (b == NULL) continue;
|
||||
if (b->alloc != NULL
|
||||
&& (int64_t)((flan_dyn_alloc_hdr *)b->alloc)->epoch != b->epoch)
|
||||
continue;
|
||||
n = b->bytes / e->size;
|
||||
if (h->len < n) n = h->len;
|
||||
if (vstack_n == vstack_cap) {
|
||||
@ -1295,10 +1374,17 @@ static void mark_words(char *base, const flan_desc *d) {
|
||||
|
||||
static void mark_desc(char *base, const flan_desc *d) {
|
||||
mark_words(base, d);
|
||||
while (vstack_n > 0) {
|
||||
vec_work w = vstack[--vstack_n];
|
||||
while (vstack_n > 0 || mapstack_n > 0) {
|
||||
int64_t i;
|
||||
for (i = 0; i < w.n; i++) mark_words(w.p + i * w.e->size, w.e);
|
||||
if (vstack_n > 0) {
|
||||
vec_work w = vstack[--vstack_n];
|
||||
for (i = 0; i < w.n; i++) mark_words(w.p + i * w.e->size, w.e);
|
||||
} else {
|
||||
map_work w = mapstack[--mapstack_n];
|
||||
for (i = 0; i < w.cap; i++)
|
||||
if (w.ctrl[i] & DYN_MAP_FULL)
|
||||
mark_words(w.slots + i * w.stride + w.voff, w.e);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -1355,7 +1441,8 @@ static void gc_sweep(void) {
|
||||
void *flan_dyn_env_new(int64_t size, const flan_desc *d) {
|
||||
flan_obj *o = gc_alloc(OBJ_ENV, size);
|
||||
o->len = size;
|
||||
o->u.env.desc = (d != NULL && (d->n > 0 || d->nenv > 0 || d->nvec > 0))
|
||||
o->u.env.desc = (d != NULL && (d->n > 0 || d->nenv > 0 || d->nvec > 0
|
||||
|| d->nmap > 0))
|
||||
? d : NULL;
|
||||
memset(o + 1, 0, (size_t)size);
|
||||
envset_put((uintptr_t)(o + 1));
|
||||
@ -1384,7 +1471,7 @@ void flan_dyn_root_push(flan_dyn *slot) { root_add(slot, NULL); }
|
||||
* compiler found no dyn in — but it still occupies an entry, because the count
|
||||
* is what the epilogue knows, and it is turned into an empty descriptor rather
|
||||
* than stored as NULL, which on this stack means something else. */
|
||||
static const flan_desc desc_empty = { 0, 0, NULL, 0, NULL, 0, NULL };
|
||||
static const flan_desc desc_empty = { 0, 0, NULL, 0, NULL, 0, NULL, 0, NULL };
|
||||
|
||||
void flan_dyn_root_push_desc(void *base, const flan_desc *d) {
|
||||
root_add(base, d == NULL ? &desc_empty : d);
|
||||
|
||||
@ -56,8 +56,11 @@ typedef uint64_t flan_dyn;
|
||||
* pointer-sized, holding a collector-allocated environment, null, or a
|
||||
* widened function's code address, told apart by the collector's own set of
|
||||
* environments and never by dereferencing — and [vecs], each a (Vec T)
|
||||
* header at [off] whose live elements are marked through [elem]. A descriptor
|
||||
* with only dyn words leaves the last four fields zero.
|
||||
* header at [off] whose live elements are marked through [elem] — and
|
||||
* [maps], each a (Map K V) header at [off] whose full slots' values are marked
|
||||
* through [elem]; a key never holds a word the collector follows, because no
|
||||
* such type is a key. A descriptor with only dyn words leaves the last six
|
||||
* fields zero.
|
||||
*
|
||||
* Nothing in this ABI ever writes a descriptor. See [flan_dyn_root_push_desc]
|
||||
* and [flan_dyn_env_new]. */
|
||||
@ -75,6 +78,8 @@ typedef struct flan_desc {
|
||||
const int64_t *envs;
|
||||
int64_t nvec;
|
||||
const flan_desc_vec *vecs;
|
||||
int64_t nmap;
|
||||
const flan_desc_vec *maps;
|
||||
} flan_desc;
|
||||
|
||||
/* ── Constructors ──────────────────────────────────────────────────── */
|
||||
|
||||
@ -2561,13 +2561,14 @@ void flan_vec_region_only(flan_vec *v, const uint8_t *loc, int64_t loclen) {
|
||||
loc, loclen);
|
||||
}
|
||||
|
||||
/* Told of every Vec block this file allocates, moves or frees: the old block
|
||||
* (or NULL), the new one (or NULL), its size in bytes, and the allocator and
|
||||
* epoch it was made under. NULL unless flan_dyn.c's [flan_dyn_track_vecs] has
|
||||
* installed its own — a program that can make a collector-owned closure
|
||||
* environment, which may sit in a Vec, installs it so the collector never
|
||||
* reads a block a stale header copy still names. A pointer rather than a
|
||||
* call so this file names nothing in flan_dyn.c. */
|
||||
/* Told of every Vec block and every Map block this file allocates, moves or
|
||||
* frees: the old block (or NULL), the new one (or NULL), its size in bytes,
|
||||
* and the allocator and epoch it was made under. NULL unless flan_dyn.c's
|
||||
* [flan_dyn_track_vecs] has installed its own — a program that can make a
|
||||
* collector-owned closure environment or holds a dyn, either of which may sit
|
||||
* in a Vec or a Map, installs it so the collector never reads a block a stale
|
||||
* header copy still names. A pointer rather than a call so this file names
|
||||
* nothing in flan_dyn.c. */
|
||||
void (*flan_vec_block_hook)(void *old, void *fresh, int64_t bytes, void *alloc,
|
||||
int64_t epoch) = NULL;
|
||||
|
||||
@ -3339,6 +3340,10 @@ static int8_t flan_map_rebuild(flan_map *m, int64_t log2cap, int64_t ksize,
|
||||
a->proc(a, FLAN_ALLOC_FREE, m->data,
|
||||
flan_map_block_size(ksize, vsize, old_cap), 0, FLAN_MAP_ALIGN);
|
||||
}
|
||||
if (flan_vec_block_hook)
|
||||
flan_vec_block_hook(m->data, fresh.data,
|
||||
flan_map_block_size(ksize, vsize, flan_map_cap(&fresh)),
|
||||
m->alloc, m->epoch);
|
||||
m->data = fresh.data;
|
||||
m->log2cap = fresh.log2cap;
|
||||
return 1;
|
||||
@ -3586,6 +3591,8 @@ void flan_map_free(flan_map *m, int64_t ksize, int64_t vsize,
|
||||
m->alloc->proc(m->alloc, FLAN_ALLOC_FREE, m->data,
|
||||
flan_map_block_size(ksize, vsize, flan_map_cap(m)), 0,
|
||||
FLAN_MAP_ALIGN);
|
||||
if (m->data && flan_vec_block_hook)
|
||||
flan_vec_block_hook(m->data, NULL, 0, NULL, 0);
|
||||
m->data = NULL;
|
||||
m->len = 0;
|
||||
m->log2cap = 0;
|
||||
|
||||
@ -1,9 +1,58 @@
|
||||
;; A closure's environment is found by walking the storage its function value
|
||||
;; sits in — a frame slot, a global, a struct, an Option, a Vec's elements —
|
||||
;; and a Map's storage is not walked. An (Fn ...) as a Map's value would hold
|
||||
;; an environment the collector cannot see and would free. A Vec holds them,
|
||||
;; and a (CFn ...) carries no environment and may go in a Map.
|
||||
;; A Map holding closures and a Map holding dyn values, both kept alive by the
|
||||
;; collector across enough allocation that it runs many times. A Map's block is
|
||||
;; walked like a Vec's: the full slots' values are marked through the value
|
||||
;; type's descriptor. A lost value is a use of freed memory here, not a wrong
|
||||
;; number.
|
||||
|
||||
(defn adder [n i32] (Fn [i32] i32)
|
||||
(fn [x] (+ x n)))
|
||||
|
||||
;; Garbage, and plenty of it: every pass boxes and drops a vector of four.
|
||||
(defn churn [n i32] ()
|
||||
(dotimes [i n]
|
||||
(let [junk (vec-new dyn)]
|
||||
(push junk i)
|
||||
(push junk "row")
|
||||
(push junk 2.5)
|
||||
(push junk true))))
|
||||
|
||||
(defn main [] i32
|
||||
(let [ops (map-new string (Fn [i32] i32))]
|
||||
(put ops "id" (fn [x] x))
|
||||
0))
|
||||
(let [ops (map-new string (Fn [i32] i32))
|
||||
many (map-new i32 (Fn [i32] i32))
|
||||
rows (map-new i32 dyn)]
|
||||
(put ops "one" (adder 1))
|
||||
(put ops "ten" (adder 10))
|
||||
(put ops "hundred" (adder 100))
|
||||
;; Each value a dyn vector the collector allocated, reachable from
|
||||
;; nothing but the map.
|
||||
(dotimes [i 64]
|
||||
(let [row (vec-new dyn)]
|
||||
(push row i)
|
||||
(push row "row")
|
||||
(put rows i row)))
|
||||
(churn 40000)
|
||||
;; Grown after the churn, so a rebuilt block is walked too.
|
||||
(dotimes [i 64]
|
||||
(put many i (adder i)))
|
||||
(churn 40000)
|
||||
(let [total 0]
|
||||
(dotimes [i 64]
|
||||
(set total (+ total (match (get many i) (Some f) (f 0) None 0))))
|
||||
(println total))
|
||||
(dotimes [i 3]
|
||||
(let [name (at ["one" "ten" "hundred"] i)]
|
||||
(println (match (get ops name) (Some f) (f 1) None -1))))
|
||||
(let [cur (i64 0)
|
||||
k 0
|
||||
v (the dyn nil)
|
||||
sum 0
|
||||
n 0]
|
||||
(while (map-next rows (addr cur) (addr k) (addr v))
|
||||
(set sum (+ sum (i32 (at v 0))))
|
||||
(set n (+ n 1)))
|
||||
(println n)
|
||||
(println sum))
|
||||
(free ops)
|
||||
(free many)
|
||||
(free rows))
|
||||
0)
|
||||
|
||||
@ -4732,8 +4732,15 @@ level "1"
|
||||
"programs/fn-vec-stale.flan" fn_vec_stale_out;
|
||||
outputs ~x86:true "a stale Vec header is not marked through, --x86"
|
||||
"programs/fn-vec-stale.flan" fn_vec_stale_out;
|
||||
refuses "a Map cannot hold function values" "programs/fn-in-map.flan"
|
||||
"a Map's storage is not walked";
|
||||
(* A Map's block is walked: closures and dyn values held only by a Map
|
||||
survive enough allocation to collect many times. *)
|
||||
let fn_in_map_out = "2016\n2\n11\n101\n64\n2016\n" in
|
||||
outputs "a Map keeps its closures and dyn values alive"
|
||||
"programs/fn-in-map.flan" fn_in_map_out;
|
||||
outputs ~opt:"-O0" "a Map keeps its closures and dyn values alive, -O0"
|
||||
"programs/fn-in-map.flan" fn_in_map_out;
|
||||
outputs ~x86:true "a Map keeps its closures and dyn values alive, --x86"
|
||||
"programs/fn-in-map.flan" fn_in_map_out;
|
||||
(* Capture is by value, and a store into a copy is refused rather than
|
||||
left to change the copy and not the local. *)
|
||||
refuses "a captured local is a copy and cannot be assigned"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user