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

The registry answers what is at an address, and a dead pointer says what it was

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 09:29:17 +07:00
commit 7b11dc07c0
11 changed files with 875 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
BUILT.md
View File

@ -4445,3 +4445,127 @@ everything else there is arithmetic over a container header.
failure — the region a container lived in was released, and there is no frame to go back to that would not read freed
memory — and the map path was left alone rather than converted half-way. Written down here so it is a known edge
rather than a discovery.
## An address answers with a type, and nothing grew a tag word
A Flan struct is exactly its C layout. No header, no tag word — deliberately, and it is what makes a struct free and
what makes the FFI work. The consequence is stated elsewhere in this file more than once: *a Flan value carries no
header, so nothing at run time can say what it is*, which is why a rendering is a compile-time walk over a type and
why `(watch "v" v)` cannot reach a composite without an arm in `check.ml`.
The allocation registry does not answer that question. It sidesteps it. **The allocator's caller knows the type at the
moment it asks for memory**, and the compiler is standing right there, so a dev build writes it down: base address,
extent, element size, and the type's printed spelling. Nothing about any value's layout changes, and raylib never
finds out.
### The split, which is the whole design
Two halves, and they are in different files because they need different things.
- **Recording the type is emitted.** `check.ml` builds one `flan_dev_reg_note_*` call after every operation that may
have allocated — `vec-new`, `push`, `reserve`, `clone`, `pool-new`, `insert`, `map-new`, `put`, `slurp`. Here is the
only place the concrete element type exists, so here is the only place that can name it. It is built in **every**
build, because a tree that differed by build flag would make every pass between the checker and the backend ask
which one it was looking at; `Emit`'s `Rt` arm drops the family when `dev` is off.
- **Recording that a block died is not emitted.** An address needs no type, so `flan_rt.c` calls into the table
directly from `flan_heap_proc`'s free, from a heap resize for the block it moved away from, from the arena's
`free-all`, and from `arena-destroy`. No signature in the allocator grew a type name and no ABI moved.
The drop in `Emit` happens **before** the arguments are walked, not after. A note takes the address of the container
it describes; emitting that address and then discarding the call would leave an escaped `alloca` behind, and an
escaped `alloca` is one mem2reg will not promote. So a release build's IR is the same IR it always was.
### It is armed by a constructor, and that is not fastidiousness
`@llvm.global_ctors` in the dev module, not a line at the top of `main`. A `defvar` initialiser can allocate, and it
runs before `main` does; a note that arrived before the flag was set would be a block the table never heard of, which
is a live pointer the inspector would call dead. That is the one failure mode worse than no registry at all.
### Lookup is containment, and that is not an optimisation
An entry is a **block**, not a value. Every pointer a program can hold into heap storage is interior: `(at v i)` is
`v->ptr + i*size`, and `(resolve p h)` is an item in the middle of a pool's items array. Neither is ever a base
address. A table that answered only exact hits would answer nothing anyone can ask it.
The two sides of the table therefore look different, and the difference is which thread is asking:
- `flan_dev_reg_note` and `flan_dev_reg_dead` are **probes** — a hash slot and a linear walk from it. Both are on the
writer's side, and a free hands back the same base address the allocator gave out, so equality is the whole
question there.
- `flan_dev_reg_live` and the epitaph are a **scan** of all 4096 slots. The reader is a person pressing a key, so the
cost belongs there.
- `flan_dev_reg_dead_range` is a scan too, and it is the one that runs per frame: an arena's `free-all` has no list of
what it handed out, so the region is matched against the table rather than the other way round. That is a real
per-frame cost in a dev build and it is named here rather than discovered later.
Dead entries are kept. That is the second thing the registry buys — an address that was freed still names what died —
and an entry is dropped only when the allocator hands the same address out again, which is exactly when the old answer
stopped being true. When the table fills it is compacted, dropping the dead and re-inserting the live; in a
long-running program the dead are the bulk of it.
### What it is for: permission, not identification
This is the part worth stating plainly, because the obvious reading is wrong.
`(Ptr Enemy)` **already says Enemy**, at compile time, in `Render`'s walk. The type at the far end was never the
difficulty. What was missing is *permission*: whether it is still true to read the storage there. `render.ml`'s old
comment said a pointer is never followed because "dereferencing one a REPL was handed is not a safe thing to do on
someone's behalf", and that sentence is still correct — the registry just makes the safety checkable. So the arm
became a branch:
```
("live" "(Ptr Enemy)" "<ptr (Enemy {.hp 41 .x 2})>")
("dead" "(Ptr Enemy)" "<ptr dead: was Enemy, freed at step 15>")
```
The recorded type name is therefore not what selects the renderer. It is what the *epitaph* says, and a cross-check
available to anything that wants one.
An address the registry never saw renders `<ptr>`, unchanged. That is a stack local, a global, or a pointer from C,
and the shadow stack and the static type table already answer for the first two by name.
**`println` does not follow a pointer, and will not.** `spec-memory.md` fixes what a printed `Ptr` prints, a printed
line belongs to the program and has to read the same in a release build, and a release build has no registry to ask.
The two callers of `Render` already differ in an emitter record; they now differ in a `pointers` record too, and
`check.ml` passes `None`. This is also why the epitaph carries **no address**: an address is not stable across two
runs, so printing one would make a rendering — and any test that reads one — depend on where the heap landed. It is
the rule `Render` already follows for an allocator.
### The arena hole: answerable, not reported
`test_valgrind.ml` measures a hole and this does not close it. `free-all` is retain-capacity: the offset goes to zero,
the pages stay mapped, and from `malloc`'s point of view nothing died — so memcheck is never told, and a later read of
stale bytes is a read of memory that is, as far as it knows, perfectly alive.
The registry **is** told. What that buys is that the same read is *answerable*: a pointer into a released region comes
back dead and names what used to be there. Memcheck still says nothing, and closing that half is
`VALGRIND_MAKE_MEM_UNDEFINED` in `flan_arena_proc`, which `test_valgrind.ml` names as the fix and which is still not
written. **The two must not be blurred into one claim.**
### What a release build actually carries, said honestly
"Release builds carry none of it" is the goal and it is not quite true, in exactly two places:
- **A load and a not-taken branch per free, and per `free-all`.** `flan_dev.c` is compiled into every build (see
`Build`, which says why), so `flan_rt.c` calls the dead-marking hooks unconditionally and each begins by testing a
flag only a dev build sets. The alternative is a second version of the allocator selected by a build flag, which is
worse than a branch for the reason the `Vec` header already carries its two dev words in every build: a layout or a
code path that changes with a flag is one that can disagree across the redefinition boundary silently.
- **Nothing else.** The table is `calloc`'d when it is armed, not declared as an array — a fixed 4096-entry table
would have been a quarter of a megabyte of BSS in a shipped game for something that build never writes. A release
binary carries a null pointer, a zero flag, and the declarations, which cost nothing.
The `@llvm.global_ctors` entry, the notes, and everything that reads them are dev-only, which is the same arrangement
the indirection cells and the shadow stack have.
### Tested twice, and one thing tested by hand
`programs/registry.flan` is **one program read twice** in the acceptance table. A dev build answers for an address at
the heap tier, the arena tier and the pool tier; a release build answers 0 to every question. The difference between
the two expectations *is* the assertion, and writing it as one program means nobody can change what a dev build does
without the release row noticing.
The inspector's pointer arm is **not** covered. `test/programs/dev-ptr.flan` is the program, its header carries the
two lines above, and they were read off a running session by hand — the `test_dev.ml` case that would drive it belongs
to another lane's file. `NEXT.md` says so rather than letting the verification read as automated.

