An Allocator value is its record and the incarnation it was made for, so one kept past its arena-destroy traps at every use even after arena-new reuses the record
This commit is contained in:
parent
c9eb425ed1
commit
c116237621
15
TODO.org
15
TODO.org
@ -1315,10 +1315,8 @@ No ordering of the frees fixes it: the container holds a pointer to the header.
|
||||
allocator header — epoch bumped, procedure trapping as =DestroyedAllocator=,
|
||||
never freed — so the stale check reads live memory on every side that makes it.
|
||||
The next =arena-new= takes a retired header back, epoch kept, so a loop of them
|
||||
stays flat and a container made before the destroy still traps. An =Allocator=
|
||||
value kept past its destroy names the new arena once its header is reused.
|
||||
Rules out freeing the header while any container may hold it. The
|
||||
=DestroyedAllocator= trap prints no site: the allocator procedure is given none. See
|
||||
stays flat and a container made before the destroy still traps.
|
||||
Rules out freeing the header while any container may hold it. See
|
||||
docs/BUILT.md, "Three amendments to a frozen spec".
|
||||
|
||||
** DONE Map removal costs a backward-shift loop
|
||||
@ -1501,11 +1499,10 @@ Deleted, in a sweep for dead code across the repository in which each removal
|
||||
was first shown unused. flan_dyn.c is the one implementation of the flan_dyn.h
|
||||
ABI; a stand-in beside it is not to come back.
|
||||
|
||||
** NEXT A destroyed arena always traps, even after its record is reused
|
||||
Decided 2026-09-25: an Allocator value is two words, the record and the
|
||||
incarnation it was made for; every use compares the incarnation, so a destroyed
|
||||
arena traps whether or not a later arena-new reused its record. Rules out
|
||||
static tracking of destroy, which is move semantics.
|
||||
** DONE A destroyed arena always traps, even after its record is reused
|
||||
CLOSED: [2026-09-25]
|
||||
An Allocator value is the record and the incarnation it was made for, compared on every use.
|
||||
Rules out static tracking of destroy, which is move semantics. docs/BUILT.md has the cost.
|
||||
|
||||
** NEXT A mixed array literal with no want is a dyn vector
|
||||
Decided 2026-09-25: with nothing expected of it, an array literal whose elements
|
||||
|
||||
@ -2768,10 +2768,10 @@ What *does* need milestone 5 is a **user-written** allocator: "here is my proc,
|
||||
`defn`'s name in value position. `make-allocator`, `allocator-from` and `allocator` are refused by name with that
|
||||
reason, rather than coming back as unknown functions.
|
||||
|
||||
**An `Allocator` value is a pointer to the runtime's struct, never a copy of one.** That is forced, not chosen. The
|
||||
**An `Allocator` value names the runtime's struct, never a copy of one.** That is forced, not chosen. The
|
||||
capability set has to be readable from wherever a container landed, and `free-all` bumps an epoch every container made
|
||||
from the allocator has to observe. A copied-by-value allocator gives each copy its own epoch and the dev trap never
|
||||
fires.
|
||||
fires. The value is two words: the struct's address and the incarnation of it the value was made for (see below).
|
||||
|
||||
### The surface
|
||||
|
||||
@ -2836,9 +2836,16 @@ turned the trap into a read of freed memory that happened to see the bumped valu
|
||||
retired instead — epoch bumped, procedure swapped for one that traps as `DestroyedAllocator`, never freed — and put on a
|
||||
list that the next `arena-new` takes from. The epoch is kept on reuse: it only ever rises on a header, so a container
|
||||
made before the destroy still records an older number and still traps. Keeping every retired header instead grew
|
||||
without bound — ten million `arena-new`/`arena-destroy` rounds peaked at 626 MB against 1.7 MB. The cost of reuse is
|
||||
an `Allocator` value kept past its destroy: while its header is on the list it traps, and once a later `arena-new` has
|
||||
taken the header it names that new arena. A second `arena-destroy` of the same allocator, before reuse, does nothing.
|
||||
without bound — ten million `arena-new`/`arena-destroy` rounds peaked at 626 MB against 1.7 MB.
|
||||
|
||||
Reuse would let an `Allocator` value kept past its destroy name the next arena to take its header, so the value carries
|
||||
the header's *incarnation*, which the retire bumps, and every use of a value (`flan_alloc_use`) compares the two. A
|
||||
stale value traps as `DestroyedAllocator` at the site that used it, reused header or not, a second `arena-destroy`
|
||||
included. The incarnation is its own counter rather than the epoch, because `free-all` keeps the arena and a value made
|
||||
before one is still good. Containers need no change: they hold the header and already trap on its epoch. The cost is a
|
||||
16-byte value and one call per use of a value — per `vec-new`, `with-allocator` or `free-all` naming one, not per push:
|
||||
on a loop of `vec-new` + `with-allocator` + `free-all` against one arena, 50 more instructions an iteration out of 549
|
||||
under LLVM and 69 out of 827 under `--x86`, cycles within noise. `test/programs/destroy-region.flan`, arguments 4 to 6.
|
||||
|
||||
**2. `context/allocator` and `context/temp` are dynamic variables with save and restore, not extra parameters.** The
|
||||
spec says the allocator is "part of the calling convention". The literal reading touches every function signature, the
|
||||
|
||||
70
lib/check.ml
70
lib/check.ml
@ -2237,6 +2237,35 @@ let to_bytes ctx loc pr (x : Tast.expr) =
|
||||
[ mk loc bslice
|
||||
(Tast.Prim (pr, [ x; addr_of loc (mk loc bty (Tast.Local s)) ])) ]))
|
||||
|
||||
(* ── An Allocator value, made and used ─────────────────────────────────
|
||||
A value is two words, flan_rt.c's [flan_alloc_value]: the runtime's
|
||||
allocator record and the incarnation of it the value was made for, which
|
||||
arena-destroy bumps. Every runtime operation takes the bare record, typed
|
||||
[raw_alloc] here; [seal_alloc] makes a value from one and [use_alloc] opens
|
||||
one, trapping if the incarnation has moved. So a value kept past its arena's
|
||||
destroy traps at its next use, including after arena-new has taken the
|
||||
record back for another arena — which a one-word value could not tell from
|
||||
the new arena's own. Both cross through the value's address, since nothing
|
||||
the runtime answers or takes is a struct by value. *)
|
||||
let raw_alloc = Types.Ptr Types.Unit
|
||||
|
||||
let seal_alloc ctx loc (record : Tast.expr) =
|
||||
let s = fresh_slot ctx Types.Alloc in
|
||||
mk loc Types.Alloc
|
||||
(Tast.Let
|
||||
([ (s, mk loc Types.Alloc (Tast.Zero Types.Alloc)) ],
|
||||
[ rt loc Types.Unit "flan_alloc_seal"
|
||||
[ record; addr_of loc (mk loc Types.Alloc (Tast.Local s)) ];
|
||||
mk loc Types.Alloc (Tast.Local s) ]))
|
||||
|
||||
let use_alloc ctx loc (v : Tast.expr) =
|
||||
let s = fresh_slot ctx Types.Alloc in
|
||||
mk loc raw_alloc
|
||||
(Tast.Let
|
||||
([ (s, v) ],
|
||||
[ rt loc raw_alloc "flan_alloc_use"
|
||||
[ addr_of loc (mk loc Types.Alloc (Tast.Local s)); here loc ] ]))
|
||||
|
||||
(* A string literal handed to a [declare-c] function goes to C without the copy
|
||||
the wrapper makes of any other string. Both backends write a NUL after a
|
||||
literal's bytes, so the literal is passed with its length counting that NUL,
|
||||
@ -3267,11 +3296,10 @@ and struct_key_pair env loc n =
|
||||
end
|
||||
|
||||
(* The pair as two expressions, ready to be passed. Their Flan type is
|
||||
[Alloc]: an opaque pointer-width value with no user-writable constructor,
|
||||
which is all the backend needs and all any Flan type ever says about it. *)
|
||||
[(Ptr ())]: one opaque word, which is all the backend needs. *)
|
||||
let key_fns env loc k =
|
||||
let h, e = key_pair env loc k in
|
||||
mk loc Types.Alloc (Tast.FnAddr h), mk loc Types.Alloc (Tast.FnAddr e)
|
||||
mk loc raw_alloc (Tast.FnAddr h), mk loc raw_alloc (Tast.FnAddr e)
|
||||
|
||||
(* ── The map operations, deferred to the instantiation ─────────────────
|
||||
True when the key is a type variable, which means the operation cannot be
|
||||
@ -3942,10 +3970,10 @@ and var ctx ?(qualified = false) loc ~want name =
|
||||
the literal reading of "calling convention" is deferred. *)
|
||||
| "context/allocator" ->
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_context_allocator", [])))
|
||||
(seal_alloc ctx loc (rt loc raw_alloc "flan_context_allocator" []))
|
||||
| "context/temp" ->
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_context_temp", [])))
|
||||
(seal_alloc ctx loc (rt loc raw_alloc "flan_context_temp" []))
|
||||
| _ when qualified ->
|
||||
(* In [builtin_set] — the arm above checked — but not one of the four
|
||||
arms above this one, so it is a builtin that exists only as a call.
|
||||
@ -6876,10 +6904,14 @@ and vec_elem loc what (t : Types.t) =
|
||||
implicit one. spec-memory.md: an operation never falls back to a hidden
|
||||
global allocator, and an explicit allocator can override the context. *)
|
||||
and allocator_arg ctx loc = function
|
||||
| [] -> rt loc Types.Alloc "flan_context_allocator" []
|
||||
| [ a ] -> check ctx ~want:Types.Alloc a
|
||||
| [] -> rt loc raw_alloc "flan_context_allocator" []
|
||||
| [ a ] -> alloc_value ctx loc a
|
||||
| _ -> fail loc "at most one allocator may be named here"
|
||||
|
||||
(* An Allocator value, checked and opened: the record every runtime call
|
||||
takes, after [use_alloc] has compared the incarnation. *)
|
||||
and alloc_value ctx loc e = use_alloc ctx loc (check ctx ~want:Types.Alloc e)
|
||||
|
||||
(* A copy of [src]'s elements — a string's bytes or a slice's elements — into
|
||||
a block from [a], answered as a slice over it: (bytes s), (clone xs) and the
|
||||
number conversions. The lowering mirrors [vec-new]: a hidden (Vec T) temp
|
||||
@ -7466,7 +7498,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
| "heap-allocator" ->
|
||||
arity ctx loc name 0 args;
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_heap_allocator", [])))
|
||||
(seal_alloc ctx loc (rt loc raw_alloc "flan_heap_allocator" []))
|
||||
(* The capacity is explicit and there is no growing backing store: an arena
|
||||
whose size is decided by the program is one a program can reason about,
|
||||
and it is the only shape under which "exhausted" is a state a test can
|
||||
@ -7475,12 +7507,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
arity ctx loc name 1 args;
|
||||
let cap = check ctx ~want:(Types.Int Types.I64) (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Alloc (Tast.Prim (Tast.Rt "flan_arena_new", [ cap ])))
|
||||
(seal_alloc ctx loc (rt loc raw_alloc "flan_arena_new" [ cap ]))
|
||||
(* Hands the pages back, which [free-all] deliberately does not — see
|
||||
TODO.org, "Allocators, (Vec T) and StorageExhausted". *)
|
||||
| "arena-destroy" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_arena_destroy", [ a ])))
|
||||
(* One of spec-memory.md's two release points. It takes the source location
|
||||
@ -7488,7 +7520,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
rather than the runtime. *)
|
||||
| "free-all" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Unit
|
||||
(Tast.Prim (Tast.Rt "flan_alloc_free_all", [ a; here loc ])))
|
||||
@ -7497,7 +7529,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
answer without the round trip, which is the call this made. *)
|
||||
| "can-free?" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Bool
|
||||
(Tast.Prim (Tast.Ne,
|
||||
@ -7506,7 +7538,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ])))
|
||||
| "can-free-all?" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Bool
|
||||
(Tast.Prim (Tast.Ne,
|
||||
@ -7518,7 +7550,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
saw. *)
|
||||
| "alloc-epoch" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc (Types.Int Types.I64)
|
||||
(Tast.Prim (Tast.Rt "flan_alloc_epoch", [ a ])))
|
||||
@ -7527,7 +7559,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
which one ran out. *)
|
||||
| "alloc-id" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Rt "flan_alloc_id", [ a ])))
|
||||
(* A ceiling on live bytes, 0 for none. spec-memory.md's retry restart is
|
||||
@ -7539,7 +7571,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
program exhausts an allocator on purpose. *)
|
||||
| "alloc-budget" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc (Types.Int Types.I64)
|
||||
(Tast.Prim (Tast.Rt "flan_alloc_budget", [ a ])))
|
||||
@ -7547,7 +7579,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
arity ctx loc name 2 args;
|
||||
(match args with
|
||||
| [ a; n ] ->
|
||||
let a = check ctx ~want:Types.Alloc a in
|
||||
let a = alloc_value ctx loc a in
|
||||
let n = check ctx ~want:(Types.Int Types.I64) n in
|
||||
expect ctx loc ~want
|
||||
(mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_alloc_set_budget", [ a; n ])))
|
||||
@ -7556,7 +7588,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
tier answering it — spec-memory.md, "Leaking is defined behaviour". *)
|
||||
| "alloc-live-blocks" ->
|
||||
arity ctx loc name 1 args;
|
||||
let a = check ctx ~want:Types.Alloc (List.hd args) in
|
||||
let a = alloc_value ctx loc (List.hd args) in
|
||||
expect ctx loc ~want
|
||||
(mk loc (Types.Int Types.I64)
|
||||
(Tast.Prim (Tast.Rt "flan_alloc_live_blocks", [ a ])))
|
||||
@ -7568,7 +7600,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
(match args with
|
||||
| [] -> fail loc "with-allocator is (with-allocator allocator body ...)"
|
||||
| a :: body ->
|
||||
let a = check ctx ~want:Types.Alloc a in
|
||||
let a = alloc_value ctx loc a in
|
||||
let body, ty =
|
||||
scoped ctx (fun () ->
|
||||
match body with
|
||||
|
||||
33
lib/emit.ml
33
lib/emit.ml
@ -271,9 +271,10 @@ let rec ll (t : Types.t) =
|
||||
| Types.Enum _ -> "i32"
|
||||
| Types.Array (n, e) -> Printf.sprintf "[%Ld x %s]" n (ll e)
|
||||
| Types.Ptr _ -> "ptr"
|
||||
(* An [Allocator] is a pointer to the runtime's [flan_allocator] and never a
|
||||
copy of one: see Types. Opaque here in the same sense [ptr] is. *)
|
||||
| Types.Alloc -> "ptr"
|
||||
(* An [Allocator] is the runtime's [flan_allocator] record and the
|
||||
incarnation of it the value was made for — flan_rt.c's [flan_alloc_value].
|
||||
The runtime is handed its address; see [Check.use_alloc]. *)
|
||||
| Types.Alloc -> "%alloc"
|
||||
(* A code address and the environment it is called with: two words, always,
|
||||
whether or not this particular value captured anything. See [%fnv]. *)
|
||||
| Types.Fn _ -> "%fnv"
|
||||
@ -488,7 +489,7 @@ let rec lay m (t : Types.t) : int * int =
|
||||
| Types.Unit | Types.Never -> 0, 1
|
||||
| Types.Enum _ -> 4, 4
|
||||
| Types.Ptr _ -> 8, 8
|
||||
| Types.Alloc -> 8, 8
|
||||
| Types.Alloc -> 16, 8
|
||||
| Types.Fn _ -> 16, 8
|
||||
| Types.CFn _ -> 8, 8
|
||||
| Types.Vec _ | Types.Map _ -> 40, 8
|
||||
@ -824,19 +825,20 @@ let rec dty m d (t : Types.t) : int =
|
||||
(List.map (fun i -> Printf.sprintf "!%d" i) ms)));
|
||||
id
|
||||
| None -> internal "no debug type for struct %s" sn)
|
||||
(* An opaque pointer under lldb, which is the truth: the allocator's
|
||||
fields are the runtime's C and lldb already has that type from
|
||||
flan_rt.c's own debug info. *)
|
||||
(* The record as an opaque pointer — its fields are the runtime's C and
|
||||
lldb already has that type from flan_rt.c's own debug info — and the
|
||||
incarnation beside it. *)
|
||||
| Types.Alloc ->
|
||||
dnode d
|
||||
"!DIDerivedType(tag: DW_TAG_pointer_type, name: \"Allocator\", baseType: null, size: 64)"
|
||||
composite "Allocator"
|
||||
[ ("record", Types.Ptr Types.Unit);
|
||||
("incarnation", Types.Int Types.U64) ]
|
||||
(* Shown as what it is. The epoch word is in the layout and so it is
|
||||
here too: a debugger that showed four fields of a five-field struct
|
||||
would put the reader's offsets out by one. *)
|
||||
| Types.Vec e ->
|
||||
composite (Types.to_string t)
|
||||
[ ("ptr", Types.Ptr e); ("len", Types.Int Types.I64);
|
||||
("cap", Types.Int Types.I64); ("allocator", Types.Alloc);
|
||||
("cap", Types.Int Types.I64); ("allocator", Types.Ptr Types.Unit);
|
||||
("epoch", Types.Int Types.I64) ]
|
||||
(* Five fields again, and shown as five for the same reason: a debugger
|
||||
that showed fewer would put the reader's offsets out. [log2cap] is
|
||||
@ -847,7 +849,7 @@ let rec dty m d (t : Types.t) : int =
|
||||
composite (Types.to_string t)
|
||||
[ ("data", Types.Ptr (Types.Int Types.U8));
|
||||
("len", Types.Int Types.I64); ("log2cap", Types.Int Types.I64);
|
||||
("allocator", Types.Alloc); ("epoch", Types.Int Types.I64) ]
|
||||
("allocator", Types.Ptr Types.Unit); ("epoch", Types.Int Types.I64) ]
|
||||
|> fun n -> ignore k; ignore v; n
|
||||
(* Two words, and shown as two, the same rule the Vec and the Map above
|
||||
follow: a debugger told a function value were one pointer would put
|
||||
@ -2192,7 +2194,7 @@ and value_at f (e : Tast.expr) : string =
|
||||
it there. See [%fnv].
|
||||
|
||||
Only a [Fn]-typed one. The same three [fnref] constructors are also asked
|
||||
for as bare addresses — carrying [CFn], and carrying [Alloc] for the
|
||||
for as bare addresses — carrying [CFn], and carrying [(Ptr ())] for the
|
||||
map's hash and equality pair and a handler frame's clause, which are
|
||||
fields of structs the runtime declares — and those stay one word. The
|
||||
node's type is what says which is being asked for. *)
|
||||
@ -2660,7 +2662,7 @@ and call_ptr f ret callee args =
|
||||
call_through f ?env ret code vs
|
||||
|
||||
(* The code address behind one of the three [fnref]s, which is the same string
|
||||
whether it is wanted as a bare [Alloc] pointer or as the first word of a
|
||||
whether it is wanted as a bare [(Ptr ())] or as the first word of a
|
||||
function value.
|
||||
|
||||
[Flanfn] and [Rtfn] are the symbol itself, not a load from it: a function's
|
||||
@ -4284,6 +4286,9 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
|
||||
; A value that captures nothing carries a null there and every call passes it
|
||||
; on regardless; see [env_param].
|
||||
%fnv = type { ptr, ptr }
|
||||
; An Allocator value: the runtime's record, and the incarnation of it the value
|
||||
; was made for, so a value kept past its arena's destroy is caught on use.
|
||||
%alloc = type { ptr, i64 }
|
||||
; (Vec T), spec-memory.md. The element type is nowhere in it: the runtime is
|
||||
; type-erased and every operation is handed size and align at its call site.
|
||||
%vec = type { ptr, i64, i64, ptr, i64 }
|
||||
@ -4347,6 +4352,8 @@ declare void @flan_slice_promise_error(ptr, i64, i64, ptr) cold
|
||||
; operands, or the destination's range for a cast.
|
||||
declare void @flan_arith_error(ptr, i64, i32, i64, i64, ptr) cold
|
||||
declare ptr @flan_context_allocator()
|
||||
declare void @flan_alloc_seal(ptr, ptr)
|
||||
declare ptr @flan_alloc_use(ptr, ptr, i64)
|
||||
declare ptr @flan_context_temp()
|
||||
declare ptr @flan_heap_allocator()
|
||||
declare ptr @flan_context_set(ptr)
|
||||
|
||||
12
lib/x86.ml
12
lib/x86.ml
@ -510,7 +510,9 @@ let is_agg (t : Types.t) =
|
||||
(* A [(CFn ...)] is one word and crosses exactly as a pointer does, which
|
||||
is the whole of its reason for existing. *)
|
||||
| Types.Int _ | Types.Float _ | Types.Bool | Types.Ptr _ | Types.Enum _
|
||||
| Types.Alloc | Types.CFn _ -> false
|
||||
| Types.CFn _ -> false
|
||||
(* The record and its incarnation — see [Emit]'s %alloc. *)
|
||||
| Types.Alloc -> true
|
||||
| Types.Unit | Types.Never -> false
|
||||
(* A [(Fn ...)] is two words — the code address and the environment beside
|
||||
it — so it crosses the way a slice does. [Emit.lay] is the one place that
|
||||
@ -1171,7 +1173,7 @@ let load_sym f ~dst s =
|
||||
else load_int f.b ~dst ~mm:(Sym (s, 0)) ~size:8 ~signed:false
|
||||
|
||||
(* The code address behind one of the three [fnref]s, which is the same
|
||||
sequence whether it is wanted as a bare [Alloc] pointer or as the first
|
||||
sequence whether it is wanted as a bare [(Ptr ())] or as the first
|
||||
word of a function value.
|
||||
|
||||
[Flanfn] and [Rtfn] are the symbol itself, not a load from it: a function's
|
||||
@ -1735,7 +1737,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
|
||||
(* A [(Fn ...)] value: the code address, then the environment beside it.
|
||||
Two words — see [Emit]'s %fnv. Only a [Fn]-typed node; the same three
|
||||
constructors are also asked for as bare addresses, carrying [CFn] or
|
||||
[Alloc], and those stay one word. The node's type says which. *)
|
||||
[(Ptr ())], and those stay one word. The node's type says which. *)
|
||||
| (Tast.FnAddr _ | Tast.Closure _ | Tast.Thicken _)
|
||||
when (match t with Types.Fn _ -> true | _ -> false) ->
|
||||
let env =
|
||||
@ -3023,8 +3025,8 @@ and call_native f ~sym ?(chan = false) ~(args : Tast.expr list) ~rty dst =
|
||||
[Unit] or a scalar. [flan_vec_as_slice] is the one that looks like a
|
||||
counter-example and is not: [check.ml] builds it as [rt loc
|
||||
Types.Unit] and [flan_rt.c] writes the two words through [void *out].
|
||||
Every other [rt] builder in the file answers [Unit], an [Int], a
|
||||
[Ptr] or an [Alloc].
|
||||
Every other [rt] builder in the file answers [Unit], an [Int]
|
||||
or a [Ptr].
|
||||
- [crossable], which admits [String] and [Slice _] only as "a
|
||||
parameter" and refuses an aggregate return from a [declare] outright.
|
||||
|
||||
|
||||
@ -1065,7 +1065,8 @@ void flan_arith_error(const uint8_t *loc, int64_t loclen, int32_t op,
|
||||
* size and align as parameters because the only place the concrete type is
|
||||
* known is the call site.
|
||||
*
|
||||
* A Flan `Allocator` value is a *pointer* to one of these, not a copy of it.
|
||||
* A Flan `Allocator` value names one of these — its address and the
|
||||
* [incarnation] it was made for, see flan_alloc_value — and is never a copy.
|
||||
* That is forced by two things in the spec and is not a convenience: the
|
||||
* capability set has to be readable at run time from wherever a container
|
||||
* landed, and `free-all` bumps an epoch that every container made from the
|
||||
@ -1122,8 +1123,22 @@ struct flan_allocator {
|
||||
* the spec names as the handler that works, needs a ceiling to raise. It
|
||||
* doubles as the knob a test exhausts an allocator with on purpose. */
|
||||
int64_t budget;
|
||||
/* Bumped when arena-destroy retires this record. A Flan Allocator value is
|
||||
* this record's address and the incarnation it was made for, and every use
|
||||
* of one compares the two (flan_alloc_use), so a value kept past its
|
||||
* arena's destroy traps even after arena-new has taken the record back for
|
||||
* another arena. Separate from [epoch]: free-all keeps the arena, and a
|
||||
* value made before a free-all is still good. */
|
||||
uint64_t incarnation;
|
||||
};
|
||||
|
||||
/* A Flan Allocator value, two words. The compiler lays it out as { ptr, i64 }
|
||||
* and hands the runtime its address. */
|
||||
typedef struct flan_alloc_value {
|
||||
flan_allocator *rec;
|
||||
uint64_t inc;
|
||||
} flan_alloc_value;
|
||||
|
||||
/* ── Byte counts that cannot wrap ──────────────────────────────────────
|
||||
*
|
||||
* Every size this file computes is a signed 64-bit count of bytes, and every
|
||||
@ -1245,7 +1260,7 @@ static void *flan_heap_proc(flan_allocator *a, int32_t mode, void *p,
|
||||
static flan_allocator flan_heap = {
|
||||
flan_heap_proc, NULL,
|
||||
FLAN_CAN_ALLOC | FLAN_CAN_RESIZE | FLAN_CAN_FREE,
|
||||
0, 0, 0, 0
|
||||
0, 0, 0, 0, 0
|
||||
};
|
||||
|
||||
/* -- Telling memcheck an arena reset happened. -----------------------
|
||||
@ -1508,9 +1523,10 @@ static void *flan_destroyed_proc(flan_allocator *a, int32_t mode, void *p,
|
||||
* makes and destroys arenas in a loop holds as many headers as it ever had
|
||||
* arenas alive at once.
|
||||
*
|
||||
* A second destroy finds the retired procedure and does nothing — while the
|
||||
* header is still on the list. Once a later arena-new has taken it back, the
|
||||
* old Allocator value names the new arena. */
|
||||
* The Allocator value that named the arena carries the incarnation it was made
|
||||
* for, which the retire bumps, so every later use of that value — a second
|
||||
* destroy included — traps in flan_alloc_use before it reaches here, whether
|
||||
* or not a later arena-new has taken the record back. */
|
||||
void flan_arena_destroy(flan_allocator *a) {
|
||||
flan_arena *ar;
|
||||
if (!a || a->proc != flan_arena_proc) return;
|
||||
@ -1525,6 +1541,7 @@ void flan_arena_destroy(flan_allocator *a) {
|
||||
}
|
||||
|
||||
static void flan_header_retire(flan_allocator *a) {
|
||||
a->incarnation++;
|
||||
a->proc = flan_destroyed_proc;
|
||||
a->live_blocks = 0;
|
||||
a->live_bytes = 0;
|
||||
@ -1534,6 +1551,33 @@ static void flan_header_retire(flan_allocator *a) {
|
||||
|
||||
flan_allocator *flan_heap_allocator(void) { return &flan_heap; }
|
||||
|
||||
/* An Allocator value made from a record: the record and its incarnation now.
|
||||
* Through an out-pointer, since nothing here returns a struct by value. */
|
||||
void flan_alloc_seal(flan_allocator *a, flan_alloc_value *out) {
|
||||
out->rec = a;
|
||||
out->inc = a ? a->incarnation : 0;
|
||||
}
|
||||
|
||||
/* Every use of an Allocator value comes through here: the record, if the
|
||||
* value's incarnation is still the record's. A mismatch is a value kept past
|
||||
* its arena's destroy, and it traps whether the record is still retired or
|
||||
* serves a newer arena — reaching the newer arena would be allocating from a
|
||||
* region the program never named. A null record passes through to the
|
||||
* operation's own null check, which names the site the same way. */
|
||||
flan_allocator *flan_alloc_use(const flan_alloc_value *v, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
flan_allocator *a = v->rec;
|
||||
if (a && a->incarnation != v->inc) {
|
||||
rt_flush_out();
|
||||
fprintf(stderr,
|
||||
"%.*s: this allocator was destroyed by arena-destroy, so nothing "
|
||||
"can be allocated from it or released through it\n",
|
||||
(int)loclen, (const char *)loc);
|
||||
rt_trap((const uint8_t *)"DestroyedAllocator", 18);
|
||||
}
|
||||
return a;
|
||||
}
|
||||
|
||||
int8_t flan_alloc_can_free(flan_allocator *a) {
|
||||
return (int8_t)(a && (a->caps & FLAN_CAN_FREE) ? 1 : 0);
|
||||
}
|
||||
|
||||
@ -615,6 +615,11 @@ operation. It works because an `Allocator` is a **pointer** to the allocator
|
||||
and not a copy of one — a copied-by-value allocator would give each copy its
|
||||
own epoch, and a copy taken before the bump would never notice it.
|
||||
|
||||
An `Allocator` value is two words: that pointer, and the incarnation of the
|
||||
allocator it was made for, which `arena-destroy` bumps. Every use of the value
|
||||
compares the two, so a value kept past its arena's destroy traps at its next
|
||||
use, even after a later `arena-new` has taken the allocator's record back.
|
||||
|
||||
### `drop` — owning something that is not memory
|
||||
|
||||
A type may name one hook:
|
||||
|
||||
@ -13,6 +13,11 @@
|
||||
;;;; container made before the destroy still traps, because the epoch on a
|
||||
;;;; header only ever rises.
|
||||
;;;;
|
||||
;;;; Arguments 4, 5 and 6 use the destroyed Allocator value itself after the
|
||||
;;;; next arena-new took its record back — for a new container, through
|
||||
;;;; with-allocator, and in a second destroy. The value carries the incarnation
|
||||
;;;; it was made for, so each traps instead of reaching the new arena.
|
||||
;;;;
|
||||
;;;; Argument 3 makes and destroys arenas in a loop, as many times as the
|
||||
;;;; second argument says. A retired allocator is reused rather than kept, so
|
||||
;;;; the loop's memory stays flat however long it runs.
|
||||
@ -35,6 +40,22 @@
|
||||
(push w 5)
|
||||
(println (at w 0))
|
||||
(println (at v 0))))
|
||||
;; The Allocator value itself, kept past its destroy, after arena-new
|
||||
;; took its record back: b works, and a traps rather than naming b's
|
||||
;; arena. Argument 5 is the same through with-allocator, and 6 through
|
||||
;; a second arena-destroy.
|
||||
(>= which 4)
|
||||
(do
|
||||
(arena-destroy a)
|
||||
(let [b (arena-new 4096)
|
||||
w (vec-new i32 b)]
|
||||
(push w 5)
|
||||
(println (at w 0))
|
||||
(cond
|
||||
(= which 4) (let [x (vec-new i32 a)] (push x 1))
|
||||
(= which 5) (with-allocator a (let [x (vec-new i32)] (push x 1)))
|
||||
:else (arena-destroy a))
|
||||
(println "unreachable")))
|
||||
(= which 3)
|
||||
(let [n (bytes->i64 (bytes-view (at args 2)))]
|
||||
(arena-destroy a)
|
||||
|
||||
20
test/programs/dev-alloc-param.flan
Normal file
20
test/programs/dev-alloc-param.flan
Normal file
@ -0,0 +1,20 @@
|
||||
;;;; A function taking an Allocator, redefined while the program runs. The value
|
||||
;;;; is two words, the record and its incarnation, and the redefined body is
|
||||
;;;; compiled by the reload emitter and called through the host's cell, so the
|
||||
;;;; two have to agree on how those words cross. test_dev.ml runs it on both
|
||||
;;;; backends.
|
||||
(import agent "vendor:agent")
|
||||
|
||||
(defonce region Allocator)
|
||||
|
||||
(defn fill [a Allocator n i32] i64
|
||||
(let [v (vec-new i64 a)]
|
||||
(dotimes [i n] (push v (i64 i)))
|
||||
(i64 (length v))))
|
||||
|
||||
(defn main [] i32
|
||||
(agent/start)
|
||||
(set region (arena-new 4096))
|
||||
(dotimes [i 4000]
|
||||
(agent/wait 5))
|
||||
0)
|
||||
@ -1968,13 +1968,13 @@ let () =
|
||||
traps, because the epoch on a header only rises. *)
|
||||
let code, text = run exe (Some "2") in
|
||||
if code <> 134 || not (contains text "5\n")
|
||||
|| not (contains text "programs/destroy-region.flan:37:")
|
||||
|| not (contains text "programs/destroy-region.flan:42:")
|
||||
|| not (contains text "allocator was released")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL a container whose destroyed allocator was reused\n\
|
||||
\ got: %S (exit %d)\n wanted: 5, then the trap at 37 (exit 134)\n"
|
||||
\ got: %S (exit %d)\n wanted: 5, then the trap at 42 (exit 134)\n"
|
||||
text code
|
||||
end;
|
||||
(* And the reuse is what keeps a make-and-destroy loop flat: two million
|
||||
@ -2010,6 +2010,33 @@ let () =
|
||||
end
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ());
|
||||
(* The destroyed Allocator value itself, used after the next arena-new
|
||||
took its record back: a new container, a with-allocator and a second
|
||||
destroy each trap at the use rather than reaching the new arena. All
|
||||
three backends, since the value's two words are laid out by each. *)
|
||||
List.iter
|
||||
(fun (x86, opt, tag) ->
|
||||
let exe = compile ~x86 ~opt "programs/destroy-region.flan" in
|
||||
List.iter
|
||||
(fun (arg, line) ->
|
||||
let code, text = run exe (Some arg) in
|
||||
if code <> 134 || not (contains text "5\n")
|
||||
|| not (contains text
|
||||
(Printf.sprintf "programs/destroy-region.flan:%d:" line))
|
||||
|| not (contains text "destroyed by arena-destroy")
|
||||
|| contains text "unreachable"
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL a destroyed Allocator value whose record was reused, \
|
||||
argument %s%s\n\
|
||||
\ got: %S (exit %d)\n wanted: 5, then the trap at \
|
||||
%d (exit 134)\n"
|
||||
arg tag text code line
|
||||
end)
|
||||
[ ("4", 55); ("5", 56); ("6", 57) ];
|
||||
(try Sys.remove exe with Sys_error _ -> ()))
|
||||
[ (false, "-O2", ""); (false, "-O0", ", -O0"); (true, "-O2", ", --x86") ];
|
||||
|
||||
|
||||
(try Sys.remove exe with Sys_error _ -> ());
|
||||
|
||||
@ -7002,6 +7002,70 @@ let () =
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
[ csock; cout ];
|
||||
|
||||
(* ── A function taking an Allocator, redefined ─────────────────
|
||||
An Allocator value is two words, the record and its incarnation. The
|
||||
redefined body is built by the reload emitter and reached through the
|
||||
host's cell, so the host and the module have to agree on how the two
|
||||
words cross; each backend is its own pair of emitters. *)
|
||||
List.iter
|
||||
(fun mode ->
|
||||
let asock = tmp ("alloc" ^ mode ^ ".sock")
|
||||
and aout = tmp ("alloc" ^ mode ^ ".out") in
|
||||
(try Sys.remove asock with Sys_error _ -> ());
|
||||
let afd =
|
||||
Unix.openfile aout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
||||
in
|
||||
let apid =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-alloc-param.flan"; "-s"; asock; mode |]
|
||||
Unix.stdin afd Unix.stderr
|
||||
in
|
||||
Unix.close afd;
|
||||
if not (listening ~pid:apid asock) then begin
|
||||
fail "the %s allocator daemon %s" mode !listen_why;
|
||||
(try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ())
|
||||
end
|
||||
else begin
|
||||
let c = connect asock in
|
||||
let value r = Option.value ~default:"" (Wire.string_field r "value") in
|
||||
let ask code =
|
||||
request c
|
||||
(Printf.sprintf
|
||||
"(:op \"eval-expr\" :code %S :file \"programs/dev-alloc-param.flan\")"
|
||||
code)
|
||||
in
|
||||
let answered = ref "" in
|
||||
let asked () =
|
||||
let r = ask "(fill region 3)" in
|
||||
status r = "ok" && (answered := value r; true)
|
||||
in
|
||||
if not (await asked) then
|
||||
fail "the %s allocator daemon never reached a frame boundary" mode
|
||||
else begin
|
||||
if !answered <> "3" then
|
||||
fail "%s: fill as built answered %S" mode !answered;
|
||||
let r =
|
||||
request c
|
||||
"(:op \"eval\" :code \"(defn fill [a Allocator n i32] i64 (let \
|
||||
[v (vec-new i64 a)] (dotimes [i (* n 10)] (push v (i64 i))) \
|
||||
(+ 1000 (i64 (length v)))))\" :file \
|
||||
\"programs/dev-alloc-param.flan\")"
|
||||
in
|
||||
if status r <> "ok" then fail "%s: redefining fill: %s" mode (status r)
|
||||
else begin
|
||||
let r = ask "(fill region 3)" in
|
||||
if value r <> "1030" then
|
||||
fail "%s: the redefined fill answered %S" mode (value r)
|
||||
end
|
||||
end;
|
||||
(try Unix.close c with Unix.Unix_error _ -> ());
|
||||
(try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ());
|
||||
(try ignore (Unix.waitpid [] apid) with Unix.Unix_error _ -> ())
|
||||
end;
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
[ asock; aout ])
|
||||
[ "--llvm"; "--x86" ];
|
||||
|
||||
(* ══ The agent socket is not the editor protocol ══════════════════
|
||||
|
||||
Two daemons of their own, both about what a session owes an editor
|
||||
|
||||
@ -252,6 +252,9 @@ let corpus =
|
||||
"programs/destroy-region.flan", [ "1" ];
|
||||
"programs/destroy-region.flan", [ "2" ];
|
||||
"programs/destroy-region.flan", [ "3"; "1000" ];
|
||||
"programs/destroy-region.flan", [ "4" ];
|
||||
"programs/destroy-region.flan", [ "5" ];
|
||||
"programs/destroy-region.flan", [ "6" ];
|
||||
"programs/string-of-bytes.flan", [];
|
||||
"programs/text.flan", [];
|
||||
"programs/time.flan", [];
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user