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

Only a closure that outlives its frame takes a collector environment, and the collector reads a Vec's elements only through a block it knows is live

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 12:12:25 +07:00
parent 3892f1ed34
commit c6cb018b9f
15 changed files with 754 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
TODO.org
View File

@ -542,22 +542,10 @@ Func, Fnptr.
** DONE Escaping closures, allocated on the GC side
CLOSED: [2026-09-25]
A capturing =fn='s environment is a collector allocation, so the value may be
returned, stored, pointed at and pushed; the escape check is gone and a dyn may be
captured. Capture stays by value — shared state goes through a captured reference
such as a dyn map. The collector follows an =Fn='s second word only when it is an
environment it allocated, so a widened name's code address is never read through.
A =Map= holding function values is refused; a =Vec= is walked. A program with no
capturing =fn= roots no =Fn= and is unchanged. Rules out a tag bit on the
environment word and a thunk that allocates. See docs/BUILT.md, "Escape: the
environment is the collector's".
** TODO A stale Vec header is marked through
A =Vec= copied by value keeps its old pointer after another copy's push
reallocates, and the collector reads that old block when it marks a =Vec= of
function values. One level deep it reads freed words the collector rejects; a
=Vec= of =Vec=s reads freed elements as headers and dereferences their allocator
word, which can fault. docs/BUILT.md, "Escape: the environment is the collector's".
Only a capturing =fn= that may outlive its frame gets a collector environment; one
only called or passed down keeps its stack environment, as every handler does.
Capture stays by value, and a =Map= of function values is refused. Rules out a
tag bit on the environment word and a heap environment for every closure.
** WAIT CFn and C's calling convention
Decided 2026-09-25: waits with C callbacks, until a program needs one.

120
docs/BUILT.md
View File

@ -4332,8 +4332,8 @@ implemented.
**Refused, each with its own reason and its own program:**
- **Capture does not exist.** *Superseded — see "Capture by value" below. It exists, the program that was this
refusal's witness now runs. The escape refusal that replaced it is gone too; see "Escape: the environment is the
collector's".*
refusal's witness now runs. The escape refusal that replaced it is gone too; see "Escape: only an escaping
closure's environment is the collector's".*
- **An `fn` with nothing to say what it takes** (`fn-no-type.flan`), above.
- **A position that would zero one** (`fn-in-struct.flan`): a struct field, a global, a fixed array's element,
`(zeroed)`. ZII fills an omitted field with all-bytes-zero, and **a zeroed function value is a null pointer, which
@ -4360,8 +4360,8 @@ feature. This compiles:
```
`bonus` is **copied** into an environment at the instant the `fn` value is made, and the lifted body reads the copy.
The environment was a slot of the enclosing frame when this section was written and is a collector allocation now;
see "Escape: the environment is the collector's" below. Not a reference: `fn-capture.flan` changes the local through a pointer *after*
The environment is a slot of the enclosing frame, or a collector allocation when the value outlives it;
see "Escape: only an escaping closure's environment is the collector's" below. Not a reference: `fn-capture.flan` changes the local through a pointer *after*
the value exists and *before* it is called, and the `fn` still answers with the old one. That test is the whole
claim, and it is the one no evaluation order can fake.
@ -4527,83 +4527,59 @@ A redefinition that changes which locals an `fn` names changes an environment's
place, a slot of the frame the literal was written in, written by the same module that reads it on every entry. A
restart for editing a capture list would take the dev loop away from the feature it was built for.
### Escape: the environment is the collector's
### Escape: only an escaping closure's environment is the collector's
spec-memory.md's **case 3**, and the section that stood here — an escape check refusing to let a capturing value be
returned, stored, pointed at or pushed — is gone with the check. A capturing `fn`'s environment is allocated by the
collector (`flan_dyn_env_new`), so the value may go anywhere a function value may: returned, handed back through a
parameter, stored through a pointer, pushed into a `Vec`, kept in an `(Option (Fn ...))` field or global.
`programs/fn-escape.flan` does each of those and calls the value after a forced collection.
spec-memory.md's **case 3**. A capturing `fn` is checked with its copies on the frame it was written in, and
`Check.place_closures` moves them to an environment the collector allocates (`flan_dyn_env_new`) only for a value
that may outlive that frame. A closure that is only called, passed down or let-bound keeps its stack environment,
costs what it cost before, and is accepted under `--no-gc`. The refusals on returning, storing, pointing at and
pushing a capturing value are gone.
**Capture stays by value.** The environment holds copies taken when the value is made; a store into a captured name
is still refused (`fn-capture-set.flan`). State shared between calls goes through something that is itself a
reference — a captured dyn map, a pointer to a global. The fixture's counter is a captured `{:n 0}`.
**What escapes** is decided over the whole program, to a fixed point: a function value is followed back to a
literal, a parameter or a lifted body's copy of a captured value, and escapes when one of those reaches a `set`, a
return, an `Option`, an array, a struct or case field, a pointer to its slot, the runtime (a push, a put), a
restart's arguments or an argument of a call through a function value. A call to a named function asks the callee
whether that parameter escapes; a capture asks the lifted body whether its copy escapes, and escapes outright when the
capturing literal does. The rewrite turns the frame-slot `Let` and `Closure` into a `Closure` carrying the copies; the
backends tell the two forms apart by the second operand's type. Handler clauses never escape and are untouched.
**What the checker builds.** `Tast.Closure (code, copies)`, where `copies` is the `Make` of the synthesised
environment struct. The backend evaluates the copies (every field a read of a rooted slot), calls
`flan_dyn_env_new(size, descriptor)`, stores the struct into it and pairs the address with the code. Between the
allocation and the value reaching a root the object is in the runtime's allocation ring. A handler clause's
environment is unchanged: still a frame slot, because a handler frame cannot outlive the frame that pushed it.
**Capture stays by value.** A store into a captured name is still refused (`fn-capture-set.flan`); shared state goes
through something that is itself a reference, such as a captured dyn map.
**Three things can be in an `Fn`'s second word**: null (a name, or an `fn` that captured nothing), a collector
environment, or — for a name widened into an `Fn` — that name's code address, which the widening thunk reads back.
Nothing in the word says which, and no tag bit is free on the code side: on wasm32 a code address is a table index,
a small integer with any low bits. So the collector keeps the **set of environment addresses it has handed out**
and follows a word only when the set has it (`mark_env` in `runtime/flan_dyn.c`); it never reads through a word it
did not allocate. That also makes a stale or unwritten word harmless — at worst a live environment is kept a little
longer — which is what lets the descriptor name words the collector cannot prove are function values (below). The set
is rebuilt from the sweep list after any sweep that freed an environment.
**Three things can be in an `Fn`'s second word** — null, an environment (on a frame or on the heap), or a widened
name's code address — and nothing in the word says which; on wasm32 a code address is a small table index, so no tag
bit is free. The collector keeps the **set of environments it allocated** and follows a word only when the set has
it, so it never reads through a code address or a frame address. The sweep deletes freed environments from the set
and shrinks it once it is mostly empty.
**The descriptor grew two tables.** `flan_desc` is now the size and three counted tables: dyn words, environment
words, and `Vec` headers whose elements hold either, each with its element's descriptor. A `Vec` entry is marked
through its header's pointer and length as they stand, and skipped when the header's allocator has moved to a later
epoch. A data type may hold a `Vec` of itself, so how deep `Vec`s nest is the data's and not the type's: the marker
queues them on an explicit stack rather than recursing, and a descriptor may name itself as its element's.
`Emit.gc_layout` computes all three for a type; `traced` is the rooting question every site used to ask of
`dyn_offsets`. Environment words are gathered through `Option`, data type payloads and unions — every case's, since
the live case is a tag this table cannot read — which is sound only because of the set above. Dyn words are gathered
where they always were.
**Descriptors** gained two tables beside the dyn words: environment words, and `Vec` headers whose elements hold
function values, with the element's descriptor. Environment words are named through `Option`, data type payloads and
unions — every case's word, since the live case is a tag the table cannot read — which is sound only because of the
set. The LLVM offsets are constant `getelementptr` expressions over the type, so wasm32's 4-byte pointers are laid
out by the target (`gcword.gpath`); x86 writes numbers. The descriptors follow the function bodies in the module,
because LLVM sizes a named type only after its definition.
**The offsets are constant expressions in LLVM.** Each word carries both its x86-64 byte offset (`goff`, what the
hand-written backend writes) and a `getelementptr` path (`gpath`); the LLVM descriptor writes
`ptrtoint (getelementptr (... ptr null ...))`, so the offset is the target's own. On wasm32 a pointer is four bytes
and an `Fn`'s environment is at offset 4, not 8, and a number computed by `lay` would have marked the wrong word. The
same change fixes a dyn field behind a pointer field on wasm32, which was wrong before this and unexercised. The
prologue's root zeroing walks the same paths. The descriptors now follow the function bodies in the module, because
LLVM wants a named type defined before a constant `getelementptr` can size it. The `size` field stays `lay`'s number:
it is read only as a `Vec`'s element stride, and every push is handed that stride by `SizeOf`.
**A `Vec` header is not trusted.** It is copied by value, so a copy goes stale when another copy's push moves the
block, and the freed block may be unmapped. flan_rt.c reports every Vec block it allocates, moves or frees through
`flan_vec_block_hook`; `flan_dyn_track_vecs`, called first thing in `main` by a program that can make a heap
environment, installs the collector's table of live blocks, and the marker reads a header's elements only when its
pointer is a live block, no further than the block's size, and not after its allocator's epoch has moved.
`fn-vec-stale.flan` segfaults in the collector without it.
**The static side does not pay.** `Emit.m.gcfn` is true only when the program contains a capturing `fn` (or in a dev
build, where a redefinition can add the first one). When it is false an `Fn` holds no environment the collector could
own, `gc_layout` answers nothing for it, and the output has no root push and no `flan_gc_init` it did not have
before — `fn-values.flan` and `higher-order.flan` are asserted to stay that way. When it is true every
`Fn`-holding slot is rooted with a descriptor, including a parameter of a function that captures nothing itself. A
non-capturing `fn` never allocates; a `defn` and a `CFn` are unchanged.
**The static side does not pay.** `Emit.m.gcfn` is true when some closure's environment is on the heap, or in a dev
build. Otherwise an `Fn` holds nothing the collector owns and nothing roots one. When it is true, a *parameter* of
function type is still not rooted — it cannot be assigned, so it holds what the caller passed, and the caller holds
that: in a rooted slot, or pinned by `Emit.held_operands`, which pins every function-value argument that is not a
read of a local. So the prelude's `map`, `filter` and `reduce` are as cheap in a program that makes one escaping
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.**
**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` whose values hold a function value (`fn-in-map.flan`): a `Map`'s storage is not walked, so the collector
would free an environment still in it. A `Vec` is walked; a `(CFn ...)` has no environment and may go in a `Map`.
The refusal does not depend on whether the program captures anything, so a program does not start failing when
someone adds a closure elsewhere.
- Under `--no-gc`, a capturing `fn` is a site like a dyn, with its own sentence.
- A bare `Fn` field, global or fixed-array element is still refused for its zero (`fn-in-struct.flan`); that is the
ZII rule and has nothing to do with the environment. `(Option (Fn ...))` is the spelling that holds one.
**Known gaps, not refused.**
- A `Vec` header copied by value goes stale when another copy's push reallocates — that is ordinary `Vec`
behaviour — and the marker still reads the stale header's elements. For a `Vec` of function values that is a read
of freed memory whose words the set rejects, and faults only if the allocator unmapped the block. For a `Vec` of
`Vec`s the freed elements are read as headers and their allocator word is dereferenced for the epoch test, which
can fault with the block still mapped. It needs a stale header in a live frame and a collection before that frame
ends.
**A module that makes a closure is never unloaded.** An environment points at its descriptor in the module that made
it, and unmapping that module would fault the next collection rather than the next call. So making one counts toward
the gate a string literal does (`nstr`), and a dev-loop expression that builds a closure keeps its mapping.
- `wasm32`'s `SizeOf` for a type with pointers in it is x86-64's, so a `Vec` of `Fn` there has a 16-byte stride over
8-byte values. Consistent everywhere it is read, and older than this.
**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
its lifted body and environment struct into the evaluation's module.
### What may be captured