99
NEXT.md
View File

@ -20,86 +20,45 @@ This matters more here than in most Lisps because the intended use is a **game l
skip a frame and carry on rather than die — exactly the case where a non-idempotent mutation bites. Write it into
`conditions.org` and `spec-conditions.md`'s prose, and into `web/index.html` beside the restart documentation.
## Queued: a dev-build allocation registry — address to type
## ~~Queued: a dev-build allocation registry~~ — **landed, in part; three of the six remain**
Raised in conversation and wanted. **What it is:** in a dev build only, every allocation records what type it was
made for. Address → type becomes a lookup.
Built. The table is in `runtime/flan_dev.c`, the note is emitted by `check.ml` and dropped by `emit.ml` in a release
build, and the inspector reads it. `BUILT.md`'s *"An address answers with a type"* is the account of it; what follows
is only what is **not** there, so that the gap is a queue entry rather than a discovery.
**Why it is possible without tagging anything.** A Flan struct is exactly its C layout with no header and no tag word
— deliberately, and it is what makes structs free and the FFI work. So "what is at this address" is normally
unanswerable at run time, and a tag cannot be added without breaking raylib. The registry sidesteps that: the
*allocator* knows the type at the moment it hands out memory, so nothing about the value's layout has to change.
Costs nothing in a release build.
**Landed:** items 1 and 2 — the inspector follows a live `(Ptr T)` and renders the pointee, and names what died at a
dead one (`<ptr dead: was Enemy, freed at step 15>`). The dead-marking covers the heap `free`, a heap resize's old
block, an arena `free-all` and `arena-destroy`.
**What it buys, in rough order of value:**
**Left, and in this order:**
- **Following a pointer.** `(Ptr T)` renders as `<ptr>` today and stops there. With a registry the inspector follows
it and renders what is actually at the other end.
- **Use-after-free that names what died.** The address is in the registry and marked dead: *"this was an Enemy, freed
at frame 412"* instead of garbage, a crash, or silence.
- Point at any heap address and get a typed rendering rather than bytes.
- **A memory breakdown by type** — how many bytes are Enemies, how many are strings. A real profiling tool for a game.
- **Leak attribution at exit**, which generalises the debug tracking allocator already queued for counting forgotten
textures.
- It closes the **arena hole Valgrind found**: releasing a region could mark everything in it dead, where today the
bytes stay quietly readable because `free-all` is retain-capacity and memcheck is never told.
- **Item 3, point at any heap address.** The lookup is there and answers for any address; nothing exposes it as an
editor op. It wants a verb beside `inspect` that takes an address and a type rather than a frame and a slot, and the
registry's own answer for the type when none is given — which needs the recorded name resolved back to a
`Types.t`, and the table records a string.
- **Item 4, a breakdown by type**, and **item 5, leak attribution at exit.** Both are a walk over the table and a
group-by; `flan_dev_reg_count` is the whole of what exists. Neither is hard and neither has a reader yet, which is
why they were left rather than half-built.
- **The memcheck half of item 6.** The registry now knows an arena's `free-all` killed everything in the region, so a
later read through a pointer into it is *answerable*. Memcheck still says nothing, because nothing told it: the
pages stay mapped and `free-all` is an integer going to zero inside one allocation. Closing that is
`VALGRIND_MAKE_MEM_UNDEFINED` in `flan_arena_proc`, which `test/test_valgrind.ml` already names. **The two must not
be blurred** — the registry answer and the memcheck answer are different tools reaching different people.
- **A test that drives the inspector's pointer arm.** `test/programs/dev-ptr.flan` is the program and its header has
the two lines a session answers with; they were read off a running session **by hand**. The case belongs beside the
other `locals`/`inspect` cases in `test_dev.ml`, which was another lane's file. `programs/registry.flan` covers the
table itself from the acceptance table, in a dev build and a release one.
**What it does not cover, and does not need to:** stack locals and globals, which the shadow stack and the static type
table already answer by name.
**On cost — settled by the author: keep it simple.** One registry insert per allocation, always on in a dev build,
no opt-out. An arena allocation is a bump pointer and an insert may well cost more than the allocation itself in a
per-frame loop, but a dev build already carries indirection cells and a shadow stack, and the author's instruction is
to build the straightforward thing and revisit only if a real program shows a problem. Do **not** build per-region
recording, range recording, or a per-allocator opt-out on speculation.
table already answer by name. A stack address is deliberately not in the table, and a pointer to one still renders
`<ptr>`.
**Note on classes:** `defclass` instances will carry shape metadata by design, so they get identification for free and
do not need the registry. This is for plain structs, `Vec`, `Map` and pool storage.
## Queued: structural typing and tuples, as one piece of work
They are the same feature — **a type identified by its shape rather than its name** — and building them separately
would mean building the same machinery twice.
### Structural typing, decided
**Compatibility requires identical layout: same fields, same types, same order.** Settled by the author, and it is
what makes the feature simple rather than hard — structural compatibility becomes "the same memory", which costs
nothing at run time and needs no copy, no reordering and no adaptor. The motivating case is `{.x 1.0 .y 1.0}` and that
order is natural anyway.
**The representation is already structural.** `types.ml` does structural equality on resolved types, and a Flan struct
is exactly its C layout with no header or tag word. What is nominal is the *checking*, not the data — so this is a
front-end change.
**Fields are writable on the ordinary terms**: by value a copy, through a `(Ptr T)` the original. Requiring identical
layout is what settles this; a reordering-tolerant version could not alias real storage and would have needed a copy.
**Not an "explicit over convenient" question.** That framing was put and the author rejected it, correctly: the
standing rules about implicit numeric conversion and integers not becoming enums are about *lossy* things happening
silently. A structural match is exact. Strong typing and nominal typing are separate choices and this touches only the
second.
**Flexible field order waits for classes**, deliberately — a class has an implementation-defined representation, so the
compiler owns the layout and order stops being observable. That is the right place to pay for flexibility, because a
class already carries identity and metadata and a `Vector2` should pay for neither.
### Tuples
**Anonymous structs with positional fields, passed and returned by value.** Decided in conversation.
To settle while building: the **spelling** of the type, and whether it collides with anything in type position; the
**accessors**, given fields are positional rather than named; and whether **destructuring** extends to them —
`[a b]` over a fixed array already exists in binding position and is the obvious model.
**Interaction with multiple return values, which are separately queued:** MRVs are *not* tuples — they are not values,
existing only at the return and the binding, so nothing stores or passes them (Odin, Go and Common Lisp all work this
way). Tuples are values. Build MRVs on the tuple machinery if that falls out, but do not conflate them: the current
customer for MRVs is `map-next!`, which uses three out-pointers because there was nothing better.
**Note for the FFI:** `shim.ml` generates a C typedef per *named* struct, and an anonymous struct has no name to
generate one from. Either anonymous structs cannot cross the FFI — refused by name, which is the house rule — or the
generator learns to name them. Decide it rather than discovering it.
**On cost, as built.** One insert per allocation, always on in a dev build, no opt-out — the author's instruction,
followed literally. Nothing was built per-region, no range recording, no per-allocator opt-out. Revisit only if a real
program shows a problem, and `BUILT.md` names the two places a release build is not quite free.
## Picked up first, 2026-09-13

