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

The runtime stops trusting multiplication, sharing one buffer, and keeping an unread word ambiguous

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-17 23:14:28 +07:00
commit c0ccbe2df2
18 changed files with 1052 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
FIX.org
View File

@ -156,9 +156,19 @@ against 985ms on LLVM.
arena does not make safe — and that a Map has no operation answering *where*
a value lives, which is what reading an arena-parsed EDN document back would
need. Both were relayed to the arena agent.
- [Tast.Addr (Tast.Pfield ...)] on an Option fails in both backends. The
working route is [Prim (AddrOf, [Field ...])]. Found by the drop lane, not
fixed.
- [Tast.Addr (Tast.Pfield ...)] on an Option: closed, and closed as
unreachable rather than fixed. Nothing in the source language builds it.
[.field] goes through [struct_target], which admits a struct and a pointer
to one and refuses everything else by name with a location — "(Option Point)
is not a struct, so it has no fields" — so [(addr (.x o))] never reaches a
place for [addr] to take. The node the drop lane hit was one the compiler
built for itself. Two rows in test_flan.ml pin the refusal, on the bare field
and on the address of one.
What is still asymmetric, and is a note rather than a bug: [x86.ml]'s
[field_loc] does lay out an Option's tag and value, and [emit.ml]'s [place]
admits only a named struct. Neither is reachable, so neither is tested, and
growing the LLVM side to match would be untestable code written to balance a
path nothing takes.
- Re-run still does not work under --two-process: a finished child is
genuinely gone. It now works under --x86 because --x86 runs merged.
- sand.flan still holds an uncommitted experiment line that is refused with a

32
NEXT.md
View File

@ -1321,7 +1321,7 @@ it *would* have written.
aborts. Only `SNAP_MAX`/`SNAP_NAMES` is still read rather than tested: sixty-five nested `restart-case`s are a lot
of program for a clamp. `escaped[ESCAPE_MAX]` was already covered, because `println.flan`
drives a 1100-character string through it on purpose — 1019 bytes out against a worst case of 1021 into 1024.
`scratch[SCRATCH]` never sees more than 20 characters of 64.
The number conversions' buffer never sees more than 20 characters of the 64 the caller supplies.
3. **Valgrind over the headless corpus, done.** `dune build --root . @valgrind` runs forty-nine programs under
memcheck, twelve of them again with `--no-bounds-checks`, in 91 seconds including the compiles — on a warm object
cache; 162s was measured on a cold one, which is the compiles and not the sweep. Clean. It needs no
@ -2688,26 +2688,26 @@ memcheck sweep (`@valgrind`), whose alarm is looser at 5400s because memcheck is
## Sharp edges
- **Two formatted numbers cannot be held at once.** `flan_i64_to_bytes`, `flan_f64_to_bytes` and `flan_u64_to_bytes`
all write into one `static char scratch[64]` — "rendered text lives here until the next call", flan_rt.c:184 — and
`(string b)` does not copy. So
- **A formatted number does not outlive its frame.** This entry used to say that two of them could not be held at
once, because `flan_i64_to_bytes`, `flan_f64_to_bytes` and `flan_u64_to_bytes` all wrote into one file-static buffer
and `(string b)` does not copy. That part is fixed: the buffer is the caller's now, one frame slot per call site,
allocated by the checker (`check.ml`, `to_bytes`) so that both backends get a function-lifetime location without
either of them reasoning about lifetimes. `test/programs/two-numbers.flan` is the case that used to print `22 22`.
What is left is the lifetime, and it is the ordinary one a pointer into a frame has:
```
(let [a (string (i64->bytes 11))
b (string (i64->bytes 22))]
(print a) (print " ") (println b)) ; => 22 22
(defn label [n i64] string (string (i64->bytes n))) ; a view of a frame that is gone
(push lines (string (i64->bytes n))) ; every element aliases one slot
```
`a` is 11 and prints 22. No crash and no diagnostic. This is not new — the `[u8]` already aliased — but a `string`
reads as more value-like and invites exactly this. Format, draw, measure, then format the next one; `digits.flan`
sequences itself strictly for this reason. `rl/draw-text` is safe because the shim's `flan_shim_cstr` copies out of
ptr+len before the call.
Neither is refused today. The first returns a view of storage the return has just released; the second pushes
ptr+len, not the bytes, and a slot reused on the next turn of a loop leaves every element reading as the last
number. Copy the bytes for anything that outlives the expression that made them — which is what the prelude's
`append-i64!` and `append-f64!` do, and the reason that shape exists: they copy into a `(Vec u8)`, so a builder
holds as many rendered numbers as it likes, and `format-f64` answers a `Vec` rather than a view.
**The prelude now has the shape that does not have this problem**, and it is the reason that shape exists.
`append-i64!` and `append-f64!` copy out of the scratch buffer into a `(Vec u8)` before returning, so a builder
holds as many rendered numbers as it likes, and `format-f64` answers a `Vec` rather than a view. The hazard is
unchanged for anyone calling `i64->bytes` directly — nothing was taken away — but a caller assembling a line of
text has a way not to meet it.
`rl/draw-text` is safe for a third reason: the shim's `flan_shim_cstr` copies out of ptr+len before the call.
- **Writing through a string literal is undefined, and the two build modes
disagree about how.** `(let [s (bytes "Hi")] (set (at s 0) \h))` stores into

41
docs/BUILT.md
View File