301
lib/check.ml
View File

@ -1141,8 +1141,9 @@ let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t =
(resolve env ~seen v)
(* (Fn [T ...] R) is a code address and the environment it is called with:
two words. A value made out of a name carries a null there; one made out
of an [fn] that captures carries the address of an environment the
collector allocated, holding the copies — so the value may go anywhere.
of an [fn] that captures carries the address of its copies: a slot of
the frame it was written in, or an environment the collector allocated
when the value outlives that frame (see [place_closures]).
(CFn [T ...] R) is the address alone, one word, and nothing that can
capture — see [Types] for why the C is information rather than
@ -2035,7 +2036,7 @@ let rec literal_arith (e : Ast.expr) : int64 option =
body reads them into. Answers the prefixed body, the slot the pointer
arrives in, the enclosing frame's binding, and the address to put in the
value. *)
let close_over ~heap ~fname (octx : ctx) (fctx : ctx) loc =
let close_over ~fname (octx : ctx) (fctx : ctx) loc =
match fctx.caught with
| [] -> (fun body -> body), None, None, None
| caught ->
@ -2064,11 +2065,9 @@ let close_over ~heap ~fname (octx : ctx) (fctx : ctx) loc =
mk loc b.bty (Tast.Local b.slot))
caught))
in
if heap then prefix, Some eslot, None, Some make
else
let mslot = fresh_slot octx ety in
prefix, Some eslot, Some (mslot, make),
Some (mk loc (Types.Ptr ety) (Tast.Addr (Tast.Plocal mslot)))
let mslot = fresh_slot octx ety in
prefix, Some eslot, Some (mslot, make),
Some (mk loc (Types.Ptr ety) (Tast.Addr (Tast.Plocal mslot)))
(* A source location as a value, for a runtime trap that has to name the site
rather than the runtime. The bounds and slice traps get theirs from [Emit],
@ -4180,10 +4179,10 @@ and block ctx ?want ?(defer_ok = false) loc body =
**Capture is by value.** The body sees its parameters, the program's
globals, and the locals of the function it was written in — those last
copied into an environment at the instant the value is made (see
[capture] and [close_over]). The environment is allocated by the
collector, so the value is two words, the second of them a heap address,
and it may be returned, stored or pushed like any other value:
spec-memory.md's case 3.
[capture] and [close_over]). The copies go on that function's frame, and
[place_closures] moves them to an environment the collector allocates for
a value that may outlive the frame — so it may be returned, stored or
pushed like any other value: spec-memory.md's case 3.
**The parameter types come from the position.** [Ast.Fn] carries names and
no types — that is the surface syntax, not an omission here — so an fn is
@ -4292,7 +4291,7 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
(* And the environment, now that the body has named everything it is going
to. [close_over] allocates in both frames, so it runs after the body's
slots and before the lifted function is recorded. *)
let prefix, fenv, _, copies = close_over ~heap:true ~fname ctx fctx loc in
let prefix, fenv, bind, addr = close_over ~fname ctx fctx loc in
(* A [CFn] is a bare address and has nowhere to keep an environment, so a
literal that captured cannot be one. Refused with the name of what it
captured, because that is the fact the writer has to act on — and with
@ -4331,13 +4330,16 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
symbol, and asking for one is how a redefinition module came to reference
a cell nothing declares. *)
let v =
match copies with
match addr with
| None -> mk loc fty (Tast.FnAddr (Tast.Flanfn fname))
(* The value, carrying the copies it is to be made with. The backend
allocates the environment from the collector and stores them into it,
so the value may go anywhere a function value may: returned, stored,
pushed, kept in a global. *)
| Some copies -> mk loc fty (Tast.Closure (Tast.Flanfn fname, copies))
(* The value, and the store that fills its environment on this frame
around it. Whether the environment stays there is decided once the
whole program is checked, by [place_closures]: a value that may
outlive this frame has its copies moved to an environment the
collector allocates instead. *)
| Some a ->
let c = mk loc fty (Tast.Closure (Tast.Flanfn fname, a)) in
mk loc fty (Tast.Let ([ Option.get bind ], [ c ]))
in
expect ctx loc ~want v
@ -4425,7 +4427,7 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
alive. So its copies stay on the establishing frame, in
a slot rooted with the environment's descriptor. *)
let prefix, fenv, bind, addr =
close_over ~heap:false ~fname ctx hctx c.Ast.hloc
close_over ~fname ctx hctx c.Ast.hloc
in
(* Every clause declares the environment, captured or not:
[flan_signal] reads it off the frame and passes it to whichever
@ -12321,6 +12323,230 @@ let dyn_descriptors (p : Tast.program) =
these; see there. *)
let is_env_struct n = String.length n >= 4 && String.sub n 0 4 = "env/"
(* ── Where a closure's environment lives ───────────────────────────────
A capturing [fn] is checked with its copies on the frame it was written
in: a slot holding the environment struct, and a [Closure] carrying the
slot's address. That is right for a value that is only called, passed
down and let-bound — the frame outlives every use — and it costs nothing
the static side would notice. A value that may outlive the frame needs
its copies somewhere the frame's end does not reclaim, and for those this
pass rewrites the literal to carry the copies themselves; the backend
then allocates the environment from the collector. Only a closure that
escapes allocates: the static side does not pay for the dynamic side.
**What escapes.** The analysis follows function values back to where they
came from — a literal, a parameter, or a lifted body's copy of a captured
value — and asks whether any of those reaches a position that outlives
the frame: a [set], a [return] or a function's last form, an [Option], a
fixed array, a struct or data type field, a pointer to the slot holding
it, anything handed to the runtime (a push, a put, a box), a restart's
arguments, and any argument of a call through a function value. A call
to a named function passes the question to the callee's parameter, and a
capture passes it to the lifted body's copy — or escapes outright when
the capturing literal itself escapes. Everything only grows, so the pass
runs to a fixed point over the whole program.
A function value read out of storage — a field, an element, a case — has
no source here and needs none: nothing puts a value in storage without
going through one of the positions above, which already sent its literal
to the collector. *)
type fsrc = Lit of string | Par of int | Env of int
(* Whether a [Closure]'s environment is a collector allocation: it carries
its copies rather than the address of a frame slot holding them. *)
let heap_env (env : Tast.expr) =
match env.Tast.ty with Types.Ptr _ -> false | _ -> true
let place_closures (fns : Tast.fn list) : Tast.fn list =
let by_name = Hashtbl.create 64 in
List.iter (fun (f : Tast.fn) -> Hashtbl.replace by_name f.Tast.name f) fns;
let lits = Hashtbl.create 16 in (* escaping literals *)
let pars = Hashtbl.create 16 in (* (fn, i) escaping params *)
let envs = Hashtbl.create 16 in (* (fn, i) escaping copies *)
let changed = ref true in
let mark tbl k =
if not (Hashtbl.mem tbl k) then begin
Hashtbl.replace tbl k ();
changed := true
end
in
let is_fn (t : Types.t) = match t with Types.Fn _ -> true | _ -> false in
let pass (fn : Tast.fn) =
let slot = Hashtbl.create 16 in
let add s rs =
let old = try Hashtbl.find slot s with Not_found -> [] in
Hashtbl.replace slot s (List.sort_uniq compare (rs @ old))
in
List.iteri (fun i t -> if is_fn t then add i [ Par i ]) fn.Tast.params;
(* The environment structs this function fills, by the slot they sit
in: a literal's [Closure] and a handler frame name the slot. *)
let makes = Hashtbl.create 8 in
let escape rs =
List.iter
(function
| Lit n -> mark lits n
| Par i -> mark pars (fn.Tast.name, i)
| Env i -> mark envs (fn.Tast.name, i))
rs
in
let rec roots (e : Tast.expr) =
if not (is_fn e.Tast.ty) then []
else
let tail body =
match List.rev body with x :: _ -> roots x | [] -> []
in
match e.Tast.e with
| Tast.Closure (Tast.Flanfn n, _) -> [ Lit n ]
| Tast.Local s -> (try Hashtbl.find slot s with Not_found -> [])
| Tast.If (_, a, b) -> roots a @ roots b
| Tast.Do body | Tast.Let (_, body) | Tast.Handled (_, body)
| Tast.WithAlloc (_, body) -> tail body
| Tast.Match (_, arms) ->
List.concat_map (fun (a : Tast.arm) -> tail a.Tast.abody) arms
| Tast.RestartCase (cs, body) ->
roots body
@ List.concat_map (fun (c : Tast.rclause) -> tail c.Tast.rbody) cs
| _ -> []
in
let deny es = List.iter (fun e -> escape (roots e)) es in
(* A capture: each copy escapes when the literal does, or when the
lifted body lets its copy escape. *)
let captured (fields : Tast.expr list) outright lifted =
List.iteri
(fun j (v : Tast.expr) ->
if outright || Hashtbl.mem envs (lifted, j) then escape (roots v))
fields
in
let go (e : Tast.expr) =
match e.Tast.e with
| Tast.Let (bs, _) ->
List.iter
(fun (s, (v : Tast.expr)) ->
(match v.Tast.e with
| Tast.Make (n, es) when is_env_struct n -> Hashtbl.replace makes s es
(* A lifted body's copy of what it captured. *)
| Tast.Field
({ Tast.e = Tast.Deref { Tast.e = Tast.Local es; _ }; _ }, i)
when fn.Tast.fenv = Some es -> add s [ Env i ]
| _ -> ());
add s (roots v))
bs
| Tast.Set (_, v) | Tast.Return (Some v) | Tast.Some_ v -> deny [ v ]
| Tast.Arr es | Tast.MakeCase (_, _, es)
| Tast.InvokeRestart (_, _, es, _, _, _) -> deny es
| Tast.Make (n, es) -> if not (is_env_struct n) then deny es
| Tast.Addr (Tast.Plocal s) ->
escape (try Hashtbl.find slot s with Not_found -> [])
| Tast.Prim (Tast.Rt _, es) | Tast.Prim (Tast.AddrOf, es) -> deny es
| Tast.CallPtr (_, es) -> deny es
| Tast.Call (name, es) ->
if Hashtbl.mem by_name name then
List.iteri (fun i a -> if Hashtbl.mem pars (name, i) then deny [ a ]) es
else deny es
| Tast.Closure (Tast.Flanfn n, { Tast.e = Tast.Addr (Tast.Plocal s); _ }) ->
(match Hashtbl.find_opt makes s with
| Some fields -> captured fields (Hashtbl.mem lits n) n
| None -> ())
| Tast.Handled (hs, _) ->
List.iter
(fun (h : Tast.hframe) ->
match h.Tast.henv with
| Some { Tast.e = Tast.Addr (Tast.Plocal s); _ } ->
(match Hashtbl.find_opt makes s with
| Some fields -> captured fields false h.Tast.hfn
| None -> ())
| _ -> ())
hs
| _ -> ()
in
(* Twice over the body: an environment struct is bound around the form
that names it, and a slot's sources are complete before a use of it
elsewhere in a loop is asked about. *)
for _ = 1 to 2 do
List.iter (Tast.walk go) fn.Tast.body;
List.iter (Tast.walk go) fn.Tast.fdefers
done;
if is_fn fn.Tast.ret then
match List.rev fn.Tast.body with x :: _ -> escape (roots x) | [] -> ()
in
while !changed do
changed := false;
List.iter pass fns
done;
if Hashtbl.length lits = 0 then fns
else begin
let rec rw (e : Tast.expr) : Tast.expr =
let r = rw and rs = List.map rw in
let e' =
match e.Tast.e with
| Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit
| Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.Global _
| Tast.None_ | Tast.FnAddr _ | Tast.Break _ | Tast.Continue _ -> e.Tast.e
| Tast.Fill (t, b) -> Tast.Fill (t, r b)
| Tast.DeadBeef (t, b) -> Tast.DeadBeef (t, r b)
| Tast.Prim (p, es) -> Tast.Prim (p, rs es)
| Tast.Call (n, es) -> Tast.Call (n, rs es)
| Tast.Do es -> Tast.Do (rs es)
| Tast.Make (n, es) -> Tast.Make (n, rs es)
| Tast.MakeCase (a, b, es) -> Tast.MakeCase (a, b, rs es)
| Tast.Arr es -> Tast.Arr (rs es)
| Tast.InvokeRestart (a, b, es, c, d, l) ->
Tast.InvokeRestart (a, b, rs es, c, d, l)
| Tast.CallPtr (c, es) -> Tast.CallPtr (r c, rs es)
(* The rewrite itself: the store of the copies into this frame and
the value carrying their address become the value carrying the
copies, which the backend stores into a collector allocation. *)
| Tast.Let
([ (_, make) ], [ { Tast.e = Tast.Closure ((Tast.Flanfn n as fr), _); _ } ])
when Hashtbl.mem lits n ->
Tast.Closure (fr, r make)
| Tast.Let (bs, body) ->
Tast.Let (List.map (fun (s, v) -> (s, r v)) bs, rs body)
| Tast.If (a, b, c) -> Tast.If (r a, r b, r c)
| Tast.While (c, body, latch) -> Tast.While (r c, rs body, rs latch)
| Tast.Return v -> Tast.Return (Option.map r v)
| Tast.Set (p, v) -> Tast.Set (rp p, r v)
| Tast.Addr p -> Tast.Addr (rp p)
| Tast.Field (t, i) -> Tast.Field (r t, i)
| Tast.Deref t -> Tast.Deref (r t)
| Tast.CaseField (t, c, i) -> Tast.CaseField (r t, c, i)
| Tast.Some_ t -> Tast.Some_ (r t)
| Tast.UnwrapSome t -> Tast.UnwrapSome (r t)
| Tast.Signal (k, i, t) -> Tast.Signal (k, i, r t)
| Tast.Closure (f, t) -> Tast.Closure (f, r t)
| Tast.Thicken (n, t) -> Tast.Thicken (n, r t)
| Tast.Match (sc, arms) ->
Tast.Match
(r sc,
List.map (fun (a : Tast.arm) -> { a with Tast.abody = rs a.Tast.abody }) arms)
| Tast.Handled (hs, body) ->
Tast.Handled
(List.map
(fun (h : Tast.hframe) -> { h with Tast.henv = Option.map r h.Tast.henv })
hs,
rs body)
| Tast.RestartCase (cs, body) ->
Tast.RestartCase
(List.map (fun (c : Tast.rclause) -> { c with Tast.rbody = rs c.Tast.rbody }) cs,
r body)
| Tast.WithAlloc (a, body) -> Tast.WithAlloc (r a, rs body)
in
if e' == e.Tast.e then e else { e with Tast.e = e' }
and rp (p : Tast.place) : Tast.place =
match p with
| Tast.Plocal _ | Tast.Pglobal _ -> p
| Tast.Pfield (t, i) -> Tast.Pfield (rw t, i)
| Tast.Pderef t -> Tast.Pderef (rw t)
| Tast.Pindex (t, idx) -> Tast.Pindex (rw t, List.map rw idx)
in
List.map
(fun (f : Tast.fn) ->
{ f with Tast.body = List.map rw f.Tast.body;
fdefers = List.map rw f.Tast.fdefers })
fns
end
let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
Tast.program * env * string list =
let env = new_env () in
@ -12468,6 +12694,8 @@ let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
they are reached *by name* from arbitrary call sites, so they carry no
[fparent] and a dev build gives each its own cell. *)
let fns = fns @ List.rev env.instances in
(* Which capturing fns outlive their frame; see [place_closures]. *)
let fns = place_closures fns in
(* And the order the computed initialisers run in, which needs the whole
function list: what a global reads is transitive through what it calls. *)
let globals = init_order globals fns in
@ -12573,6 +12801,21 @@ let instances_since env mark =
List.rev
(List.filteri (fun i _ -> i < fresh) env.instances)
(* The same protocol for a body an expression lifted — an [fn] literal or a
handler clause — and the environment struct each one captured into. Both
are in [env] and in no program, and a module that calls one or lays one
out needs them. *)
let lifted_mark env = List.length env.lifted
let lifted_since env mark =
let fresh = List.length env.lifted - mark in
List.rev (List.filteri (fun i _ -> i < fresh) env.lifted)
let env_structs env (fns : Tast.fn list) =
List.filter_map
(fun (f : Tast.fn) -> Hashtbl.find_opt env.structs ("env/" ^ f.Tast.name))
fns
(* Expressions checked against a program that is already running, all of them
into *one* frame. It is empty to start with — a REPL expression has no
parameters and no enclosing function — so the slots it ends up with are
@ -12674,7 +12917,8 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
(* A capturing fn: its environment is a collector allocation,
which is a different sentence from a dyn and has a different
fix. *)
| Tast.Closure _ -> found := (e.Tast.loc, `Closure) :: !found
| Tast.Closure (_, env) when heap_env env ->
found := (e.Tast.loc, `Closure) :: !found
| _ -> ()))
fn.Tast.body);
List.rev_map
@ -12689,10 +12933,11 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
so there is nothing smaller to compile it to — write the type"
what
| `Closure ->
"this fn captures, and --no-gc says this program carries no \
collector. The copies a capturing fn is made with live in an \
environment the collector allocates — pass what it names in as \
parameters instead"))
"this fn captures and outlives the frame it was made in, and \
--no-gc says this program carries no collector. The copies of an \
fn that outlives its frame live in an environment the collector \
allocates — call it or pass it down instead of keeping it, or \
pass what it names in as parameters"))
!found
let no_gc (p : Tast.program) =
@ -12854,10 +13099,10 @@ let memory_sites ?file (p : Tast.program) : Loc.diag list =
let cls =
match e.Tast.e with
| Tast.Prim (Tast.Rt sym, args) -> memory_class sym args
| Tast.Closure _ ->
| Tast.Closure (_, env) when heap_env env ->
Some ("memory/gc",
"allocates: an fn that captures keeps its copies in an \
environment on the collector's heap")
"allocates: an fn that captures and outlives its frame keeps its \
copies in an environment on the collector's heap")
| _ -> None
in
match cls with

73
lib/emit.ml
View File

@ -480,7 +480,8 @@ type m = {
dev : bool; (* call through cells (below) *)
(* Whether an [(Fn ...)] value may carry an environment the collector owns,
which is what makes its second word something to root and to mark. True
when the program makes a capturing [fn] anywhere, and always in a dev
when the program has a capturing [fn] that outlives its frame (see
[Check.place_closures]), and always in a dev
build — a redefinition can add the first one, and the frames of the
running program would then hold function values nobody had rooted. When
it is false every [Fn] word is a code address or null, and nothing roots
@ -1540,11 +1541,15 @@ type rootplan = {
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 held_operands m ?(fn_params = fun _ -> false) (e : Tast.expr) :
Tast.expr list =
let holds (x : Tast.expr) =
traced m x.Tast.ty
&& (match x.Tast.e with
| Tast.Call _ | Tast.CallPtr _ -> false
(* A parameter of function type cannot be assigned, so no sibling can
take the value away from under it; its caller holds it. *)
| Tast.Local s when fn_params s -> false
| Tast.Prim (Tast.Rt _, _) -> x.Tast.ty <> Types.Dyn
| Tast.Zero _ | Tast.Uninit _ | Tast.None_ | Tast.Unit -> false
| _ -> true)
@ -1578,20 +1583,53 @@ let held_operands m (e : Tast.expr) : Tast.expr list =
let is_array (x : Tast.expr) =
match x.Tast.ty with Types.Array _ -> true | _ -> false
in
(* A function value handed to a call is held by the caller for the whole of
the call, because the callee does not root a parameter of function type
(see [root_plan]). A read of a rooted local is held already; anything
else — a field, an element, a global the callee could overwrite, a fresh
closure — is pinned whatever its siblings are. *)
let fn_args es =
if not m.gcfn then []
else
List.filter
(fun (x : Tast.expr) ->
(match x.Tast.ty with Types.Fn _ -> true | _ -> false)
&& (match x.Tast.e with
| Tast.Local _ | Tast.Call _ | Tast.CallPtr _ | Tast.FnAddr _
| Tast.Thicken _ -> false
| Tast.Closure (_, env) ->
(match env.Tast.ty with Types.Ptr _ -> false | _ -> true)
| _ -> true))
es
in
let with_fn_args es picked =
picked @ List.filter (fun x -> not (List.memq x picked)) (fn_args es)
in
match e.Tast.e with
| Tast.Call (_, es) -> with_fn_args es (pick (by_value es))
| Tast.CallPtr (c, es) -> with_fn_args es (pick (by_value (c :: es)))
| Tast.Prim (Tast.Rt _, es) -> pick (List.map (fun x -> (x, is_array x)) es)
| Tast.Prim ((Tast.At | Tast.Slice), t :: rest) ->
pick ((t, true) :: by_value rest)
| Tast.Prim (_, es) | Tast.Call (_, es) | Tast.Make (_, es)
| Tast.Prim (_, 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
let nparams = List.length fn.Tast.params in
Array.iteri
(fun i t ->
if traced m t then
(* A parameter of function type is not rooted here: a parameter
cannot be assigned, so it holds what the caller passed for the whole
call, and the caller holds that — in a rooted slot, or pinned by
[held_operands]. This is what keeps a higher-order function such as
the prelude's [map] free of root pushes in a program that makes an
escaping closure somewhere else. *)
let fn_param =
i < nparams && (match t with Types.Fn _ -> true | _ -> false)
in
if traced m t && not fn_param then
rslots := (i, t) :: !rslots)
fn.Tast.slots;
let dyn = ref 0 and agg = ref [] in
@ -1606,7 +1644,10 @@ let root_plan m (fn : Tast.fn) : rootplan =
let collect (e : Tast.expr) =
List.iter
(fun x -> if not (List.memq x !pins) then pins := x :: !pins)
(held_operands m e)
(held_operands m ~fn_params:(fun s ->
s < List.length fn.Tast.params
&& (match fn.Tast.slots.(s) with Types.Fn _ -> true | _ -> false))
e)
in
List.iter (Tast.walk collect) fn.Tast.body;
List.iter (Tast.walk collect) fn.Tast.fdefers;
@ -2470,6 +2511,11 @@ and value_at f (e : Tast.expr) : string =
every field is a read of a slot, and those slots are still rooted
while the allocation collects. The fresh object is in the
runtime's allocation ring until this value reaches a root. *)
(* A closure that does not outlive this frame: its copies are in a
slot of it, and the value carries that slot's address. *)
| Tast.Closure (r, env)
when (match env.Tast.ty with Types.Ptr _ -> true | _ -> false) ->
fnaddr f ~loc:e.Tast.loc r, value f env
| Tast.Closure (r, copies) ->
(* The environment will point at this module's descriptor, and the
value at this module's code, for as long as the collector keeps it.
@ -4787,6 +4833,7 @@ declare i64 @flan_dyn_view_flat(ptr, i64, i32)
declare void @flan_dyn_root_push(ptr)
declare void @flan_dyn_root_push_desc(ptr, ptr)
declare ptr @flan_dyn_env_new(i64, ptr)
declare void @flan_dyn_track_vecs()
declare void @flan_dyn_root_pop(i64)
declare void @flan_dyn_root_globals_begin()
declare void @flan_dyn_root_globals_end()
@ -4871,10 +4918,16 @@ declare i8 @flan_slurp_into(ptr, ptr, i64, i64, ptr, i64)
Every shape a dyn can take is one of these: a global of that type, a
signature that mentions it, a slot that holds one, or an expression that
produces one. *)
(* Whether any closure in the program has its environment allocated by the
collector. *)
let makes_closures (p : Tast.program) =
let found = ref false in
let see (e : Tast.expr) =
match e.Tast.e with Tast.Closure _ -> found := true | _ -> ()
match e.Tast.e with
| Tast.Closure (_, env)
when (match env.Tast.ty with Types.Ptr _ -> false | _ -> true) ->
found := true
| _ -> ()
in
List.iter
(fun (fn : Tast.fn) ->
@ -4933,6 +4986,12 @@ 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";
(* 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

21
lib/session.ml
View File

@ -2257,8 +2257,10 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
below — without this the thunk calls a symbol the module never defines
and the host has no cell for. *)
let mark = Check.instance_mark t.env in
let lmark = Check.lifted_mark t.env in
let checked, base, bnames = Check.expression t.env parsed in
let fresh = Check.instances_since t.env mark in
let lifted = Check.lifted_since t.env lmark in
(* The thunk's frame starts at whatever [Check.expression] needed and grows
as the walk finds slices in it, so the slots the renderer asks for are
appended past [base] and collected here to size the frame below. *)
@ -2294,9 +2296,26 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
(* Built against the program but never spliced into it: an evaluation is not
a declaration, and adding one would leave the session carrying an eval/N
for every expression ever typed. *)
(* A body the expression lifted — an [fn] literal, a handler clause — is
reached by address from the thunk, so it goes into the module with it:
parented on the thunk, which is what makes [redefinition] carry it, and
with the environment struct it captured into, which is what lays it out.
Placed like any other capturing fn, against the whole program, so a
closure the expression keeps gets an environment the collector owns. *)
let lifted =
List.map (fun (f : Tast.fn) -> { f with Tast.fparent = Some name }) lifted
in
let placed =
Check.place_closures (t.program.Tast.fns @ fresh @ lifted @ [ thunk ])
in
let own = List.map (fun (f : Tast.fn) -> f.Tast.name) (lifted @ [ thunk ]) in
let placed =
List.filter (fun (f : Tast.fn) -> List.mem f.Tast.name own) placed
in
let program =
{ t.program with
Tast.fns = t.program.Tast.fns @ fresh @ [ thunk ];
Tast.fns = t.program.Tast.fns @ fresh @ placed;
structs = t.program.Tast.structs @ Check.env_structs t.env lifted;
externs = t.program.Tast.externs @ externs }
in
let ir =

19
lib/tast.ml
View File

@ -112,13 +112,18 @@ and expr_kind =
dev build is not the symbol but whatever the indirection cell holds, and
carries the Flan type [Fn]. *)
| FnAddr of fnref
(* A function value with an environment: the lifted body, and the copies it
is made with — a [Make] of a struct the checker synthesised, one field per
captured name, every field a read of a local. The backend allocates the
environment from the collector ([flan_dyn_env_new], with the struct's
descriptor), stores the copies into it, and pairs its address with the
code. So the copies are taken where the value is made, and the value may
outlive the frame: spec-memory.md's case 3.
(* A function value with an environment: the lifted body, and one of two
things, told apart by the second expression's type.
- A pointer: the address of a slot of this frame holding the copies, filled
by the [Let] around this node. A value that never outlives its frame.
- The environment struct itself — a [Make] of the struct the checker
synthesised, every field a read of a local. The backend allocates the
environment from the collector ([flan_dyn_env_new], with the struct's
descriptor), stores the copies into it, and pairs its address with the
code. A value that may outlive its frame: spec-memory.md's case 3.
[Check.place_closures] decides which, once the whole program is checked.
Its own node rather than a field on [FnAddr] because the two answer
different questions: [FnAddr] is an address, and is asked for by three

11
lib/x86.ml
View File

@ -1812,6 +1812,11 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
slot, so nothing between the allocation and the last store can
collect. The object is in the runtime's allocation ring until the
value reaches a root. *)
(* A closure that does not outlive this frame: its copies are in a
slot of it, and the value carries that slot's address. *)
| Tast.Closure (r, env)
when (match env.Tast.ty with Types.Ptr _ -> true | _ -> false) ->
fnaddr_at f ~loc:e.Tast.loc ~reg:rax r; Some (`Expr env)
| Tast.Closure (r, copies) ->
(* See [Emit]'s arm: the environment points into this module. *)
f.md.Emit.nstr <- f.md.Emit.nstr + 1;
@ -4420,6 +4425,12 @@ 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
xor_rr b ~dst:rax ~src:rax;
call_sym b "flan_dyn_track_vecs"
end;
(* The dyn globals, rooted here and never popped, which is the whole of what
a global's extent means. They go on the root stack *before* the startup
function runs, because that function is what fills them and its first

213
runtime/flan_dyn.c
View File

@ -1040,14 +1040,13 @@ static void mark_value(flan_dyn v) {
* environment is never read through, which also makes a stale or unwritten
* word harmless: at worst it keeps a live environment alive a little longer.
*
* Open addressing, rebuilt from the sweep list after any sweep that freed an
* environment, because deletion from a linear-probe table is the fiddly part
* and a rebuild is one pass over objects the sweep has just walked anyway. */
* Open addressing with linear probing. The sweep deletes each environment it
* frees, and shrinks the table once it is mostly empty. */
static uintptr_t *envset;
static int64_t envset_cap, envset_n;
static inline uint64_t env_hash(uintptr_t p) {
static inline uint64_t ptr_hash(uintptr_t p) {
uint64_t x = (uint64_t)p;
x ^= x >> 33;
x *= 0xff51afd7ed558ccdULL;
@ -1057,11 +1056,12 @@ static inline uint64_t env_hash(uintptr_t p) {
static void envset_put(uintptr_t p);
static void envset_grow(int64_t cap) {
/* A fresh table of [cap] slots, a power of two, filled from [old]. */
static void envset_resize(int64_t cap) {
uintptr_t *old = envset;
int64_t oldcap = envset_cap, i;
envset = (uintptr_t *)calloc((size_t)cap, sizeof *envset);
if (envset == NULL) trap_oom(cap * (int64_t)sizeof *envset);
if (envset == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *envset);
envset_cap = cap;
envset_n = 0;
for (i = 0; i < oldcap; i++)
@ -1072,8 +1072,8 @@ static void envset_grow(int64_t cap) {
static void envset_put(uintptr_t p) {
uint64_t h;
if ((envset_n + 1) * 2 > envset_cap)
envset_grow(envset_cap ? envset_cap * 2 : 64);
h = env_hash(p) & (uint64_t)(envset_cap - 1);
envset_resize(envset_cap ? envset_cap * 2 : 64);
h = ptr_hash(p) & (uint64_t)(envset_cap - 1);
while (envset[h] != 0) {
if (envset[h] == p) return;
h = (h + 1) & (uint64_t)(envset_cap - 1);
@ -1085,7 +1085,7 @@ static void envset_put(uintptr_t p) {
static int envset_has(uintptr_t p) {
uint64_t h;
if (envset_cap == 0 || p == 0) return 0;
h = env_hash(p) & (uint64_t)(envset_cap - 1);
h = ptr_hash(p) & (uint64_t)(envset_cap - 1);
while (envset[h] != 0) {
if (envset[h] == p) return 1;
h = (h + 1) & (uint64_t)(envset_cap - 1);
@ -1093,42 +1093,189 @@ static int envset_has(uintptr_t p) {
return 0;
}
/* One environment freed. Backward-shift deletion, so the table needs no
* tombstones: every entry after the hole that could have been placed in it
* moves back. */
static void envset_del(uintptr_t p) {
uint64_t mask, i, j, k;
if (envset_cap == 0) return;
mask = (uint64_t)(envset_cap - 1);
i = ptr_hash(p) & mask;
while (envset[i] != p) {
if (envset[i] == 0) return;
i = (i + 1) & mask;
}
j = i;
for (;;) {
j = (j + 1) & mask;
if (envset[j] == 0) break;
k = ptr_hash(envset[j]) & mask;
/* Move [j] back into the hole at [i] unless its home lies cyclically
in (i, j]. */
if ((i <= j) ? (i < k && k <= j) : (i < k || k <= j)) continue;
envset[i] = envset[j];
i = j;
}
envset[i] = 0;
envset_n--;
}
/* After a sweep: a table that has emptied to an eighth of its size is
* rebuilt at a size for what is left, so a program that once held a million
* environments does not keep a million-slot table. */
static int64_t envs_made; /* environments allocated since the last sweep */
static void envset_shrink(void) {
int64_t cap = 64, want = envset_n * 4;
/* Room for as many as the last cycle made, so a program that makes and
drops closures at a steady rate does not shrink and regrow the table
every cycle. */
if (envs_made * 2 > want) want = envs_made * 2;
envs_made = 0;
if (envset_cap <= 64 || envset_n * 8 > envset_cap) return;
while (cap < want) cap *= 2;
if (cap < envset_cap) envset_resize(cap);
}
static void mark_env(uintptr_t w) {
if (envset_has(w)) mark_push((flan_obj *)w - 1);
}
/* Vecs still to walk, as (header, element descriptor). Explicit for the mark
* stack's reason: a data type can hold a Vec of itself, so how deep Vecs nest
* is the data's and not the type's, and recursion would put it on the C
* stack. */
typedef struct { flan_dyn_vec_hdr *h; const flan_desc *e; } vec_work;
/* ── The Vec blocks a marker may read ──────────────────────────────────
*
* A (Vec T) header is copied by value, so the one the marker is handed may be
* a stale copy whose block another copy's push has since reallocated and
* freed. Reading its elements would read freed memory — and a block large
* enough for malloc to have unmapped it faults. So the marker never trusts a
* header's pointer: flan_rt.c reports every Vec block it allocates, moves or
* frees through [flan_vec_block_hook], this table keeps the live ones with
* their byte size and the allocator epoch they were made at, and a header is
* followed only when its pointer is a live block — for no more elements than
* the block holds, and not after its allocator has been reset past that
* epoch. A stale header whose pointer malloc has since reused for another Vec
* is bounded by that Vec's block and its words go through the same checks as
* any other, so nothing outside a live block is ever read.
*
* The hook is installed by [flan_dyn_track_vecs], which a program that can
* make a collector-owned environment calls first thing in main; blocks made
* before it cannot hold one. Allocator headers are never freed (flan_rt.c's
* [flan_arena_destroy]), so reading one's epoch is always safe.
*
* Open addressing with tombstones, since blocks come and go all the time. */
typedef struct {
uintptr_t ptr; /* 0 empty, 1 deleted */
int64_t bytes;
void *alloc;
int64_t epoch;
} vblock;
static vblock *vblocks;
static int64_t vblocks_cap, vblocks_n, vblocks_used;
extern void (*flan_vec_block_hook)(void *old, void *fresh, int64_t bytes,
void *alloc, int64_t epoch);
static void vblock_put(uintptr_t p, int64_t bytes, void *alloc, int64_t epoch);
static void vblock_resize(int64_t cap) {
vblock *old = vblocks;
int64_t oldcap = vblocks_cap, i;
vblocks = (vblock *)calloc((size_t)cap, sizeof *vblocks);
if (vblocks == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *vblocks);
vblocks_cap = cap;
vblocks_n = 0;
vblocks_used = 0;
for (i = 0; i < oldcap; i++)
if (old[i].ptr > 1)
vblock_put(old[i].ptr, old[i].bytes, old[i].alloc, old[i].epoch);
free(old);
}
static vblock *vblock_find(uintptr_t p) {
uint64_t h;
if (vblocks_cap == 0 || p <= 1) return NULL;
h = ptr_hash(p) & (uint64_t)(vblocks_cap - 1);
while (vblocks[h].ptr != 0) {
if (vblocks[h].ptr == p) return &vblocks[h];
h = (h + 1) & (uint64_t)(vblocks_cap - 1);
}
return NULL;
}
static void vblock_put(uintptr_t p, int64_t bytes, void *alloc, int64_t epoch) {
uint64_t h;
vblock *hit = vblock_find(p);
if (hit != NULL) {
hit->bytes = bytes; hit->alloc = alloc; hit->epoch = epoch;
return;
}
if ((vblocks_used + 1) * 2 > vblocks_cap) {
int64_t cap = 64;
while (cap < (vblocks_n + 1) * 4) cap *= 2;
vblock_resize(cap);
}
h = ptr_hash(p) & (uint64_t)(vblocks_cap - 1);
while (vblocks[h].ptr > 1) h = (h + 1) & (uint64_t)(vblocks_cap - 1);
if (vblocks[h].ptr == 0) vblocks_used++;
vblocks[h].ptr = p;
vblocks[h].bytes = bytes;
vblocks[h].alloc = alloc;
vblocks[h].epoch = epoch;
vblocks_n++;
}
static void vblock_drop(uintptr_t p) {
vblock *hit = vblock_find(p);
if (hit != NULL) { hit->ptr = 1; vblocks_n--; }
}
static void vblock_hook(void *old, void *fresh, int64_t bytes, void *alloc,
int64_t epoch) {
if (old != NULL) vblock_drop((uintptr_t)old);
if (fresh != NULL) vblock_put((uintptr_t)fresh, bytes, alloc, epoch);
}
void flan_dyn_track_vecs(void) { flan_vec_block_hook = vblock_hook; }
/* Vecs still to walk, as (live block, element count, element descriptor).
* Explicit for the mark stack's reason: a data type can hold a Vec of itself,
* so how deep Vecs nest is the data's and not the type's, and recursion would
* put it on the C stack. */
typedef struct { char *p; int64_t n; const flan_desc *e; } vec_work;
static vec_work *vstack;
static int64_t vstack_n, vstack_cap;
/* The words [d] names inside the instance at [base]. A Vec entry is queued
* rather than walked here; [mark_desc] drains the queue before it returns. A
* header whose allocator has moved on to a later epoch was released by
* [free-all] and its elements are not the Vec's any more, so they are passed
* over — the same test [flan_vec_check] traps on. */
/* 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. */
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->nvec; j++) {
flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)(base + d->vecs[j].off);
if (h->ptr == NULL || h->len <= 0 || d->vecs[j].elem == NULL) continue;
if (h->alloc != NULL
&& (int64_t)((flan_dyn_alloc_hdr *)h->alloc)->epoch != h->epoch)
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);
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) {
int64_t cap = vstack_cap ? vstack_cap * 2 : 16;
vec_work *v = (vec_work *)realloc(vstack, (size_t)cap * sizeof *v);
if (v == NULL) trap_oom(cap * (int64_t)sizeof *v);
if (v == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *v);
vstack = v;
vstack_cap = cap;
}
vstack[vstack_n].h = h;
vstack[vstack_n].e = d->vecs[j].elem;
vstack[vstack_n].p = (char *)h->ptr;
vstack[vstack_n].n = n;
vstack[vstack_n].e = e;
vstack_n++;
}
}
@ -1138,8 +1285,7 @@ static void mark_desc(char *base, const flan_desc *d) {
while (vstack_n > 0) {
vec_work w = vstack[--vstack_n];
int64_t i;
for (i = 0; i < w.h->len; i++)
mark_words((char *)w.h->ptr + i * w.e->size, w.e);
for (i = 0; i < w.n; i++) mark_words(w.p + i * w.e->size, w.e);
}
}
@ -1167,7 +1313,6 @@ static void gc_mark_all(void) {
static void gc_sweep(void) {
flan_obj **link = &gc_all;
flan_obj *o = gc_all;
int envs_freed = 0;
while (o != NULL) {
flan_obj *next = o->next;
if (o->mark) {
@ -1176,7 +1321,7 @@ static void gc_sweep(void) {
} else {
int64_t held = (int64_t)sizeof(flan_obj);
if (o->kind == OBJ_TEXT || o->kind == OBJ_ENV) held += o->len;
if (o->kind == OBJ_ENV) envs_freed = 1;
if (o->kind == OBJ_ENV) envset_del((uintptr_t)(o + 1));
if (o->kind == OBJ_VEC || o->kind == OBJ_MAP) {
int64_t per = o->kind == OBJ_MAP ? 2 : 1;
held += o->u.v.cap * per * (int64_t)sizeof(flan_dyn);
@ -1189,14 +1334,9 @@ static void gc_sweep(void) {
}
o = next;
}
/* A freed environment's address must leave the set before malloc can hand
/* A freed environment's address left the set above, before malloc can hand
it out again as something else. */
if (envs_freed) {
memset(envset, 0, (size_t)envset_cap * sizeof *envset);
envset_n = 0;
for (o = gc_all; o != NULL; o = o->next)
if (o->kind == OBJ_ENV) envset_put((uintptr_t)(o + 1));
}
envset_shrink();
}
void *flan_dyn_env_new(int64_t size, const flan_desc *d) {
@ -1206,6 +1346,7 @@ void *flan_dyn_env_new(int64_t size, const flan_desc *d) {
? d : NULL;
memset(o + 1, 0, (size_t)size);
envset_put((uintptr_t)(o + 1));
envs_made++;
return (void *)(o + 1);
}

6
runtime/flan_dyn.h
View File

@ -390,6 +390,12 @@ void flan_dyn_root_push_desc(void *base, const flan_desc *d);
* address somewhere rooted. [d] is static data and must outlive the object. */
void *flan_dyn_env_new(int64_t size, const flan_desc *d);
/* From here on, the collector is told of every Vec block the runtime
* allocates, moves or frees, and reads a Vec's elements only through a block
* it knows to be live. Called first thing in main by a program that can make
* a collector-owned environment. */
void flan_dyn_track_vecs(void);
/* ── Extensions ────────────────────────────────────────────────────────
*
* Additions to the agreed ABI, none of which the compiler lane has to emit.

14
runtime/flan_rt.c
View File

@ -1871,6 +1871,16 @@ 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. */
void (*flan_vec_block_hook)(void *old, void *fresh, int64_t bytes, void *alloc,
int64_t epoch) = NULL;
static int8_t flan_vec_grow(flan_vec *v, int64_t want, int64_t size,
int64_t align) {
flan_allocator *a = flan_vec_adopt(v);
@ -1903,6 +1913,8 @@ static int8_t flan_vec_grow(flan_vec *v, int64_t want, int64_t size,
else
p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, align);
if (!p) return 0;
if (flan_vec_block_hook)
flan_vec_block_hook(v->ptr, p, bytes, v->alloc, v->epoch);
v->ptr = p;
v->cap = cap;
/* Any slice taken before this points at storage that may have moved. The
@ -2004,6 +2016,8 @@ void flan_vec_free(flan_vec *v, int64_t size, int64_t align,
flan_vec_check(v, loc, loclen);
if (v->ptr && v->alloc && (v->alloc->caps & FLAN_CAN_FREE))
v->alloc->proc(v->alloc, FLAN_ALLOC_FREE, v->ptr, v->cap * size, 0, align);
if (v->ptr && flan_vec_block_hook)
flan_vec_block_hook(v->ptr, NULL, 0, NULL, 0);
(void)align;
v->ptr = NULL;
v->len = 0;

14
test/programs/fn-escape.flan
View File

@ -62,9 +62,18 @@
(defn double [x i64] i64 (* 2 x))
;; A closure made as an argument and held while the next argument collects.
;; A closure made as an argument and held while the next argument collects —
;; kept by the callee, so it is one the collector owns — and one collected
;; for while the callee runs, before the callee has put it anywhere. A
;; parameter of function type is not rooted by the callee; the caller holds
;; it.
(defn apply-to [f (Fn [i64] i64) x i64] i64 (f x))
(defn churn-1 [] i64 (churn) 1)
(defonce last-fn (Option (Fn [i64] i64)))
(defn remember [f (Fn [i64] i64) x i64] i64
(churn)
(set last-fn (Some f))
(f x))
;; A handler clause keeps its copies on the establishing frame, and may now
;; capture a dyn and a closure like an fn may.
@ -164,7 +173,8 @@
(println (f 1) (slot 1)))
;; Held beside a sibling operand that collects.
(let [n 40]
(println (apply-to (fn [x] (+ x n)) (churn-1))))
(println (apply-to (fn [x] (+ x n)) (churn-1))
(remember (fn [x] (+ x n)) 1)))
;; A Vec of function values, one capture per iteration plus a widened name.
(let [fs (vec-new (Fn [i64] i64))]
(let [i 0]

40
test/programs/fn-vec-stale.flan Normal file
View File

@ -0,0 +1,40 @@
;; A Vec header is copied by value, so a copy goes stale when another copy's
;; push moves the block, and the old block is freed — large enough here that
;; malloc hands it back to the system. The collector marks through every
;; header it can see, the stale copy included, and must read only a block it
;; knows to be live: a Vec of closures, and a Vec of Vecs of closures, whose
;; freed elements would otherwise be read as headers.
(declare gc-collect [] () "flan_gc_collect")
(defn make-adder [n i64] (Fn [i64] i64) (fn [x] (+ x n)))
(defn counter [v (Vec (Fn [i64] i64))] (Fn [] i64) (fn [] (i64 (length v))))
(defn flat [] ()
(let [fs (vec-new (Fn [i64] i64))]
(dotimes [i 20000] (push fs (make-adder i)))
(let [c (counter fs)
old fs]
(dotimes [i 200000] (push fs (make-adder i)))
(gc-collect)
(println (c) (length old) (length fs) ((at fs 219999) 1)))))
(defn nested [] ()
(let [a (arena-new 67108864)
outer (vec-new (Vec (Fn [i64] i64)) a)]
(dotimes [i 20000]
(let [inner (vec-new (Fn [i64] i64) a)]
(push inner (make-adder i))
(push outer inner)))
(let [old outer]
(dotimes [i 200000]
(let [inner (vec-new (Fn [i64] i64) a)]
(push inner (make-adder i))
(push outer inner)))
(gc-collect)
(println (length old) (length outer) ((at (at outer 219999) 0) 1)))))
(defn main [] i32
(flat)
(nested)
0)

49
test/test_acceptance.ml
View File

@ -3473,7 +3473,7 @@ let () =
in
(* And [programs/fn-escape.flan]'s, for the same reason. *)
let fn_escape_out =
"15\n15\n21 8\n41\n1007\n3\n3\n2\n1007\n53\n35 4\n5\n100000 true\n"
"15\n15\n21 8\n41 41\n1007\n3\n3\n2\n1007\n53\n35 4\n5\n100000 true\n"
in
(* ── wasm32 ────────────────────────────────────────────────────────
TODO.org, "The web target does not reach four things".
@ -4411,6 +4411,16 @@ level "1"
outputs "an fn captures a dyn" "programs/fn-capture-dyn.flan" "7\n";
outputs ~x86:true "an fn captures a dyn, --x86"
"programs/fn-capture-dyn.flan" "7\n";
(* A stale copy of a Vec of closures, and of a Vec of Vecs of them, whose
block a push on another copy moved and freed. With the marker trusting
the header's pointer this segfaults in the collector. *)
let fn_vec_stale_out =
"20000 20000 220000 200000\n20000 220000 200000\n"
in
outputs "a stale Vec header is not marked through"
"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";
(* Capture is by value, and a store into a copy is refused rather than
@ -5366,6 +5376,43 @@ level "1"
(* A capturing fn allocates its environment from the collector, so it is
a site too, with its own sentence. The file has more than one. *)
no_gc_sites "programs/fn-escape.flan" 2;
(* In a program that does make a collector-owned environment, a function
whose only function value is a parameter still roots nothing: the
caller holds what it passed. This is what keeps the prelude's
higher-order functions as cheap as they were. *)
(let path = "programs/fn-escape.flan" in
let l = Load.program ~file:path (Reader.read_file path) in
let ir = Emit.program (Check.program_all l.Load.decls) in
let body =
match String.split_on_char '\n' ir with
| lines ->
let rec from = function
| [] -> []
| x :: rest when contains x "define" && contains x "@\"flan.apply-to\"" ->
let rec upto = function
| [] -> []
| "}" :: _ -> []
| y :: r -> y :: upto r
in
upto rest
| _ :: rest -> from rest
in
String.concat "\n" (from lines)
in
if body = "" || contains body "flan_dyn_root_push" then begin
incr failures;
Printf.printf "FAIL apply-to roots its function parameter (or was not found)\n"
end);
(* And a capturing fn that is only called and passed down keeps its
copies on its frame, so --no-gc has nothing to say about it. *)
(let path = "programs/fn-capture.flan" in
let l = Load.program ~file:path (Reader.read_file path) in
match Check.no_gc (Check.program_all l.Load.decls) with
| () -> ()
| exception Loc.Errors ds ->
incr failures;
Printf.printf "FAIL --no-gc refused %s: %s\n" path
(String.concat "; " (List.map (fun (d : Loc.diag) -> d.Loc.dmsg) ds)));
(* And the price closures do not charge: a program whose function values
capture nothing roots none of them and sets up no heap, so its IR has

12
test/test_dev.ml
View File

@ -6971,6 +6971,18 @@ let () =
if not (await ~ms:20000 (fun () -> value "(> seen 0)" = Some "true"))
then fail "--%s: the stale fixture never ran step" backend
else begin
(* A capturing fn typed at the prompt: the body it lifts and the
environment it captures into go into the evaluation's module
with it. *)
(match
value
"(let [k (i64 1000) xs [(i64 1) (i64 2)]] \
(reduce (slice xs 0 2) (i64 0) (fn [a b] (+ a (+ b k)))))"
with
| Some "2003" -> ()
| v ->
fail "--%s: a capturing fn at the prompt answered %s" backend
(Option.value ~default:"nothing" v));
let r = eval "(defn scale [x i64 k i64] i64 (* x k))" in
if status r <> "ok" then
fail "--%s: a signature change was refused: %s" backend (said r)

18
test/test_flan.ml
View File

@ -6347,17 +6347,21 @@ let () =
"may allocate: a push past the Vec's capacity grows it through its \
allocator") ];
(* A capturing fn allocates its environment on the collected heap; one that
captures nothing is a code address and allocates nothing. *)
memory "a capturing fn, and one that captures nothing"
(* A capturing fn that outlives its frame allocates its environment on the
collected heap. One only called or passed down keeps its copies on the
frame, and one that captures nothing is a code address; neither
allocates. *)
memory "a capturing fn that escapes, one that does not, and one that captures nothing"
"(defn apply1 [f (Fn [i32] i32) x i32] i32 (f x))\n\
(defn make [n i32] (Fn [i32] i32) (fn [x] (+ x n)))\n\
(defn main [] ()\n\
\ (let [n 3]\n\
\ (print (apply1 (fn [x] (+ x n)) 1))\n\
\ (print (apply1 (fn [x] x) 1))))"
[ (4, 20, gc,
"allocates: an fn that captures keeps its copies in an environment on \
the collector's heap") ];
\ (print (apply1 (fn [x] x) 1))\n\
\ (print ((make 2) 1))))"
[ (2, 35, gc,
"allocates: an fn that captures and outlives its frame keeps its \
copies in an environment on the collector's heap") ];
(* The allocator side, and the two shapes of [flan_vec_init]: [slurp] sizes
the Vec to the file and takes a block here, [(vec-new i32 a)] passes a