106
lib/check.ml
View File

@ -589,6 +589,37 @@ let here loc = mk loc Types.String (Tast.Str (Loc.to_string loc))
(* A runtime call, with the result type spelled at the site. *)
let rt loc ty sym args = mk loc ty (Tast.Prim (Tast.Rt sym, args))
(* ── The allocation registry's note, NEXT.md ───────────────────────────
One after every operation that may have allocated — which is *here*, and
nowhere else, because here is the only place the concrete type is known. A
Flan struct is exactly its C layout with no header and no tag word, so
nothing at run time can say what is at an address; the allocator's caller
knew, and this is the caller writing it down.
The type is spelled with [Types.to_string], the same spelling a slot
fingerprint and a DWARF node already key on, so a name that appears in a
registry answer is a name the programmer wrote.
It is built unconditionally and dropped by the backend in a release build
(see [Emit]'s [Rt] arm). The checker does not know which kind of build this
is and must not learn: a note that existed only in a dev build would make
the two builds different *trees*, and every pass between here and the
backend would have to agree about which one it was looking at.
[target] is the container, passed by address like every other container
operation; the extent comes off its header in the runtime, because the
header is the only thing that knows where the storage landed. *)
let reg_note loc sym (target : Tast.expr) sizes ty =
rt loc Types.Unit sym
((target :: sizes) @ [ mk loc Types.String (Tast.Str (Types.to_string ty)) ])
(* [(do attempt note)] — the note runs only once the guard's retry loop has
stopped, so it describes the storage the program ended up with rather than
one of the attempts that failed. *)
let with_note loc (guarded : Tast.expr) (note : Tast.expr) =
mk loc Types.Unit (Tast.Do [ guarded; note ])
(* ── Reading a file at compile time, decision 1 ────────────────────────
The path is a *literal*, because the bytes have to be in hand before any
value exists — this is Odin's rule too (check_load_directive rejects
@ -2928,7 +2959,10 @@ and named_call ctx ~want loc name args =
expect loc ~want
(mk loc (Types.Vec elem)
(Tast.Let ([ (v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ],
[ alloc_guard ctx loc attempt;
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_vec"
(mk loc (Types.Vec elem) (Tast.Local v))
[ size_of loc elem ] elem);
mk loc (Types.Vec elem) (Tast.Local v) ])))
(* Unit, not a Result and not an ignorable error code: see [alloc_guard]. *)
| "push" ->
@ -2946,9 +2980,17 @@ and named_call ctx ~want loc name args =
[ target; addr_of loc (mk loc elem (Tast.Local e));
size_of loc elem; align_of loc elem; here loc ]
in
(* Re-noted after every push, not only the first: a push that grows the
Vec moves the storage, and the note is keyed on the base address, so
an unmoved block costs a probe and an overwrite with the same
numbers. This is the insert per allocation NEXT.md settles on, and
the settled answer to what it costs is "measure a real program". *)
expect loc ~want
(mk loc Types.Unit
(Tast.Let ([ (e, x) ], [ alloc_guard ctx loc attempt ])))
(Tast.Let ([ (e, x) ],
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_vec" target
[ size_of loc elem ] elem) ])))
| _ -> assert false)
| "reserve" ->
arity loc name 2 args;
@ -2959,7 +3001,7 @@ and named_call ctx ~want loc name args =
let n64 =
mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ]))
in
let attempt =
let attempt, note =
match target.Tast.ty with
(* For a map the number is entries, not slots: the runtime sizes the
block so that [n] still sits under the 75% load factor, which is
@ -2968,13 +3010,17 @@ and named_call ctx ~want loc name args =
| Types.Map (k, v) ->
let hash, _ = key_fns ctx.env loc k in
rt loc (Types.Int Types.I8) "flan_map_reserve"
[ target; n64; size_of loc k; size_of loc v; hash; here loc ]
[ target; n64; size_of loc k; size_of loc v; hash; here loc ],
reg_note loc "flan_dev_reg_note_map" target
[ size_of loc k; size_of loc v ] target.Tast.ty
| _ ->
let elem = vec_elem loc "reserve" target.Tast.ty in
rt loc (Types.Int Types.I8) "flan_vec_reserve"
[ target; n64; size_of loc elem; align_of loc elem; here loc ]
[ target; n64; size_of loc elem; align_of loc elem; here loc ],
reg_note loc "flan_dev_reg_note_vec" target
[ size_of loc elem ] elem
in
expect loc ~want (alloc_guard ctx loc attempt)
expect loc ~want (with_note loc (alloc_guard ctx loc attempt) note)
| _ -> assert false)
(* (as-slice v) and (as-slice v lo hi) — spec-memory.md, "Borrowing". The
result is a non-owning view: copying it copies ptr+len and never the
@ -3072,7 +3118,10 @@ and named_call ctx ~want loc name args =
expect loc ~want
(mk loc mty
(Tast.Let ([ (d, mk loc mty (Tast.Zero mty)) ],
[ alloc_guard ctx loc attempt;
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_map"
(mk loc mty (Tast.Local d))
[ size_of loc k; size_of loc v ] mty);
mk loc mty (Tast.Local d) ])))
(* Refused by name rather than falling through to "clone takes a
(Vec T)". Copying a pool would duplicate every slot *and* every
@ -3098,7 +3147,10 @@ and named_call ctx ~want loc name args =
(mk loc (Types.Vec elem)
(Tast.Let ([ (d, mk loc (Types.Vec elem)
(Tast.Zero (Types.Vec elem))) ],
[ alloc_guard ctx loc attempt;
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_vec"
(mk loc (Types.Vec elem) (Tast.Local d))
[ size_of loc elem ] elem);
mk loc (Types.Vec elem) (Tast.Local d) ]))))
| _ -> fail loc "clone is (clone v) or (clone v allocator)")
@ -3124,7 +3176,10 @@ and named_call ctx ~want loc name args =
expect loc ~want
(mk loc pty
(Tast.Let ([ (p, mk loc pty (Tast.Zero pty)) ],
[ alloc_guard ctx loc attempt;
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_pool"
(mk loc pty (Tast.Local p))
[ size_of loc elem ] elem);
mk loc pty (Tast.Local p) ])))
(* (insert p x) -> (Handle T). The handle is the *only* way back to what was
@ -3152,7 +3207,9 @@ and named_call ctx ~want loc name args =
expect loc ~want
(mk loc hty
(Tast.Let ([ (e, x); (h, mk loc hty (Tast.Zero hty)) ],
[ alloc_guard ctx loc attempt;
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_pool" target
[ size_of loc elem ] elem);
mk loc hty (Tast.Local h) ])))
| _ -> assert false)
@ -3333,7 +3390,10 @@ and named_call ctx ~want loc name args =
expect loc ~want
(mk loc mty
(Tast.Let ([ (m, mk loc mty (Tast.Zero mty)) ],
[ alloc_guard ctx loc attempt;
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_map"
(mk loc mty (Tast.Local m))
[ size_of loc k; size_of loc v ] mty);
mk loc mty (Tast.Local m) ])))
(* (put m k v) — the upsert. Unit, not a Result and not an ignorable error
@ -3360,7 +3420,11 @@ and named_call ctx ~want loc name args =
in
expect loc ~want
(mk loc Types.Unit
(Tast.Let ([ (ks, k); (vs, v) ], [ alloc_guard ctx loc attempt ])))
(Tast.Let ([ (ks, k); (vs, v) ],
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_map" target
[ size_of loc kt; size_of loc vt ]
target.Tast.ty) ])))
| _ -> assert false)
(* (get m k) -> (Option V). Absence is None, not an untyped nil, and the
@ -3597,9 +3661,13 @@ and named_call ctx ~want loc name args =
(* Previous turn's storage, if a retry brought us back here. *)
rt loc Types.Unit "flan_vec_free"
[ vv (); size_of loc u8; align_of loc u8; here loc ];
alloc_guard ctx loc
(rt loc (Types.Int Types.I8) "flan_vec_init"
[ vv (); a; nv (); size_of loc u8; align_of loc u8; here loc ]);
with_note loc
(alloc_guard ctx loc
(rt loc (Types.Int Types.I8) "flan_vec_init"
[ vv (); a; nv (); size_of loc u8; align_of loc u8;
here loc ]))
(reg_note loc "flan_dev_reg_note_vec" (vv ())
[ size_of loc u8 ] u8);
(* Fills the Vec the line above sized. A file that grew since the
measurement is truncated to the buffer; one that shrank leaves a
shorter Vec. Both are successful reads of what was there. *)
@ -3850,6 +3918,14 @@ and named_call ctx ~want loc name args =
unions = Hashtbl.fold (fun _ v acc -> v :: acc) ctx.env.unions [];
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) ctx.env.enums [];
emit = emitter;
(* [println] never follows a pointer, and the allocation registry does
not change that. spec-memory.md fixes what it prints — "Ptr and
Handle print their address or identity rather than recursively
dereferencing" — and a printed line belongs to the program, so it
must read the same in a release build, where there is no registry to
ask. Following one is the *inspector's* move, and session.ml is
where that context is built. *)
ptrs = None;
alloc = (fun ty -> fresh_slot ctx ty) }
in
let parts =

