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

Following a pointer was never a type question; it was a permission question

Browse Source 
(Ptr Enemy) already says Enemy, at compile time, in the walk. What the renderer
lacked was any way to know whether the storage at the far end is still there —
and an allocation registry is exactly a record of which addresses it is still
true to read. So the inspector follows a live one and renders the pointee by the
same walk as anything else, and names what died at a dead one.

println does not, and the split is not squeamishness: 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 already differ in an emitter record; they differ in one more.

No address appears in the text. An address is not stable across two runs, so
printing one would make a rendering depend on where the heap landed — the rule
Render already follows for an allocator. What a reader wants from a dangling
pointer is what died.

registry.flan is one program read twice: a dev build answers for an address at
the heap, arena and pool tiers, and a release build answers 0 to all of it. The
arena row is the free-all Valgrind cannot see — this does not make memcheck
report it, it makes the same read answerable.
This commit is contained in:
Joseph Ferano 2026-09-13 09:17:47 +07:00
parent 662b25ef5b
commit c897526e47
6 changed files with 234 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lib/check.ml
View File

@ -3918,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 =

59
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,36 @@ 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 ->
let inner =
do_ ([ lit "<ptr " ]
@ render c (depth + 1) { Tast.e = Tast.Deref e; ty = t; loc }
@ [ lit ">" ])
in
let gone = do_ [ lit "<ptr"; pt.epitaph e; lit ">" ] in
[ unit_ (Tast.If (pt.live e, 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;

65
runtime/flan_dev.c
View File

@ -999,42 +999,41 @@ int32_t flan_dev_reg_live(const void *p) {
return (int32_t)(e != NULL && e->died == 0 ? 1 : 0);
}
/* What is at this address, in words, for the branch that may not follow it.
* Written into a static buffer rather than allocated: the caller is a render
* thunk, which has no allocator and must not acquire one. */
static char flan_reg_desc[192];
const char *flan_dev_reg_describe(const void *p, int64_t *len) {
/* 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) {
/* Not "this is not a Flan allocation": a stack local's address is a
perfectly good pointer and is not in here by design. Say what is
known, which is the address. */
n = snprintf(flan_reg_desc, sizeof flan_reg_desc, "0x%llx",
(unsigned long long)a);
} else {
int64_t off = (int64_t)(a - e->base);
char where[64];
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);
if (e->died == 0)
n = snprintf(flan_reg_desc, sizeof flan_reg_desc, "0x%llx %s%.*s",
(unsigned long long)a, where, (int)e->typelen, e->type);
else
n = snprintf(flan_reg_desc, sizeof flan_reg_desc,
"0x%llx dead: was %s%.*s, freed at step %lld",
(unsigned long long)a, where, (int)e->typelen, e->type,
(long long)e->died);
}
if (n < 0) n = 0;
if (n > (int)sizeof flan_reg_desc) n = (int)sizeof flan_reg_desc;
*len = n;
return flan_reg_desc;
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

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