Merge branch 'master' into worktree-agent-a6ffe579d55d1892b
This commit is contained in:
commit
9aeee9d676
25
TODO.org
25
TODO.org
@ -540,14 +540,12 @@ an ordinary =defn= declares no environment and is byte-for-byte what it was. The
|
||||
static side does not pay for the dynamic side. Rejected names: Closure, Proc, Fun,
|
||||
Func, Fnptr.
|
||||
|
||||
** NEXT Escaping closures, allocated on the GC side
|
||||
Decided 2026-09-25: start it. It must work on wasm32.
|
||||
The second half of "do both". What changes is where the environment points — a
|
||||
frame slot today, a collector allocation then — and the escape check goes away
|
||||
with it, along with the refusals on returning, storing, pointing at and pushing a
|
||||
capturing value. Two things for it to know: a widening thunk's environment holds a
|
||||
code pointer rather than a GC object, and capturing a dyn stays refused until a
|
||||
synthesised environment has a descriptor.
|
||||
** DONE Escaping closures, allocated on the GC side
|
||||
CLOSED: [2026-09-25]
|
||||
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.
|
||||
@ -1089,7 +1087,7 @@ An unknown call whose near miss is a value — =(context-allocator)= against
|
||||
=context/allocator=, or a global — says the name is a value written without
|
||||
parentheses, and names no call at all when the call had arguments.
|
||||
|
||||
** NEXT (max-of T) and (min-of T)
|
||||
** NEXT (max-value T) and (min-value T)
|
||||
Decided 2026-09-25: the type-limit constants as a form taking a type, Odin's
|
||||
max(T), valid at any numeric type or a numeric?-bounded variable. For a float,
|
||||
min-of is the most negative finite value.
|
||||
@ -1204,6 +1202,8 @@ the buffer.
|
||||
** TODO Marking through a descriptor an x86 reload module emitted
|
||||
The module links and runs. What is not proved is a collection running while a live
|
||||
instance of a dyn-holding struct sits in a frame of a body that module delivered.
|
||||
The same holds for a closure environment a reload module allocated: the module
|
||||
builds on both backends, and nothing yet collects while one is live.
|
||||
For the next sweep rather than for a lane.
|
||||
|
||||
** NEXT A sliced string loses the trailing NUL
|
||||
@ -1276,6 +1276,13 @@ lowering buffer annotates all four sections, the two =llc= ones from a =--debug=
|
||||
copy of the IR. Rules out writing a disassembler, and reading the source off disk
|
||||
at disassembly time.
|
||||
|
||||
** NEXT A temporary allocator, wiped each frame
|
||||
Decided 2026-09-25: Odin's context.temp_allocator. i64->bytes, f64->bytes and
|
||||
other quick formatting allocate from it, so a number drawn every frame no longer
|
||||
leaks from the default allocator. A dev build wipes it at each frame boundary;
|
||||
otherwise the program calls (free-temp) once per frame. Text kept past the frame
|
||||
is cloned.
|
||||
|
||||
* Runtime
|
||||
|
||||
** DONE An index out of range is a condition
|
||||
|
||||
120
docs/BUILT.md
120
docs/BUILT.md
@ -4332,7 +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, and what is refused in its place is the **escape**.*
|
||||
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
|
||||
@ -4358,8 +4359,9 @@ feature. This compiles:
|
||||
(apply2 (fn [x] (+ x bonus)) 5))
|
||||
```
|
||||
|
||||
`bonus` is **copied** into an environment on the enclosing function's frame at the instant the `fn` value is made,
|
||||
and the lifted body reads the copy. Not a reference: `fn-capture.flan` changes the local through a pointer *after*
|
||||
`bonus` is **copied** into an environment at the instant the `fn` value is made, and the lifted body reads the copy.
|
||||
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.
|
||||
|
||||
@ -4525,76 +4527,69 @@ 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, which is what makes "case 2" a bounded claim
|
||||
### Escape: only an escaping closure's environment is the collector's
|
||||
|
||||
A value carrying an environment may be **called, passed down, and held in a `let`**. It may not be **returned,
|
||||
stored, pointed at, or pushed into a container**. The check runs over the typed IR of every function the program
|
||||
ends up with — including the lifted ones, so an `fn` inside an `fn` needs no special case — and classifies
|
||||
function-typed values as *suspect* or clean:
|
||||
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.
|
||||
|
||||
- suspect: a capturing literal (`Tast.Closure`, the only node that makes one); a **parameter** of type `Fn`, in
|
||||
every function; an `Fn` read back out of a struct, a case or a pointer; a local bound to any of those,
|
||||
transitively; a branch or a valued form whose value is one.
|
||||
- clean: the address of a name, the result of any call, and **everything of type `CFn`** — the last for free,
|
||||
because a `CFn` has no environment to dangle and the type says so. The second follows from the first refusal,
|
||||
which is what stops a function from returning a suspect at all.
|
||||
**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.
|
||||
|
||||
The two types made this pass narrower rather than wider, which is the point of having them: a signature that says
|
||||
`CFn` has already promised what the analysis would otherwise have to prove, and nothing written against one is
|
||||
ever examined.
|
||||
**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.
|
||||
|
||||
**The clean set is the enumeration, not the suspect set**, and that is a correction. It read the other way round —
|
||||
`Field`, `CaseField` and `Deref` named as suspect, everything else clean — and had a hole exactly where a list like
|
||||
this cannot: `(at s 0)` over a slice of `Fn` is a `Prim`, so it came out clean while the `Vec`, struct and pointer
|
||||
spellings of the same act were refused. Nothing can write an `Fn` into a slice today, so it was unreachable; but
|
||||
the pass claims its enumeration is closed, and a default of "clean" is how that claim stops being true without
|
||||
anyone noticing. `fn-escape-at.flan` pins it. The same inversion fixed which of the two refusal messages an index
|
||||
read gets.
|
||||
**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.
|
||||
|
||||
Two of those arms are there because leaving them out is unsound rather than merely conservative, and each has a
|
||||
program. **A function value read out of an environment** (`fn-escape-copy.flan`): a lifted body holds *copies* of
|
||||
what it captured, read back with `Field(Deref env, i)`, so a copy of a captured function value carries whatever
|
||||
environment the original did. Treat it as clean and the lifted body can return it, the return arrives at the outer
|
||||
caller as an ordinary call result, and the whole "a call result is clean" rule has been walked around from inside.
|
||||
**A valued form's tail** (`fn-escape-handled.flan`): `handler-bind`, `with-allocator` and `restart-case` are
|
||||
expressions whose value is their body's — and a `restart-case`'s is a clause's too — so each is a way for a suspect
|
||||
to be a function's answer that a check looking only at `return` and at the last form of a block would step over.
|
||||
**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 parameter rule is the whole answer to the hard case.** A capturing `fn` passed to a function that stores it is
|
||||
caught *inside that function*: its parameter is suspect there and the store is refused where it is written. So no
|
||||
call can leak what its caller passed, and no caller has to be analysed. What it costs is real:
|
||||
`(defn keep [f (Fn [] i32)] (Fn [] i32) f)` is refused although it is harmless, and so is holding a parameter of
|
||||
function type in a `Vec` that never leaves the frame. `fn-escape-param.flan` is that refusal, written down as a
|
||||
refusal of something that would sometimes have been fine.
|
||||
**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.
|
||||
|
||||
Refusing `Addr` of a suspect matters more than it looks: without it, `deref` of a `(Ptr (Fn ...))` launders a
|
||||
suspect into a clean value and the return refusal has been walked around. Treating the `deref` itself as suspect is
|
||||
the other half of that door, and it is free: nothing a `(Ptr (Fn ...))` can point at is anywhere but a frame, since
|
||||
a global and a struct field of function type are both refused already.
|
||||
**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.
|
||||
|
||||
Name resolution inside a lifted body now asks the enclosing function's locals **before** the globals, which is a
|
||||
deliberate tightening: inside the enclosing function a local shadows a global of the same name, so a body lifted out
|
||||
of it must mean the same thing. The old order was an accident of where the refusal sat.
|
||||
**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.
|
||||
|
||||
Every one of these messages names **case 3** — the escaping closure, with an environment the collector owns —
|
||||
because "this cannot be done" and "this cannot be done yet" are different sentences and the second is the true one.
|
||||
Five programs: `fn-escape-return.flan`, `fn-escape-param.flan`, `fn-escape-store.flan`, `fn-escape-vec.flan`, and
|
||||
`fn-capture-set.flan`.
|
||||
**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
|
||||
|
||||
Anything but a **dyn**. A scalar, a struct and a fixed array copy whole. A string, a slice and a `Vec` or `Map`
|
||||
header copy as their words, aliasing whatever they pointed at — which is exactly right while the value cannot
|
||||
outlive the frame that owns the storage, and is exactly what would break under escape. A function value copies as a
|
||||
function value, environment included; capturing one into another `fn`'s environment is the one place a suspect may
|
||||
be written into an aggregate, and it is sound because the outer literal is itself suspect, so the pair of
|
||||
environments lives and dies with one frame.
|
||||
|
||||
A **dyn is refused**, for the reason a struct field of dyn already is (`A struct cannot hold a dyn field the
|
||||
collector would never find`): the collector's roots are frames, and nothing pushes the fields of a synthesised
|
||||
environment. A copy in there would be a live value reachable only through memory the marker never walks. Milestone
|
||||
2's per-type descriptors lift it, alongside the condition payload's and the struct field's — and case 3's
|
||||
collector-allocated environment is where it belongs anyway. `fn-capture-dyn.flan`.
|
||||
Anything. A scalar, a struct and a fixed array copy whole. A string, a slice and a `Vec` or `Map` header copy as their
|
||||
words and alias what they point at — the same borrow a struct holding a slice has when it is returned, which the
|
||||
static side leaves to the program; there is no ownership tracking to refuse it with. A function value copies as a
|
||||
function value, environment included, and the environment's descriptor names the copy's environment word, so a
|
||||
closure capturing a closure keeps it alive. A **dyn** copies as a dyn word and the descriptor names it
|
||||
(`fn-capture-dyn.flan`); the refusal that stood here waited for exactly this descriptor. A handler clause may capture a
|
||||
dyn for the same reason: its frame slot holding the copies is rooted with the environment struct's descriptor.
|
||||
|
||||
### Handlers, which get this for free and have no case 3 to wait for
|
||||
|
||||
@ -4638,7 +4633,8 @@ after it, seeing the last iteration's copies — cannot be written: a captured v
|
||||
### What each backend cost
|
||||
|
||||
Very little, which was the point of putting the environment in a frame slot and passing it as an ordinary argument
|
||||
at the one call that needs it.
|
||||
at the one call that needs it. (The environment has since moved to the collector's heap; what that cost is in the
|
||||
escape section above.)
|
||||
|
||||
`emit.ml`: a `%fnv` type and a 16-byte layout for `Fn`, `ptr` and eight for `CFn`; an `insertvalue` pair where a
|
||||
symbol used to stand alone; two `extractvalue`s at a call through an `Fn`; one appended operand on that call and on
|
||||
|
||||
@ -127,7 +127,7 @@ and expr_kind =
|
||||
| ArrayFill of len list * expr
|
||||
| ArrayGen of len list * expr
|
||||
(* These bind names or alter control flow, so none of them can be a call. *)
|
||||
| Fn of string list * expr list (* (fn [x y] ...) — non-escaping *)
|
||||
| Fn of string list * expr list (* (fn [x y] ...) *)
|
||||
(* (dotimes :o [i n] ...), (dotimes [i start stop] ...) and
|
||||
(dotimes [i start stop step] ...). The bounds are a record rather than
|
||||
three positional fields because the one-bound form is the common one and
|
||||
|
||||
453
lib/check.ml
453
lib/check.ml
@ -741,19 +741,7 @@ let rec capture ctx loc name =
|
||||
| None -> if ctx.outer_what = None then None else from_parent ()
|
||||
in
|
||||
match ctx.outer_what, outer with
|
||||
| Some what, Some (outer : binding) ->
|
||||
if outer.bty = Types.Dyn then
|
||||
(* [what] is a descriptor — "an fn", "a handler" — so it reads as the
|
||||
subject of a sentence and nowhere else. It used to be substituted
|
||||
into a noun slot as well, which produced "the environment an fn is
|
||||
handed"; the environment belongs to *this* capture and naming it
|
||||
twice said less, not more. *)
|
||||
Loc.failk "check/capture-dyn" loc
|
||||
"%s cannot capture %s: it is a dyn, and the collector finds its \
|
||||
roots by frame — a copy inside the environment would be a live \
|
||||
value nothing walks. Pass it in as a parameter, or hold it in a \
|
||||
global"
|
||||
what name;
|
||||
| Some _, Some (outer : binding) ->
|
||||
let slot = bind ctx name outer.bty ~assignable:false in
|
||||
ctx.caught <- ctx.caught @ [ (name, (outer, slot)) ];
|
||||
Some { slot; bty = outer.bty; assignable = false; bwhat = None }
|
||||
@ -1077,12 +1065,9 @@ let map_type ?(preds = []) loc (k : Types.t) (v : Types.t) =
|
||||
(* The positions a function value may not be written in, and the one reason
|
||||
they are all the same position: something zeroes it.
|
||||
|
||||
Since capture arrived there is a second reason standing behind the first,
|
||||
and it is the sharper one: every position on this list outlives the frame
|
||||
a captured environment is on, so even a value nobody zeroed could not be
|
||||
kept there. The message names the zero because that is the one that applies
|
||||
to *every* function value and not only to a capturing one — and the escape
|
||||
is what [escape_check] says, at the store rather than at the declaration.
|
||||
The zero is the whole reason: a capturing value's environment belongs to
|
||||
the collector and may be kept anywhere, and [(Option (Fn ...))] is how a
|
||||
field or a global holds one.
|
||||
|
||||
ZII is the language's rule — an omitted struct field, a fixed array's
|
||||
elements, a [defonce] with no initialiser are all all-bytes-zero — and a
|
||||
@ -1211,9 +1196,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 the copies on the frame
|
||||
it was written in, and [escape_check] is what stops that address
|
||||
outliving the frame.
|
||||
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
|
||||
@ -2310,7 +2295,6 @@ let close_over ~fname (octx : ctx) (fctx : ctx) loc =
|
||||
caught
|
||||
in
|
||||
let prefix body = [ mk loc fctx.ret (Tast.Let (binds, body)) ] in
|
||||
let mslot = fresh_slot octx ety in
|
||||
let make =
|
||||
mk loc ety
|
||||
(Tast.Make (ename,
|
||||
@ -2319,6 +2303,7 @@ let close_over ~fname (octx : ctx) (fctx : ctx) loc =
|
||||
mk loc b.bty (Tast.Local b.slot))
|
||||
caught))
|
||||
in
|
||||
let mslot = fresh_slot octx ety in
|
||||
prefix, Some eslot, Some (mslot, make),
|
||||
Some (mk loc (Types.Ptr ety) (Tast.Addr (Tast.Plocal mslot)))
|
||||
|
||||
@ -4464,15 +4449,13 @@ and block ctx ?want ?(defer_ok = false) loc body =
|
||||
landed, and the surface feature is that machinery given a name rather than a
|
||||
second one invented beside it.
|
||||
|
||||
**Capture is by value, and the value may not escape.** 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 on that function's
|
||||
frame at the instant the value is made (see [capture] and [close_over]).
|
||||
So the value is two words, the second of them an address into a frame, and
|
||||
what keeps that address good is [escape_check]: it may be called, passed
|
||||
down and let-bound, and may not be returned, stored or pushed anywhere.
|
||||
spec-memory.md's case 3 — an environment the collector owns, and with it
|
||||
the escaping closure — is a separate lane, and every refusal names it.
|
||||
**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 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
|
||||
@ -4622,11 +4605,12 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
|
||||
let v =
|
||||
match addr with
|
||||
| None -> mk loc fty (Tast.FnAddr (Tast.Flanfn fname))
|
||||
(* 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 ->
|
||||
(* The value, and the store that fills its environment around it. What
|
||||
stops the value leaving this frame is [escape_check], which reads the
|
||||
finished body: a rule about where a value may *go* cannot be settled
|
||||
at the point it is made. *)
|
||||
let c = mk loc fty (Tast.Closure (Tast.Flanfn fname, a)) in
|
||||
mk loc fty (Tast.Let ([ Option.get bind ], [ c ]))
|
||||
in
|
||||
@ -4713,7 +4697,8 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
|
||||
case to leave over. A handler frame is popped by the body that
|
||||
pushed it and nothing in the language can name one, so the clause
|
||||
cannot be reached from anywhere the establishing frame is not
|
||||
alive. There is nothing here that case 3 would change. *)
|
||||
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 ~fname ctx hctx c.Ast.hloc
|
||||
in
|
||||
@ -12481,8 +12466,82 @@ let value_sites (p : Tast.program) ?(after_fn = fun (_ : Tast.fn) -> ())
|
||||
(* Over the whole program rather than at each declaration, because the type
|
||||
that hides a dyn may be declared after the one that names it — and because
|
||||
a struct nobody ever holds a value of costs nothing either way. *)
|
||||
(* Does a value of this type hold an (Fn ...) in its own storage — the
|
||||
function values a collector-allocated environment may hang off. A
|
||||
pointer and a slice are views of storage checked where it is declared. *)
|
||||
let rec holds_fn p seen (t : Types.t) =
|
||||
let go = holds_fn p seen in
|
||||
match t with
|
||||
| Types.Fn _ -> true
|
||||
| Types.Array (_, e) | Types.Vec e | Types.Option e -> go e
|
||||
| Types.Map (k, v) -> go k || go v
|
||||
| Types.Named n when not (List.mem n seen) ->
|
||||
let seen = n :: seen in
|
||||
let field (fl : Tast.field) = holds_fn p seen fl.Tast.fty in
|
||||
(match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
|
||||
p.Tast.structs with
|
||||
| Some s -> List.exists field s.Tast.fields
|
||||
| None ->
|
||||
match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
|
||||
p.Tast.datas with
|
||||
| Some u ->
|
||||
List.exists
|
||||
(fun (c : Tast.variant) -> List.exists field 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 -> List.exists field u.Tast.fields
|
||||
| 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
|
||||
@ -12556,240 +12615,10 @@ let dyn_descriptors (p : Tast.program) =
|
||||
"What C hands back points at storage this compiler never rooted")
|
||||
p.Tast.externs;
|
||||
value_sites p (fun ~slot:_ loc what t -> check loc what t)
|
||||
(* ── Escape, which is the other half of capture ────────────────────────
|
||||
spec-memory.md's case 2 is the *non-escaping* fn, and this is what makes
|
||||
the word mean something. A captured copy lives in a slot of the frame the
|
||||
literal was written in, so a value holding that frame's address may be
|
||||
called, passed down and copied about as much as anyone likes — and must
|
||||
never outlive the frame. Case 3, the escaping closure with an environment
|
||||
the collector allocates, is a separate lane; every refusal here names it,
|
||||
because "this cannot be done" and "this cannot be done yet" are different
|
||||
sentences and the second one is the true one.
|
||||
|
||||
Run over the typed IR rather than over the surface, and over every
|
||||
function the program ends up with rather than only over the ones anyone
|
||||
wrote. Two reasons, and both are about not having to be careful: the IR
|
||||
has one node per way a value can be stored, so the list below is closed;
|
||||
and a lifted body is checked by exactly the same pass as the body it came
|
||||
out of, so an [fn] inside an [fn] needs no special case.
|
||||
|
||||
**What is suspect.** A value of function type that may carry an
|
||||
environment, decided by a rule that needs no interprocedural anything:
|
||||
|
||||
- a capturing literal, which is a [Closure] node and is the only place one
|
||||
is made;
|
||||
- a *parameter* of function type, in every function, because nothing at a
|
||||
definition can see what its callers will pass;
|
||||
- a local bound to either of those, transitively;
|
||||
- a branch or a block whose value is one.
|
||||
|
||||
Everything else of function type is clean: the address of a name, and the
|
||||
result of any call — the second follows from the first refusal below, which
|
||||
is what stops a function from returning a suspect in the first place.
|
||||
|
||||
**Why the parameter rule is the whole answer to the hard case.** An [fn]
|
||||
that captures, passed to a function that stores it, is caught *inside that
|
||||
function*: its parameter is suspect there, and the store is refused where
|
||||
it is written. So no call can leak what its caller passed, and no caller
|
||||
has to be analysed. What it costs is real and worth naming: [(defn id [f
|
||||
(Fn [] i32)] (Fn [] i32) f)] is refused although it is harmless, and so is
|
||||
holding a parameter of function type in a Vec that never leaves the frame.
|
||||
Both become writable when case 3 lands, and neither is worth an analysis
|
||||
before then.
|
||||
|
||||
**Where a suspect may stand**: an argument of a call, the callee of one, a
|
||||
[let] binding, and the field of an environment another literal captures it
|
||||
into — that last is the [env/] exemption below, and it is sound for the
|
||||
same reason everything here is: the outer literal is itself suspect, so
|
||||
the pair of environments lives and dies with one frame. *)
|
||||
let rec escaping suspects (e : Tast.expr) =
|
||||
(* The value of a body is its last form, which is the only part of one that
|
||||
can be this expression's own value. *)
|
||||
let tail body =
|
||||
match List.rev body with x :: _ -> escaping suspects x | [] -> false
|
||||
in
|
||||
match e.Tast.ty with
|
||||
| Types.Fn _ ->
|
||||
(match e.Tast.e with
|
||||
| Tast.Closure _ -> true
|
||||
| Tast.Local s -> List.mem s !suspects
|
||||
| Tast.If (_, a, b) -> escaping suspects a || escaping suspects b
|
||||
| Tast.Do body | Tast.Let (_, body) -> tail body
|
||||
| Tast.Match (_, arms) -> List.exists (fun (a : Tast.arm) -> tail a.Tast.abody) arms
|
||||
(* The forms that establish something around a body and yield the body's
|
||||
value. Easy to forget and not safe to: each of them is an expression,
|
||||
so each of them is a way for a suspect to be the answer. A
|
||||
restart-case yields its body's value *or* a clause's, so every clause
|
||||
is a tail too. *)
|
||||
| Tast.Handled (_, body) | Tast.WithAlloc (_, body) -> tail body
|
||||
| Tast.RestartCase (cs, body) ->
|
||||
escaping suspects body
|
||||
|| List.exists (fun (c : Tast.rclause) -> tail c.Tast.rbody) cs
|
||||
(* And then the clean list, which is short, closed, and stated as a list
|
||||
rather than as a default — a *read* of an [Fn] from anywhere is
|
||||
suspect unless it is one of these.
|
||||
|
||||
It used to be the other way round, with [Field], [CaseField] and
|
||||
[Deref] named as suspect and everything else clean, and that spelling
|
||||
had a hole in it exactly where a list like this cannot: an [(at s 0)]
|
||||
over a slice of [Fn] is a [Prim], so it read as clean while the [Vec]
|
||||
and pointer spellings of the same thing were refused. Nothing can
|
||||
write an [Fn] into a slice today, so it was not reachable — but the
|
||||
header above claims this enumeration is closed, and a default of
|
||||
[false] is how that claim stops being true without anyone noticing.
|
||||
|
||||
What is clean, and why. The address of a name never carried an
|
||||
environment. A widening carries a thunk and a code pointer, which is
|
||||
not a frame address. And the result of a call cannot carry one,
|
||||
because a function that would return one is refused below — that
|
||||
refusal is what this arm rests on, which is why the two have to be
|
||||
read together. *)
|
||||
| Tast.FnAddr _ | Tast.Thicken _ | Tast.Call _ | Tast.CallPtr _ -> false
|
||||
(* Everything else that can produce an [Fn]: read out of a struct — which
|
||||
for a function value means read out of an *environment*, the one
|
||||
aggregate a capture may be written into — out of a case, through a
|
||||
pointer, or out of a container. A copy of a captured function value
|
||||
carries whatever environment the original did, so it is suspect
|
||||
exactly as the original was: without this, a lifted body could hand
|
||||
back its copy of a captured value and the result would arrive at the
|
||||
caller as an ordinary call result, which is to say as clean. *)
|
||||
| _ -> true)
|
||||
| _ -> false
|
||||
|
||||
(* The environment struct a capture built, which is the one aggregate a
|
||||
suspect may be written into. See the header. *)
|
||||
let is_env_struct n = String.length n >= 4 && String.sub n 0 4 = "env/"
|
||||
|
||||
let escape_check (fn : Tast.fn) =
|
||||
let suspects = ref [] in
|
||||
List.iteri
|
||||
(fun i ty -> match ty with Types.Fn _ -> suspects := i :: !suspects | _ -> ())
|
||||
fn.Tast.params;
|
||||
(* Two refusals, because the two cases know different amounts. A literal
|
||||
written here captures, full stop, and the message can name the frame its
|
||||
copies are on. A function value that arrived as a parameter *may* carry
|
||||
an environment and nothing at a definition can tell — so it is refused
|
||||
where it is written rather than at the calls that would have been fine,
|
||||
and the message says that is what happened. *)
|
||||
let owner = match fn.Tast.fparent with Some p -> p | None -> fn.Tast.name in
|
||||
(* Which of the two this is, found by following the same tails [escaping]
|
||||
followed. The refused expression is often a form that *yields* the
|
||||
suspect — a handler-bind, a branch — and the message has to describe what
|
||||
is actually escaping and not the shape it arrived in. *)
|
||||
let rec written_here (e : Tast.expr) =
|
||||
let tail body =
|
||||
match List.rev body with x :: _ -> written_here x | [] -> true
|
||||
in
|
||||
match e.Tast.e with
|
||||
| Tast.Closure _ -> true
|
||||
| Tast.If (_, a, b) -> written_here a && written_here b
|
||||
| Tast.Do body | Tast.Let (_, body) | Tast.Handled (_, body)
|
||||
| Tast.WithAlloc (_, body) -> tail body
|
||||
| Tast.Match (_, arms) ->
|
||||
List.for_all (fun (a : Tast.arm) -> tail a.Tast.abody) arms
|
||||
| Tast.RestartCase (cs, body) ->
|
||||
written_here body
|
||||
&& List.for_all (fun (c : Tast.rclause) -> tail c.Tast.rbody) cs
|
||||
(* Everything else is a *read* of a value made elsewhere — a local, a
|
||||
field, an index, a load through a pointer — and the message that fits
|
||||
one is the other message, about a value this definition did not make
|
||||
and cannot see into. The literal is the short list here, exactly as
|
||||
the clean set is the short list in [escaping]; whichever is short is
|
||||
the one to write out. *)
|
||||
| _ -> false
|
||||
in
|
||||
let refuse (e : Tast.expr) where =
|
||||
if not (written_here e) then
|
||||
Loc.failk "check/fn-escapes" e.Tast.loc
|
||||
"this function value may carry an environment, and %s would outlive \
|
||||
the frame that environment is on. A value reaching %s as a parameter \
|
||||
was made by a caller this definition cannot see, so it is refused \
|
||||
here rather than at the calls that would be safe. Call it, pass it \
|
||||
down, or hold it in a let — an fn whose environment the collector \
|
||||
owns is spec-memory.md's case 3 and is not built yet"
|
||||
where owner
|
||||
else
|
||||
Loc.failk "check/fn-escapes" e.Tast.loc
|
||||
(* No "hold it in a let" here, unlike the message above: an fn literal
|
||||
takes its types from the position it is written in, so there is no
|
||||
let binding to offer — see fn-no-type.flan. Every suggestion this
|
||||
compiler prints has to compile. *)
|
||||
"this fn captures, and %s would outlive the frame its copies are on. \
|
||||
The copies are slots of %s, taken where the value was made, so a \
|
||||
reader reached after that frame has gone would read whatever \
|
||||
replaced them. Call it, or pass it down — an fn whose environment \
|
||||
the collector owns is spec-memory.md's case 3 and is not built yet"
|
||||
where owner
|
||||
in
|
||||
let deny where es = List.iter (fun e -> if escaping suspects e then refuse e where) es in
|
||||
let go (e : Tast.expr) =
|
||||
(match e.Tast.e with
|
||||
| Tast.Let (bs, _) ->
|
||||
(* A binding is where a suspect spreads, and one of the two places it
|
||||
does. *)
|
||||
List.iter
|
||||
(fun (slot, v) -> if escaping suspects v then suspects := slot :: !suspects)
|
||||
bs
|
||||
(* And the other: an arm's pattern binds the case's fields to slots, and
|
||||
the store that fills them is inside the branch rather than in a form
|
||||
this walk reads as a binding. Reading the same field by hand is a
|
||||
[CaseField] and suspect — a copy of a captured function value carries
|
||||
whatever environment the original did — so the slot the pattern binds
|
||||
it to is suspect too, or [(match o (Some f) f ...)] would hand back
|
||||
through a name what [(case-field o ...)] cannot hand back at all.
|
||||
|
||||
Every arm's binds, not only an [Option]'s: a data type's field of
|
||||
function type is written through [MakeCase], which denies suspects,
|
||||
and read back through this. *)
|
||||
| Tast.Match (_, arms) ->
|
||||
List.iter
|
||||
(fun (a : Tast.arm) ->
|
||||
List.iter
|
||||
(fun s ->
|
||||
match fn.Tast.slots.(s) with
|
||||
| Types.Fn _ -> suspects := s :: !suspects
|
||||
| _ -> ())
|
||||
a.Tast.binds)
|
||||
arms
|
||||
| Tast.Set (_, v) -> deny "a store" [ v ]
|
||||
| Tast.Return (Some v) -> deny "a return" [ v ]
|
||||
| Tast.Some_ v -> deny "an Option" [ v ]
|
||||
| Tast.Arr es -> deny "a fixed array" es
|
||||
| Tast.MakeCase (_, _, es) -> deny "a data type's field" es
|
||||
| Tast.Make (n, es) -> if not (is_env_struct n) then deny "a struct field" es
|
||||
| Tast.Addr (Tast.Plocal s) ->
|
||||
if List.mem s !suspects then
|
||||
refuse e "a pointer to it"
|
||||
(* Everything the runtime takes: a push into a Vec, a put into a Map, a
|
||||
box into a dyn. All of them put the value somewhere this frame does
|
||||
not own — and all of them take it *by address*, because the container
|
||||
runtime is type-erased, so the address is what has to be caught and
|
||||
not the value beside it. *)
|
||||
| Tast.Prim (Tast.Rt _, es) ->
|
||||
deny "a container" es;
|
||||
List.iter
|
||||
(fun (a : Tast.expr) ->
|
||||
match a.Tast.e with
|
||||
| Tast.Prim (Tast.AddrOf, [ v ]) -> deny "a container" [ v ]
|
||||
| _ -> ())
|
||||
es
|
||||
| Tast.Prim (Tast.AddrOf, [ v ]) -> deny "a pointer to it" [ v ]
|
||||
| Tast.InvokeRestart (_, _, es, _, _, _) -> deny "a restart's argument" es
|
||||
| _ -> ())
|
||||
in
|
||||
(* Outermost first, which is the order [Tast.walk] gives and the order a
|
||||
[let] has to be seen in: a binding must be recorded before anything that
|
||||
reads the slot. *)
|
||||
List.iter (fun e -> Tast.walk go e) fn.Tast.body;
|
||||
(* And the defers on the transfer path, which are the same forms again but
|
||||
are not reachable from [body] — they hang off the function, and a store
|
||||
written in one is a store. *)
|
||||
List.iter (fun e -> Tast.walk go e) fn.Tast.fdefers;
|
||||
(* And the tail, which is a return with nothing written. *)
|
||||
(match List.rev fn.Tast.body with
|
||||
| last :: _ when (match fn.Tast.ret with Types.Fn _ -> true | _ -> false) ->
|
||||
deny "a return" [ last ]
|
||||
| _ -> ())
|
||||
(* See lib/closures.ml. *)
|
||||
let is_env_struct = Closures.is_env_struct
|
||||
let heap_env = Closures.heap_env
|
||||
let place_closures fns = Closures.place ~dev:false fns
|
||||
|
||||
let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
|
||||
Tast.program * env * string list =
|
||||
@ -12938,10 +12767,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
|
||||
(* Where a captured copy may go, asked of every function the program ended
|
||||
up with. Here rather than inside [check] because it is a question about a
|
||||
finished body — see the header on [escaping]. *)
|
||||
List.iter escape_check fns;
|
||||
(* 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
|
||||
@ -13047,6 +12874,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
|
||||
@ -13118,7 +12960,7 @@ let expression env ?want (e : Ast.expr) :
|
||||
|
||||
let dyn_sites (p : Tast.program) : Loc.diag list =
|
||||
let found = ref [] in
|
||||
let add loc what = found := (loc, what) :: !found in
|
||||
let add loc what = found := (loc, `Dyn what) :: !found in
|
||||
(* A type that *holds* a dyn and not only the type [dyn] itself. A struct
|
||||
with a dyn field is a collected value as much as a bare one is, and since
|
||||
the per-type descriptors it is a value a program can have without any
|
||||
@ -13145,17 +12987,30 @@ let dyn_sites (p : Tast.program) : Loc.diag list =
|
||||
&& String.length sym > 8
|
||||
&& String.sub sym 0 8 = "flan_dyn" ->
|
||||
add e.Tast.loc (Printf.sprintf "this value in %s" fn.Tast.name)
|
||||
(* A capturing fn: its environment is a collector allocation,
|
||||
which is a different sentence from a dyn and has a different
|
||||
fix. *)
|
||||
| Tast.Closure (_, env) when heap_env env ->
|
||||
found := (e.Tast.loc, `Closure) :: !found
|
||||
| _ -> ()))
|
||||
fn.Tast.body);
|
||||
List.rev_map
|
||||
(fun (loc, what) ->
|
||||
(fun (loc, site) ->
|
||||
Loc.diag ~kind:"check/no-gc" loc
|
||||
(Printf.sprintf
|
||||
"%s holds a dyn, and --no-gc says this program carries no \
|
||||
collector. A \
|
||||
dyn value is one the runtime allocates and the collector owns, so \
|
||||
there is nothing smaller to compile it to — write the type"
|
||||
what))
|
||||
(match site with
|
||||
| `Dyn what ->
|
||||
Printf.sprintf
|
||||
"%s holds a dyn, and --no-gc says this program carries no \
|
||||
collector. A \
|
||||
dyn value is one the runtime allocates and the collector owns, \
|
||||
so there is nothing smaller to compile it to — write the type"
|
||||
what
|
||||
| `Closure ->
|
||||
"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) =
|
||||
@ -13314,19 +13169,25 @@ let memory_sites ?file (p : Tast.program) : Loc.diag list =
|
||||
let found = ref [] in
|
||||
let seen = Hashtbl.create 64 in
|
||||
let look (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Prim (Tast.Rt sym, args) ->
|
||||
(match memory_class sym args with
|
||||
| None -> ()
|
||||
| Some (kind, msg) ->
|
||||
let loc = e.Tast.loc in
|
||||
let key = (loc.Loc.file, loc.Loc.line, loc.Loc.col, kind) in
|
||||
if (match file with None -> true | Some f -> String.equal f loc.Loc.file)
|
||||
&& not (Hashtbl.mem seen key) then begin
|
||||
Hashtbl.replace seen key ();
|
||||
found := Loc.diag ~kind loc msg :: !found
|
||||
end)
|
||||
| _ -> ()
|
||||
let cls =
|
||||
match e.Tast.e with
|
||||
| Tast.Prim (Tast.Rt sym, args) -> memory_class sym args
|
||||
| Tast.Closure (_, env) when heap_env env ->
|
||||
Some ("memory/gc",
|
||||
"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
|
||||
| None -> ()
|
||||
| Some (kind, msg) ->
|
||||
let loc = e.Tast.loc in
|
||||
let key = (loc.Loc.file, loc.Loc.line, loc.Loc.col, kind) in
|
||||
if (match file with None -> true | Some f -> String.equal f loc.Loc.file)
|
||||
&& not (Hashtbl.mem seen key) then begin
|
||||
Hashtbl.replace seen key ();
|
||||
found := Loc.diag ~kind loc msg :: !found
|
||||
end
|
||||
in
|
||||
(* A global's initialiser runs at startup and allocates there as much as a
|
||||
body does — [(defonce names (vec-new dyn))] is a heap object before main
|
||||
|
||||
242
lib/closures.ml
Normal file
242
lib/closures.ml
Normal file
@ -0,0 +1,242 @@
|
||||
(* Where a capturing fn's environment lives: on the frame it was written in,
|
||||
or on the collector's heap. A module of its own, beneath both [Check] and
|
||||
the emitters, because the answer depends on the build: [Check] places
|
||||
precisely, and a dev build's emitters place again under the dev rule —
|
||||
see [place]. *)
|
||||
|
||||
(* The environment struct a capture built. [Session]'s layout guard exempts
|
||||
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
|
||||
|
||||
(* [dev] is a dev build's rule. There a call to a named function goes through
|
||||
its cell, and a redefinition can replace the callee with a body that keeps
|
||||
the value — while the caller, which is not recompiled, still made it on its
|
||||
frame. So a closure handed to any named call escapes, whatever the callee
|
||||
does today. A release build asks the callee. *)
|
||||
let place ~dev (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 && not dev 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 dev_program (p : Tast.program) =
|
||||
{ p with Tast.fns = place ~dev:true p.Tast.fns }
|
||||
511
lib/emit.ml
511
lib/emit.ml
@ -428,6 +428,34 @@ let dfile d path =
|
||||
|
||||
let align_up x a = if a <= 1 then x else ((x + a - 1) / a) * a
|
||||
|
||||
(* One word inside an instance that the collector follows, located twice.
|
||||
[goff] is the byte offset under [lay]'s numbers, which are x86-64's and are
|
||||
what the hand-written backend writes. [gpath] is the same place as a walk
|
||||
an LLVM [getelementptr] can take — each step a type and its indices — so
|
||||
the LLVM backend can write the offset as a constant expression and let the
|
||||
target's own layout answer it. That is the difference on wasm32, where 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
|
||||
tables of runtime/flan_dyn.h's [flan_desc]. [gvec] carries each Vec's
|
||||
element type, whose own descriptor the entry points at. *)
|
||||
type gclayout = {
|
||||
gdyn : gcword list;
|
||||
genv : gcword list;
|
||||
gvec : (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. *)
|
||||
type desc = {
|
||||
dsym : string;
|
||||
dlay : gclayout;
|
||||
dsize : int;
|
||||
dvecs : string list;
|
||||
}
|
||||
|
||||
(* ── Module-level state ────────────────────────────────────────────── *)
|
||||
|
||||
type m = {
|
||||
@ -450,6 +478,16 @@ type m = {
|
||||
externs : (string, string) Hashtbl.t;
|
||||
checks : bool; (* emit bounds checks *)
|
||||
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 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
|
||||
one or starts the collector for it: the static side does not pay for the
|
||||
dynamic one. See [gc_layout]. *)
|
||||
gcfn : bool;
|
||||
(* Was this name in the build the running process came from? False only in a
|
||||
redefinition module, and only for a name introduced since. *)
|
||||
known : string -> bool;
|
||||
@ -505,8 +543,10 @@ type m = {
|
||||
the entries that named it came off when the frames that pushed them did,
|
||||
and no value of any type points at one. A redefinition module naming a
|
||||
type the base program already named therefore gets its own copy, which is
|
||||
harmless — a descriptor is read-only and has no identity. *)
|
||||
descs : (string, string * int list * int) Hashtbl.t;
|
||||
harmless — a descriptor is read-only and has no identity. A closure's
|
||||
environment is the exception: it points at its descriptor for as long as
|
||||
it lives, which is why making one counts in [nstr]. *)
|
||||
descs : (string, desc) Hashtbl.t;
|
||||
(* Every Flan function in the program, by name, with its parameters and its
|
||||
return: what a dev call site compares the cell's signature word against.
|
||||
Filled from the program the module is built from, which in a
|
||||
@ -730,20 +770,198 @@ let desc_mangle (t : Types.t) =
|
||||
order is deterministic. Private or local in both backends, so a redefinition
|
||||
module naming the same type as the program it patches is not a duplicate
|
||||
symbol. *)
|
||||
let desc_of m (t : Types.t) : string option =
|
||||
match dyn_offsets m t with
|
||||
| [] -> None
|
||||
| offs ->
|
||||
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
|
||||
else
|
||||
let key = Types.to_string t in
|
||||
match Hashtbl.find_opt m.descs key with
|
||||
| Some (sym, _, _) -> Some sym
|
||||
| Some d -> Some d.dsym
|
||||
| None ->
|
||||
let sym =
|
||||
Printf.sprintf "flan.desc.%s.%d" (desc_mangle t) (Hashtbl.length m.descs)
|
||||
in
|
||||
Hashtbl.replace m.descs key (sym, offs, fst (lay m t));
|
||||
(* 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 =
|
||||
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
|
||||
in
|
||||
Hashtbl.replace m.descs key
|
||||
{ dsym = sym; dlay = l; dsize = fst (lay m t); dvecs };
|
||||
Some sym
|
||||
|
||||
(* ── The words the collector follows ─────────────────────────────────
|
||||
|
||||
What [dyn_offsets] answers, widened by the two words closures added: the
|
||||
environment half of an [(Fn ...)] value, and a [(Vec T)] whose elements hold
|
||||
one. Both only when [m.gcfn] — a program that never makes a capturing [fn]
|
||||
has no environment anywhere for the collector to find, so its [Fn] values
|
||||
are code addresses and null and are rooted by nothing, exactly as before.
|
||||
|
||||
The dyn words are gathered where [dyn_offsets] gathers them and nowhere
|
||||
else: a dyn inside an [Option], a data type's payload, a union or a Vec is
|
||||
refused by [Check.hidden_dyn], so there is nothing more to find.
|
||||
|
||||
The environment words are gathered through all of those as well. An
|
||||
[(Option (Fn ...))] is how a struct field or a global holds a function
|
||||
value — a bare one would be zeroed — and a data type or a union overlays
|
||||
its cases, so which bytes are a function value depends on a tag this table
|
||||
cannot read. Naming every case's word is sound here, and would not be for
|
||||
a dyn, because the collector never reads *through* an environment word it
|
||||
did not allocate: it asks its own set first (runtime/flan_dyn.c's
|
||||
[mark_env]). The word of a case that is not the live one is an integer or
|
||||
half of something else, it is not in the set, and it is passed over.
|
||||
|
||||
Duplicates are kept apart by path, not by offset. Two cases can put a word
|
||||
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 step ty idx path = path @ [ (ty, idx) ] in
|
||||
let rec go ~full seen off path (t : Types.t) =
|
||||
match t with
|
||||
| Types.Dyn -> if full then dyn := { goff = off; gpath = path } :: !dyn
|
||||
| Types.Fn _ when m.gcfn ->
|
||||
env := { goff = off + 8; gpath = step "%fnv" [ "i32 0"; "i32 1" ] path }
|
||||
:: !env
|
||||
(* Asked with [reaches_fn] and not by laying the element out: a data type
|
||||
may hold a Vec of itself, and the element's own descriptor, which
|
||||
[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
|
||||
| Types.Array (n, e) ->
|
||||
let s, _ = lay m e in
|
||||
for i = 0 to Int64.to_int n - 1 do
|
||||
go ~full seen (off + (i * s))
|
||||
(step (ll t) [ "i32 0"; Printf.sprintf "i64 %d" i ] path) e
|
||||
done
|
||||
| Types.Option e when m.gcfn ->
|
||||
let _, _, offs = lay_fields m [ Types.Int Types.I8; e ] in
|
||||
go ~full:false seen (off + List.nth offs 1)
|
||||
(step (ll t) [ "i32 0"; "i32 1" ] path) e
|
||||
| Types.Named nm when not (List.mem nm seen) ->
|
||||
let seen = nm :: seen in
|
||||
(match Hashtbl.find_opt m.structs nm with
|
||||
| Some st ->
|
||||
let tys = List.map (fun (fl : Tast.field) -> fl.Tast.fty) st.Tast.fields in
|
||||
let _, _, offs = lay_fields m tys in
|
||||
List.iteri
|
||||
(fun i (ty, o) ->
|
||||
go ~full seen (off + o)
|
||||
(step (sname nm) [ "i32 0"; Printf.sprintf "i32 %d" i ] path) ty)
|
||||
(List.combine tys offs)
|
||||
| None when not m.gcfn -> ()
|
||||
| None ->
|
||||
match Hashtbl.find_opt m.datas nm with
|
||||
| Some u ->
|
||||
let size, align = payload_lay m u in
|
||||
if size > 0 then begin
|
||||
let _, _, poffs =
|
||||
lay_fields m
|
||||
[ Types.Int Types.I32;
|
||||
Types.Array (Int64.of_int (size / align),
|
||||
Types.Int (int_kind (align * 8))) ]
|
||||
in
|
||||
let poff = off + List.nth poffs 1 in
|
||||
let ppath = step (sname nm) [ "i32 0"; "i32 1" ] path in
|
||||
List.iter
|
||||
(fun (c : Tast.variant) ->
|
||||
let tys =
|
||||
List.map (fun (fl : Tast.field) -> fl.Tast.fty) c.Tast.vfields
|
||||
in
|
||||
let _, _, offs = lay_fields m tys in
|
||||
List.iteri
|
||||
(fun i (ty, o) ->
|
||||
go ~full:false seen (poff + o)
|
||||
(step (sname (nm ^ "." ^ c.Tast.vname))
|
||||
[ "i32 0"; Printf.sprintf "i32 %d" i ] ppath) ty)
|
||||
(List.combine tys offs))
|
||||
u.Tast.cases
|
||||
end
|
||||
| None ->
|
||||
match Hashtbl.find_opt m.unions nm with
|
||||
| Some u ->
|
||||
(* Every member starts where the union does, so the walk goes on
|
||||
from the same place with the member's own type. *)
|
||||
List.iter
|
||||
(fun (fl : Tast.field) -> go ~full:false seen off path fl.Tast.fty)
|
||||
u.Tast.fields
|
||||
| None -> ())
|
||||
| _ -> ()
|
||||
in
|
||||
go ~full:true [] 0 [] t;
|
||||
let order (a : gcword) (b : gcword) =
|
||||
match compare a.goff b.goff with 0 -> compare a.gpath b.gpath | c -> c
|
||||
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 }
|
||||
|
||||
(* 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
|
||||
terminates a data type holding a Vec of itself without losing a function
|
||||
value found along another path. *)
|
||||
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.Named nm when not (List.mem nm seen) ->
|
||||
let seen = nm :: seen in
|
||||
let fields =
|
||||
match Hashtbl.find_opt m.structs nm with
|
||||
| Some st -> st.Tast.fields
|
||||
| None ->
|
||||
match Hashtbl.find_opt m.datas nm with
|
||||
| Some u -> List.concat_map (fun (c : Tast.variant) -> c.Tast.vfields) u.Tast.cases
|
||||
| None ->
|
||||
match Hashtbl.find_opt m.unions nm with
|
||||
| Some u -> u.Tast.fields
|
||||
| None -> []
|
||||
in
|
||||
List.exists (fun (fl : Tast.field) -> reaches_fn m seen fl.Tast.fty) fields
|
||||
| _ -> 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 <> [])
|
||||
|
||||
(* 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]. *)
|
||||
let gc_zero_offsets m (t : Types.t) : int list =
|
||||
if t = Types.Dyn then [ 0 ]
|
||||
else
|
||||
let l = gc_layout m t in
|
||||
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
|
||||
|
||||
(* A [gpath] as an LLVM constant expression over [base]: nested constant
|
||||
[getelementptr]s, one per step. Over [ptr null] and through [ptrtoint] it
|
||||
is the word's byte offset on whatever target the module is compiled for. *)
|
||||
let path_const base path =
|
||||
List.fold_left
|
||||
(fun acc (ty, idx) ->
|
||||
Printf.sprintf "getelementptr (%s, ptr %s, %s)" ty acc
|
||||
(String.concat ", " idx))
|
||||
base path
|
||||
|
||||
let offset_const (w : gcword) =
|
||||
match w.gpath with
|
||||
| [] -> "0"
|
||||
| p -> Printf.sprintf "ptrtoint (ptr %s to i64)" (path_const "null" p)
|
||||
|
||||
(* A DWARF type node for a Flan type, memoised by the type's printed form so
|
||||
the pool holds one node per distinct type. *)
|
||||
let rec dty m d (t : Types.t) : int =
|
||||
@ -1323,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) =
|
||||
(x.Tast.ty = Types.Dyn || dyn_offsets m x.Tast.ty <> [])
|
||||
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)
|
||||
@ -1361,24 +1583,57 @@ 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 t = Types.Dyn || dyn_offsets 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
|
||||
let want (t : Types.t) = t <> Types.Dyn && dyn_offsets m t <> [] in
|
||||
let want (t : Types.t) = t <> Types.Dyn && traced m t in
|
||||
(* The pinned operands first, as a set of nodes. The checker shares a node
|
||||
between two positions now and then — the same [Local] read in two places
|
||||
— and the backends spill by identity, so a node pinned in one position is
|
||||
@ -1389,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;
|
||||
@ -2248,7 +2506,36 @@ and value_at f (e : Tast.expr) : string =
|
||||
let code, env =
|
||||
match e.Tast.e with
|
||||
| Tast.FnAddr r -> fnaddr f ~loc:e.Tast.loc r, "null"
|
||||
| Tast.Closure (r, env) -> fnaddr f ~loc:e.Tast.loc r, value f env
|
||||
(* The copies, made here as a struct value and stored into an
|
||||
environment the collector allocates. Built before the allocation:
|
||||
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.
|
||||
Counted with the string literals so an expression thunk that makes
|
||||
one keeps its mapping rather than being unloaded under it. *)
|
||||
f.md.nstr <- f.md.nstr + 1;
|
||||
let v = value f copies in
|
||||
let ety = copies.Tast.ty in
|
||||
let desc =
|
||||
match desc_of f.md ety with
|
||||
| Some s -> Printf.sprintf "@\"%s\"" s
|
||||
| None -> "null"
|
||||
in
|
||||
let p = fresh f in
|
||||
ins f
|
||||
"%s = call ptr @flan_dyn_env_new(i64 ptrtoint (ptr getelementptr (%s, \
|
||||
ptr null, i32 1) to i64), ptr %s)"
|
||||
p (ll ety) desc;
|
||||
ins f "store %s %s, ptr %s" (ll ety) v p;
|
||||
fnaddr f ~loc:e.Tast.loc r, p
|
||||
(* The widening: the thunk's code, with the bare address stored where
|
||||
an environment would be. The thunk reads it back out and calls it,
|
||||
which is what keeps every indirect call exactly typed. *)
|
||||
@ -2487,7 +2774,7 @@ and addr f (e : Tast.expr) : string =
|
||||
unrooted copy. [root_plan] counts exactly these two callers. *)
|
||||
and addr_rooted f (e : Tast.expr) : string =
|
||||
if addr_is_place e || e.Tast.ty = Types.Dyn
|
||||
|| dyn_offsets f.md e.Tast.ty = [] then addr f e
|
||||
|| not (traced f.md e.Tast.ty) then addr f e
|
||||
else begin
|
||||
let tmp = agg_tmp f e.Tast.ty in
|
||||
let v = value f e in
|
||||
@ -2798,7 +3085,7 @@ and call_through f ?env ret callee vs =
|
||||
let slot = dyn_tmp f in
|
||||
ins f "store i64 %s, ptr %s" t slot
|
||||
end
|
||||
else if dyn_offsets f.md ret <> [] then begin
|
||||
else if traced f.md ret then begin
|
||||
let slot = agg_tmp f ret in
|
||||
ins f "store %s %s, ptr %s" (ll ret) t slot
|
||||
end;
|
||||
@ -3840,22 +4127,39 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
|
||||
in
|
||||
if nroots > 0 then begin
|
||||
let nparams = List.length fn.Tast.params in
|
||||
(* Zeroing the dyn words at [base], which is the whole of the contract
|
||||
runtime/flan_dyn.h states for a pushed root. *)
|
||||
(* Zeroing the words the collector reads at [base], which is the whole of
|
||||
the contract runtime/flan_dyn.h states for a pushed root: each dyn
|
||||
word, each environment word, and each Vec header's pointer and length.
|
||||
Reached through the word's [gpath], so the store lands where the
|
||||
target lays the word out and not where x86-64 would. *)
|
||||
let zero_dyn base (ty : Types.t) =
|
||||
if ty = Types.Dyn then
|
||||
Buffer.add_string f.allocas (Printf.sprintf " store i64 0, ptr %s\n" base)
|
||||
else
|
||||
else begin
|
||||
let at path =
|
||||
List.fold_left
|
||||
(fun acc (sty, idx) ->
|
||||
let p = Printf.sprintf "%%z%d" f.n in
|
||||
f.n <- f.n + 1;
|
||||
Buffer.add_string f.allocas
|
||||
(Printf.sprintf " %s = getelementptr inbounds %s, ptr %s, %s\n"
|
||||
p sty acc (String.concat ", " idx));
|
||||
p)
|
||||
base path
|
||||
in
|
||||
let store what path =
|
||||
Buffer.add_string f.allocas
|
||||
(Printf.sprintf " store %s, ptr %s\n" what (at path))
|
||||
in
|
||||
let l = gc_layout m ty in
|
||||
List.iter (fun w -> store "i64 0" w.gpath) l.gdyn;
|
||||
List.iter (fun w -> store "ptr null" w.gpath) l.genv;
|
||||
List.iter
|
||||
(fun off ->
|
||||
let p = Printf.sprintf "%%z%d" f.n in
|
||||
f.n <- f.n + 1;
|
||||
Buffer.add_string f.allocas
|
||||
(Printf.sprintf " %s = getelementptr inbounds i8, ptr %s, i64 %d\n"
|
||||
p base off);
|
||||
Buffer.add_string f.allocas
|
||||
(Printf.sprintf " store i64 0, ptr %s\n" p))
|
||||
(dyn_offsets m ty)
|
||||
(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
|
||||
end
|
||||
in
|
||||
let push base (ty : Types.t) =
|
||||
match (if ty = Types.Dyn then None else desc_of m ty) with
|
||||
@ -4532,6 +4836,8 @@ declare i64 @flan_dyn_view_vec(ptr, i32)
|
||||
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()
|
||||
@ -4616,7 +4922,29 @@ 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 (_, env)
|
||||
when (match env.Tast.ty with Types.Ptr _ -> false | _ -> true) ->
|
||||
found := true
|
||||
| _ -> ()
|
||||
in
|
||||
List.iter
|
||||
(fun (fn : Tast.fn) ->
|
||||
List.iter (Tast.walk see) fn.Tast.body;
|
||||
List.iter (Tast.walk see) fn.Tast.fdefers)
|
||||
p.Tast.fns;
|
||||
List.iter (fun (g : Tast.global) -> Tast.walk see g.Tast.ginit) p.Tast.globals;
|
||||
!found
|
||||
|
||||
(* A program that makes a capturing [fn] allocates its environments from the
|
||||
collector, so it has a heap to set up even if no dyn is ever written. *)
|
||||
let uses_dyn (p : Tast.program) =
|
||||
makes_closures p ||
|
||||
let structs = Hashtbl.create 16 in
|
||||
List.iter
|
||||
(fun (s : Tast.structure) -> Hashtbl.replace structs s.Tast.sname s)
|
||||
@ -4662,6 +4990,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
|
||||
@ -4799,7 +5133,8 @@ let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false)
|
||||
unions = Hashtbl.create 16;
|
||||
globals = Hashtbl.create 16;
|
||||
externs = Hashtbl.create 32;
|
||||
checks; dev; known; nstr = 0; nfi = 0; sanitize; ann = annotate;
|
||||
checks; dev; gcfn = dev || makes_closures p;
|
||||
known; nstr = 0; nfi = 0; sanitize; ann = annotate;
|
||||
descs = Hashtbl.create 8;
|
||||
dbg = (if debug then Some (new_dbg p) else None);
|
||||
fsigs = fsigs_of p;
|
||||
@ -4902,35 +5237,61 @@ let dmodule d =
|
||||
Buffer.add_buffer b d.dout;
|
||||
Buffer.contents b
|
||||
|
||||
(* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out
|
||||
by hand: two i64s and a pointer to the offset table. [private] because a
|
||||
redefinition module may name a type the program it patches already named,
|
||||
and a private constant has no symbol for the two to collide over. Sorted, so
|
||||
the .ll is reproducible build to build. *)
|
||||
(* The per-type descriptors, as runtime/flan_dyn.h's [flan_desc] laid out by
|
||||
hand: the size, then a count and a table for each of the three kinds of
|
||||
word. An empty table is a null pointer rather than a zero-length array.
|
||||
[private] because a redefinition module may name a type the program it
|
||||
patches already named, and a private constant has no symbol for the two to
|
||||
collide over. Sorted, so the .ll is reproducible build to build.
|
||||
|
||||
Every offset is a constant expression over the word's [gpath] rather than
|
||||
a number, so the offset is the one the target lays the type out with — on
|
||||
wasm32 a pointer is four bytes, and [goff]'s x86-64 number would name the
|
||||
wrong word. [size] stays [lay]'s number: it is only read as a Vec's
|
||||
element stride, and a Vec's elements are placed at that stride by the
|
||||
[SizeOf] every push is handed. *)
|
||||
let descriptors m =
|
||||
let b = Buffer.create 256 in
|
||||
let table sym suffix ty rows =
|
||||
if rows = [] then "null"
|
||||
else begin
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf "@\"%s.%s\" = private unnamed_addr constant [%d x %s] [%s]\n"
|
||||
sym suffix (List.length rows) ty (String.concat ", " rows));
|
||||
Printf.sprintf "@\"%s.%s\"" sym suffix
|
||||
end
|
||||
in
|
||||
let word (w : gcword) = "i64 " ^ offset_const w in
|
||||
Hashtbl.fold (fun k v acc -> (k, v) :: acc) m.descs []
|
||||
|> List.sort (fun (a, _) (c, _) -> String.compare a c)
|
||||
|> List.iter
|
||||
(fun (_, (sym, offs, size)) ->
|
||||
(fun (_, d) ->
|
||||
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 }"
|
||||
(List.map2
|
||||
(fun ((w : gcword), _) e ->
|
||||
Printf.sprintf "{ i64, ptr } { i64 %s, ptr @\"%s\" }"
|
||||
(offset_const w) e)
|
||||
l.gvec d.dvecs)
|
||||
in
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
"@\"%s.offs\" = private unnamed_addr constant [%d x i64] [%s]\n"
|
||||
sym (List.length offs)
|
||||
(String.concat ", "
|
||||
(List.map (Printf.sprintf "i64 %d") offs)));
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
"@\"%s\" = private unnamed_addr constant { i64, i64, ptr } \
|
||||
{ i64 %d, i64 %d, ptr @\"%s.offs\" }\n"
|
||||
sym size (List.length offs) sym));
|
||||
"@\"%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"
|
||||
d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv)
|
||||
envs (List.length l.gvec) vecs));
|
||||
Buffer.contents b
|
||||
|
||||
(* The same table in the other backend's syntax. It lives here rather than in
|
||||
x86.ml so that the two renderings sit beside each other and the layout the
|
||||
runtime reads is agreed in one place. [.L] so the labels never reach the
|
||||
symbol table, which is what lets a redefinition module name a type the
|
||||
program it patches already named. *)
|
||||
program it patches already named. The offsets are [goff]'s numbers, which
|
||||
are this backend's own layout. *)
|
||||
let descriptors_asm m =
|
||||
let b = Buffer.create 256 in
|
||||
let rows =
|
||||
@ -4939,10 +5300,11 @@ let descriptors_asm m =
|
||||
in
|
||||
if rows <> [] then
|
||||
Buffer.add_string b
|
||||
"\n# The per-type dyn descriptors — runtime/flan_dyn.h's flan_desc: the\n\
|
||||
# size of one instance, how many dyn words it holds, and where they are.\n\
|
||||
# Read by the collector through flan_dyn_root_push_desc and by nothing\n\
|
||||
# else; no value points at one.\n\
|
||||
"\n# The per-type descriptors — runtime/flan_dyn.h's flan_desc: the size\n\
|
||||
# of one instance, then the dyn words, the environment words of its\n\
|
||||
# function values, and the Vec headers whose elements hold either, each\n\
|
||||
# as a count and a table. Read by the collector through\n\
|
||||
# flan_dyn_root_push_desc and flan_dyn_env_new and by nothing else.\n\
|
||||
#\n\
|
||||
# .data.rel.ro and not .rodata, because a descriptor holds the address\n\
|
||||
# of its own offset table. That is a relocation, and a relocation in a\n\
|
||||
@ -4952,20 +5314,41 @@ let descriptors_asm m =
|
||||
# for exactly this: relocated at load and read-only from then on.\n\
|
||||
\t.section\t.data.rel.ro,\"aw\",@progbits\n";
|
||||
List.iter
|
||||
(fun (_, (sym, offs, size)) ->
|
||||
Buffer.add_string b (Printf.sprintf "\t.align\t8\n.L%s.offs:\n" sym);
|
||||
List.iter
|
||||
(fun o -> Buffer.add_string b (Printf.sprintf "\t.quad\t%d\n" o))
|
||||
offs;
|
||||
(fun (_, d) ->
|
||||
let l = d.dlay in
|
||||
let table suffix lines =
|
||||
if lines = [] then "0"
|
||||
else begin
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf "\t.align\t8\n.L%s.%s:\n" d.dsym suffix);
|
||||
List.iter (fun s -> Buffer.add_string b ("\t.quad\t" ^ s ^ "\n")) lines;
|
||||
Printf.sprintf ".L%s.%s" d.dsym suffix
|
||||
end
|
||||
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"
|
||||
(List.concat
|
||||
(List.map2
|
||||
(fun ((w : gcword), _) e -> [ string_of_int w.goff; ".L" ^ e ])
|
||||
l.gvec d.dvecs))
|
||||
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.L%s.offs\n"
|
||||
sym size (List.length offs) sym))
|
||||
"\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"
|
||||
d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv) envs
|
||||
(List.length l.gvec) vecs))
|
||||
rows;
|
||||
Buffer.contents b
|
||||
|
||||
(* The descriptors go after the body, because their offsets are constant
|
||||
expressions over the module's named types and LLVM wants a type defined
|
||||
before a [getelementptr] can size it. A global may be named before it is
|
||||
defined, so the functions that push them are unaffected. *)
|
||||
let finish m =
|
||||
header ^ Buffer.contents m.strs ^ descriptors m ^ "\n" ^ Buffer.contents m.out
|
||||
header ^ Buffer.contents m.strs ^ Buffer.contents m.out ^ "\n" ^ descriptors m
|
||||
^ (if m.sanitize then "\nattributes #0 = { sanitize_address }\n" else "")
|
||||
^ (match m.dbg with None -> "" | Some d -> dmodule d)
|
||||
|
||||
@ -5038,6 +5421,10 @@ let macro_thunk m (fn : Tast.fn) =
|
||||
let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
|
||||
?(sanitize = false) ?(macros = []) ?(hidden = false) ?(annotate = false)
|
||||
(p : Tast.program) : string =
|
||||
(* A dev build places closures under the dev rule: a named callee can be
|
||||
replaced by a redefinition that keeps what it was handed. See
|
||||
[Closures.place]. *)
|
||||
let p = if dev then Closures.dev_program p else p in
|
||||
(* [hidden] and [dev] are opposites and the refusal is here so that they
|
||||
cannot be written together by accident. A dev build's whole point is that
|
||||
its cells, its globals and [flan.abi.*] are in the dynamic symbol table
|
||||
@ -5141,7 +5528,7 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
|
||||
~dyn_globals:
|
||||
(List.filter_map
|
||||
(fun (g : Tast.global) ->
|
||||
if g.Tast.gty = Types.Dyn || dyn_offsets m g.Tast.gty <> []
|
||||
if traced m g.Tast.gty
|
||||
then Some (g.Tast.gname, g.Tast.gty) else None)
|
||||
p.Tast.globals)
|
||||
fn
|
||||
@ -5188,6 +5575,10 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
|
||||
?(known = fun _ -> true) ?(retains = true)
|
||||
?call ?(consts = []) ?(annotate = false) (p : Tast.program) ~fns
|
||||
: string =
|
||||
(* A dev build places closures under the dev rule: a named callee can be
|
||||
replaced by a redefinition that keeps what it was handed. See
|
||||
[Closures.place]. *)
|
||||
let p = if dev then Closures.dev_program p else p in
|
||||
let target name =
|
||||
match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = name) p.Tast.fns with
|
||||
| Some f -> f
|
||||
|
||||
@ -455,13 +455,16 @@ let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) =
|
||||
(fun (s : Tast.structure) ->
|
||||
(* An environment the checker synthesised for a capturing fn is not
|
||||
subject to this rule, and that is not a loophole. The layout rule is
|
||||
about values the running program is *holding*: every other struct can
|
||||
be in a global, in a container, in a frame that is on the stack right
|
||||
now. An environment can be in exactly one place — a slot of the frame
|
||||
the literal was written in — and it is written there by the same
|
||||
module that reads it, on every entry. So editing which locals an fn
|
||||
names is an ordinary body change, and demanding a restart for it
|
||||
would take the dev loop away from the feature it was built for. *)
|
||||
about values the running program reads with code newer than the code
|
||||
that wrote them. An environment is only ever read by the lifted body
|
||||
that was compiled beside the literal that made it: a function value
|
||||
carries that body's own symbol, not a cell, and a redefinition module
|
||||
carries its own copy of every lifted body it replaces. A value made
|
||||
before the reload keeps calling the old body over the old layout —
|
||||
and each environment carries the descriptor it was allocated with —
|
||||
so editing which locals an fn names is an ordinary body change, and
|
||||
demanding a restart for it would take the dev loop away from the
|
||||
feature it was built for. *)
|
||||
if Check.is_env_struct s.Tast.sname then () else
|
||||
match
|
||||
List.find_opt
|
||||
@ -2274,8 +2277,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. *)
|
||||
@ -2311,9 +2316,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 =
|
||||
|
||||
25
lib/tast.ml
25
lib/tast.ml
@ -112,22 +112,23 @@ 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 address of
|
||||
the copies the enclosing frame is holding for it. The environment is a
|
||||
[Make] of a struct the checker synthesised, stored into a slot of the
|
||||
frame the literal was written in, so this node's second half is an
|
||||
[Addr (Plocal _)] and the copies were taken where the value was made.
|
||||
(* 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
|
||||
unrelated readers that want a bare symbol ([Alloc]-typed, see [fnref]),
|
||||
while this is a *value* of type [Fn] and can never be anything else.
|
||||
|
||||
What stops it dangling is the checker, not this node: a value carrying an
|
||||
environment may not leave the frame that owns it, so every position that
|
||||
would outlive the frame is refused. spec-memory.md's case 2, and the
|
||||
escaping half — an environment the collector allocates — is the case the
|
||||
refusals name. *)
|
||||
while this is a *value* of type [Fn] and can never be anything else. *)
|
||||
| Closure of fnref * expr
|
||||
(* A (CFn ...) value where a (Fn ...) is wanted. The one coercion between
|
||||
the two function types, and it goes this way only: there is nowhere for
|
||||
|
||||
57
lib/x86.ml
57
lib/x86.ml
@ -489,7 +489,8 @@ let layout_ctx ~checks ~dev (p : Tast.program) : Emit.m =
|
||||
p.Tast.globals;
|
||||
{ Emit.out = Buffer.create 1; strs = Buffer.create 1; structs; datas; unions;
|
||||
globals; externs = Hashtbl.create 1; checks;
|
||||
dev; known = (fun _ -> true); dbg = None; sanitize = false; ann = false;
|
||||
dev; gcfn = dev || Emit.makes_closures p;
|
||||
known = (fun _ -> true); dbg = None; sanitize = false; ann = false;
|
||||
nstr = 0; nfi = 0; descs = Hashtbl.create 8; fsigs = Emit.fsigs_of p }
|
||||
|
||||
let sizeof md t = fst (Emit.lay md t)
|
||||
@ -1806,17 +1807,43 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
|
||||
let env =
|
||||
match e.Tast.e with
|
||||
| Tast.FnAddr r -> fnaddr_at f ~loc:e.Tast.loc ~reg:rax r; None
|
||||
| Tast.Closure (r, env) -> fnaddr_at f ~loc:e.Tast.loc ~reg:rax r; Some env
|
||||
(* The environment first, into a frame temporary: allocated by the
|
||||
collector, then filled with the copies — every field a read of a
|
||||
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;
|
||||
let ety = copies.Tast.ty in
|
||||
let p = ptmp f in
|
||||
imm_into f ~reg:rdi (Int64.of_int (sizeof f.md ety));
|
||||
(match desc_label f.md ety with
|
||||
| Some l -> lea f.b ~dst:rsi ~mm:(Sym (l, 0))
|
||||
| None -> xor_rr f.b ~dst:rsi ~src:rsi);
|
||||
xor_rr f.b ~dst:rax ~src:rax;
|
||||
call_sym f.b "flan_dyn_env_new";
|
||||
store_int f.b ~src:rax ~mm:(Frame p) ~size:8;
|
||||
lower f copies (Lp (p, 0));
|
||||
fnaddr_at f ~loc:e.Tast.loc ~reg:rax r;
|
||||
Some (`Made p)
|
||||
(* The widening: the thunk's code, with the bare address stored where
|
||||
an environment would be. The thunk reads it back out and calls it,
|
||||
which is what keeps every indirect call exactly typed. *)
|
||||
| Tast.Thicken (n, p) -> addr_sym f ~dst:rax (fsym n); Some p
|
||||
| Tast.Thicken (n, p) -> addr_sym f ~dst:rax (fsym n); Some (`Expr p)
|
||||
| _ -> assert false
|
||||
in
|
||||
store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8;
|
||||
(match env with
|
||||
| None -> xor_rr f.b ~dst:rax ~src:rax
|
||||
| Some ev -> let l = eval f ev in load_loc f ~reg:rax l (Types.Ptr Types.Unit));
|
||||
| Some (`Made p) -> load_int f.b ~dst:rax ~mm:(Frame p) ~size:8 ~signed:false
|
||||
| Some (`Expr ev) ->
|
||||
let l = eval f ev in load_loc f ~reg:rax l (Types.Ptr Types.Unit));
|
||||
store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8
|
||||
| Tast.FnAddr r ->
|
||||
fnaddr_at f ~loc:e.Tast.loc ~reg:rax r;
|
||||
@ -2482,7 +2509,7 @@ and lvalue f (e : Tast.expr) : loc =
|
||||
decided how many of these slots to mint asked that same function. *)
|
||||
and lvalue_rooted f (e : Tast.expr) : loc =
|
||||
if Emit.addr_is_place e || e.Tast.ty = Types.Dyn
|
||||
|| Emit.dyn_offsets f.md e.Tast.ty = [] then lvalue f e
|
||||
|| not (Emit.traced f.md e.Tast.ty) then lvalue f e
|
||||
else begin
|
||||
let o = agg_tmp f e.Tast.ty in
|
||||
lower f e (Lf o);
|
||||
@ -3018,7 +3045,7 @@ and call_flan f ?env ~target ~args ~rty dst =
|
||||
let o = dyn_tmp f in
|
||||
store_int f.b ~src:rax ~mm:(Frame o) ~size:8
|
||||
end
|
||||
else if (not (is_void rty)) && Emit.dyn_offsets f.md rty <> [] then begin
|
||||
else if (not (is_void rty)) && Emit.traced f.md rty then begin
|
||||
let o = agg_tmp f rty in
|
||||
copy_loc f ~dst:(Lf o) ~src:dst (sizeof f.md rty)
|
||||
end
|
||||
@ -4000,7 +4027,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
|
||||
else
|
||||
List.iter
|
||||
(fun d -> store_int f.b ~src:rax ~mm:(Frame (off + d)) ~size:8)
|
||||
(Emit.dyn_offsets f.md ty))
|
||||
(Emit.gc_zero_offsets f.md ty))
|
||||
!droot_zero;
|
||||
List.iter
|
||||
(fun (off, ty) ->
|
||||
@ -4398,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
|
||||
@ -4840,6 +4873,10 @@ let emit_dwarf (dw : dwarf) ~cufile ~tbeg ~tend =
|
||||
(* A whole program as one assembly file. *)
|
||||
let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
||||
(p : Tast.program) : string =
|
||||
(* A dev build places closures under the dev rule: a named callee can be
|
||||
replaced by a redefinition that keeps what it was handed. See
|
||||
[Closures.place]. *)
|
||||
let p = if dev then Closures.dev_program p else p in
|
||||
let md = layout_ctx ~checks ~dev p in
|
||||
let externs = Hashtbl.create 16 in
|
||||
List.iter
|
||||
@ -4979,7 +5016,7 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
||||
~dyn_globals:
|
||||
(List.filter_map
|
||||
(fun (g : Tast.global) ->
|
||||
if g.Tast.gty = Types.Dyn || Emit.dyn_offsets md g.Tast.gty <> []
|
||||
if Emit.traced md g.Tast.gty
|
||||
then Some (g.Tast.gname, g.Tast.gty) else None)
|
||||
p.Tast.globals)
|
||||
md fn)
|
||||
@ -5130,6 +5167,10 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
||||
let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
|
||||
?(retains = true) ?(consts = []) ?call ?(annotate = false)
|
||||
(p : Tast.program) ~fns : string =
|
||||
(* A dev build places closures under the dev rule: a named callee can be
|
||||
replaced by a redefinition that keeps what it was handed. See
|
||||
[Closures.place]. *)
|
||||
let p = if dev then Closures.dev_program p else p in
|
||||
if not dev then
|
||||
unsupported
|
||||
"x86 redefinition without cells: there is nothing to publish a body \
|
||||
|
||||
3
plan.org
3
plan.org
@ -276,7 +276,8 @@ and on a managed ~class~ instance. An ordinary ~struct~ never carries one.
|
||||
pointer with no environment — the only kind that crosses FFI or sits in a reload
|
||||
cell; a *non-escaping* ~fn~ captures enclosing locals by value into a stack
|
||||
environment, which is what ~reduce~ callbacks and ~handler-bind~ handlers use;
|
||||
an *escaping* closure needs a heap environment and is still an open decision.
|
||||
an *escaping* closure's environment is allocated by the collector (built
|
||||
2026-09-25; every capturing ~fn~ takes that path now, see docs/BUILT.md).
|
||||
- No monads, no HKTs, no type classes. Effects are direct; error handling is
|
||||
conditions plus ~Option~ and ~or-else~. Monadic sequencing, if ever wanted, is a
|
||||
macro.
|
||||
|
||||
@ -111,15 +111,40 @@ int8_t flan_vec_push(void *v, const void *elem, int64_t size, int64_t align,
|
||||
|
||||
typedef uint64_t flan_dyn;
|
||||
|
||||
/* A type's dyn map: where the dyn words are inside one instance of it. The
|
||||
* compiler emits one of these per type that has any, as static data, and hands
|
||||
* a pointer to it to [flan_dyn_root_push_desc]. Nothing here ever writes one.
|
||||
* [size] is not read by the collector; it is the stride an array of the type
|
||||
* has, which is what the typed-container view will need. */
|
||||
/* A type's map of the words the collector follows: where they are inside one
|
||||
* instance of it. The compiler emits one of these per type that has any, as
|
||||
* static data, and hands a pointer to it to [flan_dyn_root_push_desc] or
|
||||
* [flan_dyn_env_new]. Nothing here ever writes one.
|
||||
*
|
||||
* Three kinds of word, one table each:
|
||||
*
|
||||
* - [offs]: a dyn word, marked by [mark_value].
|
||||
* - [envs]: the environment half of an (Fn ...) value, pointer-sized. It holds
|
||||
* a collector-allocated environment, null, or — for a named function widened
|
||||
* into an Fn — that function's code address. [mark_env] follows only the
|
||||
* first, and tells them apart by asking [envset] rather than by reading the
|
||||
* word, so a code address is never dereferenced.
|
||||
* - [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.
|
||||
*
|
||||
* [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
|
||||
* collector reads it only through a [vecs] entry's element descriptor. */
|
||||
struct flan_desc;
|
||||
typedef struct flan_desc_vec {
|
||||
int64_t off;
|
||||
const struct flan_desc *elem;
|
||||
} flan_desc_vec;
|
||||
|
||||
typedef struct flan_desc {
|
||||
int64_t size;
|
||||
int64_t n;
|
||||
const int64_t *offs;
|
||||
int64_t size;
|
||||
int64_t n;
|
||||
const int64_t *offs;
|
||||
int64_t nenv;
|
||||
const int64_t *envs;
|
||||
int64_t nvec;
|
||||
const flan_desc_vec *vecs;
|
||||
} flan_desc;
|
||||
|
||||
#define DYN_QNAN 0xFFF8000000000000ULL
|
||||
@ -188,6 +213,10 @@ static inline flan_dyn dyn_make(unsigned tag, uint64_t payload) {
|
||||
#define OBJ_INT 2 /* an i64 too wide for the payload */
|
||||
#define OBJ_MAP 3 /* keys and values interleaved: k0 v0 k1 v1 ... */
|
||||
#define OBJ_VIEW 4 /* a typed container crossing into dyn as a view */
|
||||
#define OBJ_ENV 5 /* a closure's environment: bytes after the header,
|
||||
marked through the descriptor it was made with.
|
||||
Never a dyn value — nothing boxes one — so no tag
|
||||
word, printer or operation ever sees this kind. */
|
||||
|
||||
/* flan_vec, restated. This file must not name flan_rt.c's [flan_vec] — see
|
||||
* the "if either table changes, change both" note above [flan_vec_push] —
|
||||
@ -295,6 +324,10 @@ typedef struct flan_obj {
|
||||
at the crossing, for a slice or a fixed array, neither of which moves.
|
||||
[elem] is one of FLAN_VIEW_I64/F64/BOOL. */
|
||||
struct { void *base; int64_t len; int32_t elem; int32_t is_vec; } view;
|
||||
/* OBJ_ENV: the descriptor the environment's bytes are marked through,
|
||||
or NULL when it holds nothing the collector follows. [len] is the
|
||||
byte count, and the bytes trail the header as a text's do. */
|
||||
struct { const struct flan_desc *desc; } env;
|
||||
/* OBJ_TEXT's bytes trail the header; see [obj_text_bytes]. */
|
||||
} u;
|
||||
} flan_obj;
|
||||
@ -311,7 +344,7 @@ typedef struct flan_obj {
|
||||
* is what keeps a future change to the marking gate from silently trusting
|
||||
* this function's default arm instead of failing loudly. */
|
||||
static inline int64_t obj_words(flan_obj *o) {
|
||||
if (o->kind == OBJ_VIEW) return 0;
|
||||
if (o->kind == OBJ_VIEW || o->kind == OBJ_ENV) return 0;
|
||||
return o->kind == OBJ_MAP ? o->len * 2 : o->len;
|
||||
}
|
||||
|
||||
@ -971,9 +1004,11 @@ static int64_t mstack_n, mstack_cap;
|
||||
static void mark_push(flan_obj *o) {
|
||||
if (o == NULL || o->mark) return;
|
||||
o->mark = 1;
|
||||
/* Only a vec and a map have anything to trace. A text and a boxed int are
|
||||
* leaves, and marking them is the whole of their visit. */
|
||||
if (o->kind != OBJ_VEC && o->kind != OBJ_MAP) return;
|
||||
/* Only a vec, a map and an environment with a descriptor have anything to
|
||||
* trace. A text and a boxed int are leaves, and marking them is the whole
|
||||
* of their visit. */
|
||||
if (o->kind != OBJ_VEC && o->kind != OBJ_MAP
|
||||
&& !(o->kind == OBJ_ENV && o->u.env.desc != NULL)) return;
|
||||
if (mstack_n == mstack_cap) {
|
||||
int64_t cap = mstack_cap ? mstack_cap * 2 : 64;
|
||||
flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m);
|
||||
@ -988,22 +1023,289 @@ static void mark_value(flan_dyn v) {
|
||||
if (dyn_boxed(v) && dyn_box(v) == BOX_OBJ) mark_push(dyn_obj(v));
|
||||
}
|
||||
|
||||
/* ── Environments ──────────────────────────────────────────────────────
|
||||
*
|
||||
* The second word of an (Fn ...) value is one of three things: null, for a
|
||||
* value made from a name or from an fn that captured nothing; the address of
|
||||
* an environment this file allocated; or, for a named function widened into
|
||||
* an Fn, that function's code address, which the widening thunk reads back
|
||||
* and calls. The marker meets all three at the same offset and must follow
|
||||
* only the second.
|
||||
*
|
||||
* Nothing in the word says which. A code address can have any low bits — on
|
||||
* wasm32 it is a table index, a small integer — so no tag bit is free on that
|
||||
* side, and dereferencing one to look for a header would read code or trap.
|
||||
* So the collector keeps the set of environment addresses it has handed out
|
||||
* and follows a word only when the set has it. An address that is not an
|
||||
* 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 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 ptr_hash(uintptr_t p) {
|
||||
uint64_t x = (uint64_t)p;
|
||||
x ^= x >> 33;
|
||||
x *= 0xff51afd7ed558ccdULL;
|
||||
x ^= x >> 33;
|
||||
return x;
|
||||
}
|
||||
|
||||
static void envset_put(uintptr_t p);
|
||||
|
||||
/* 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(NULL, 0, cap * (int64_t)sizeof *envset);
|
||||
envset_cap = cap;
|
||||
envset_n = 0;
|
||||
for (i = 0; i < oldcap; i++)
|
||||
if (old[i] != 0) envset_put(old[i]);
|
||||
free(old);
|
||||
}
|
||||
|
||||
static void envset_put(uintptr_t p) {
|
||||
uint64_t h;
|
||||
if ((envset_n + 1) * 2 > envset_cap)
|
||||
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);
|
||||
}
|
||||
envset[h] = p;
|
||||
envset_n++;
|
||||
}
|
||||
|
||||
static int envset_has(uintptr_t p) {
|
||||
uint64_t h;
|
||||
if (envset_cap == 0 || p == 0) return 0;
|
||||
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);
|
||||
}
|
||||
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);
|
||||
}
|
||||
|
||||
/* ── 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 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);
|
||||
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(NULL, 0, cap * (int64_t)sizeof *v);
|
||||
vstack = v;
|
||||
vstack_cap = cap;
|
||||
}
|
||||
vstack[vstack_n].p = (char *)h->ptr;
|
||||
vstack[vstack_n].n = n;
|
||||
vstack[vstack_n].e = e;
|
||||
vstack_n++;
|
||||
}
|
||||
}
|
||||
|
||||
static void mark_desc(char *base, const flan_desc *d) {
|
||||
mark_words(base, d);
|
||||
while (vstack_n > 0) {
|
||||
vec_work w = vstack[--vstack_n];
|
||||
int64_t i;
|
||||
for (i = 0; i < w.n; i++) mark_words(w.p + i * w.e->size, w.e);
|
||||
}
|
||||
}
|
||||
|
||||
static void gc_mark_all(void) {
|
||||
int64_t i;
|
||||
unsigned k;
|
||||
for (i = 0; i < roots_n; i++) {
|
||||
const flan_desc *d = roots[i].desc;
|
||||
if (d == NULL) mark_value(*(flan_dyn *)roots[i].base);
|
||||
else {
|
||||
int64_t j;
|
||||
for (j = 0; j < d->n; j++)
|
||||
mark_value(*(flan_dyn *)((char *)roots[i].base + d->offs[j]));
|
||||
}
|
||||
else mark_desc((char *)roots[i].base, d);
|
||||
}
|
||||
for (k = 0; k < RING; k++) mark_push(ring[k]);
|
||||
while (mstack_n > 0) {
|
||||
flan_obj *o = mstack[--mstack_n];
|
||||
int64_t n = obj_words(o);
|
||||
int64_t n;
|
||||
if (o->kind == OBJ_ENV) {
|
||||
mark_desc((char *)(o + 1), o->u.env.desc);
|
||||
continue;
|
||||
}
|
||||
n = obj_words(o);
|
||||
for (i = 0; i < n; i++) mark_value(o->u.v.items[i]);
|
||||
}
|
||||
}
|
||||
@ -1018,7 +1320,8 @@ static void gc_sweep(void) {
|
||||
link = &o->next;
|
||||
} else {
|
||||
int64_t held = (int64_t)sizeof(flan_obj);
|
||||
if (o->kind == OBJ_TEXT) held += o->len;
|
||||
if (o->kind == OBJ_TEXT || o->kind == OBJ_ENV) held += o->len;
|
||||
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);
|
||||
@ -1031,6 +1334,20 @@ static void gc_sweep(void) {
|
||||
}
|
||||
o = next;
|
||||
}
|
||||
/* A freed environment's address left the set above, before malloc can hand
|
||||
it out again as something else. */
|
||||
envset_shrink();
|
||||
}
|
||||
|
||||
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))
|
||||
? d : NULL;
|
||||
memset(o + 1, 0, (size_t)size);
|
||||
envset_put((uintptr_t)(o + 1));
|
||||
envs_made++;
|
||||
return (void *)(o + 1);
|
||||
}
|
||||
|
||||
static void root_add(void *base, const flan_desc *d) {
|
||||
@ -1054,7 +1371,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 };
|
||||
static const flan_desc desc_empty = { 0, 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);
|
||||
|
||||
@ -48,16 +48,33 @@ typedef uint64_t flan_dyn;
|
||||
* outer offset plus the inner one, and there is no walking of a type graph at
|
||||
* run time and no second descriptor to follow.
|
||||
*
|
||||
* [size] is the stride of one instance. The collector does not read it; the
|
||||
* typed-container view will, which is the reason it is here now rather than
|
||||
* being added later to data both lanes already emit.
|
||||
* [size] is the stride of one instance, which is what a [vecs] entry's
|
||||
* element descriptor is read for.
|
||||
*
|
||||
* Nothing in this ABI ever writes a descriptor, and no value ever points at
|
||||
* one. See [flan_dyn_root_push_desc]. */
|
||||
* Besides the dyn words, two more kinds of word the collector follows:
|
||||
* [envs], the environment half of each (Fn ...) value inside the instance —
|
||||
* 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.
|
||||
*
|
||||
* Nothing in this ABI ever writes a descriptor. See [flan_dyn_root_push_desc]
|
||||
* and [flan_dyn_env_new]. */
|
||||
struct flan_desc;
|
||||
typedef struct flan_desc_vec {
|
||||
int64_t off;
|
||||
const struct flan_desc *elem;
|
||||
} flan_desc_vec;
|
||||
|
||||
typedef struct flan_desc {
|
||||
int64_t size;
|
||||
int64_t n;
|
||||
const int64_t *offs;
|
||||
int64_t size;
|
||||
int64_t n;
|
||||
const int64_t *offs;
|
||||
int64_t nenv;
|
||||
const int64_t *envs;
|
||||
int64_t nvec;
|
||||
const flan_desc_vec *vecs;
|
||||
} flan_desc;
|
||||
|
||||
/* ── Constructors ──────────────────────────────────────────────────── */
|
||||
@ -390,6 +407,20 @@ void flan_dyn_root_pop(int64_t n);
|
||||
* lifetime of the program; nothing copies it. */
|
||||
void flan_dyn_root_push_desc(void *base, const flan_desc *d);
|
||||
|
||||
/* A closure's environment: [size] zeroed bytes the collector owns, marked
|
||||
* through [d] (NULL when the environment holds nothing to follow). Answers
|
||||
* the address of the first byte, which is what an (Fn ...) value carries as
|
||||
* its second word. The object is in the allocation ring until 64 more
|
||||
* allocations have happened, so the caller has that long to store the
|
||||
* 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.
|
||||
|
||||
@ -1891,6 +1891,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);
|
||||
@ -1923,6 +1933,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
|
||||
@ -2024,6 +2036,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;
|
||||
|
||||
@ -896,7 +896,7 @@ static void desc(void) {
|
||||
(int64_t)offsetof(desc_row, tail)
|
||||
};
|
||||
static const flan_desc row_desc = {
|
||||
(int64_t)sizeof(desc_row), 3, offs
|
||||
(int64_t)sizeof(desc_row), 3, offs, 0, NULL, 0, NULL
|
||||
};
|
||||
desc_row row;
|
||||
flan_dyn was_label, was_note;
|
||||
|
||||
@ -1,9 +1,6 @@
|
||||
;; A dyn is the one thing a capture refuses outright, and for the reason a
|
||||
;; struct field of dyn already refuses: the collector's roots are frames, and
|
||||
;; nothing pushes the fields of the environment struct a capture synthesises.
|
||||
;; A copy in there would be a live value reachable only through memory the
|
||||
;; marker never walks. Milestone 2's per-type descriptors lift it, alongside
|
||||
;; the condition payload's and the struct field's.
|
||||
;; A dyn captured by an fn. The copy lives in the fn's environment, which the
|
||||
;; collector allocated and marks through the environment's descriptor, so the
|
||||
;; value it names stays alive for as long as the function value does.
|
||||
(defn run [f (Fn [] i64)] i64 (f))
|
||||
|
||||
;; [d] is unannotated, which is what makes it a dyn.
|
||||
|
||||
8
test/programs/fn-dev-escape.flan
Normal file
8
test/programs/fn-dev-escape.flan
Normal file
@ -0,0 +1,8 @@
|
||||
;; [store] only calls what it is handed, so in a release build [go]'s closure
|
||||
;; stays on go's frame. In a dev build [store] can be redefined to keep it —
|
||||
;; (set kept (Some f)) — and only [store] is recompiled, so [go] must already
|
||||
;; have made its closure on the collector's heap.
|
||||
(defonce kept (Option (Fn [i64] i64)))
|
||||
(defn store [f (Fn [i64] i64)] () (println (f 0)))
|
||||
(defn go [n i64] () (store (fn [x] (+ x n))))
|
||||
(defn main [] i32 (go 5) 0)
|
||||
@ -1,13 +0,0 @@
|
||||
;; An index read is a read, and the escape check's clean list has to be a
|
||||
;; list. A function value out of a slice is refused exactly as one out of a
|
||||
;; Vec, a struct or a pointer is — the four are the same act and there is no
|
||||
;; reason for a reader to have to remember which spellings were enumerated.
|
||||
;;
|
||||
;; Not reachable today: nothing can write an Fn into a slice, because every
|
||||
;; position that would have to hold one is refused. It is here so that the
|
||||
;; day one can, this is already true — the alternative was a default of
|
||||
;; "clean" for anything the enumeration had not thought of, which is how a
|
||||
;; closed list quietly stops being closed.
|
||||
(defn leak [s [(Fn [] i32)]] (Fn [] i32) (at s 0))
|
||||
|
||||
(defn main [] i32 0)
|
||||
@ -1,19 +0,0 @@
|
||||
;; The hole a capture could otherwise be laundered through, and the reason
|
||||
;; "the result of a call is clean" is a rule and not a hope.
|
||||
;;
|
||||
;; [sneak]'s literal captures [g], so its body holds a *copy* of a function
|
||||
;; value that may itself carry an environment — and the copy is read out of an
|
||||
;; environment, which is the one aggregate a function value is ever stored in.
|
||||
;; If a copy read back out were treated as clean, the literal could return it,
|
||||
;; the return would arrive at [sneak]'s caller as an ordinary call result, and
|
||||
;; a capturing value would be out of the frame that owns it with nothing
|
||||
;; having refused anything.
|
||||
;;
|
||||
;; So a function value read out of a struct, a case or a pointer is suspect,
|
||||
;; and the refusal lands inside the lifted body where the return is written.
|
||||
(defn getf [f (Fn [] (Fn [] i32))] (Fn [] i32) (f))
|
||||
|
||||
(defn sneak [g (Fn [] i32)] (Fn [] i32)
|
||||
(getf (fn [] g)))
|
||||
|
||||
(defn main [] i32 0)
|
||||
@ -1,12 +0,0 @@
|
||||
;; A handler-bind is an expression and its value is its body's, so it is a way
|
||||
;; for a function value to be a function's answer — and it would have walked
|
||||
;; straight past a check that only looked at [return] and at the last form of
|
||||
;; a block. with-allocator and restart-case are the same shape and are checked
|
||||
;; the same way.
|
||||
(defstruct C [id i32])
|
||||
(defonce seen i32)
|
||||
|
||||
(defn keep [f (Fn [] i32)] (Fn [] i32)
|
||||
(handler-bind [(C [c] (set seen (.id c)))] f))
|
||||
|
||||
(defn main [] i32 0)
|
||||
@ -1,16 +0,0 @@
|
||||
;; A match arm's binding is a binding, and the escape check has to see it.
|
||||
;;
|
||||
;; Reading the payload by hand is a case-field read, which is suspect: a copy
|
||||
;; of a function value carries whatever environment the original did. Binding
|
||||
;; it to a name in an arm is the same read, and the store that fills the arm's
|
||||
;; slot is inside the branch rather than in any form the walk reads as a
|
||||
;; binding — so without the arm's slots being taken as suspect too, the Vec,
|
||||
;; slice, struct and pointer spellings of this were all refused while the one
|
||||
;; that goes through Option and a name was not.
|
||||
|
||||
(defn leak [o (Option (Fn [] i32))] (Fn [] i32)
|
||||
(match o
|
||||
(Some f) f
|
||||
None (fn [] 0)))
|
||||
|
||||
(defn main [] i32 0)
|
||||
@ -1,11 +0,0 @@
|
||||
;; The hard case, answered without looking at a single call site: a function
|
||||
;; value that arrives as a parameter may carry an environment on its caller's
|
||||
;; frame, so a function that *stores* one is refused where it is written.
|
||||
;;
|
||||
;; That is what makes passing a capturing fn down safe everywhere — no callee
|
||||
;; can keep it — and it is also the conservative half: this particular [keep]
|
||||
;; would be harmless for a caller that passed a name, and there is no way for
|
||||
;; the definition to know that it did.
|
||||
(defn keep [f (Fn [] i32)] (Fn [] i32) f)
|
||||
|
||||
(defn main [] i32 (println ((keep (fn [] 1)))) 0)
|
||||
@ -1,10 +0,0 @@
|
||||
;; The refusal that defines "non-escaping". The copies live in a slot of
|
||||
;; [make]'s frame, and the value would still be pointing at them after that
|
||||
;; frame has gone.
|
||||
;;
|
||||
;; A returned function value is still fine when it captures nothing —
|
||||
;; fn-values.flan returns one — so this is about the environment and not about
|
||||
;; the shape of the value.
|
||||
(defn make [n i32] (Fn [] i32) (fn [] n))
|
||||
|
||||
(defn main [] i32 (println ((make 3))) 0)
|
||||
@ -1,7 +0,0 @@
|
||||
;; A store through a pointer is the same escape wearing a different hat: the
|
||||
;; pointer names storage this frame does not own, so the value would outlive
|
||||
;; the environment it carries.
|
||||
(defn stash [p (Ptr (Fn [] i32)) f (Fn [] i32)] ()
|
||||
(set (deref p) f))
|
||||
|
||||
(defn main [] i32 0)
|
||||
@ -1,9 +0,0 @@
|
||||
;; A Vec's elements are in a block the allocator owns and the frame does not,
|
||||
;; so a function value pushed into one outlives whatever environment it
|
||||
;; carries. Refused for that, and not for the shape of the element type: a Vec
|
||||
;; of function values is a perfectly good thing to want, and is what case 3
|
||||
;; is for.
|
||||
(defn stash [v (Vec (Fn [] i32)) f (Fn [] i32)] ()
|
||||
(push v f))
|
||||
|
||||
(defn main [] i32 0)
|
||||
215
test/programs/fn-escape.flan
Normal file
215
test/programs/fn-escape.flan
Normal file
@ -0,0 +1,215 @@
|
||||
;; Closures that outlive the frame they were made in. The environment is
|
||||
;; allocated by the collector, so a capturing fn may be returned, kept in a
|
||||
;; Vec, an Option field of a struct or a global, and called after any number
|
||||
;; of collections. Every line below is called after a forced collection that
|
||||
;; would have freed an environment nobody rooted.
|
||||
;;
|
||||
;; Capture is by value: the environment holds copies of the locals taken when
|
||||
;; the fn was made. A counter shares state through a captured dyn map, which
|
||||
;; is a reference to one object on the collector's heap.
|
||||
|
||||
(declare gc-collect [] () "flan_gc_collect")
|
||||
|
||||
(defn churn [] ()
|
||||
(let [i 0]
|
||||
(while (< i 2000)
|
||||
(let [v (vec-new dyn)] (push v i) (push v "junk"))
|
||||
(set i (+ i 1))))
|
||||
(gc-collect))
|
||||
|
||||
(defn make-adder [n i64] (Fn [i64] i64)
|
||||
(fn [x] (+ x n)))
|
||||
|
||||
;; Two captures deep: the inner fn captures the outer one's copy of [base],
|
||||
;; and the returned value captures a function value that captures.
|
||||
(defn make-scaled [base i64 k i64] (Fn [i64] i64)
|
||||
(let [add (make-adder base)]
|
||||
(fn [x] (* k (add x)))))
|
||||
|
||||
(defn keep [f (Fn [i64] i64)] (Fn [i64] i64) f)
|
||||
|
||||
;; A function value read back out of an environment and handed on: [sneak]'s
|
||||
;; literal captures [g], and [getf] returns the copy.
|
||||
(defn getf [f (Fn [] (Fn [i64] i64))] (Fn [i64] i64) (f))
|
||||
(defn sneak [g (Fn [i64] i64)] (Fn [i64] i64) (getf (fn [] g)))
|
||||
|
||||
;; Stored through a pointer into a slot of the caller's frame.
|
||||
(defn stash [p (Ptr (Fn [i64] i64)) f (Fn [i64] i64)] () (set (deref p) f))
|
||||
|
||||
(defn make-counter [] (Fn [] i64)
|
||||
(let [st {:n 0}]
|
||||
(fn []
|
||||
(put st :n (+ (get st :n) 1))
|
||||
(i64 (get st :n)))))
|
||||
|
||||
;; A dyn captured and returned: the text is on the collector's heap and
|
||||
;; reachable only through the environment.
|
||||
(defn make-greeter [who] (Fn [] i64)
|
||||
(let [msg (vec-new dyn)]
|
||||
(push msg who)
|
||||
(push msg "and")
|
||||
(push msg who)
|
||||
(fn [] (i64 (length msg)))))
|
||||
|
||||
(defstruct Button [label string on-click (Option (Fn [] i64))])
|
||||
|
||||
(defonce handler (Option (Fn [i64] i64)))
|
||||
|
||||
(defn call-opt [o (Option (Fn [i64] i64)) x i64] i64
|
||||
(match o
|
||||
(Some f) (f x)
|
||||
None -1))
|
||||
|
||||
(defn double [x i64] i64 (* 2 x))
|
||||
|
||||
;; 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.
|
||||
(defstruct Ping [n i64])
|
||||
(defonce heard i64)
|
||||
(defn pinged [x i64] i64 (signal (Ping {.n x})) x)
|
||||
|
||||
(defn keep-handled [f (Fn [i64] i64)] (Fn [i64] i64)
|
||||
(handler-bind [(Ping [c] (set heard 0))] f))
|
||||
|
||||
(defn handled [] ()
|
||||
(let [names (vec-new dyn)
|
||||
f (make-adder 50)]
|
||||
(push names "a")
|
||||
(push names "b")
|
||||
(handler-bind [(Ping [c] (churn) (set heard (+ (f (.n c)) (i64 (length names)))))]
|
||||
(pinged 1))
|
||||
(println heard)))
|
||||
|
||||
;; A data type's case holding a function value, in a Vec, and a Vec of Vecs.
|
||||
;; The collector names every case's function-value word and follows only the
|
||||
;; ones that hold an environment it made.
|
||||
(defdata Action
|
||||
[Idle
|
||||
(Run [f (Option (Fn [i64] i64)) n i64])
|
||||
(Pair [k i64 g (Option (Fn [i64] i64))])])
|
||||
|
||||
(defn act [a Action x i64] i64
|
||||
(match a
|
||||
Idle 0
|
||||
(Run f n) (+ n (call-opt f x))
|
||||
(Pair k g) (+ k (call-opt g x))))
|
||||
|
||||
(defn shapes [] ()
|
||||
(let [acts (vec-new Action)
|
||||
a (arena-new 65536)
|
||||
outer (vec-new (Vec (Fn [i64] i64)) a)]
|
||||
(push acts (Action.Run {.f (Some (make-adder 1)) .n 10}))
|
||||
(push acts (Action.Pair {.k 20 .g (Some (make-adder 2))}))
|
||||
(push acts Action.Idle)
|
||||
(let [inner (vec-new (Fn [i64] i64) a)]
|
||||
(push inner (make-adder 3))
|
||||
(push outer inner))
|
||||
(churn)
|
||||
(println (+ (act (at acts 0) 1) (+ (act (at acts 1) 1) (act (at acts 2) 1)))
|
||||
((at (at outer 0) 0) 1))))
|
||||
|
||||
;; A data type holding a Vec of itself: the collector walks as deep as the
|
||||
;; data goes, and the function value two levels down is still found.
|
||||
(defdata Tree [(Node [f (Option (Fn [i64] i64)) kids (Vec Tree)])])
|
||||
|
||||
(defn tree-sum [t Tree x i64] i64
|
||||
(match t
|
||||
(Node f kids)
|
||||
(let [s (call-opt f x)
|
||||
i 0]
|
||||
(while (< i (length kids))
|
||||
(set s (+ s (tree-sum (at kids i) x)))
|
||||
(set i (+ i 1)))
|
||||
s)))
|
||||
|
||||
(defn trees [] ()
|
||||
(let [a (arena-new 65536)
|
||||
leaf-kids (vec-new Tree a)
|
||||
kids (vec-new Tree a)]
|
||||
(push kids (Tree.Node {.f (Some (make-adder 5)) .kids leaf-kids}))
|
||||
(let [root (Tree.Node {.f None .kids kids})]
|
||||
(churn)
|
||||
(println (tree-sum root 1)))))
|
||||
|
||||
;; Environments nobody holds are collected: a hundred thousand of them made
|
||||
;; and dropped leave the heap as small as it was.
|
||||
(declare gc-live-bytes [] i64 "flan_gc_live_bytes")
|
||||
|
||||
(defn many [] ()
|
||||
(let [sum (i64 0)]
|
||||
(dotimes [i 100000]
|
||||
(set sum (+ sum ((make-adder 1) 0))))
|
||||
(gc-collect)
|
||||
(println sum (< (gc-live-bytes) 1000000))))
|
||||
|
||||
(defn main [] i32
|
||||
;; Returned, then called after a collection.
|
||||
(let [add5 (make-adder 5)]
|
||||
(churn)
|
||||
(println (add5 10)))
|
||||
;; Nested, and passed through a function that hands its parameter back.
|
||||
(let [f (keep (make-scaled 1 3))]
|
||||
(churn)
|
||||
(println (f 4)))
|
||||
;; Out of an environment, through a handler-bind's value, and through a
|
||||
;; pointer.
|
||||
(let [f (keep-handled (sneak (make-adder 20)))
|
||||
slot (make-adder 0)]
|
||||
(stash (addr slot) (make-adder 7))
|
||||
(churn)
|
||||
(println (f 1) (slot 1)))
|
||||
;; Held beside a sibling operand that collects.
|
||||
(let [n 40]
|
||||
(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]
|
||||
(while (< i 5)
|
||||
(push fs (make-adder (* i 100)))
|
||||
(set i (+ i 1))))
|
||||
(push fs double)
|
||||
(churn)
|
||||
(let [total (i64 0)]
|
||||
(let [i 0]
|
||||
(while (< i (length fs))
|
||||
(set total (+ total ((at fs i) 1)))
|
||||
(set i (+ i 1))))
|
||||
(println total)))
|
||||
;; A counter over a captured dyn map: two calls on one value see one state.
|
||||
(let [c (make-counter)]
|
||||
(c)
|
||||
(churn)
|
||||
(c)
|
||||
(println (c)))
|
||||
;; A captured dyn.
|
||||
(let [g (make-greeter "world")]
|
||||
(churn)
|
||||
(println (g)))
|
||||
;; A struct field and a global, both through Option.
|
||||
(let [b (Button {.label "ok" .on-click (Some (make-counter))})]
|
||||
(churn)
|
||||
(match (.on-click b)
|
||||
(Some f) (do (f) (println (f)))
|
||||
None (println "none")))
|
||||
(set handler (Some (make-adder 1000)))
|
||||
(churn)
|
||||
(println (call-opt handler 7))
|
||||
(handled)
|
||||
(shapes)
|
||||
(trees)
|
||||
(many)
|
||||
0)
|
||||
9
test/programs/fn-in-map.flan
Normal file
9
test/programs/fn-in-map.flan
Normal file
@ -0,0 +1,9 @@
|
||||
;; 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.
|
||||
(defn main [] i32
|
||||
(let [ops (map-new string (Fn [i32] i32))]
|
||||
(put ops "id" (fn [x] x))
|
||||
0))
|
||||
@ -5,11 +5,9 @@
|
||||
;; left to crash at the call, and the same rule covers a global, a fixed
|
||||
;; array's element and (zeroed).
|
||||
;;
|
||||
;; Capture sharpened the reason behind this one without changing it. A struct
|
||||
;; outlives the frame it was built on, so a field could not hold a value
|
||||
;; carrying an environment either — see fn-escape-*.flan. The zero is still
|
||||
;; what the message names, because it is the objection that applies to every
|
||||
;; function value and not only to a capturing one.
|
||||
;; The zero is the whole objection: a capturing value's environment belongs to
|
||||
;; the collector and may be kept anywhere, and (Option (Fn ...)) is the field
|
||||
;; that holds one — see fn-escape.flan.
|
||||
;;
|
||||
;; Which means a (CFn ...) field is refused too, and for the zero alone —
|
||||
;; a table of function pointers is exactly what that type is for, and nothing
|
||||
|
||||
@ -1,7 +1,6 @@
|
||||
;; Function values, and specifically the ones with no environment. Nothing
|
||||
;; here captures, which is what makes every one of these safe to return and to
|
||||
;; hand around — fn-capture.flan is the other half, and fn-escape-*.flan is
|
||||
;; the line between them.
|
||||
;; here captures — fn-capture.flan is the other half, and fn-escape.flan is a
|
||||
;; capturing value outliving the frame that made it.
|
||||
;;
|
||||
;; Every signature below says (Fn ...), which is the wide one: it admits a
|
||||
;; capturing value and so pays for a two-word value and a widening thunk where
|
||||
|
||||
40
test/programs/fn-vec-stale.flan
Normal file
40
test/programs/fn-vec-stale.flan
Normal 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)
|
||||
@ -3471,6 +3471,10 @@ let () =
|
||||
local: kept 42\naggregate: kept 42\nnested: kept 42\n\
|
||||
fn value: kept 42\nindex: kept 42\nfield index: kept 42\n"
|
||||
in
|
||||
(* And [programs/fn-escape.flan]'s, for the same reason. *)
|
||||
let fn_escape_out =
|
||||
"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".
|
||||
|
||||
@ -3590,7 +3594,15 @@ let () =
|
||||
value held beside a sibling that collects is rooted through the
|
||||
same explicit slots there as natively. *)
|
||||
wasm_case "dyn: an operand held while a sibling collects, wasm32"
|
||||
"programs/dyn-held-operand.flan" dyn_held_out));
|
||||
"programs/dyn-held-operand.flan" dyn_held_out;
|
||||
(* Closures under collection, where a pointer is four bytes: an
|
||||
Fn's environment word is at offset 4, and a descriptor written
|
||||
with x86-64's numbers marks the wrong word — the counter line
|
||||
then reads a freed map. *)
|
||||
wasm_case "an fn that outlives its frame, wasm32"
|
||||
"programs/fn-escape.flan" fn_escape_out;
|
||||
wasm_case "an fn that outlives its frame, wasm32, -O0" ~opt:"-O0"
|
||||
"programs/fn-escape.flan" fn_escape_out));
|
||||
|
||||
(* The EDN tokenizer, and the struct reader written by hand against it
|
||||
(vendor/edn, test/programs/edn.flan). The expected output is a raw
|
||||
@ -4300,11 +4312,9 @@ level "1"
|
||||
outputs ~opt:"-O0" "the prelude's map, filter, reduce and sort-by, -O0"
|
||||
"programs/higher-order.flan" higher_order_out;
|
||||
|
||||
(* Capture by value into a stack environment — spec-memory.md's case 2.
|
||||
Three opt levels for the reason the case above has them, and for one
|
||||
more: the environment is a struct in the frame and the value carries
|
||||
its address, which is exactly the shape -O2 is entitled to make
|
||||
disappear. -O0 is what proves there is a real store and a real load
|
||||
(* Capture by value. Three opt levels for the reason the case above has
|
||||
them, and for one more: the value carries the address of the copies,
|
||||
which is exactly the shape -O2 is entitled to make disappear. -O0 is what proves there is a real store and a real load
|
||||
behind it. A dev build is here because the value's code half still
|
||||
comes out of the indirection cell and the environment half must not
|
||||
have disturbed that.
|
||||
@ -4378,32 +4388,43 @@ level "1"
|
||||
outputs ~dev:true "an fn capturing by value, dev" "programs/fn-capture.flan"
|
||||
fn_capture_out;
|
||||
|
||||
(* What function values do *not* include, each refused by name. Escape is
|
||||
the headline now that capture is not: the copies live in the frame the
|
||||
literal was written in, so a value carrying their address may be
|
||||
called, passed down and copied about, and may not outlive that frame.
|
||||
Each of these names case 3 — the collector-allocated environment —
|
||||
because "not yet" is the true sentence. *)
|
||||
refuses "a captured fn cannot be returned" "programs/fn-escape-return.flan"
|
||||
"a return would outlive the frame";
|
||||
refuses "a function value parameter cannot be kept"
|
||||
"programs/fn-escape-param.flan" "may carry an environment";
|
||||
refuses "a function value cannot be stored through a pointer"
|
||||
"programs/fn-escape-store.flan" "a store would outlive the frame";
|
||||
refuses "a function value cannot be pushed into a Vec"
|
||||
"programs/fn-escape-vec.flan" "a container would outlive the frame";
|
||||
(* The two an escape check written by eye would have missed. A function
|
||||
value read back out of an environment is a copy of something that may
|
||||
carry one, and a handler-bind is an expression whose value is its
|
||||
body's — so both are ways for a suspect to be a function's answer. *)
|
||||
refuses "an index read is a read like any other"
|
||||
"programs/fn-escape-at.flan" "may carry an environment";
|
||||
refuses "a match arm's binding is a binding"
|
||||
"programs/fn-escape-match.flan" "may carry an environment";
|
||||
refuses "a captured function value cannot be handed back"
|
||||
"programs/fn-escape-copy.flan" "a return would outlive the frame";
|
||||
refuses "a handler-bind's value is a return too"
|
||||
"programs/fn-escape-handled.flan" "a return would outlive the frame";
|
||||
(* Closures that outlive their frame: spec-memory.md's case 3. The
|
||||
environment is allocated by the collector, so a capturing fn is
|
||||
returned, passed through a function that hands it back, held as an
|
||||
argument while the next one collects, read back out
|
||||
of another fn's environment, stored through a pointer, pushed into a
|
||||
Vec beside a widened name, kept in an Option field and an Option
|
||||
global, and called after a forced collection every time. The counter
|
||||
shares state through a captured dyn map; a handler clause captures a
|
||||
dyn and a closure; and a hundred thousand dropped environments leave
|
||||
the heap small, which is the line that fails if they are never freed.
|
||||
With the collector not marking environments, valgrind reports reads of
|
||||
freed blocks on this program and the counter line traps. *)
|
||||
outputs "an fn that outlives its frame" "programs/fn-escape.flan"
|
||||
fn_escape_out;
|
||||
outputs ~opt:"-O0" "an fn that outlives its frame, -O0"
|
||||
"programs/fn-escape.flan" fn_escape_out;
|
||||
outputs ~x86:true "an fn that outlives its frame, --x86"
|
||||
"programs/fn-escape.flan" fn_escape_out;
|
||||
outputs ~dev:true "an fn that outlives its frame, dev"
|
||||
"programs/fn-escape.flan" fn_escape_out;
|
||||
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
|
||||
left to change the copy and not the local. *)
|
||||
refuses "a captured local is a copy and cannot be assigned"
|
||||
"programs/fn-capture-set.flan" "cannot assign to n";
|
||||
(* The two function types, and the line between them. A CFn is the bare
|
||||
@ -4413,8 +4434,6 @@ level "1"
|
||||
"programs/fn-cfn-captures.flan" "and not a (CFn [i32] i32)";
|
||||
refuses "an Fn does not narrow to a CFn"
|
||||
"programs/fn-cfn-narrow.flan" "expected (CFn [i32] i32)";
|
||||
refuses "an fn cannot capture a dyn" "programs/fn-capture-dyn.flan"
|
||||
"the collector finds its roots by frame";
|
||||
refuses "an fn with no type to take" "programs/fn-no-type.flan"
|
||||
"nothing here says what this fn";
|
||||
refuses "a function value would be zeroed" "programs/fn-in-struct.flan"
|
||||
@ -5303,7 +5322,7 @@ level "1"
|
||||
(List.filter
|
||||
(fun line ->
|
||||
contains line prefix
|
||||
&& contains line "constant { i64, i64, ptr }")
|
||||
&& contains line "constant { i64, i64, ptr, i64, ptr, i64, ptr }")
|
||||
(String.split_on_char '\n' ir))
|
||||
in
|
||||
if n <> want then begin
|
||||
@ -5402,6 +5421,105 @@ level "1"
|
||||
[the global ...] sites and two [the return type of ...] ones, which a
|
||||
walk over function bodies alone would never have found. *)
|
||||
no_gc_sites "programs/dyn-global.flan" 6;
|
||||
(* 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;
|
||||
(* A dev build cannot trust what a named callee does with a closure: a
|
||||
redefinition of the callee recompiles the callee alone. So [go]'s
|
||||
closure is on the heap in both dev backends and on the frame in a
|
||||
release build. The text between go's entry and the next function is
|
||||
asked, which is enough to tell the two apart. *)
|
||||
(let path = "programs/fn-dev-escape.flan" in
|
||||
let l = Load.program ~file:path (Reader.read_file path) in
|
||||
let p = Check.program_all l.Load.decls in
|
||||
(* From go's entry to the end of its body. *)
|
||||
let go_part key text =
|
||||
let n = String.length text and k = String.length key in
|
||||
let rec find i =
|
||||
if i + k > n then None
|
||||
else if String.sub text i k = key then Some i else find (i + 1)
|
||||
in
|
||||
match find 0 with
|
||||
| None -> ""
|
||||
| Some i ->
|
||||
let rest = String.sub text i (n - i) in
|
||||
let m = String.length rest in
|
||||
let rec close j =
|
||||
if j + 2 > m then m
|
||||
else if rest.[j] = '\n' && rest.[j + 1] = '}' then j
|
||||
else close (j + 1)
|
||||
in
|
||||
if key.[0] = 'd' then String.sub rest 0 (close 0)
|
||||
else String.sub rest 0 (min 4000 m)
|
||||
in
|
||||
let heap_ll text = contains (go_part "define {} @\"flan.go\"" text) "flan_dyn_env_new" in
|
||||
let heap_x86 text = contains (go_part "\"flan.go\":" text) "flan_dyn_env_new" in
|
||||
if heap_ll (Emit.program ~dev:false p) then begin
|
||||
incr failures;
|
||||
print_endline "FAIL a release build moved a frame closure to the heap"
|
||||
end;
|
||||
if not (heap_ll (Emit.program ~dev:true p)) then begin
|
||||
incr failures;
|
||||
print_endline "FAIL a dev build left a closure handed to a named call on the frame"
|
||||
end;
|
||||
if not (heap_x86 (X86.program ~checks:true ~dev:true p)) then begin
|
||||
incr failures;
|
||||
print_endline
|
||||
"FAIL a dev --x86 build left a closure handed to a named call on the frame"
|
||||
end);
|
||||
(* 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
|
||||
no root push and no collector start-up in it. *)
|
||||
List.iter
|
||||
(fun path ->
|
||||
let l = Load.program ~file:path (Reader.read_file path) in
|
||||
let ir = Emit.program (Check.program_all l.Load.decls) in
|
||||
if contains ir "call void @flan_dyn_root_push"
|
||||
|| contains ir "call void @flan_gc_init" then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL %s roots or starts the collector with no capture in it\n"
|
||||
path
|
||||
end)
|
||||
[ "programs/fn-values.flan"; "programs/higher-order.flan" ];
|
||||
|
||||
(* The other half, and the reason the flag is a pass and not a parameter of
|
||||
[Emit]: a program with nothing to refuse compiles to the same bytes with
|
||||
|
||||
@ -7128,6 +7128,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)
|
||||
|
||||
@ -6437,6 +6437,22 @@ let () =
|
||||
"may allocate: a push past the Vec's capacity grows it through its \
|
||||
allocator") ];
|
||||
|
||||
(* 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))\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
|
||||
capacity of zero and takes none. Same runtime entry point, two answers,
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user