@ -2561,6 +2561,11 @@ nothing marked it — which is precisely what a static rule cannot see.
exists for is not implemented: a slice is ptr+len and has nowhere to carry the Vec's identity or its generation. Said
plainly here rather than implied by the word's presence in the header.
It is not "not yet", either, and the runtime's own comment now says so. A reader for that word is a third word on every
slice in the language — a layout `spec-memory.md` fixes — so implementing the trap is a spec amendment and an ABI
change, not a runtime patch. The two live options are that amendment, or dropping the word from the header and from the
spec together; neither is a cleanup, and until one is taken the word is carried and trusted by nothing.
### What this leaves for steps 5 to 7
`(Map K V)` is built — see below. What is left: `drop` and with it the transitive move-only rule, recursive teardown,
@ -2594,9 +2599,14 @@ Odin's header states them and they are why it was the thing to follow (`base/run
### Two departures from Odin, both deliberate
**There are no tombstones**, because `spec-memory.md` defers removal ("Move-aware lookup, removal, and owned entries
are deferred"). A slot is empty or occupied and nothing else, which deletes Odin's backward-shift loop entirely — it
is the single largest reason this file is shorter than the original. When removal arrives, that loop is what it costs.
**There are still no tombstones, now that removal exists.** A slot is empty or occupied and nothing else, and
`flan_map_remove` keeps it that way by shifting the run back over the hole rather than marking it. Odin does the
opposite, and this paragraph used to say otherwise: read out of
`base/runtime/dynamic_map_internal.odin`, `map_erase_dynamic` sets a tombstone bit and leaves the repair to the next
insert, which is why Odin's *insert* carries a backward-shift loop and its every lookup tests for a tombstone. The
trade is the usual one — erase is O(1) there and the shift is here, and the lookups, which outnumber the removals,
pay nothing. What `spec-memory.md` still defers is the rest of its sentence: move-aware lookup and owned entries. A
removed value is copied out, and nothing is dropped.
**The header does not tag the capacity into the data pointer.** Odin stuffs `log2cap` into the low six bits because
its `Raw_Map` must be three words. This header already carries an allocator, a generation and an epoch, so the tagging
@ -2644,6 +2654,7 @@ calls per field, which has no channel to hand on.
| `(put m k v)` | upsert, `()` |
| `(get m k)` | `(Option V)` — absence is `None` |
| `(has-key? m k)` | `bool`, copying no value — **an addition; the spec does not name it** |
| `(map-remove! m k)` | `(Option V)` — the value that was there, or `None` |
| `(len m)` `(reserve m n)` `(clone m)` `(clone m a)` `(free m)` | extended, not duplicated |
`has-key?` is **not in `spec-memory.md`** and is an addition, flagged because everything else here is the spec's.
@ -3738,8 +3749,10 @@ function.
```
**The cursor is a slot index the caller owns, and there is no iterator struct** because there is nothing for one to
hold. A map has no tombstones — removal is deferred (`spec-memory.md`) — so a slot is either empty or occupied and the
position is the whole of the state. The cursor starts at 0, comes back one past the entry just answered, and is left
hold. A map has no tombstones — removal shifts the run back instead of marking a hole — so a slot is either empty or
occupied and the position is the whole of the state. What a cursor does *not* survive is a removal taken while it is
in flight: the shift moves entries to lower slots, and a cursor already past them steps over entries it has not
answered, the same bargain a put that grows already makes. The cursor starts at 0, comes back one past the entry just answered, and is left
at `cap` by the call that answers false, so a spent cursor keeps answering false rather than wrapping.
**Three out-pointers and not a returned pair**, because there are no tuples. An `(Option K)` would answer half an
@ -4948,6 +4961,17 @@ The two sides of the table therefore look different, and the difference is which
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.
**Two threads, so the table has the watch table's seqlock.** The writer is the game thread, inside every allocation and
every free; the reader is the agent's listener, and the two listing verbs are asked of a *running* program — "what is
still held" is the question asked in the last moment before a game is killed, which is not a moment anything is stopped
in. So the frame chain's answer, snapshot it while the thread is parked, is not available here. Each entry carries its
own counter, odd while it is written; a reader copies the entry and re-reads the counter, and a compaction bumps a
table-wide counter around itself because it moves entries between slots and a per-slot counter cannot describe that.
The pair this protects is `type` and `typelen`: they mean nothing apart, and a reader holding the new pointer with the
old length reads off the end of a string literal. `reg at`, the one verb that makes a claim about a single address
rather than describing the program, is refused while running instead — the daemon already refused it, and the agent now
says so too.
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
@ -5369,9 +5393,10 @@ to name and nothing to choose between, so the abstract pass could not build the
pair would have been worse than refusing: it would hash a string's pointer and a struct's padding.
**What closes it is deferral, and what makes deferral safe is the `where` clause.** `put`, `get`, `has-key?`,
`reserve` and `clone` — the five arms that reach `key_fns` — now check their arguments and then, when the key is a
type variable, return a placeholder of the operation's own type: `Unit` for `put` and `reserve`, `None` for `get`
so the `(Option V)` around it still checks, `false` for `has-key?`, a zeroed map for `clone`. The whole node is
`map-remove!`, `reserve` and `clone` — the arms that reach `key_fns` — now check their arguments and then, when the
key is a type variable, return a placeholder of the operation's own type: `Unit` for `put` and `reserve`, `None` for
`get` and for `map-remove!` so the `(Option V)` around either still checks, `false` for `has-key?`, a zeroed map for
`clone`. The whole node is
thrown away with the rest of the abstract pass, exactly as `println`'s is, and the real one is built when the copy
is checked with `$t` concrete.

28
lib/build.ml
View File

@ -659,7 +659,17 @@ let clang_stamp = lazy (stamp_of clang)
the source text, the compiler and the flags are all unchanged. The key has
to carry [opt] and [target]: the acceptance table builds the same programs
at -O0 and -O2, and an -O2 object must not serve an -O0 build. *)
let compile_c ~opts ?tflags ~src ~name () =
(* Warnings for the translation units this project *owns*, which is the runtime
and the dev half of it. They are not on for a package's C or for the
generated shim: a package's sources are someone else's code, and a warning
nobody in this repository can fix is noise on every build that imports it.
The runtime is the opposite case — an unused result, a sign compare or a
conversion that narrows is a bug report here, and the file had none of this
coverage before. [-Werror] is deliberately absent: a clang upgrade must not
stop a user's build over a new diagnostic in code they did not write. *)
let runtime_warnings = [ "-Wall"; "-Wextra" ]
let compile_c ~opts ?tflags ?(warn = []) ~src ~name () =
(* The whole flag list, not just the triple: on wasm32 the sysroot and the
resource directory decide which headers and which builtins an object was
built against, so repointing either must not serve a stale .o. *)
@ -671,7 +681,8 @@ let compile_c ~opts ?tflags ~src ~name () =
(String.concat "\000"
[ name; src; stamp_of cc; opts.opt;
String.concat " " (cflags opts);
String.concat " " tflags ]))
String.concat " " tflags;
String.concat " " warn ]))
in
let obj = Filename.concat (cachedir ()) (key ^ ".o") in
if not (Sys.file_exists obj) then begin
@ -685,6 +696,7 @@ let compile_c ~opts ?tflags ~src ~name () =
String.concat " "
([ Filename.quote cc; opts.opt ]
@ cflags opts
@ warn
@ [ "-c" ] @ tflags
@ [ Filename.quote c; "-o"; Filename.quote tmp ])
in
@ -830,13 +842,13 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
rather than as a missing flag. The table is BSS, so this costs address
space and not binary size, and [-rdynamic] and the cells are still what
[--dev] means. *)
let cc src name = compile_c ~opts ~tflags ~src ~name () in
let cc ?(warn = []) src name = compile_c ~opts ~tflags ~warn ~src ~name () in
(* The runtime's own C wants -g too, or a backtrace that passes through
flan_error lands in a frame with no line. The flag is part of the object
cache key via [compile_c]'s [opt]/[tflags] digest — see [cflags]. *)
let objs =
cc Runtime_src.source "flan_rt.c"
:: [ cc Runtime_src.dev_source "flan_dev.c" ]
cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c"
:: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c" ]
(* wasi-libc's entry point, which is not [main]. See [wasm_main_source].
Not the browser's: emscripten's start code calls [main] under that name,
so the .ll's @main is already the entry point and the shim would be a
@ -1087,10 +1099,10 @@ let macro_module ?(opts = default) ?(csrcs = []) ?(lflags = []) ~macros
link time, not at codegen, which is the same trap [shared] meets and
answers with -relocation-model=pic. *)
let tflags = target_flags opts @ [ "-fPIC" ] in
let cc src name = compile_c ~opts ~tflags ~src ~name () in
let cc ?(warn = []) src name = compile_c ~opts ~tflags ~warn ~src ~name () in
let objs =
cc Runtime_src.source "flan_rt.c"
:: [ cc Runtime_src.dev_source "flan_dev.c" ]
cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c"
:: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c" ]
@ (match p.Tast.cshim with
| [] -> []
| parts ->

129
lib/check.ml
View File

@ -1186,6 +1186,38 @@ let align_of loc t = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.AlignOf t, []
let addr_of loc (e : Tast.expr) =
mk loc (Types.Ptr e.Tast.ty) (Tast.Prim (Tast.AddrOf, [ e ]))
(* ── Where a rendered number's bytes live ──────────────────────────────
The three number-to-text conversions used to answer a slice into one static
buffer in the runtime, shared by every call in the process, and nothing
copied it: (print a) (print b) over two of them printed the second number
twice. No crash and nothing for a sanitizer to find, because the read was
inside a buffer that was perfectly alive — the wrong bytes, alive.
The buffer is now the caller's, one frame slot per call site, and it is
allocated here rather than in either backend on purpose: a slot is a
function-lifetime frame location in both of them — an entry-block alloca in
[Emit], a prologue-allocated offset in [X86] — where a backend temporary in
[X86] is bump-allocated and reclaimed at the end of the expression that made
it, which is exactly the lifetime a returned slice must outlive. Doing it
once here also keeps the two backends symmetric by construction: each gains
one pointer argument and no lifetime reasoning of its own.
64 bytes is agreed with flan_rt.c's FLAN_NUM_BYTES, which clamps the length
it publishes to it. The zeroing the [Let] does is one 64-byte clear beside
an snprintf. *)
let num_bytes = 64L
let to_bytes ctx loc pr (x : Tast.expr) =
let bty = Types.Array (num_bytes, Types.Int Types.U8) in
let bslice = Types.Slice (Types.Int Types.U8) in
let s = fresh_slot ctx bty in
mk loc bslice
(Tast.Let
([ (s, mk loc bty (Tast.Zero bty)) ],
[ mk loc bslice
(Tast.Prim (pr, [ x; addr_of loc (mk loc bty (Tast.Local s)) ])) ]))
(* ── The region requirement, emitted ───────────────────────────────────
spec-memory.md's arena rule, and the whole of what replaced the three
refusals a container of owning elements used to meet at its *type*. The
@ -4527,6 +4559,62 @@ and named_call ctx ~want loc name args =
[ mk loc oty (Tast.If (cond, some, none)) ])))
| _ -> assert false)
(* (map-remove! m k) -> (Option V): the value that was there, or None when
the key was not. The same answer [get] gives, for the same reason — a key
that is not in the map is an answer and not a failure — and the value
comes back rather than being dropped on the floor, which is what makes
"take this out and use it" one call instead of a get and a remove that
hash the key twice.
It allocates nothing and releases nothing, so unlike [put] there is no
alloc_guard and no region check around it: a key and a value live inside
the one block the map allocated, and removal moves entries within that
block. That is what makes it mean the same thing on a map backed by an
arena — or by any allocator that refuses can-free — as on a heap-backed
one. Nothing is freed per entry because nothing was allocated per entry.
The [!] is the mutation the naming rule asks for ([map-next!], and the
note below on the two suffixes). *)
| "map-remove!" ->
arity loc name 2 args;
(match args with
| [ target; k ] ->
let target = borrowed ctx target (fun () -> check ctx target) in
let kt, vt = map_kv loc "map-remove!" target.Tast.ty in
let k = check ctx ~want:kt k in
(* Deferred exactly as [get] is, and with [None] for the same reason:
the abstract pass still has to check whatever the body does with the
answer. *)
if deferred_key ctx.env loc "map-remove!" kt then
expect loc ~want (mk loc (Types.Option vt) Tast.None_)
else
let hash, eq = key_fns ctx.env loc kt in
let ks = fresh_slot ctx kt in
let out = fresh_slot ctx vt in
let found =
rt loc (Types.Int Types.I8) "flan_map_remove"
[ target; addr_of loc (mk loc kt (Tast.Local ks));
addr_of loc (mk loc vt (Tast.Local out));
size_of loc kt; size_of loc vt; hash; eq; here loc ]
in
let oty = Types.Option vt in
(* Built here and not there, as [get]'s is: the runtime fills [out] only
when it answers 1 and has no idea what an Option's layout is. *)
let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in
let none = mk loc oty Tast.None_ in
let cond =
mk loc Types.Bool
(Tast.Prim (Tast.Ne,
[ found;
mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
in
expect loc ~want
(mk loc oty
(Tast.Let ([ (ks, k);
(out, mk loc vt (Tast.Zero vt)) ],
[ mk loc oty (Tast.If (cond, some, none)) ])))
| _ -> assert false)
(* (map-next! m (addr cur) (addr k) (addr v)) -> bool, and the whole of map
iteration. Before it there was no way to read a map's keys or its values
at all: every other map operation addresses one entry by hashing it, and
@ -4736,7 +4824,8 @@ and named_call ctx ~want loc name args =
(* 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. *)
try_ (rt loc (Types.Int Types.I8) "flan_slurp_into" [ vv (); psv () ]) ]
try_ (rt loc (Types.Int Types.I8) "flan_slurp_into"
[ vv (); psv (); size_of loc u8; here loc ]) ]
in
expect loc ~want
(mk loc vt
@ -5038,11 +5127,13 @@ and named_call ctx ~want loc name args =
Provenance is still what the other direction needs; nothing here
depends on having it.
The one sharp edge is not new but is easier to trip over now: the slice
that i64->bytes / f64->bytes / u64->bytes answer is a view into one shared
static buffer in the runtime, overwritten by the next such call. Calling
it a string does not copy it. Use it before formatting the next number;
you cannot hold two at once. *)
The sharp edge left here is one of lifetime and no longer one of sharing:
the slice that i64->bytes / f64->bytes / u64->bytes answer is a view into
a frame slot belonging to *that call site* (see [to_bytes]), so two of
them can be held at once and the text of one survives the making of the
next. What it does not survive is its frame — calling it a string does not
copy it, so storing one in a container or returning it hands back a view
of storage that has been reused. Copy the bytes for that. *)
| "string" ->
arity loc name 1 args;
prim Tast.StrOfBytes Types.String [ byte_slice ctx (List.hd args) ]
@ -5054,12 +5145,14 @@ and named_call ctx ~want loc name args =
prim Tast.BytesToI64 (Types.Int Types.I64) [ byte_slice ctx (List.hd args) ]
| "f64->bytes" ->
arity loc name 1 args;
prim Tast.F64ToBytes (Types.Slice (Types.Int Types.U8))
[ check ctx ~want:(Types.Float Types.F64) (List.hd args) ]
expect loc ~want
(to_bytes ctx loc Tast.F64ToBytes
(check ctx ~want:(Types.Float Types.F64) (List.hd args)))
| "i64->bytes" ->
arity loc name 1 args;
prim Tast.I64ToBytes (Types.Slice (Types.Int Types.U8))
[ check ctx ~want:(Types.Int Types.I64) (List.hd args) ]
expect loc ~want
(to_bytes ctx loc Tast.I64ToBytes
(check ctx ~want:(Types.Int Types.I64) (List.hd args)))
| "write-stdout" ->
arity loc name 1 args;
prim Tast.WriteStdout Types.Unit [ byte_slice ctx (List.hd args) ]
@ -5110,7 +5203,7 @@ and named_call ctx ~want loc name args =
call site these can be refused at. They are deferred and then always
succeed. That is the cheapest possible membership.
The map operations — [put], [get], [has-key?], [reserve], [clone],
The map operations — [put], [get], [has-key?], [map-remove!], [reserve], [clone],
through [deferred_key] beside [key_fns] — are the other kind, and they
are here on a different argument. They *can* fail at a concrete type,
so deferring them does move a refusal. But [{:where (hashable? $t)}] is
@ -5136,10 +5229,20 @@ and named_call ctx ~want loc name args =
else
let bslice = Types.Slice (Types.Int Types.U8) in
let write x = mk loc Types.Unit (Tast.Prim (Tast.WriteStdout, [ x ])) in
let conv pr x = mk loc bslice (Tast.Prim (pr, [ x ])) in
(* One frame slot per conversion the printer emits, which is what
[to_bytes] is for. The printer writes each number out before making the
next, so a shared buffer would in fact have served it — but the slot is
what the node now carries, and a printer that assembled its own buffer
would be a second answer to the same question. [escape] is the one that
still renders into a static: it is reachable from nowhere but here, and
its 1KB buffer per printed string field is a frame cost with no bug
behind it. Said here so the asymmetry is a decision and not an
oversight. *)
let conv pr x = to_bytes ctx loc pr x in
let emitter : Render.emitter =
{ Render.ebytes = write;
estr = (fun x -> write (conv Tast.EscapeBytes x));
estr = (fun x -> write (mk loc bslice
(Tast.Prim (Tast.EscapeBytes, [ x ]))));
ei64 = (fun x -> write (conv Tast.I64ToBytes x));
eu64 = (fun x -> write (conv Tast.U64ToBytes x));
ef64 = (fun x -> write (conv Tast.F64ToBytes x)) }

23
lib/emit.ml
View File

@ -2169,9 +2169,12 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
| Tast.StrOfBytes, [ x ] -> value f x
| Tast.BytesToF64, [ x ] -> shim_in f "@flan_bytes_to_f64" "double" x
| Tast.BytesToI64, [ x ] -> shim_in f "@flan_bytes_to_i64" "i64" x
| Tast.F64ToBytes, [ x ] -> shim_out f "@flan_f64_to_bytes" x
| Tast.I64ToBytes, [ x ] -> shim_out f "@flan_i64_to_bytes" x
| Tast.U64ToBytes, [ x ] -> shim_out f "@flan_u64_to_bytes" x
(* The second argument is the caller's buffer — a frame slot the checker gave
this call site, so that two conversions in one expression are two buffers.
See check.ml's [to_bytes]. *)
| Tast.F64ToBytes, [ x; b ] -> shim_out f "@flan_f64_to_bytes" x b
| Tast.I64ToBytes, [ x; b ] -> shim_out f "@flan_i64_to_bytes" x b
| Tast.U64ToBytes, [ x; b ] -> shim_out f "@flan_u64_to_bytes" x b
| Tast.EscapeBytes, [ x ] -> shim_in_out f "@flan_escape_bytes" x
| Tast.WriteStdout, [ x ] ->
let p, n = explode f x in
@ -2263,10 +2266,11 @@ and shim_in f name ret x =
ins f "%s = call %s %s(ptr %s, i64 %s)" t ret name p n;
t
and shim_out f name (x : Tast.expr) =
and shim_out f name (x : Tast.expr) (buf : Tast.expr) =
let v = value f x in
let b = value f buf in
let tmp = alloca f (Types.Slice (Types.Int Types.U8)) in
ins f "call void %s(%s %s, ptr %s)" name (ll x.Tast.ty) v tmp;
ins f "call void %s(%s %s, ptr %s, ptr %s)" name (ll x.Tast.ty) v b tmp;
load f tmp (Types.Slice (Types.Int Types.U8))
(* Slice in, slice out: [shim_in] returns a scalar and [shim_out] takes one, so
@ -2703,9 +2707,9 @@ declare void @flan_write_stdout(ptr, i64)
declare void @flan_exit(i32)
declare double @flan_bytes_to_f64(ptr, i64)
declare i64 @flan_bytes_to_i64(ptr, i64)
declare void @flan_f64_to_bytes(double, ptr)
declare void @flan_i64_to_bytes(i64, ptr)
declare void @flan_u64_to_bytes(i64, ptr)
declare void @flan_f64_to_bytes(double, ptr, ptr)
declare void @flan_i64_to_bytes(i64, ptr, ptr)
declare void @flan_u64_to_bytes(i64, ptr, ptr)
declare void @flan_escape_bytes(ptr, i64, ptr)
declare void @flan_handler_push(ptr)
declare void @flan_handler_pop(ptr)
@ -2782,6 +2786,7 @@ declare i8 @flan_map_init(ptr, ptr, i64, i64, ptr, i64)
declare i8 @flan_map_put(ptr, ptr, ptr, i64, i64, ptr, ptr, ptr, i64)
declare i8 @flan_map_get(ptr, ptr, ptr, i64, i64, ptr, ptr, ptr, i64)
declare i8 @flan_map_has(ptr, ptr, i64, i64, ptr, ptr, ptr, i64)
declare i8 @flan_map_remove(ptr, ptr, ptr, i64, i64, ptr, ptr, ptr, i64)
declare i8 @flan_map_reserve(ptr, i64, i64, i64, ptr, ptr, i64)
declare i8 @flan_map_clone(ptr, ptr, ptr, i64, i64, ptr, ptr, i64)
declare i64 @flan_map_len(ptr, ptr, i64)
@ -2818,7 +2823,7 @@ declare i8 @flan_file_delete(ptr, i64)
declare i8 @flan_file_rename(ptr, i64, ptr, i64)
declare i8 @flan_file_mkdir(ptr, i64)
declare i64 @flan_file_fail_reason()
declare i8 @flan_slurp_into(ptr, ptr, i64)
declare i8 @flan_slurp_into(ptr, ptr, i64, i64, ptr, i64)
|}
(* C's main, adapting to whichever of the four shapes Flan's main has: argv and

20
lib/shim.ml
View File

@ -306,11 +306,21 @@ let header =
what keeps that allocation-free in the overwhelmingly common case, and it is
256 because that covers a title, a path and a line of text without making
every foreign call carry a page of stack. The only truncation left is when
malloc itself fails, where the alternative is handing C a null pointer. *)
malloc itself fails, where the alternative is handing C a null pointer.
An embedded NUL is refused rather than copied, which is the policy
flan_path_cstr has always had for a path and which a title, a name or a
query needs for the same reason: C reads to the first NUL, so what crosses
would be a prefix of the string the program passed and the function would
act on a value nobody wrote. The refusal is the runtime's — the shim has no
condition channel — and it names the declare-c it came from. *)
let cstr_helpers =
"static char *flan_shim_cstr(const char *p, int64_t n, char *buf, size_t cap) {\n\
"_Noreturn void flan_shim_nul_fail(const char *site);\n\n\
static char *flan_shim_cstr(const char *p, int64_t n, char *buf, size_t cap,\n\
\ const char *site) {\n\
\ size_t len = n <= 0 ? 0 : (size_t)n;\n\
\ char *d = buf;\n\
\ if (len != 0 && memchr(p, '\\0', len) != NULL) flan_shim_nul_fail(site);\n\
\ if (len + 1 > cap) {\n\
\ d = (char *)malloc(len + 1);\n\
\ if (d == NULL) { d = buf; len = cap - 1; } /* out of memory: truncate */\n\
@ -386,9 +396,11 @@ let c_for (s : shim) =
| Pstr ->
let a = arg_name i in
Printf.bprintf b " char %s_b[%d];\n" a cstr_cap;
(* The Flan name travels with the copy so that a refusal names the
call the way every other runtime trap names its site. *)
Printf.bprintf b
" char *%s = flan_shim_cstr(%s_p, %s_n, %s_b, sizeof %s_b);\n" a a a
a a
" char *%s = flan_shim_cstr(%s_p, %s_n, %s_b, sizeof %s_b, %S);\n"
a a a a a s.sflan
| _ -> ())
s.sargs;
let call_args =

25
lib/x86.ml
View File

@ -2668,9 +2668,12 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst =
(* string and [u8] are the same two words, so both directions are views and
not copies — the same non-instruction [emit.ml] emits. *)
| (Tast.Bytes | Tast.StrOfBytes), [ a ] -> lower f a dst
| Tast.I64ToBytes, [ a ] -> shim_out f "flan_i64_to_bytes" a dst
| Tast.U64ToBytes, [ a ] -> shim_out f "flan_u64_to_bytes" a dst
| Tast.F64ToBytes, [ a ] -> shim_out f "flan_f64_to_bytes" a dst
(* [b] is the caller's buffer, a frame slot the checker gave this call site.
See check.ml's [to_bytes]: a backend temporary here would be reclaimed at
the end of this expression and the slice outlives it. *)
| Tast.I64ToBytes, [ a; b ] -> shim_out f "flan_i64_to_bytes" a b dst
| Tast.U64ToBytes, [ a; b ] -> shim_out f "flan_u64_to_bytes" a b dst
| Tast.F64ToBytes, [ a; b ] -> shim_out f "flan_f64_to_bytes" a b dst
| Tast.EscapeBytes, [ a ] ->
let l = eval f a in
slice_in_out f "flan_escape_bytes" l dst
@ -2718,17 +2721,23 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst =
| Tast.Cast target, [ a ] -> cast f a target dst
| _ -> unsupported "primitive with %d arguments" (List.length args)
(* [void shim(T, flan_slice *out)] — a scalar in, a slice written through a
hidden out pointer. The three number printers, and nothing else. *)
and shim_out f sym (a : Tast.expr) dst =
(* [void shim(T, uint8_t *buf, flan_slice *out)] — a scalar in, text rendered
into the caller's buffer, and a slice over it written through a hidden out
pointer. The three number printers, and nothing else.
Both operands are evaluated before any argument register is loaded:
evaluating one is arbitrary code and would otherwise overwrite the other. *)
and shim_out f sym (a : Tast.expr) (buf : Tast.expr) dst =
let l = eval f a in
let lb = eval f buf in
if is_float a.Tast.ty then begin
fload f.b ~dst:xmm0 ~mm:(lmem f l ~scratch:r11) ~f64:(f64_of a.Tast.ty);
addr_into f ~reg:rdi dst;
load_loc f ~reg:rdi lb buf.Tast.ty;
addr_into f ~reg:rsi dst;
imm_into f ~reg:rax 1L
end else begin
load_loc f ~reg:rdi l a.Tast.ty;
addr_into f ~reg:rsi dst;
load_loc f ~reg:rsi lb buf.Tast.ty;
addr_into f ~reg:rdx dst;
imm_into f ~reg:rax 0L
end;
call_sym f.b sym

216
runtime/flan_dev.c
View File

@ -1047,8 +1047,78 @@ typedef struct {
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 */
uint64_t gen; /* this slot's own seqlock; odd while it is written */
} flan_reg_entry;
/* ── Why this table has a seqlock and the watch table's is the model ───
*
* The writer is the game thread, inside every allocation and every free. The
* reader is the agent's listener thread, on a program that is *running* — the
* two listing verbs answer "where did the memory go" and "what is still held",
* and the second of those is asked in the last moment before a game is killed,
* which is a moment the program is not stopped in. So the frame chain's answer
* — snapshot it while the thread is parked — is not available to this table,
* and a plain read of it is a read of eight words another thread is in the
* middle of writing.
*
* The consequence is not a slightly wrong number. [type] and [typelen] are a
* pointer and a length that are only meaningful together, and a reader that
* takes the new pointer with the old length reads off the end of a string
* literal. That is the failure this closes.
*
* Per slot, exactly as [watch_slot] does it: odd while a write is in flight,
* even when it is whole, and a reader copies the slot and re-reads the counter
* to find out whether what it copied ever existed. The compaction is the one
* thing a per-slot counter cannot describe, because it moves entries between
* slots — so it bumps a table-wide counter around itself and a scan that sees
* that counter move starts again. Nothing here blocks the writer: a reader
* that cannot get a clean read gives up after a bounded number of attempts,
* which is the rule everywhere else in this file. */
static uint64_t flan_reg_epoch; /* odd while the table is being compacted */
static void flan_reg_begin(flan_reg_entry *e) {
__atomic_store_n(&e->gen, e->gen | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
}
/* Back to even, so a reader that sees the new count sees the whole entry. The
* [| 1] is [watch]'s: a write abandoned by a break taken inside it must still
* land on an even count. */
static void flan_reg_end(flan_reg_entry *e) {
__atomic_store_n(&e->gen, (e->gen | 1) + 1, __ATOMIC_RELEASE);
}
/* One slot, copied whole or not at all. 0 means the writer kept winning, which
* a caller reports as a slot it could not read rather than as an empty one. */
static int flan_reg_snap(flan_reg_entry *e, flan_reg_entry *out) {
int attempt;
for (attempt = 0; attempt < 64; attempt++) {
uint64_t g1 = __atomic_load_n(&e->gen, __ATOMIC_ACQUIRE);
if (g1 & 1) continue; /* a write is in progress */
*out = *e;
/* Ordered before the second read of the counter, or the check is of a copy
* the compiler was free to make afterwards. */
__atomic_thread_fence(__ATOMIC_ACQUIRE);
if (__atomic_load_n(&e->gen, __ATOMIC_ACQUIRE) == g1) return 1;
}
return 0;
}
/* The table-wide counter, read on the way into a scan and again on the way
* out: a compaction between the two moved entries, so the scan saw some of
* them twice and some not at all. */
static int flan_reg_scan_open(uint64_t *at) {
uint64_t g = __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE);
if (g & 1) return 0;
*at = g;
return 1;
}
static int flan_reg_scan_ok(uint64_t at) {
__atomic_thread_fence(__ATOMIC_ACQUIRE);
return __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE) == at;
}
/* 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
@ -1104,8 +1174,23 @@ static void flan_reg_compact(void) {
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; }
/* Odd for the duration, so a scan that overlapped this throws its counts
away rather than reporting a table half in one arrangement and half in
the other. */
__atomic_store_n(&flan_reg_epoch, flan_reg_epoch | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
memcpy(old, flan_reg, bytes);
memset(flan_reg, 0, bytes);
/* Cleared slot by slot under each slot's own counter rather than by one
memset over the array: the memset would zero the counters themselves, and
a reader holding one would then validate a read of an entry that was
rewritten underneath it. */
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
flan_reg_begin(e);
e->type = NULL; e->typelen = 0; e->base = 0;
e->bytes = 0; e->elem = 0; e->seq = 0; e->died = 0;
flan_reg_end(e);
}
flan_reg_used = 0;
for (i = 0; i < FLAN_REG_CAP; i++) {
size_t s;
@ -1115,13 +1200,19 @@ static void flan_reg_compact(void) {
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_entry *e = &flan_reg[j];
flan_reg_begin(e);
e->type = old[i].type; e->typelen = old[i].typelen;
e->base = old[i].base; e->bytes = old[i].bytes;
e->elem = old[i].elem; e->seq = old[i].seq; e->died = old[i].died;
flan_reg_end(e);
flan_reg_used++;
break;
}
}
}
free(old);
__atomic_store_n(&flan_reg_epoch, (flan_reg_epoch | 1) + 1, __ATOMIC_RELEASE);
}
/* One note per allocation. [base] replaces whatever was recorded there, live
@ -1139,6 +1230,10 @@ void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
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++;
/* The pair a torn read would get wrong is [type] and [typelen], which is
why the whole entry goes under the counter rather than the two of them
being ordered somehow. */
flan_reg_begin(&flan_reg[j]);
flan_reg[j].type = type;
flan_reg[j].typelen = typelen;
flan_reg[j].base = a;
@ -1146,6 +1241,7 @@ void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
flan_reg[j].elem = elem;
flan_reg[j].seq = ++flan_reg_seq;
flan_reg[j].died = 0;
flan_reg_end(&flan_reg[j]);
return;
}
/* Full of live blocks. Killing the program because it ran out of diagnostic
@ -1194,7 +1290,11 @@ void flan_dev_reg_dead(void *base) {
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;
if (flan_reg[j].died == 0) {
flan_reg_begin(&flan_reg[j]);
flan_reg[j].died = ++flan_reg_seq;
flan_reg_end(&flan_reg[j]);
}
return;
}
}
@ -1213,7 +1313,11 @@ void flan_dev_reg_dead_range(void *base, int64_t bytes) {
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;
if (e->base >= lo && e->base < hi) {
flan_reg_begin(e);
e->died = now;
flan_reg_end(e);
}
}
}
@ -1305,15 +1409,39 @@ int64_t flan_dev_reg_count(int32_t live_only) {
int32_t flan_dev_reg_at(const void *p, const char **type, int64_t *typelen,
int64_t *off, int64_t *bytes, int64_t *elem,
int64_t *seq, int64_t *died) {
flan_reg_entry *e = flan_reg_on ? flan_reg_find((uintptr_t)p) : NULL;
if (e == NULL) return 0;
if (type) *type = e->type;
if (typelen) *typelen = e->typelen;
if (off) *off = (int64_t)((uintptr_t)p - e->base);
if (bytes) *bytes = e->bytes;
if (elem) *elem = e->elem;
if (seq) *seq = e->seq;
if (died) *died = e->died;
/* The one reader of the containment lookup that is not on the game thread —
* [flan_dev_reg_live] and [flan_dev_reg_emit] above run inside a render
* thunk, which is the writer's own thread — so this one copies each slot
* under its counter instead of pointing into the table. See the seqlock
* note above the entry type. */
uintptr_t a = (uintptr_t)p;
flan_reg_entry best, cur;
int have = 0, attempt;
if (!flan_reg_on || a == 0) return 0;
for (attempt = 0; attempt < 8; attempt++) {
uint64_t at;
int64_t i;
have = 0;
if (!flan_reg_scan_open(&at)) continue;
for (i = 0; i < FLAN_REG_CAP; i++) {
if (!flan_reg_snap(&flan_reg[i], &cur)) continue;
if (cur.base == 0) continue;
if (a < cur.base || a >= cur.base + (uintptr_t)cur.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 (!have || (best.died != 0 && cur.died == 0)) { best = cur; have = 1; }
}
if (flan_reg_scan_ok(at)) break;
have = 0;
}
if (!have) return 0;
if (type) *type = best.type;
if (typelen) *typelen = best.typelen;
if (off) *off = (int64_t)(a - best.base);
if (bytes) *bytes = best.bytes;
if (elem) *elem = best.elem;
if (seq) *seq = best.seq;
if (died) *died = best.died;
return 1;
}
@ -1357,31 +1485,49 @@ int64_t flan_dev_reg_by_type(int32_t live_only, int64_t *counts,
int64_t *bytes, const char **types,
int64_t *typelens, int64_t cap) {
int64_t i, n = 0;
int attempt;
if (!flan_reg_on) return 0;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
int64_t j;
int found = 0;
if (e->base == 0) continue;
if (live_only && e->died != 0) continue;
for (j = 0; j < n && j < cap; j++) {
if (typelens[j] != e->typelen) continue;
if (memcmp(types[j], e->type, (size_t)e->typelen) != 0) continue;
counts[j]++;
bytes[j] += e->bytes;
found = 1;
break;
/* Read off a running program, which is what makes the counters below
necessary: a row is a (pointer, length) pair that is only meaningful
together, and the memcmp two lines down is where a torn one would read off
the end of a string literal. The whole walk is retried when a compaction
ran through the middle of it, since entries moved and the counts would
hold some blocks twice and some not at all. */
for (attempt = 0; attempt < 8; attempt++) {
uint64_t at;
n = 0;
if (!flan_reg_scan_open(&at)) continue;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry e;
int64_t j;
int found = 0;
if (!flan_reg_snap(&flan_reg[i], &e)) continue;
if (e.base == 0) continue;
if (live_only && e.died != 0) continue;
for (j = 0; j < n && j < cap; j++) {
if (typelens[j] != e.typelen) continue;
if (memcmp(types[j], e.type, (size_t)e.typelen) != 0) continue;
counts[j]++;
bytes[j] += e.bytes;
found = 1;
break;
}
if (found) continue;
if (n < cap) {
types[n] = e.type;
typelens[n] = e.typelen;
counts[n] = 1;
bytes[n] = e.bytes;
}
n++;
}
if (found) continue;
if (n < cap) {
types[n] = e->type;
typelens[n] = e->typelen;
counts[n] = 1;
bytes[n] = e->bytes;
}
n++;
if (flan_reg_scan_ok(at)) return n;
}
return n;
/* Eight walks and a compaction through every one of them. Answering with the
last walk's rows would be answering with a table that never existed, so
this answers with none — the caller prints a header saying how many rows
follow, and zero is a number it can print. */
return 0;
}
/* ── What is still held when the program returns ──────────────────────

324
runtime/flan_rt.c
View File

@ -157,9 +157,28 @@ void flan_rt_init(int32_t argc, char **argv) {
setvbuf(stdout, NULL, _IOLBF, 0);
}
/* Defined below with the rest of the non-local exits, and forward-declared
* here because the argument vector is built long before them. */
static _Noreturn void rt_die(void);
/* The one malloc in this file that is not an allocator's, because the argument
* vector belongs to the process rather than to any region a Flan program named.
* A failure here cannot be a condition: [argv] has no allocation site for the
* compiler to wrap in a restart, and answering with a shorter vector — or with
* a null pointer and a length — is the silently-wrong answer every other entry
* point in this file refuses to give. It cannot fire in practice: this is a
* handful of words asked for before the program has allocated anything. */
void flan_argv(flan_slice *out) {
if (rt_args == NULL && rt_argc > 0) {
rt_args = (flan_slice *)malloc(sizeof(flan_slice) * (size_t)rt_argc);
if (rt_args == NULL) {
fflush(stdout);
fprintf(stderr,
"flan: out of memory building the argument vector for %d "
"arguments\n",
rt_argc);
rt_die();
}
for (int i = 0; i < rt_argc; i++) {
rt_args[i].ptr = (const uint8_t *)rt_argv[i];
rt_args[i].len = (int64_t)strlen(rt_argv[i]);
@ -214,21 +233,35 @@ void flan_condition_stacks_reset(void) {
/* The conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it.
* calc-me's tokenizer needs the first, the prelude's printers the second. */
#define SCRATCH 64
static char scratch[SCRATCH]; /* rendered text lives here until the next call */
/* Where the rendered text goes, and who owns it.
*
* The buffer belongs to the *caller*: the compiler gives every one of these
* call sites a frame slot of its own and passes its address, so two
* conversions in one expression are two buffers and the text of the first is
* still there while the second is made. It used to be one file-static, shared
* by every call in the process — (print a) (print b) over two conversions
* printed the second number twice, with no crash and nothing for a sanitizer
* to see, because the read was inside a buffer that was perfectly alive.
*
* What this does *not* buy is storage: the slice points into the caller's
* frame, so holding one past the function that made it, or pushing it into a
* container that outlives the frame, is still the caller's problem. Copy the
* bytes for that. The size is agreed with check.ml, which allocates the slot —
* grep FLAN_NUM_BYTES there before changing it here. */
#define FLAN_NUM_BYTES 64
/* snprintf returns what it *would* have written, not what it did. The three
* shims below hand the result back as a slice, so taking that number at face
* value would publish a length past the end of the buffer and every reader of
* that slice would run off it. No format here can reach 64 — %g is at most 13
* characters and %lld at most 20 — so this clamp cannot fire today; it is here
* because the distance between "cannot fire" and "reads off the end of a
* static buffer" is one format string, and nothing else in the file says so.
* value would publish a length past the end of the caller's buffer and every
* reader of that slice would run off it. No format here can reach 64 — %g is
* at most 13 characters and %lld at most 20 — so this clamp cannot fire today;
* it is here because the distance between "cannot fire" and "reads off the end
* of the frame" is one format string, and nothing else in the file says so.
* Found by reading, under a sanitizer sweep that could not have found it:
* nothing in the corpus prints a number long enough. */
static int64_t fit(int n) {
if (n < 0) return 0;
return n < SCRATCH ? (int64_t)n : (int64_t)(SCRATCH - 1);
return n < FLAN_NUM_BYTES ? (int64_t)n : (int64_t)(FLAN_NUM_BYTES - 1);
}
/* The length is clamped below *and* above. Above is obvious and was always
@ -263,15 +296,15 @@ int64_t flan_bytes_to_i64(const uint8_t *p, int64_t n) {
/* %g so that 3.5 prints as "3.5" and not "3.500000" — calc-me's expected
* output is a table of exact strings. */
void flan_f64_to_bytes(double x, flan_slice *out) {
int n = snprintf(scratch, SCRATCH, "%g", x);
out->ptr = (const uint8_t *)scratch;
void flan_f64_to_bytes(double x, uint8_t *buf, flan_slice *out) {
int n = snprintf((char *)buf, FLAN_NUM_BYTES, "%g", x);
out->ptr = buf;
out->len = fit(n);
}
void flan_i64_to_bytes(int64_t x, flan_slice *out) {
int n = snprintf(scratch, SCRATCH, "%lld", (long long)x);
out->ptr = (const uint8_t *)scratch;
void flan_i64_to_bytes(int64_t x, uint8_t *buf, flan_slice *out) {
int n = snprintf((char *)buf, FLAN_NUM_BYTES, "%lld", (long long)x);
out->ptr = buf;
out->len = fit(n);
}
@ -279,9 +312,9 @@ void flan_i64_to_bytes(int64_t x, flan_slice *out) {
* not -1, and routing it through the signed printer is the only way println
* could disagree with the REPL about a value both can hold. Hence a second
* shim rather than a cast at the call site. */
void flan_u64_to_bytes(uint64_t x, flan_slice *out) {
int n = snprintf(scratch, SCRATCH, "%llu", (unsigned long long)x);
out->ptr = (const uint8_t *)scratch;
void flan_u64_to_bytes(uint64_t x, uint8_t *buf, flan_slice *out) {
int n = snprintf((char *)buf, FLAN_NUM_BYTES, "%llu", (unsigned long long)x);
out->ptr = buf;
out->len = fit(n);
}
@ -780,9 +813,47 @@ struct flan_allocator {
int64_t budget;
};
/* Would this request put the allocator over its budget? */
/* ── Byte counts that cannot wrap ──────────────────────────────────────
*
* Every size this file computes is a signed 64-bit count of bytes, and every
* one of them is a product or a sum of numbers a Flan program chose: a
* capacity from (vec-reserve!), an element size from the checker. Signed
* overflow is undefined, and the defined-in-practice outcome is worse than
* the undefined one — a product that wraps to a small positive allocates a
* block that fits while the container records the unwrapped capacity, and the
* next push memcpys past the end of it. Nothing traps, nothing is reported,
* and a sanitizer sees a write inside a block it was told to expect.
*
* So the arithmetic goes through these two, which answer "did it fit" the way
* every allocating entry point in this file does. A count that does not fit
* is *not* a new condition: the request is one no allocator could satisfy, so
* it reports as StorageExhausted along the path an out-of-memory takes, and
* the caller's [flan_fail_bytes] carries FLAN_BYTES_UNREPRESENTABLE — the
* largest number the field can hold, which is honest in the only way it can
* be, since the true size has no representation to report. */
#define FLAN_BYTES_UNREPRESENTABLE INT64_MAX
static int flan_mul_bytes(int64_t a, int64_t b, int64_t *out) {
if (a < 0 || b < 0) return 0;
return !__builtin_mul_overflow(a, b, out);
}
static int flan_add_bytes(int64_t a, int64_t b, int64_t *out) {
if (a < 0 || b < 0) return 0;
return !__builtin_add_overflow(a, b, out);
}
/* Would this request put the allocator over its budget?
*
* The sum is checked for the same reason the products are: a size that makes
* [live_bytes + size] wrap negative would compare below any ceiling and pass,
* which is the one answer this function must never give. A request that
* cannot even be added to what is already live is over every budget there is. */
static int flan_over_budget(flan_allocator *a, int64_t size) {
return a->budget > 0 && a->live_bytes + size > a->budget;
int64_t total;
if (a->budget <= 0) return 0;
if (!flan_add_bytes(a->live_bytes, size, &total)) return 1;
return total > a->budget;
}
/* ── The allocation registry's two halves, and why they are split ──────
@ -1214,7 +1285,16 @@ _Noreturn void flan_region_only_fail(const uint8_t *loc, int64_t loclen) {
*
* ptr len cap allocator the release layout spec-memory.md fixes
* gen bumped on every reallocation — the stale-slice
* word. It has no reader yet; see docs/BUILT.md.
* word spec-memory.md asks for. It has no reader
* and cannot have one as things stand, which is
* the part "not yet" used to hide: a slice is
* ptr+len, so it carries neither the Vec it came
* from nor the generation it was taken at, and
* the check has nothing to compare. Giving it a
* reader is a third word on every slice in the
* language, not a change to this file. Nothing
* here or anywhere else reads it; do not write
* code that trusts it. See docs/BUILT.md.
* epoch the allocator's epoch when this Vec last
* touched it. Any operation on a container whose
* recorded epoch has moved traps.
@ -1322,7 +1402,7 @@ void flan_vec_region_only(flan_vec *v, const uint8_t *loc, int64_t loclen) {
static int8_t flan_vec_grow(flan_vec *v, int64_t want, int64_t size,
int64_t align) {
flan_allocator *a = flan_vec_adopt(v);
int64_t cap = v->cap;
int64_t cap = v->cap, bytes;
void *p;
if (want <= cap) return 1;
/* Doubling, from four. Four rather than one because the three reallocations
@ -1333,13 +1413,23 @@ static int8_t flan_vec_grow(flan_vec *v, int64_t want, int64_t size,
if (cap > (int64_t)1 << 40) { cap = want; break; }
cap *= 2;
}
flan_fail_bytes = cap * size;
/* [want] arrives from (vec-reserve!) unfiltered, and the doubling loop above
* hands a want past 1<<40 straight through as the capacity, so this product
* is the one the program picked times the one the checker did. See the note
* on flan_mul_bytes. */
if (!flan_mul_bytes(cap, size, &bytes)) {
flan_fail_bytes = FLAN_BYTES_UNREPRESENTABLE;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
return 0;
}
flan_fail_bytes = bytes;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
if (v->ptr)
p = a->proc(a, FLAN_ALLOC_RESIZE, v->ptr, v->cap * size, cap * size, align);
p = a->proc(a, FLAN_ALLOC_RESIZE, v->ptr, v->cap * size, bytes, align);
else
p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, cap * size, align);
p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, align);
if (!p) return 0;
v->ptr = p;
v->cap = cap;
@ -1563,6 +1653,7 @@ static int8_t flan_pool_grow(flan_pool *p, int64_t want, int64_t size,
int64_t align) {
flan_allocator *a = flan_pool_adopt(p);
int64_t cap = p->cap, sslot = (int64_t)sizeof(flan_pool_slot);
int64_t ibytes, sbytes, total;
void *ni, *ns;
if (want <= cap) return 1;
/* Doubling from four, exactly as the Vec grows. */
@ -1571,19 +1662,30 @@ static int8_t flan_pool_grow(flan_pool *p, int64_t want, int64_t size,
if (cap > (int64_t)1 << 40) { cap = want; break; }
cap *= 2;
}
flan_fail_bytes = cap * size + cap * sslot;
/* Two products and their sum, all three checked: the pool asks for the items
* and the slots as separate blocks but reports them as one number, and a
* wrap in either half is the same memcpy past the end the Vec's is. */
if (!flan_mul_bytes(cap, size, &ibytes)
|| !flan_mul_bytes(cap, sslot, &sbytes)
|| !flan_add_bytes(ibytes, sbytes, &total)) {
flan_fail_bytes = FLAN_BYTES_UNREPRESENTABLE;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
return 0;
}
flan_fail_bytes = total;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
ni = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, cap * size, align);
ni = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, ibytes, align);
if (!ni) return 0;
ns = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, cap * sslot, 8);
ns = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, sbytes, 8);
if (!ns) {
/* An allocator without can-free leaks the first block here. That is the
* defined outcome and not a new one: the request failed because the
* region is exhausted, and the region is about to be released whole or
* the ceiling raised and the call re-attempted. */
if (a->caps & FLAN_CAN_FREE)
a->proc(a, FLAN_ALLOC_FREE, ni, cap * size, 0, align);
a->proc(a, FLAN_ALLOC_FREE, ni, ibytes, 0, align);
return 0;
}
if (p->len > 0) {
@ -1785,11 +1887,14 @@ void flan_pool_free(flan_pool *p, int64_t size, int64_t align,
#define FLAN_MAP_MIN_LOG2 3 /* 8 slots */
/* The hash word. Zero means the slot is empty, which is what makes a
* zeroed hash block an empty map. There is no tombstone: removal is deferred
* (spec-memory.md defers move-aware lookup, removal and owned entries), so the
* only two states a slot has are empty and occupied. That deletes Odin's
* backward-shift loop from this file entirely, and it is the single largest
* reason this is shorter than the Odin original.
* zeroed hash block an empty map. There is still no tombstone now that
* removal exists: the only two states a slot has are empty and occupied, and
* flan_map_remove restores that by shifting the run back rather than by
* marking the hole. Odin marks it and repairs on the next insert, which is
* why its insert has a second loop and its every lookup tests for a
* tombstone; neither is here. What spec-memory.md still defers is the rest of
* that sentence — move-aware lookup and owned entries — so a removed value is
* copied out and nothing is dropped.
*
* The top bit is set on every stored hash so that a hasher answering 0 does
* not read as an empty slot. It is the highest bit, so the desired slot and
@ -2036,9 +2141,15 @@ static int64_t flan_cell_size(int64_t size) {
* one, far outweighing the per-slot indexing the cell shift covers. */
static int64_t flan_run_bytes(int64_t epc, int64_t cell, int64_t shift,
int64_t count) {
int64_t cells =
(shift >= 0) ? ((count + epc - 1) >> shift) : ((count + epc - 1) / epc);
return cells * cell;
int64_t cells, bytes;
if (count < 0 || count > FLAN_BYTES_UNREPRESENTABLE - epc)
return FLAN_BYTES_UNREPRESENTABLE;
cells = (shift >= 0) ? ((count + epc - 1) >> shift) : ((count + epc - 1) / epc);
/* One predictable branch on a path that is otherwise two shifts. The count
* is a capacity the program asked for, so the product is only bounded by
* what the checker knows the element to be — see flan_mul_bytes. */
if (!flan_mul_bytes(cells, cell, &bytes)) return FLAN_BYTES_UNREPRESENTABLE;
return bytes;
}
static int64_t flan_cells_bytes(int64_t size, int64_t count) {
@ -2077,10 +2188,24 @@ static uint8_t *flan_cell_at(uint8_t *base, int64_t size, int64_t epc,
* the element in flight. Odin allocates the same two, for the same reason: the
* swap is a memcpy between type-erased buffers and there is no local of the
* right type to hold one. */
/* Saturating rather than refusing, because this is called for its number by
* the geometry as well as by the allocation, and the geometry has nowhere to
* put a failure. FLAN_BYTES_UNREPRESENTABLE out of here is the only value the
* allocation is allowed to see and not attempt: flan_map_alloc turns it into
* the StorageExhausted an impossible request deserves. */
static int64_t flan_map_block_size(int64_t ksize, int64_t vsize, int64_t cap) {
return flan_cells_bytes(ksize, cap) + flan_cells_bytes(vsize, cap)
+ flan_cells_bytes((int64_t)sizeof(flan_map_hash), cap)
+ flan_cells_bytes(ksize, 2) + flan_cells_bytes(vsize, 2);
int64_t total = 0;
int64_t parts[5];
int i;
parts[0] = flan_cells_bytes(ksize, cap);
parts[1] = flan_cells_bytes(vsize, cap);
parts[2] = flan_cells_bytes((int64_t)sizeof(flan_map_hash), cap);
parts[3] = flan_cells_bytes(ksize, 2);
parts[4] = flan_cells_bytes(vsize, 2);
for (i = 0; i < 5; i++)
if (!flan_add_bytes(total, parts[i], &total))
return FLAN_BYTES_UNREPRESENTABLE;
return total;
}
/* Everything an operation needs to walk the block, computed once on entry.
@ -2278,6 +2403,10 @@ static int8_t flan_map_alloc(flan_map *m, flan_allocator *a, int64_t log2cap,
flan_fail_bytes = bytes;
flan_fail_align = FLAN_MAP_CACHE_LINE;
flan_fail_id = (int64_t)(intptr_t)a;
/* A block whose size does not fit in the count is a request no allocator can
* answer, and asking anyway would hand a wrapped number to a proc that might
* take it. The failure is the allocator's own. */
if (bytes == FLAN_BYTES_UNREPRESENTABLE) return 0;
p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, FLAN_MAP_CACHE_LINE);
if (!p) return 0;
m->data = p;
@ -2420,6 +2549,69 @@ int8_t flan_map_has(flan_map *m, const void *key, int64_t ksize, int64_t vsize,
return (int8_t)(flan_map_find_g(m, key, ksize, vsize, hash, eq, NULL) >= 0);
}
/* Removal, by backward shift, which is what keeps this file tombstone-free.
*
* Odin's own erase (base/runtime/dynamic_map_internal.odin, map_erase_dynamic)
* marks a tombstone and leaves the repair to the next insert, which is why its
* insert carries a second loop this file has never had. Read rather than
* recalled: the note in this file that said Odin deletes by backward shift was
* describing its *insert*. The trade is the usual one — erase is O(1) there
* and the shift is here, and every lookup there pays a tombstone test this one
* does not.
*
* The invariant Robin Hood lookups depend on is that no live element is ever
* separated from its home slot by an empty one: the probe stops at the first
* empty slot, so a hole left in the middle of a run would hide everything
* after it. So the hole walks forward: each following element that is not
* already home moves back one slot, and the walk stops at the first slot that
* is empty or whose occupant is already home — neither can be moved back, and
* neither can be hiding anything.
*
* It releases nothing. A key and a value live inside the one block the map
* allocated, so there is no per-entry allocation to hand back and nothing here
* asks the allocator for anything — which is what makes removal from a map
* backed by an arena, or by any allocator that refuses can-free, mean exactly
* what it means for a heap-backed one. The block is released only by free and
* by the grow that replaces it.
*
* [out] takes a copy of the value that was there, or is NULL when the caller
* does not want one. A cursor held across this is invalidated the way a put
* that grows invalidates one: the shift moves entries to lower slots, and an
* iteration resuming at a higher index would step over them. */
int8_t flan_map_remove(flan_map *m, const void *key, void *out, int64_t ksize,
int64_t vsize, flan_hash_fn hash, flan_eq_fn eq,
const uint8_t *loc, int64_t loclen) {
flan_map_geom g;
int64_t at, mask, pos;
flan_map_check(m, loc, loclen);
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g);
if (at < 0) return 0;
if (vsize > 0 && out)
flan_copy_small(
out, flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, at), vsize);
mask = flan_map_cap(m) - 1;
pos = at;
for (;;) {
int64_t next = (pos + 1) & mask;
uint64_t eh = g.hs[next];
if (eh == 0 || flan_map_distance(eh, next, mask) == 0) {
g.hs[pos] = 0;
break;
}
flan_copy_small(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos),
flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, next),
ksize);
if (vsize > 0)
flan_copy_small(
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, pos),
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, next), vsize);
g.hs[pos] = eh;
pos = next;
}
m->len--;
return 1;
}
int64_t flan_map_len(flan_map *m, const uint8_t *loc, int64_t loclen) {
flan_map_check(m, loc, loclen);
return m->len;
@ -2436,13 +2628,16 @@ int64_t flan_map_len(flan_map *m, const uint8_t *loc, int64_t loclen) {
* slot index gives for free: it starts at 0, it is written back one past the
* entry just answered, and a 0 answer leaves it at [cap] so calling again is
* still 0. There is no iterator struct because there is nothing for one to
* hold — a map has no tombstones (removal is deferred), so no state beyond the
* position is needed to know where to resume.
* hold — a map has no tombstones, so no state beyond the position is needed to
* know where to resume.
*
* Invalidated by anything that moves the block, exactly as a Vec's slice is:
* a put that grows rehashes into a new block and every index before it means a
* different entry. The epoch check below catches a released arena and nothing
* catches a resize, which is the same bargain [as-slice] already makes.
* different entry. A remove is the same hazard without the reallocation — its
* backward shift moves entries to lower slots, and a cursor already past them
* steps over entries it has not answered. The epoch check below catches a
* released arena and nothing catches either of these, which is the same
* bargain [as-slice] already makes.
*
* The layout is the one the geometry describes and is worth restating because
* it is the thing most likely to be got wrong here: [data] is *one* allocation
@ -2636,6 +2831,26 @@ int64_t flan_file_fail_reason(void) { return flan_file_fail; }
* silently opened, which is the failure this exists to avoid. */
#define FLAN_PATH_MAX 4096
/* The same policy at the other boundary, for the generated FFI shim.
*
* flan_path_cstr refuses an embedded NUL because the file opened would not be
* the file named; a string handed to any other C function is no different —
* the callee reads to the first NUL, so what crosses is a prefix of the value
* the program passed, and every C API that takes a name, a title or a query
* would act on the wrong one. The shim cannot signal: a foreign call has no
* allocation site for the compiler to wrap and no transfer channel of its own,
* so this traps naming the declare-c that was called, the way an out-of-bounds
* index traps naming its site. See lib/shim.ml, which emits the call. */
_Noreturn void flan_shim_nul_fail(const char *site) {
fflush(stdout);
fprintf(stderr,
"%s: a string passed to C contains a NUL byte — C reads to the "
"first one, so the value this function would act on is a prefix of "
"the one passed. Remove the NUL before the call.\n",
site);
rt_die();
}
static int flan_path_cstr(const uint8_t *p, int64_t n, char *out) {
if (n < 0 || n >= FLAN_PATH_MAX) return 0;
if (n > 0) memcpy(out, p, (size_t)n);
@ -2743,10 +2958,25 @@ int8_t flan_file_write(const uint8_t *path, int64_t n, const void *src,
* allocate is StorageExhausted with retry, and a failure to read is FileError
* with retry and use-value. Two failures, two conditions, neither swallowing
* the other. */
int8_t flan_slurp_into(flan_vec *v, const uint8_t *path, int64_t n) {
int64_t got = 0;
if (!flan_file_read(path, n, v->ptr, v->cap, &got)) return 0;
v->len = got;
int8_t flan_slurp_into(flan_vec *v, const uint8_t *path, int64_t n,
int64_t size, const uint8_t *loc, int64_t loclen) {
int64_t got = 0, room;
/* The same check every other operation on a container runs, and skipped here
* until now: the Vec was sized on this turn, but a handler between the
* sizing and the read can have released the region it lives in, and this is
* the one entry point that would have written into it anyway. */
flan_vec_check(v, loc, loclen);
/* A capacity is a count of elements and a read is a count of bytes. They
* were the same number while slurp answered only (Vec u8) — the checker
* still pins it to that — and the conflation was a byte count one element
* size away from being wrong. The product is the block flan_vec_init already
* allocated, so it is representable by construction; the guard is here
* because "by construction" is an argument and not a check. */
if (!flan_mul_bytes(v->cap, size, &room)) return 0;
if (!flan_file_read(path, n, v->ptr, room, &got)) return 0;
/* Whole elements only: a file that ends mid-element leaves the partial one
* out rather than publishing a length that covers bytes nobody wrote. */
v->len = size > 0 ? got / size : 0;
return 1;
}

121
test/programs/map-remove.flan Normal file
View File

@ -0,0 +1,121 @@
;;;; (map-remove! m k) — the operation a Map has been missing.
;;;;
;;;; Removal is the one map operation that can break the *other* ones: Robin
;;;; Hood lookups stop at the first empty slot, so a hole punched in the middle
;;;; of a probe run hides every entry after it, and the entries it hides are
;;;; found by no test that only removes and asks about what it removed. So the
;;;; rows below are mostly about the survivors.
;;;;
;;;; Odin marks a tombstone and repairs on the next insert; this shifts the run
;;;; back and stays tombstone-free, which is the arrangement the rest of the
;;;; file already assumed. A version that punched the hole and left it passes
;;;; row 1 and fails row 3.
(defstruct Cell [x i32 y i32])
(defn main [] i32
;; (1) The value comes back, the length drops, and the key is gone. An
;; absent key is None and changes nothing — the same answer get gives, since
;; a key that was not there is an answer and not a failure.
(let [m (map-new i32 i64)]
(put m 1 100)
(put m 2 200)
(match (map-remove! m 1)
(Some v) (do (print v) (println "")) ; 100
None (println "missing"))
(print (len m)) (println "") ; 1
(print (has-key? m 1)) (println "") ; false
(match (map-remove! m 1) (Some v) (do (print v) (println "")) None (println "gone"))
(println (len m)) ; gone, then 1
(free m))
;; (2) Removing every entry empties the map, and it is usable afterwards:
;; the block is still there and the slots are empty rather than poisoned.
(let [m (map-new i32 i32)]
(dotimes [i 64] (put m i i))
(dotimes [i 64] (map-remove! m i))
(print (len m)) (println "") ; 0
(put m 7 77)
(match (get m 7) (Some v) (do (print v) (println "")) None (println "?")) ; 77
(print (len m)) (println "") ; 1
(free m))
;; (3) The survivors, which is the row that matters. 2000 entries is eight
;; grows, so the runs are long and interleaved; removing the even keys and
;; then asking after every odd one is asking whether any probe run was cut.
;; A backward shift that stopped one slot early loses entries here and
;; nowhere else.
(let [m (map-new i32 i64)]
(dotimes [i 2000] (put m i (* (i64 i) 3)))
(let [taken 0]
(dotimes [i 2000]
(if (= 0 (% i 2))
(match (map-remove! m i)
(Some v) (if (= v (* (i64 i) 3)) (set taken (+ taken 1)))
None (set taken taken))))
(print taken) (println "")) ; 1000
(print (len m)) (println "") ; 1000
(let [lost 0 ghosts 0]
(dotimes [i 2000]
(match (get m i)
(Some v) (if (or (= 0 (% i 2)) (not (= v (* (i64 i) 3))))
(set ghosts (+ ghosts 1)))
None (if (not (= 0 (% i 2))) (set lost (+ lost 1)))))
(print lost) (println "") ; 0
(print ghosts) (println "")) ; 0
;; Re-inserting what was taken out puts the length back, through no grow:
;; the block still has the room the removals freed up.
(dotimes [i 2000] (if (= 0 (% i 2)) (put m i (* (i64 i) 3))))
(print (len m)) (println "") ; 2000
(free m))
;; (4) A struct key and a string key, so the emitted hash/equality pair is
;; on the removal path too and not only on get's.
(let [g (map-new Cell i32)]
(dotimes [i 20] (dotimes [j 20] (put g (Cell {.x i .y j}) (+ (* i 100) j))))
(match (map-remove! g (Cell {.x 7 .y 9}))
(Some v) (do (print v) (println "")) ; 709
None (println "?"))
(print (has-key? g (Cell {.x 7 .y 9}))) (println "") ; false
(print (has-key? g (Cell {.x 7 .y 10}))) (println "") ; true
(print (len g)) (println "") ; 399
(free g))
(let [s (map-new string i32)]
(put s "alpha" 1)
(put s "beta" 2)
(match (map-remove! s "alpha")
(Some v) (do (print v) (println "")) ; 1
None (println "?"))
(print (has-key? s "beta")) (println "") ; true
(print (len s)) (println "") ; 1
(free s))
;; (5) Iteration after removals answers exactly the survivors. The cursor is
;; started fresh — a cursor held *across* a removal is invalidated by the
;; shift, the same way a put that grows invalidates one.
(let [m (map-new i32 i32)]
(dotimes [i 100] (put m i i))
(dotimes [i 100] (if (= 0 (% i 3)) (map-remove! m i)))
(let [cur (i64 0) k 0 v 0 seen 0 sum 0]
(while (map-next! m (addr cur) (addr k) (addr v))
(set seen (+ seen 1))
(if (not (= k v)) (set sum (+ sum 1))))
(print seen) (println "") ; 66
(print sum) (println "")) ; 0
(print (len m)) (println "") ; 66
(free m))
;; (6) An arena, which refuses can-free. Removal asks the allocator for
;; nothing and hands it back nothing — a key and a value live inside the one
;; block the map allocated — so it means here exactly what it means on the
;; heap, and the region is released whole as always.
(let [ar (arena-new 1048576)]
(with-allocator ar
(let [t (map-new i32 i32)]
(dotimes [i 300] (put t i (* i 2)))
(dotimes [i 300] (if (= 0 (% i 2)) (map-remove! t i)))
(print (len t)) (println "") ; 150
(match (get t 299) (Some v) (do (print v) (println "")) None (println "?")) ; 598
(print (has-key? t 298)) (println ""))) ; false
(free-all ar))
0)

30
test/programs/reserve-overflow.flan Normal file
View File

@ -0,0 +1,30 @@
;;;; A capacity whose byte count has no representation — the overflow half of
;;;; spec-memory.md's "Allocation failure".
;;;;
;;;; (reserve v n) forwards n to the growth path unfiltered and the bytes asked
;;;; for are the capacity times the element size, so a large element and a
;;;; large count multiply past what a signed 64-bit count of bytes can hold.
;;;; The element here is 2^33 + 1 bytes and the capacity the doubling settles
;;;; on is 2^31, whose product is 2^64 + 2^31: the wrap leaves 2 GiB, which a
;;;; heap allocator answers. The block then fits and the recorded capacity does
;;;; not, and the first push past 2 GiB writes outside it with nothing said —
;;;; no trap, no diagnostic, and a sanitizer sees a write inside a block it was
;;;; told to expect. That is why the guard is on the arithmetic and not on the
;;;; allocator's answer.
;;;;
;;;; A size that cannot be represented is a request no allocator can satisfy,
;;;; so it reports as StorageExhausted along the path an out-of-memory takes,
;;;; and with nothing handling it the program stops here rather than carrying
;;;; on — the same rule exhausted-unhandled.flan pins for a ceiling that was
;;;; genuinely reached.
(defstruct Big
[f0 [1073741824 u8] f1 [1073741824 u8] f2 [1073741824 u8]
f3 [1073741824 u8] f4 [1073741824 u8] f5 [1073741824 u8]
f6 [1073741824 u8] f7 [1073741824 u8] tail [1 u8]])
(defn main [] i32
(let [v (vec-new Big)]
(println "before")
(reserve v 1073741825)
(println "unreachable"))
0)

28
test/programs/shim-nul.flan Normal file
View File

@ -0,0 +1,28 @@
;;;; A string with a NUL in it, handed to C.
;;;;
;;;; A Flan string is ptr+len and a C string ends at its first NUL, so the two
;;;; disagree about what the value *is* the moment one of those bytes is in the
;;;; middle. The generated shim copies and terminates — string-of-bytes.flan
;;;; pins that — and a copy of these bytes is a C string of length 1 where the
;;;; program passed 5. The function would then act on a value nobody wrote.
;;;;
;;;; flan_path_cstr has always refused this for a path, on the grounds that the
;;;; file opened would not be the file named. Nothing about a path is special:
;;;; the same reasoning covers a window title, a shader name and a query, so
;;;; the shim refuses it too, naming the declare-c that was called. It is a
;;;; trap rather than a condition because a foreign call has no allocation site
;;;; for the compiler to guard and no transfer channel of its own.
(declare-c c-puts [s string] i32 "puts")
(defn main [] i32
(let [v (vec-new u8)]
(push v 104) ; h
(push v 105) ; i
(push v 0)
(push v 104) ; h
(push v 105) ; i
(println "before")
(c-puts (string (as-slice v)))
(println "unreachable")
(free v))
0)

42
test/programs/two-numbers.flan Normal file
View File

@ -0,0 +1,42 @@
;;;; Two rendered numbers, held at once.
;;;;
;;;; i64->bytes and its two siblings render into a buffer and answer a slice
;;;; over it. That buffer used to be one file-static in the runtime, shared by
;;;; every call in the process, so the program below printed "22 22": the
;;;; second conversion overwrote the first, and the first slice — still a
;;;; perfectly valid pointer into a perfectly live buffer — was read after it.
;;;; No crash, no diagnostic, and nothing for a sanitizer to catch, because
;;;; every byte read was inside an object that was alive. The wrong bytes.
;;;;
;;;; The buffer is the caller's now, one frame slot per call site, which is why
;;;; the two conversions below do not collide and why the f64 held across an
;;;; i64 conversion — a different shim, and the same buffer before — survives
;;;; it. What the slice still does not outlive is its frame: storing one in a
;;;; container that lives longer, or returning it, hands back a view of storage
;;;; that has been reused. That is copying's job and is said in check.ml.
(defn main [] i32
;; Two i64 conversions alive at the same time.
(let [a (string (i64->bytes 11))
b (string (i64->bytes 22))]
(print a) (print " ") (println b)) ; 11 22
;; Three, and read in the order they were made rather than in reverse, so a
;; version that rotated among two buffers would still be caught.
(let [a (string (i64->bytes 1))
b (string (i64->bytes 2))
c (string (i64->bytes 3))]
(print a) (print b) (println c)) ; 123
;; Across the two shims: the f64's text is made first and read last.
(let [x (string (f64->bytes 2.5))
n (string (i64->bytes 7))]
(print x) (print " ") (println n)) ; 2.5 7
;; Inside a loop, where the slot is reused per iteration: each turn's text is
;; read before the next turn writes it, which is the contract a frame slot
;; gives. Printed on one line so the loop's shape is visible in the output.
(dotimes [i 4]
(let [s (string (i64->bytes (i64 (* i 11))))]
(print s) (print " ")))
(println "") ; 0 11 22 33
0)

82
test/test_acceptance.ml
View File

@ -336,6 +336,37 @@ let () =
outputs "string of bytes" "programs/string-of-bytes.flan" string_of_bytes_out;
outputs ~opt:"-O0" "string of bytes, -O0" "programs/string-of-bytes.flan"
string_of_bytes_out;
(* Two rendered numbers held at once, which is what one shared buffer in
the runtime made impossible: this printed "22 22" and could not have
been caught by a sanitizer, because every byte read was inside a live
object — the wrong one. -O0 too, since the buffer is now a frame slot
and mem2reg is what decides whether the address escapes. *)
let two_numbers_out = "11 22\n123\n2.5 7\n0 11 22 33 \n" in
outputs "two rendered numbers at once" "programs/two-numbers.flan"
two_numbers_out;
outputs ~opt:"-O0" "two rendered numbers at once, -O0"
"programs/two-numbers.flan" two_numbers_out;
(* The other side of that boundary: bytes the copy cannot represent. A NUL
inside the string is where ptr+len and C's "ends at the first NUL" stop
describing the same value, so the shim refuses instead of handing C a
prefix — the policy flan_path_cstr has always had for a path. The
refusal names the declare-c, which is the only name the program's author
wrote. *)
let exe = compile "programs/shim-nul.flan" in
let code, text = run exe None in
if code <> 134 || not (contains text "before")
|| not (contains text "c-puts: a string passed to C contains a NUL byte")
|| contains text "unreachable"
then begin
incr failures;
Printf.printf
"FAIL a string with a NUL in it is refused at the C boundary\n\
\ got: %S (exit %d)\n wanted: exit 134, naming the call\n"
text code
end;
(try Sys.remove exe with Sys_error _ -> ());
(* handler-bind and signal, spec-conditions.md §1 and §2: signal returns
Unit and carries on, an unhandled one is a no-op, a nested frame does
not displace the one outside it, and the stack is restored after. *)
@ -767,6 +798,27 @@ let () =
end;
(try Sys.remove exe with Sys_error _ -> ());
(* The request whose *size* is the thing that does not fit. The count times
the element size wraps to a number a heap allocator answers, so the
block is real, the recorded capacity is not, and the write past it is
the failure no sanitizer can see — it is inside a block ASan was told to
expect. Guarded arithmetic makes it the same StorageExhausted an
exhausted region raises, because it is the same answer: the storage
asked for is not available. *)
let exe = compile "programs/reserve-overflow.flan" in
let code, text = run exe None in
if code <> 134 || not (contains text "before")
|| not (contains text "unhandled StorageExhausted")
|| contains text "unreachable"
then begin
incr failures;
Printf.printf
"FAIL a byte count that cannot be represented is StorageExhausted\n\
\ got: %S (exit %d)\n wanted: exit 134, naming the condition\n"
text code
end;
(try Sys.remove exe with Sys_error _ -> ());
(* -- Files, NEXT.md decisions 1, 2 and 5 --------------------------
Embedding first, because it is the one that costs nothing at run time
and needs no host ABI at all: a compiler feature, so no linker
@ -2274,10 +2326,12 @@ ERR@7 unexpected token: not the kind the caller was reading
The buffer is sized here and not per call site, because a generator has
no call site to look at: 256 on the stack, the heap past that, and the
copy is freed after the call rather than before the return value is
computed. *)
computed. The Flan name travels with the copy so that the refusal a NUL
in the bytes raises can name the call — see programs/shim-nul.flan. *)
shim_case "declare-c: a string is copied, NUL-terminated and freed"
"(declare-c open-it [path string] bool \"OpenIt\")"
[ "char a0_b[256];"; "flan_shim_cstr(a0_p, a0_n, a0_b, sizeof a0_b)";
[ "char a0_b[256];";
"flan_shim_cstr(a0_p, a0_n, a0_b, sizeof a0_b, \"open-it\")";
"bool r = OpenIt(a0);"; "flan_shim_cstr_free(a0, a0_b);";
" return r;\n" ];
shim_case "declare-c: two strings get two buffers"
@ -2427,6 +2481,25 @@ ERR@7 unexpected token: not the kind the caller was reading
outputs "map iteration" "programs/map-iter.flan" map_iter_out;
outputs ~opt:"-O0" "map iteration, -O0" "programs/map-iter.flan" map_iter_out;
(* Removal, which is the operation that can break the others. A Robin Hood
probe stops at the first empty slot, so a hole left in the middle of a
run hides every entry past it — and the hidden ones are exactly what a
test that only asks after what it removed never looks at. Hence the
third row: 2000 entries, the even keys taken out, and then every odd one
asked for. A removal that punched the hole and left it answers row one
correctly and loses entries there.
-O0 as well, because the Option the removal answers with is built in the
compiler and not in the runtime, and mem2reg is what would hide a store
into the wrong half of it. *)
let map_remove_out =
"100\n1\nfalse\ngone\n1\n0\n77\n1\n1000\n1000\n0\n0\n2000\n\
709\nfalse\ntrue\n399\n1\ntrue\n1\n66\n0\n66\n150\n598\nfalse\n"
in
outputs "map removal" "programs/map-remove.flan" map_remove_out;
outputs ~opt:"-O0" "map removal, -O0" "programs/map-remove.flan"
map_remove_out;
(* The allocation-failure rule is one rule over every allocating operation,
so it has to hold for map-new, put, reserve and clone as it does for the
Vec's four. A map is the harder case: its growth allocates a new block,
@ -2443,6 +2516,11 @@ ERR@7 unexpected token: not the kind the caller was reading
is the refusal (Vec (Vec T)) already carries, for the identical reason.
Unit as a value is refused rather than dividing a cache line by zero,
and it is named because it is the natural spelling of a set. *)
(* Removal is a map's operation and says so, rather than reaching for a
[len] that a Vec would also answer. *)
refuses_src "map-remove! wants a map"
"(defn main [] i32 (let [v (vec-new i32)] (map-remove! v 1) (free v)) 0)"
"map-remove! takes a (Map K V)";
refuses_src "a float is not a map key"
"(defn f [m (Map f32 i32)] () 0)" "is not a map key";
refuses_src "a Ptr is not a map key"

22
test/test_flan.ml
View File

@ -912,6 +912,22 @@ let () =
(defn f [s [u8]] i32 (let [c (Cursor {.src s})] (g (addr c))))");
rejects_check "addr of a non-place"
"(defn f [] () (addr (+ 1 2)))" ~needle:"addr takes the address of a place";
(* An Option's two fields exist in both backends' layouts — the tag and the
value — and the structural printer reads the tag through them. What has no
spelling in the source language is reaching one: [match] and [some] are
how an Option is opened, and a (.field o) that read the value of a None
would be reading storage the tag says is not there. FIX.org recorded
[Addr (Pfield ...)] on an Option as a hole in both backends; this is the
pair of rows that says the hole has no door — the refusal is the field
access itself, so (addr ...) never gets a place to take the address of. *)
rejects_check "a field of an Option"
"(defstruct Point [x i32 y i32])\n\
(defn f [o (Option Point)] i32 (.x o))"
~needle:"(Option Point) is not a struct, so it has no fields";
rejects_check "the address of a field of an Option"
"(defstruct Point [x i32 y i32])\n\
(defn f [o (Option Point)] (Ptr i32) (addr (.x o)))"
~needle:"(Option Point) is not a struct, so it has no fields";
(* ── Option, some, match ───────────────────────────────────────── *)
accepts "some unwraps in an Option-returning function"
@ -2681,6 +2697,12 @@ let () =
accepts "get over a type-variable key answers an (Option V)"
"(defn f [m (Map $t i32) k $t] i32 {:where (hashable? $t)} \
(match (get m k) (Some v) v _ 0))";
(* And so does the removal, whose placeholder is [get]'s for the same reason:
it answers an (Option V), so the match around it still has to check while
the key is a variable. *)
accepts "map-remove! over a type-variable key answers an (Option V)"
"(defn f [m (Map $t i32) k $t] i32 {:where (hashable? $t)} \
(match (map-remove! m k) (Some v) v _ 0))";
accepts "and so do has-key?, reserve and clone"
"(defn f [m (Map $t i32) k $t] bool {:where (hashable? $t)} \
(do (reserve m 8) (let [c (clone m)] (free c) (has-key? m k))))";

6
test/test_sanitize.ml
View File

@ -118,6 +118,12 @@ let corpus =
the harness rather than in anything under test. *)
"programs/bounds.flan", [ "0" ];
"programs/arena-value.flan", [];
(* Here for what it would catch rather than for what it prints: the three
number conversions render into a frame slot the checker allocates per
call site, and a slot that ended up as a reclaimed temporary instead
would be a stack-use-after-scope — which is exactly what ASan sees and
an output comparison does not. *)
"programs/two-numbers.flan", [];
"programs/arena-edn.flan", [];
"programs/bytes2.flan", [];
"programs/cleanup.flan", [];

24
vendor/agent/flan_agent.c vendored
View File

@ -1057,10 +1057,11 @@ static void handle_line(char *line, sink *o) {
* (Ptr T) to read a type off, and the recorded name is the whole of what
* there is to go on.
*
* Answered while the program is running as well as while it is stopped:
* this reads a table, not a stack, and nothing here walks a chain another
* thread is pushing. Whether the *answer* holds still long enough to be
* worth acting on is the caller's judgement, and the daemon makes it.
* It used to say here that this is answered while the program runs as well
* as while it is stopped, on the grounds that a table is not a stack. The
* table is not a stack and it is still written by the other thread, and the
* answer to one address is a claim that stops being true as it is made — so
* the gate below now says what the daemon already said.
*
* ADDR is read with base 0, so both 0x-hex and decimal arrive; an editor
* that has an address as text has it in one of those two spellings. */
@ -1069,6 +1070,21 @@ static void handle_line(char *line, sink *o) {
int64_t typelen = 0, off = 0, bytes = 0, elem = 0, seq = 0, died = 0;
char *end = NULL;
unsigned long long a;
/* Stopped only, like every break verb. Whether an address is still live is
* exactly what a running program is changing, so the answer would describe
* a table the game thread has already moved on from — the daemon refuses
* the question for that reason before it ever reaches here
* (lib/dev.ml, [inspect_addr]), and this says the same thing to anything
* else that asks. The two listing verbs below are the opposite case and
* stay answerable while running: a breakdown is a description of the
* program and not a claim about one address, and the table carries its own
* seqlock so that reading it while it is written is safe. */
if (!(atomic_load(&depth) > 0)) {
reply(o, "err not stopped: whether one address is still live is what a "
"running program is changing, so this is read from a stopped "
"one\n");
return;
}
if (!flan_dev_reg_enabled()) {
reply(o, "err the allocation registry is off; this is not a dev build\n");
return;