27
lib/emit.ml
View File

@ -1866,6 +1866,19 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
(* One arm for every runtime entry point the allocator and container runtime
has. The result type is the node's own and the argument types are the
arguments' own, so nothing here has to know which symbol it is calling. *)
(* The allocation registry's notes are the one family in here a release
build drops on the floor, and the drop has to happen before the arguments
are walked rather than after: a note takes the address of the container it
is describing, and emitting that address only to discard the call would
leave an escaped alloca behind for mem2reg to refuse. So this is a
[Types.t] the checker built and the backend declines to use, which is the
same arrangement the indirection cells and the shadow stack have — the
checker does not know whether this is a dev build and does not have to. *)
| Tast.Rt sym, _
when (not f.md.dev)
&& String.length sym > 17
&& String.equal (String.sub sym 0 17) "flan_dev_reg_note" ->
"zeroinitializer"
| Tast.Rt sym, args ->
let vs =
List.concat
@ -2394,6 +2407,10 @@ declare i64 @flan_alloc_fail_align()
declare i64 @flan_alloc_fail_id()
declare i64 @flan_alloc_budget(ptr)
declare void @flan_alloc_set_budget(ptr, i64)
declare void @flan_dev_reg_enable()
declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_pool(ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_map(ptr, i64, i64, ptr, i64)
declare i8 @flan_vec_init(ptr, ptr, i64, i64, i64, ptr, i64)
declare i8 @flan_vec_reserve(ptr, i64, i64, i64, ptr, i64)
declare i8 @flan_vec_push(ptr, ptr, i64, i64, ptr, i64)
@ -2671,6 +2688,16 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
(Printf.sprintf "%s = global ptr %s\n" (cellname fn.Tast.name)
(fname fn.Tast.name)))
p.Tast.fns;
(* And the allocation registry is armed, which is the whole of what makes
it a dev-build feature at run time. A constructor rather than a line in
[main]: the notes are emitted into every function, a global that a
[defvar] initialiser allocates runs before main does, and a note that
arrived before the flag was set would be a block the table never heard
of. Priority 65535 is the default slot; nothing here needs to beat
another constructor, only to beat the program. *)
Buffer.add_string m.out
"@llvm.global_ctors = appending global [1 x { i32, ptr, ptr }] \
[{ i32, ptr, ptr } { i32 65535, ptr @flan_dev_reg_enable, ptr null }]\n";
Buffer.add_char m.out '\n'
end;
List.iter (emit_global m) p.Tast.globals;

69
lib/render.ml
View File

@ -33,6 +33,28 @@ type emitter = {
ef64 : Tast.expr -> Tast.expr;
}
(* What a walk is allowed to do with a pointer, and it is exactly two
questions. Both are asked of the allocation registry (runtime/flan_dev.c),
which is the only thing in the program that can answer either: a Flan value
carries no header, so the *type* at the far end is known here and statically
— (Ptr Enemy) says Enemy — while whether the storage is still there is not
knowable at compile time at all.
A record of functions rather than two names, for the reason the emitter is
one: only the REPL's side has these. [println] passes [None] and keeps
printing [<ptr>], which is what spec-memory.md says it prints and what the
acceptance table reads back. Following a pointer in a printed line would
also cost every release build the two calls, and a release build has no
registry to call. *)
type pointers = {
live : Tast.expr -> Tast.expr; (* a (Ptr a) -> bool: may it be read *)
(* Emits what the registry remembers about a dead address, and emits nothing
at all for one it never saw — a stack local is not in it by design, and
inventing a sentence about one would be worse than the silence [<ptr>]
already is. *)
epitaph : Tast.expr -> Tast.expr; (* a (Ptr a) -> unit *)
}
type ctx = {
structs : Tast.structure list;
(* The declared unions. [Types.Named] covers a struct and a union alike, so
@ -41,6 +63,9 @@ type ctx = {
unions : Tast.union list;
enums : (string * (string * int64) list) list;
emit : emitter;
(* [None] in a build with no registry to ask, which is every release build
and every [println]. See [pointers]. *)
ptrs : pointers option;
(* A slot in the *caller's* frame. Only the slice arm needs one, and it needs
two: the slice itself, so the expression it came from is evaluated once
rather than once per element, and the loop counter. Who owns the frame
@ -110,10 +135,46 @@ let rec render c depth (e : Tast.expr) : Tast.expr list =
unit_ (Tast.If (is, lit (":" ^ name), otherwise)))
number members
|> fun x -> [ x ]
(* A pointer is rendered as its shape and never followed: it is the only
thing that could make this walk cycle, and dereferencing one a REPL was
handed is not a safe thing to do on someone's behalf. *)
| Types.Ptr _ -> [ lit "<ptr>" ]
(* A pointer with nobody to ask is rendered as its shape and never
followed: it is the only thing that could make this walk cycle, and
dereferencing one a REPL was handed is not a safe thing to do on
someone's behalf.
The registry is the somebody to ask, and it changes only the second half
of that sentence. The type at the far end was never the difficulty —
(Ptr Enemy) says Enemy, here, at compile time. What was missing is
*permission*, and an allocation registry is exactly a record of which
addresses it is still true to read. So a live pointer is followed and
its pointee rendered by the same walk as anything else, one level
deeper, which the depth cap bounds the way it bounds a self-containing
struct. A dead one names what died instead of showing bytes that are no
longer what they say, which is the whole difference between an
inspector and a hex dump.
An address the registry never saw is neither: it prints [<ptr>]. That
is a stack local, a global, or a pointer from C, and the shadow stack
and the static type table already answer for the first two by name. *)
| Types.Ptr t ->
(match c.ptrs with
| None -> [ lit "<ptr>" ]
| Some pt ->
(* Into a slot first, the slice arm's rule and for its reason: this
arm names the pointer three times — asked about, followed, and
mourned — and the expression it came from may be a call. An
[inspect] with a path reaches a leaf through [flan_vec_at], which
is a bounds check and a transfer guard; three of those to render
one pointer would be the walk paying for its own shape. *)
let pv = c.alloc e.Tast.ty in
let p () = { Tast.e = Tast.Local pv; ty = e.Tast.ty; loc } in
let inner =
do_ ([ lit "<ptr " ]
@ render c (depth + 1) { Tast.e = Tast.Deref (p ()); ty = t; loc }
@ [ lit ">" ])
in
let gone = do_ [ lit "<ptr"; pt.epitaph (p ()); lit ">" ] in
[ unit_
(Tast.Let ([ (pv, e) ],
[ unit_ (Tast.If (pt.live (p ()), inner, gone)) ])) ])
(* Opaque on purpose, and for the same reason: its contents are the
runtime's, its address is not stable across runs, and printing either
would make an acceptance test's output depend on the heap. *)

56
lib/session.ml
View File

@ -414,7 +414,27 @@ let externs : Tast.extern list =
{ Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin";
eparams = []; eret = Types.Unit };
{ Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end";
eparams = []; eret = Types.Unit } ]
eparams = []; eret = Types.Unit };
(* The allocation registry's two questions about an address. Both take a
[(Ptr u8)] and every pointer is cast to it: the registry is asked
whether a *byte* is inside a block it knows, and the type at the far
end is the renderer's business and already known there.
[reg-live] returns i32 rather than bool because that is what the C
returns, and a Flan bool is one bit wide; the comparison to zero is
made below, where the type is spelled once.
[reg-emit] writes into the same result buffer every other piece of a
rendering goes to. It answers whether it wrote anything, which this
side ignores — the renderer needs the *emission*, and "nothing was
written" is already the right rendering for an address the registry
never saw. *)
{ Tast.ename = "flan/reg-live"; esym = "flan_dev_reg_live";
eparams = [ Types.Ptr (Types.Int Types.U8) ];
eret = Types.Int Types.I32 };
{ Tast.ename = "flan/reg-emit"; esym = "flan_dev_reg_emit";
eparams = [ Types.Ptr (Types.Int Types.U8) ];
eret = Types.Int Types.I32 } ]
(* The REPL's emitter. Each piece is one extern call: the dev runtime already
has a renderer per scalar, and [flan_dev_emit_str] already quotes and
@ -429,6 +449,36 @@ let dev_emitter : Render.emitter =
eu64 = call emit_u64;
ef64 = call emit_f64 }
(* And what the REPL may do with a pointer, which [println] may not. See
render.ml's [pointers] for why the two sides differ. *)
let dev_pointers : Render.pointers =
let i32 = Types.Int Types.I32 in
let ask name (p : Tast.expr) : Tast.expr =
let loc = p.Tast.loc in
let byte =
{ Tast.e = Tast.Prim (Tast.Cast (Types.Ptr (Types.Int Types.U8)), [ p ]);
ty = Types.Ptr (Types.Int Types.U8); loc }
in
{ Tast.e = Tast.Call (name, [ byte ]); ty = i32; loc }
in
{ Render.live =
(fun p ->
let loc = p.Tast.loc in
let zero = { Tast.e = Tast.Int (0L, Types.I32); ty = i32; loc } in
{ Tast.e = Tast.Prim (Tast.Ne, [ ask "flan/reg-live" p; zero ]);
ty = Types.Bool; loc });
(* Called for the emission and not for the answer, so the i32 is discarded
here rather than in render.ml: a [Do] whose last element is the unit is
the honest way to say "run this and forget what it said", and it keeps
the walk's node types true. *)
epitaph =
(fun p ->
let loc = p.Tast.loc in
{ Tast.e =
Tast.Do [ ask "flan/reg-emit" p;
{ Tast.e = Tast.Unit; ty = Types.Unit; loc } ];
ty = Types.Unit; loc }) }
(* ── The locals of a stopped frame ─────────────────────────────────── *)
(* The second half of what a break loop can show, and it is the same primitive
@ -466,6 +516,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
unions = t.program.Tast.unions;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
emit = dev_emitter;
ptrs = Some dev_pointers;
alloc = (fun ty ->
let i = !nslots in
incr nslots;
@ -763,6 +814,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
unions = t.program.Tast.unions;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
emit = dev_emitter;
ptrs = Some dev_pointers;
alloc = (fun ty ->
let i = !nslots in
incr nslots;
@ -854,6 +906,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
unions = t.program.Tast.unions;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
emit = dev_emitter;
ptrs = Some dev_pointers;
alloc = (fun ty ->
let i = !nslots in
incr nslots;
@ -924,6 +977,7 @@ let eval_expr ?(origin = "<eval>") t src : change =
unions = t.program.Tast.unions;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
emit = dev_emitter;
ptrs = Some dev_pointers;
alloc = (fun ty ->
let i = !nslots in
incr nslots;

266
runtime/flan_dev.c
View File

@ -817,3 +817,269 @@ void *flan_dev_frame_slot(const void *frame, int32_t i) {
return f->slots[i];
}
/* ── The allocation registry: an address answers with a type ───────────
*
* A Flan struct is exactly its C layout: no header, no tag word. That is
* deliberate — it is what makes a struct free and the FFI work — and it is
* also why "what is at this address" has no run-time answer. A tag cannot be
* added without breaking raylib.
*
* The registry sidesteps the question rather than answering it. The
* allocator's *caller* knows the type at the moment it asks for memory, and
* the compiler is standing right there: a dev build emits one note after every
* allocating call, naming the type the memory was asked for. Nothing about a
* value's layout changes. A release build emits no note and this table stays
* empty for the life of the process.
*
* What a note records is a *block*, not a value: base, extent, and the size of
* one element. So a lookup is containment rather than equality, and that is
* not an optimisation — every pointer a program can hold into heap storage is
* interior. (at v i) is v->ptr + i*size and (resolve p h) is an item in the
* middle of a pool's array; neither is ever a base address. A table that
* answered only exact hits would answer nothing anybody can ask it.
*
* Dead entries are kept, which is the second thing this buys: an address that
* was freed still names what died. An entry is dropped only when the allocator
* hands the same address out again, which is exactly when the old answer stops
* being true.
*
* The type name is a pointer into read-only data, not a copy. The strings are
* the ones the compiler already emits beside the call site, and this file's
* header says a module is never dlclose'd, so they outlive the table.
*/
/* A power of two: the probe wraps with a mask. Fixed, and full is not fatal —
* see flan_dev_reg_note. */
#define FLAN_REG_CAP 4096
typedef struct {
const char *type; /* the Flan spelling, e.g. "Enemy" or "(Vec i32)" */
int64_t typelen;
uintptr_t base; /* 0 for an empty slot */
int64_t bytes; /* the extent of the block */
int64_t elem; /* one element's size, or 0 if it is not an array */
int64_t seq; /* when it was made */
int64_t died; /* when it was released, or 0 while it is live */
} flan_reg_entry;
/* Allocated by flan_dev_reg_enable and null until then, which is the whole of
* what a release build carries: a null pointer, a zero flag, and the load and
* not-taken branch each of the hooks below begins with. A fixed array here
* instead would be a quarter of a megabyte of BSS in a shipped game, for a
* table nothing in that build ever writes. */
static flan_reg_entry *flan_reg;
static int64_t flan_reg_used; /* live + dead slots in use */
static int64_t flan_reg_seq; /* a monotonic clock, in events */
static int flan_reg_on; /* only a dev build turns this on */
static int flan_reg_full; /* something found no slot */
/* Armed by the program's entry in a dev build. The free-side hooks in
* flan_rt.c are called unconditionally and begin with this load and a
* not-taken branch, because flan_dev.c is linked into every build and a
* second version of the allocator gated on a build flag is worse than a
* branch. That is a real cost and not zero; BUILT.md says so rather than
* repeating the claim that a release build carries nothing. */
void flan_dev_reg_enable(void) {
if (flan_reg_on) return;
flan_reg = (flan_reg_entry *)calloc(FLAN_REG_CAP, sizeof *flan_reg);
/* A registry that could not be made is not worth dying over; the flag stays
off and every question about an address answers "never heard of it",
which is what a release build answers too. */
if (flan_reg == NULL) return;
flan_reg_on = 1;
}
int flan_dev_reg_enabled(void) { return flan_reg_on; }
/* Knuth's multiplicative hash over the address, which is what an allocator
* hands out: aligned, and therefore dense in its low bits. */
static size_t flan_reg_slot(uintptr_t a) {
return (size_t)(((a >> 3) * 11400714819323198485ULL) >> 40)
& (FLAN_REG_CAP - 1);
}
/* Drop every dead entry and re-insert the live ones. Called when the table
* fills: in a long-running program the dead are the bulk of it, and losing
* them is much cheaper than losing the live half. */
static void flan_reg_compact(void) {
size_t bytes = FLAN_REG_CAP * sizeof(flan_reg_entry);
flan_reg_entry *old = (flan_reg_entry *)malloc(bytes);
int64_t i;
/* Borrowed rather than kept: a second permanent copy would double what a
dev build holds for a rearrangement that happens rarely. If it cannot be
had, the table simply stays as it is and says it is full. */
if (old == NULL) { flan_reg_full = 1; return; }
memcpy(old, flan_reg, bytes);
memset(flan_reg, 0, bytes);
flan_reg_used = 0;
for (i = 0; i < FLAN_REG_CAP; i++) {
size_t s;
int64_t probe;
if (old[i].base == 0 || old[i].died != 0) continue;
s = flan_reg_slot(old[i].base);
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
if (flan_reg[j].base == 0) {
flan_reg[j] = old[i];
flan_reg_used++;
break;
}
}
}
free(old);
}
/* One note per allocation. [base] replaces whatever was recorded there, live
* or dead: the allocator handing out an address is the event that makes any
* older answer about it wrong. */
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen) {
uintptr_t a = (uintptr_t)base;
size_t s;
int64_t probe;
if (!flan_reg_on || a == 0 || bytes <= 0) return;
if (flan_reg_used * 4 > (int64_t)FLAN_REG_CAP * 3) flan_reg_compact();
s = flan_reg_slot(a);
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
if (flan_reg[j].base != 0 && flan_reg[j].base != a) continue;
if (flan_reg[j].base == 0) flan_reg_used++;
flan_reg[j].type = type;
flan_reg[j].typelen = typelen;
flan_reg[j].base = a;
flan_reg[j].bytes = bytes;
flan_reg[j].elem = elem;
flan_reg[j].seq = ++flan_reg_seq;
flan_reg[j].died = 0;
return;
}
/* Full of live blocks. Killing the program because it ran out of diagnostic
* room would be the diagnostic shooting the patient — the watch table's rule
* and the same answer: a flag, readable by whoever asks, so that a missing
* entry is never mistaken for a freed one. */
flan_reg_full = 1;
}
int flan_dev_reg_overflowed(void) { return flan_reg_full; }
/* The block containing [a], live or dead, or NULL. A linear scan, because the
* reader is a person pressing a key and the writer is a game loop: the cost
* belongs on this side of the table. */
static flan_reg_entry *flan_reg_find(uintptr_t a) {
int64_t i;
flan_reg_entry *best = NULL;
if (a == 0) return NULL;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
if (e->base == 0) continue;
if (a < e->base || a >= e->base + (uintptr_t)e->bytes) continue;
/* A live block wins over a dead one covering the same address: the dead
entry is a stale answer the allocator has already contradicted. */
if (best == NULL || (best->died != 0 && e->died == 0)) best = e;
}
return best;
}
/* One block dies. The heap allocator's free calls this, and so does a resize,
* for the block it moved away from.
*
* The probe, not the scan — and the difference matters because this is on the
* *writer's* side. A free hands back the base address the allocator gave out,
* which is what the slot is keyed on, so the question here is equality and
* never containment. Reaching for flan_reg_find would put a 4096-entry sweep
* on every free in a dev build, which is the cost the note was careful not to
* have. */
void flan_dev_reg_dead(void *base) {
uintptr_t a = (uintptr_t)base;
size_t s;
int64_t probe;
if (!flan_reg_on || a == 0) return;
s = flan_reg_slot(a);
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
if (flan_reg[j].base == 0) return; /* never noted; nothing to mark */
if (flan_reg[j].base != a) continue;
if (flan_reg[j].died == 0) flan_reg[j].died = ++flan_reg_seq;
return;
}
}
/* Every block inside [base, base+bytes) dies — which is an arena's free-all,
* and it is the release Valgrind cannot see. free-all is retain-capacity: the
* offset goes to zero and the pages stay mapped, so memcheck is never told
* anything died and a later read of stale bytes is a read of memory that is,
* as far as it knows, perfectly alive. The registry is told. That does not
* make memcheck report it; it makes the inspector able to. */
void flan_dev_reg_dead_range(void *base, int64_t bytes) {
uintptr_t lo = (uintptr_t)base, hi = lo + (uintptr_t)bytes;
int64_t i, now;
if (!flan_reg_on || bytes <= 0) return;
now = ++flan_reg_seq;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
if (e->base == 0 || e->died != 0) continue;
if (e->base >= lo && e->base < hi) e->died = now;
}
}
/* Is it safe to follow this pointer? The one question the renderer asks, and
* the reason the answer is worth having: the type at the other end is already
* static — (Ptr Enemy) says Enemy — so the registry is not supplying the type.
* It is supplying permission. */
int32_t flan_dev_reg_live(const void *p) {
flan_reg_entry *e;
if (!flan_reg_on) return 0;
e = flan_reg_find((uintptr_t)p);
return (int32_t)(e != NULL && e->died == 0 ? 1 : 0);
}
/* What was at this address, in words, for the branch that may not follow it.
* Emitted straight into the result buffer rather than returned: the caller is
* a render thunk, which has no allocator, and every other piece of a rendering
* arrives here the same way.
*
* There is no address in the text, and that is deliberate rather than an
* omission. An address is not stable across two runs of the same program, so
* printing one would make a rendering — and therefore a test that reads one —
* depend on where the heap happened to land. It is the rule [Render] already
* follows for an allocator. What a reader wants from a dangling pointer is
* *what died*, and the registry has that.
*
* Returns 1 if anything was written, so that a caller can tell "the registry
* has never heard of this address" — a stack local, which is by design not in
* here — from "this is dead", which is the sentence worth printing. */
int32_t flan_dev_reg_emit(const void *p) {
static char desc[192];
uintptr_t a = (uintptr_t)p;
flan_reg_entry *e = flan_reg_on ? flan_reg_find(a) : NULL;
int64_t off;
char where[64];
int n;
if (e == NULL || e->died == 0) return 0;
off = (int64_t)(a - e->base);
where[0] = '\0';
if (e->elem > 0 && off % e->elem == 0 && off / e->elem > 0)
snprintf(where, sizeof where, "[%lld] of ", (long long)(off / e->elem));
else if (off != 0)
snprintf(where, sizeof where, "+%lld into ", (long long)off);
n = snprintf(desc, sizeof desc, " dead: was %s%.*s, freed at step %lld",
where, (int)e->typelen, e->type, (long long)e->died);
if (n < 0) return 0;
if (n > (int)sizeof desc - 1) n = (int)sizeof desc - 1;
flan_dev_emit((const uint8_t *)desc, n);
return 1;
}
/* How many blocks the table holds — everything, or only the live ones. For a
* test, and for the breakdown-by-type listing that is not built yet. */
int64_t flan_dev_reg_count(int32_t live_only) {
int64_t i, n = 0;
if (!flan_reg_on) return 0;
for (i = 0; i < FLAN_REG_CAP; i++) {
if (flan_reg[i].base == 0) continue;
if (live_only && flan_reg[i].died != 0) continue;
n++;
}
return n;
}

86
runtime/flan_rt.c
View File

@ -612,6 +612,24 @@ static int flan_over_budget(flan_allocator *a, int64_t size) {
return a->budget > 0 && a->live_bytes + size > a->budget;
}
/* ── The allocation registry's two halves, and why they are split ──────
*
* Recording *what type* a block was made for happens where the type is known,
* which is the compiler: a dev build emits a note after every allocating call.
* Nothing in this file has to learn a type name and no signature here grows
* one. See flan_dev.c, which holds the table.
*
* Recording that a block *died* happens here, and needs no type at all — it is
* an address, or a range of them. So this half is unconditional and calls into
* flan_dev.c, which is linked into every build and begins each of these with a
* load of a flag that only a dev build ever sets. A release build pays a load
* and a not-taken branch per free, which is not nothing, and BUILT.md says so.
*/
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen);
void flan_dev_reg_dead(void *base);
void flan_dev_reg_dead_range(void *base, int64_t bytes);
/* -- The heap allocator: malloc, realloc, free. ---------------------- */
static void *flan_heap_proc(flan_allocator *a, int32_t mode, void *p,
@ -640,11 +658,24 @@ static void *flan_heap_proc(flan_allocator *a, int32_t mode, void *p,
if (!q) return NULL;
if (p && old_size > 0)
memcpy(q, p, (size_t)(old_size < size ? old_size : size));
if (p) { free(p); a->live_blocks--; a->live_bytes -= old_size; }
/* The block moved, so the old address stops meaning what it meant. The
new one is named again by the note the compiler emits after the call
that got here — which is also why a resize needs no note of its own. */
if (p) {
flan_dev_reg_dead(p);
free(p);
a->live_blocks--;
a->live_bytes -= old_size;
}
return q;
}
case FLAN_ALLOC_FREE:
if (p) { free(p); a->live_blocks--; a->live_bytes -= old_size; }
if (p) {
flan_dev_reg_dead(p);
free(p);
a->live_blocks--;
a->live_bytes -= old_size;
}
return NULL;
case FLAN_ALLOC_FREE_ALL:
default:
@ -721,6 +752,12 @@ static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
case FLAN_ALLOC_FREE:
return NULL; /* refused by the capability set above */
case FLAN_ALLOC_FREE_ALL:
/* The hole test_valgrind.ml measures. The pages stay mapped and the bytes
stay readable, so memcheck is told nothing and never will be by this
line; what it does is make the *registry* agree that everything in the
region died, so a later read through a pointer into it is answerable
rather than silent. */
flan_dev_reg_dead_range(ar->base, ar->cap);
ar->offset = 0;
a->live_blocks = 0;
a->live_bytes = 0;
@ -794,6 +831,7 @@ void flan_arena_destroy(flan_allocator *a) {
if (a == flan_ctx_alloc) flan_ctx_alloc = &flan_heap;
if (a == flan_ctx_tmp) flan_ctx_tmp = NULL;
a->epoch++;
flan_dev_reg_dead_range(ar->base, ar->cap);
free(ar->base);
free(ar);
free(a);
@ -2158,6 +2196,50 @@ int8_t flan_map_clone(flan_map *dst, flan_map *src, flan_allocator *a,
return 1;
}
/* ── Noting a container's storage ─────────────────────────────────────
*
* The type name comes from the compiler; the *extent* comes from here, because
* the header is the only thing that knows where the storage landed and how
* much of it there is. Three entry points rather than one because three
* headers are three layouts, and a pool is two blocks that are allocated and
* released together but are not adjacent.
*
* Each is called immediately after the operation that may have allocated —
* every one of them, not only the first — because storage moves. A note is an
* upsert keyed on the base address, so re-noting an unmoved block costs a
* probe and overwrites the entry with the same numbers.
*
* A container with no storage yet notes nothing: flan_dev_reg_note ignores a
* null base, so an empty Vec needs no branch on this side. */
void flan_dev_reg_note_vec(flan_vec *v, int64_t size, const char *type,
int64_t typelen) {
if (v) flan_dev_reg_note(v->ptr, v->cap * size, size, type, typelen);
}
void flan_dev_reg_note_pool(flan_pool *p, int64_t size, const char *type,
int64_t typelen) {
if (!p) return;
flan_dev_reg_note(p->items, p->cap * size, size, type, typelen);
/* The slot headers are the pool's own bookkeeping and not the element type,
so they are named for what they are. Recording them matters for the same
reason the items do: after a free-all their bytes are still readable and
an address landing in them must not come back as an element. */
flan_dev_reg_note(p->slots, p->cap * (int64_t)sizeof(flan_pool_slot),
(int64_t)sizeof(flan_pool_slot), "pool slots", 11);
}
void flan_dev_reg_note_map(flan_map *m, int64_t ksize, int64_t vsize,
const char *type, int64_t typelen) {
if (!m || !m->data) return;
/* One block holding the hashes, the keys and the values, so the element
size is meaningless here and is passed as 0: an address inside it is
"+n into" rather than "[i] of". */
flan_dev_reg_note(m->data,
flan_map_block_size(ksize, vsize, flan_map_cap(m)), 0,
type, typelen);
}
/* ── The filesystem, and the whole of what it adds to the host ABI ───
*
* plan.org names the filesystem as the #1 portability risk — "pack assets, one

50
test/programs/dev-ptr.flan Normal file
View File

@ -0,0 +1,50 @@
;;;; A stopped stack holding two pointers into Vec storage, one of which is
;;;; already dead. The allocation registry is what lets the inspector tell
;;;; them apart, and this is the program that shows it:
;;;;
;;;; ("live" "(Ptr Enemy)" "<ptr (Enemy {.hp 41 .x 2})>")
;;;; ("dead" "(Ptr Enemy)" "<ptr dead: was Enemy, freed at step N>")
;;;;
;;;; N is the registry's own event counter and is no part of the claim: it
;;;; moves if anything allocates or frees ahead of this program's two Vecs.
;;;; A test that asserts these lines should match around it, not on it.
;;;;
;;;; Both lines are what `(:op "locals" :frame 1)` answers with today, and
;;;; both were read off a running session by hand. **No test drives this
;;;; program yet**: the case belongs beside the other `locals` and `inspect`
;;;; cases in test_dev.ml, which is another lane's file. NEXT.md says so
;;;; rather than letting the verification read as automated.
;;;;
;;;; Why a Vec rather than a struct on the stack: a stack address is not in
;;;; the registry by design — the shadow stack already answers for a local by
;;;; name — so a pointer to one renders <ptr>, which is neither half of what
;;;; this is demonstrating.
(import agent "vendor:agent")
(defstruct Boom [why i32])
(defstruct Enemy [hp i32 x i32])
(defn deeper [] i64
(restart-case
(do (error (Boom {.why 7})) 1)
(carry-on [] 5)))
(defn outer [] i64
(let [v (vec-new Enemy)
w (vec-new Enemy)]
(push v (Enemy {.hp 41 .x 2}))
(push w (Enemy {.hp 7 .x 9}))
(let [live (addr (at v 0))
dead (addr (at w 0))]
(free w)
(deeper))))
(defvar ticks i64)
(defn main [] i32
(agent/start "/tmp/flan-dev-ptr-fallback.sock")
(print (outer)) (println "")
(dotimes [i 4000]
(agent/wait 5)
(set ticks (+ ticks 1)))
0)

66
test/programs/registry.flan Normal file
View File

@ -0,0 +1,66 @@
;;;; The allocation registry — NEXT.md, "a dev-build allocation registry".
;;;;
;;;; A Flan struct is exactly its C layout with no header and no tag word, so
;;;; nothing at run time can say what is at an address. The registry sidesteps
;;;; that: the allocator's *caller* knew the type, and a dev build writes it
;;;; down. What is asserted here is the consequence a program can see without
;;;; an inspector — whether an address is still live — and the three ways
;;;; storage dies underneath one.
;;;;
;;;; This program is deliberately readable in a release build too, and prints
;;;; a different and equally correct answer there: nothing is recorded, so
;;;; every question about an address comes back 0. The two expectations sit
;;;; side by side in the acceptance table, which is the honest way to assert
;;;; "a release build carries none of it".
(declare-c reg-on [] i32 "flan_dev_reg_enabled")
(declare-c reg-live [p (Ptr i32)] i32 "flan_dev_reg_live")
(declare-c reg-count [live i32] i64 "flan_dev_reg_count")
(defvar frame Allocator)
(defn main [] i32
;; Armed by a constructor in a dev build and never in a release one.
(println (reg-on))
;; 1. The heap tier. A pointer into a Vec's storage is live while the Vec is,
;; and the free that releases it is seen — which is the whole of "use
;; after free that names what died", minus the naming, which needs the
;; inspector to read it back.
(let [v (vec-new i32)]
(push v 7)
(push v 8)
(let [p (addr (at v 1))]
(println (reg-live p)) ; dev: 1
(free v)
(println (reg-live p)))) ; 0 either way
;; 2. The arena tier, and the hole test_valgrind.ml measures. free-all is
;; retain-capacity: the pages stay mapped and the bytes stay readable, so
;; memcheck is never told anything died and a later read of stale bytes
;; goes unnoticed. This does not tell memcheck. It tells the registry, so
;; that the same read is at least *answerable*.
(set frame (arena-new 4096))
(let [w (vec-new i32 frame)]
(push w 3)
(let [q (addr (at w 0))]
(println (reg-live q)) ; dev: 1
(free-all frame)
(println (reg-live q)))) ; 0 either way
;; 3. And the pool, whose storage is the one place a (Ptr T) is handed to a
;; program by name: (resolve p h) points into the middle of the items
;; array, never at its base. Nothing but a containment lookup can answer
;; for it.
(let [pool (pool-new i32)]
(let [h (insert pool 5)]
(match (resolve pool h)
(Some ip) (println (reg-live ip)) ; dev: 1
None (println -1))
(free pool)))
;; Nothing is live by now except whatever the arena's own destroy leaves, so
;; the count is a statement about the table rather than about one address.
(arena-destroy frame)
(println (reg-count 1)) ; 0 either way
0)

18
test/test_acceptance.ml
View File

@ -431,6 +431,24 @@ let () =
outputs "allocators" "programs/allocators.flan" allocators_out;
outputs ~opt:"-O0" "allocators, -O0" "programs/allocators.flan" allocators_out;
outputs ~dev:true "allocators, dev" "programs/allocators.flan" allocators_out;
(* The allocation registry, NEXT.md. Two expectations rather than one, and
the difference between them *is* the assertion: a dev build answers for
an address at each of the three tiers and a release build answers 0 to
every question, because a release build records nothing. Written as one
program read twice rather than two programs, so that nobody can change
what a dev build does without the release row noticing.
The arena row is the one worth naming. test_valgrind.ml measures a hole:
free-all is retain-capacity, so memcheck is never told the storage died
and a later read of stale bytes goes unnoticed. This does not close that
— memcheck still says nothing — it makes the same read *answerable*, by
a different tool. The two must not be blurred. *)
outputs "registry, dev" ~dev:true "programs/registry.flan"
"1\n1\n0\n1\n0\n1\n0\n";
outputs "registry, release" "programs/registry.flan"
"0\n0\n0\n0\n0\n0\n0\n";
outputs "registry, release -O0" ~opt:"-O0" "programs/registry.flan"
"0\n0\n0\n0\n0\n0\n0\n";
(* free-all on an allocator that does not offer it traps rather than doing
nothing, because "I released the region" and "I leaked the region" must
not be the same program text. Its own case for the same reason the