From 7d4bec521e576affbf7c2930babec37e5d2a7e69 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 05:52:47 +0700 Subject: [PATCH 1/2] A value carries its own type, and the heap under it collects Milestone 1 of dynamic-by-default, the runtime half: NaN-boxed values in one machine word, a mark-sweep heap, and the operations over them. A double is itself, which is what a language with a physics loop and a float calculator in its corpus wants; everything else hides in the quiet-NaN space, three tag bits and a 48-bit payload that is exactly an x86-64 user pointer. The negative-NaN collision is answered by canonicalising every NaN on the way in, which flan_rt.c had already decided was the right thing to print. An i64 past the payload goes on the heap rather than becoming a 48-bit integer with a 64-bit name. The collector is mark-sweep and nothing else -- no generation, no barrier, no free list -- because the answer to wanting it faster is to type the program. Roots are pushed, not scanned: NaN-boxing makes a conservative guess wrong in both directions, and flan_dev.c's frame chain is the precedent. A fixed ring of the last sixty-four allocations is marked unconditionally, which closes the window where an expression with two constructors in it can collect its own first result before the compiler has rooted either. A type mismatch traps rather than aborting, through a flan_trap exported from flan_rt.c so it takes the same path the six existing traps take: parked for inspection in a dev session, dead where it stands otherwise. The sentence names the operation, both tags as words, and both values. flan_dyn.c is its own translation unit and nothing in the release runtime names a symbol in it, so a program with no dyn operation links no collector and --no-gc can be file-level selection rather than an argument with the linker. docs/SPIKE-DYNAMIC.md carries the argument. test/dyn_ops.c drives every operation and all twenty-four refusals from C, the way dev_limits.c does, including a million allocations against a hundred live and the control that says an unrooted object really is reclaimed. --- docs/SPIKE-DYNAMIC.md | 539 ++++++++++++++++++ lib/build.ml | 34 +- lib/dev.ml | 8 +- lib/dune | 21 +- runtime/flan_dyn.c | 1065 +++++++++++++++++++++++++++++++++++ runtime/flan_dyn.h | 177 ++++++ runtime/flan_rt.c | 18 + test/dune | 17 +- test/dyn_ops.c | 631 +++++++++++++++++++++ test/programs/dyn-host.flan | 13 + test/test_dyn.ml | 165 ++++++ test/test_sanitize.ml | 45 ++ 12 files changed, 2726 insertions(+), 7 deletions(-) create mode 100644 docs/SPIKE-DYNAMIC.md create mode 100644 runtime/flan_dyn.c create mode 100644 runtime/flan_dyn.h create mode 100644 test/dyn_ops.c create mode 100644 test/programs/dyn-host.flan create mode 100644 test/test_dyn.ml diff --git a/docs/SPIKE-DYNAMIC.md b/docs/SPIKE-DYNAMIC.md new file mode 100644 index 0000000..52d4eef --- /dev/null +++ b/docs/SPIKE-DYNAMIC.md @@ -0,0 +1,539 @@ +# The dynamic-value runtime: NaN-boxed values over a mark-sweep heap + +Milestone 1 of dynamic-by-default. Unannotated code computes with values that carry their type at run +time; fully annotated code compiles to exactly what it compiled to before; and a build that wants +neither a tag nor a collector can be given one that has neither. This document is the runtime half — +`runtime/flan_dyn.h`, `runtime/flan_dyn.c`, and the C tests in `test/dyn_ops.c` driven by +`test/test_dyn.ml`. The compiler half — deciding which locals are dyn, emitting the root pushes, +enforcing `--no-gc` — is a parallel lane and is built against the ABI in the header, which is fixed. + +Everything here is implemented and green. `dune test --force` includes `test_dyn`, which is 29 processes +and 0.42 seconds; `dune build @sanitize` covers the same C under ASan and UBSan. + +--- + +## 1. Value representation: NaN-boxing + +`flan_dyn` is `uint64_t`, one machine word, so a dyn local is a register or a stack slot and never a +struct whose return convention two backends would have to agree about. That much was fixed by the ABI. +What was open was the tagging scheme, and the two candidates are the usual pair. + +**Low-bit tagging** puts the tag in the bottom three bits of a word and requires every payload to be +either a pointer to something aligned or an integer with three bits to spare. Its cost lands on floats: +an `f64` uses all 64 of its bits, so a low-bit scheme either boxes every float on the heap or steals the +mantissa's low bits and computes with a shortened double. + +**NaN-boxing** does the opposite. A double is *itself* — the bit pattern is returned unchanged — and +everything else hides inside the quiet-NaN space, which IEEE 754 leaves as 2^52 unused encodings. + +This codebase decides it. `f64` is a first-class type here, not a library afterthought: `sand.flan` runs +a physics loop, `calc-me.flan` is a float calculator, the prelude carries a hand-written `format-f64` +because `%g` was not enough, and `flan_rt.c` has three paragraphs on how to print a NaN. A representation +whose float path is the expensive one is the wrong representation for this language. Under NaN-boxing +`flan_dyn_from_f64` is a `memcpy` of 8 bytes and `flan_dyn_need_f64` is the same in reverse; neither +allocates, neither branches except on the NaN canonicalisation below. + +The layout: + +``` + 63 62..52 51 50..48 47..0 + 1 1...1 1 tag payload + ^ sign ^ quiet +``` + +A word is *boxed* when `(v & 0xFFF8000000000000) == 0xFFF8000000000000` — sign bit set, exponent all +ones, quiet bit set. Bits 50..48 are three tag bits; bits 47..0 are the payload, which is exactly the +width of an x86-64 user-space pointer (48-bit canonical form, top 16 bits zero for user addresses). +Anything else is a double, read straight back. + +Four box tags are used and four are free: + +| tag | meaning | payload | +|-----|---------|---------| +| 0 | nil | 0 | +| 1 | bool | 0 or 1 | +| 2 | int | 48-bit two's complement, sign-extended on read | +| 3 | object | pointer to a `flan_obj` (text, vec, or a wide int) | +| 4–7 | unassigned | reserved for interop; see §7 | + +### The negative-NaN collision, and why canonicalising is free here + +Every NaN-boxing scheme has to answer for the doubles that are already negative quiet NaNs: their bits +are indistinguishable from a box. `flan_dyn_from_f64` answers it by mapping *every* NaN to the one +positive quiet NaN on the way in. + +That is not a new rule invented for this file. `flan_rt.c`'s `flan_f64_to_bytes` already renders every +NaN as `nan` with no sign, and carries the argument at length: IEEE 754 does not specify the sign of a +NaN any operation produces, LLVM's constant folder and `divsd` disagree about `(/ 0.0 0.0)`, and the same +two-line program printed `nan` through one backend and `-nan` through the other. The runtime already +decided that a NaN's sign is not a fact about the arithmetic. This takes the same line one step further +and declines to *store* it. Nothing observable is lost: NaN is not equal to itself, so no comparison can +see which NaN it is, and the printer was already refusing to say. `-0.0` is untouched and keeps its sign, +which is tested. + +### Integers: 48 bits inline, the rest on the heap + +`i64` is first class here and 48 bits is not 64. The two honest options were a 48-bit integer with a +64-bit name, or a box for the overflow. This takes the box. + +An `i64` in ±2^47 — that is ±140,737,488,355,327 — is inline: every array index, every byte count, every +timestamp in milliseconds until the year 6429, every value any program in the corpus computes. Outside +that range `flan_dyn_from_i64` allocates a `flan_obj` of kind `OBJ_INT` holding the full 64 bits. Both +shapes report `int` from `flan_dyn_tag`, compare and print identically, and round-trip through +`flan_dyn_need_i64`; nothing above the ABI can tell them apart. The cost is one range test on the +constructor and one branch in `dyn_int_value`, and the benefit is that a dyn `i64` is an `i64`. + +`u64` has no constructor in this ABI, deliberately. Typed Flan distinguishes `u64` from `i64` — that is +why `flan_u64_to_bytes` exists beside `flan_i64_to_bytes` — and a `u64` above 2^63 has no dyn spelling in +milestone 1. It is an interop question (§7), not a representation one: the box already holds 64 bits and +a seventh tag would distinguish the signedness. + +### Why not a two-word value + +It would have made all of the above go away: a tag word and a payload word, no NaN games, no integer +boxing. It was not available — `typedef uint64_t flan_dyn` is in the fixed ABI — and it would have been +the wrong call anyway, for the reason `flan_rt.c`'s header gives about returning structs by value: the +emitted `.ll` would then have to agree with the platform's struct-return convention, which works on +x86-64 and silently does not on wasm32, and this project has two backends and a third target. + +--- + +## 2. Heap objects + +One header, three kinds, one singly-linked list of everything allocated. + +```c +typedef struct flan_obj { + struct flan_obj *next; /* every object ever allocated, newest first */ + uint8_t kind; /* OBJ_TEXT | OBJ_VEC | OBJ_INT */ + uint8_t mark; + int64_t len; /* bytes of a text, elements of a vec */ + union { + int64_t i; /* OBJ_INT */ + struct { flan_dyn *items; int64_t cap; } v; /* OBJ_VEC */ + } u; /* OBJ_TEXT's bytes trail */ +} flan_obj; +``` + +- **Text** is immutable and length-prefixed, with the bytes inline after the header — one allocation per + string, and a length that is a count and not a NUL scan. `flan_dyn_from_bytes` copies, so a literal in + `.rodata`, a frame slot, or a slice about to be dropped are all legitimate sources. Nothing in the ABI + writes into a text; `flan_dyn_set_at` on one refuses by name rather than copying on write. +- **Vec** is mutable, with its elements in a plain `malloc` block hanging off the header rather than in a + GC object of their own. Growth is then a `realloc` rather than a copy this file writes, and the + elements are never reachable except through their vec, so giving them an identity would buy nothing + and cost a header. Their bytes are counted in the live figure and freed when the vec is swept. +- **Int** is the overflow case above. + +`mark` is a byte in the header and not a bit in a side table. A side table is the right answer when the +sweep is the cost, and the sweep is never going to be the cost here — see §3. + +There is no free list, no size class, and no interning. Two texts built from the same bytes are two +objects, which `test_dyn` asserts directly: equality is bytewise (§5) and a test that only compared +structurally would pass against an implementation that had quietly shared. + +--- + +## 3. The collector + +**Mark-sweep, precise, non-moving, stop-the-world, in about 120 lines.** + +The author's constraint was explicit — *"the answer to 'I need more performance' will never be a faster +GC, it will be to type the whole program"* — so there is no generation, no card table, no write barrier, +no incremental phase and no reference counting. The design goal is that somebody can read the whole +collector in one sitting and believe it. + +### Trigger + +Collection happens inside `gc_alloc` and nowhere else. The policy is the plainest one that bounds the +heap: + +``` +if (gc_bytes + need > gc_next) collect(); +... +gc_next = gc_bytes * 2; if (gc_next < gc_floor) gc_next = gc_floor; +``` + +Collect when this allocation would carry the heap past a limit; afterwards set the limit to twice what +survived, with a floor (1 MiB by default) so a program with a tiny live set does not collect every other +allocation. That gives amortised O(1) collection work per byte allocated, and a heap bounded at roughly +twice the live set plus the floor — which is the property `test_dyn`'s million-allocation case asserts, +as a bound rather than as an exact figure, because pinning the high-water mark would make a tuning change +a test failure. + +`flan_gc_set_floor` is an ABI extension and exists for the tests: a megabyte of floor would make the +million-allocation case a megabyte of arithmetic before it proved anything. It recomputes the trigger +from the new floor rather than only raising it to meet it — raising alone left a heap that had been given +a *lower* floor still running to the old one, which is a bug this document's first draft had. + +A vec's element array growing is a `realloc` and not a collection point, deliberately: the value being +pushed may not be rooted yet. The bytes are charged to the heap immediately so the trigger sees them at +the next real allocation, but nothing is swept in the middle of a push. + +### Mark + +An explicit worklist, not recursion. A vec of a vec of a vec is an ordinary dyn value and its depth is +the program's, not the runtime's; a recursive marker would put the heap's depth on the C stack and a long +enough chain would overflow it *during a collection*, which is the worst available moment. The mark stack +is grown on demand and kept between collections, so a steady program stops paying for it after the first. +`test_dyn`'s `nested` mode is a chain 64 deep and would notice a marker that stopped being iterative. + +Only a vec has anything to trace; a text and a boxed int are leaves and marking them is the whole visit. + +### Sweep + +Walk the all-objects list, unlink and free anything unmarked, clear the mark on anything else, and +subtract the freed bytes. A vec's element array is freed with its header. + +### What "precise" buys + +The collector never guesses whether a word is a pointer, which matters more here than usual. NaN-boxing +makes conservative scanning wrong *in both directions*: a live double is bit-identical to a boxed pointer +often enough to retain garbage indefinitely, and a payload with the box stripped is not the pointer a +scanner would recognise. Precision is cheaper than the arguments about it. + +--- + +## 4. Roots + +No conservative stack scanning. The compiler emits `flan_dyn_root_push` per dyn local on entry and one +`flan_dyn_root_pop(n)` for the lot on the way out — shadow-stack style, exactly as `flan_dev.c`'s frame +chain works and for the same reasons its header gives: a pushed record needs no agreement with the +optimiser about what a frame looks like, is the same on wasm32 as on x86-64, and needs no `.eh_frame` +walk to borrow (this language lowers every non-local exit explicitly and has none). + +The root stack holds *addresses*, not values, so a local that is reassigned needs no second push. It +grows on demand, because a deep recursion over dyn locals is an ordinary program and a fixed table would +be a limit nobody could predict. Dyn globals go through the same pair, pushed once at startup and never +popped. + +**The one contract the compiler lane must honour: a slot must hold a valid `flan_dyn` before it is +pushed.** The collector reads every registered address on every mark, and an uninitialised slot is a word +of stack garbage that will be decoded. Storing `flan_dyn_nil()` at the declaration is the whole of it. + +`flan_dyn_root_pop` clamps at empty rather than refusing. A pop that outruns its pushes means the frame +machinery is already out of step, and the useful thing at that point is a heap that still collects. + +`flan_dyn_root_reset` is an ABI extension with one caller: the merged dev build's `main`, which is +re-entered by `longjmp` and therefore pops no frame, so every root the finished run pushed still points +into stack the next run is about to write over. It is the exact counterpart of `flan_dev_frames_reset` +and `flan_condition_stacks_reset`, which exist for the same `longjmp`. + +### The temporaries ring, and the hazard it closes + +"Collection triggers only inside `flan_gc_alloc`, so between pushes nothing moves" protects against +*relocation*. It does not protect against *freeing*, and mark-sweep frees whatever is unreachable — which +includes an object allocated a moment ago and not yet stored anywhere the collector looks. Concretely: + +```c +flan_dyn_push(v, flan_dyn_add(flan_dyn_from_bytes(p, n), other)); +``` + +Two allocating calls in one expression. C leaves argument evaluation order unspecified, so this is not +even a window a careful emitter could close by ordering its calls. + +The answer is the smallest one that does not depend on another agent having read this document: **every +object `flan_dyn.c` allocates is written into a fixed 64-slot ring, and the marker roots the whole ring +unconditionally.** Any expression making at most 64 allocations before rooting its result is safe. The +cost is one store and a masked increment per allocation, plus up to 64 objects of float in the heap, +which the trigger absorbs because the trigger is a fraction of live bytes and not a count. There is no +ABI change and no contract for the compiler lane to get wrong. + +The visible consequence, and the only one: after a full collection up to 64 unreachable objects are still +alive. `test_dyn`'s `unrooted` mode asserts exactly that — "reclaimed all but the ring" — rather than +pretending the figure is zero. + +An expression with 65 allocating calls and no intervening root would be a single Flan form with 65 +constructors in it. If that ever exists, the compiler will have rooted its intermediates and the ring is +belt on top of braces. + +--- + +## 5. The operations, as implemented + +### Arithmetic — `+ - * / %` + +Two ints answer an int; a float anywhere answers a float; anything non-numeric traps. + +**The promotion is the one place dyn is more permissive than the typed language, and it is deliberate.** +Typed Flan has no implicit widening anywhere — `(print-i64 x)` used to force an explicit `(i64 x)` at +every site, and the prelude's history is full of that. But `(+ 1 2.5)` has exactly one sensible answer, +and a dynamic language that refuses it is not dynamic in any useful sense. A program that wants the +refusal annotates, which is the whole bargain of dynamic-by-default. + +Integer division and remainder by zero trap, matching typed Flan, which signals `ArithError` and dies +with "divide by zero" if nothing handles it. `INT64_MIN / -1` gets its own sentence for the reason +`flan_rt.c` gives it one. The float cases are left to IEEE: `1.0/0.0` is `inf` and that is an answer. +Float `%` is computed by truncated division rather than by calling `fmod`, which would pull `math.h` into +this translation unit for one operator; the quotient is range-checked first, because casting a double +past 2^63 to an integer is undefined rather than merely wrong. + +### Ordering — `< <= > >=` + +Numbers against numbers (promoting across the two tags), text against text bytewise, and nothing else. +Bytewise means `memcmp` with the shorter operand first on a tie — the order a sort of `(Vec string)` +wants, and the only one needing no locale and no collation table. + +A number against a text traps. The temptation is to order by tag so that everything is comparable and +sorting never fails; the reason not to is that the resulting order is an artefact of this file's tag +numbering, and a program sorting a mixed vec would get a stable answer that means nothing. + +NaN is unordered in all four directions, which is what IEEE says and what `test_dyn` asserts. + +### Equality — `=` + +Structural, and **the only operation here that never traps**: two values of unrelated tags are unequal, +which is an answer. Making it an error would mean a dyn program could not ask "is this the string I +expected" without first checking that it is a string at all. + +- Numbers compare by value across the two tags: `(= 1 1.0)` is true. +- Text is **bytewise, not by identity**. `flan_dyn_from_bytes` copies and does not intern, so two texts + built from the same bytes are two objects; the only defensible equality for an immutable byte string is + its bytes. Embedded NULs are compared like any other byte — the length is a count, not a `strlen`. +- A vec is equal element by element, with an identity shortcut first. +- NaN is not equal to itself. + +Cycles: `flan_dyn_set_at` lets a vec contain itself, so the recursion is capped at 64. Past the cap two +vecs are equal only if they are the same vec, which terminates and answers correctly for the case that +actually arises — a cycle compared against itself. Two *distinct* cyclic vecs of the same shape answer +false, which is a wrong answer to a question nobody has asked yet; the honest fix is a visited set and it +can be added the day somebody needs it. + +### `len`, `at`, `set-at`, `push` + +`len` is bytes of a text or elements of a vec. `at` is an element of a vec or a byte of a text as an int +— which is what `(at s i)` on a `(Slice u8)` does in the typed language; codepoints are `utf8`'s job and +stay there. `set-at` and `push` are vec-only, and a `set-at` on a text says *"a text is immutable — build +another one"* rather than quietly copying. + +An index that is not an int is a different sentence from a container that is not indexable, because +`(at v "1")` and `(at 3 1)` are different mistakes and one message naming both would name neither. + +### `print` + +Structural, and per tag it renders what typed `print` renders. The reference forms were **captured from a +running program**, not read off `lib/render.ml` — that file is the REPL's inspector and not necessarily +`println`'s expansion: + +| tag | rendering | example | +|-----|-----------|---------| +| int | `%lld` | `42` | +| float | `%g`, NaN unsigned | `3.5`, `1`, `nan` | +| bool | the word | `true` | +| text | bare at the top level | `hi` | +| text | quoted and escaped inside a structure | `"a b"`, `"q\"\n"` | +| vec | a slice's spelling | `[ 1 2 3]` | +| nil | — | `nil` | + +The leading space before every element is what `lib/render.ml`'s slice loop emits and what a Flan program +prints today; a tidier answer would diverge from an acceptance test. The escape table is the third copy +of the one in `flan_rt.c`'s `flan_escape_bytes` and `flan_dev.c`'s `flan_dev_emit_str` — those two are +already kept identical because the REPL parses the printed form back, and this one joins them. If that +table changes, change all three. + +**A typed `Vec` prints as `` and a dyn vec does not.** That looks like a mismatch and is not. The +typed printer's refusal is about walking storage it does not own — `render.ml` says so, and directs you to +`(print (as-slice v))`, which borrows explicitly at the call site. A dyn vec's storage belongs to the +collector, the printer is inside the runtime that owns it, and there is nobody to ask permission from. So +a dyn vec prints the way a *slice* does, which is also the only rendering that carries any information. + +`print` has a depth cap of 16. A typed value cannot contain itself, so the typed printer needs no +run-time cap; `set-at` makes a dyn vec that can, so this one has one, and past it prints `...`, which is +the mark `render.ml` uses for the same idea. + +--- + +## 6. The typed boundary + +`flan_dyn_need_i64`, `_need_f64`, `_need_bool` are what an annotated parameter does with a dyn argument +and what a dyn expression does where the checker wants a machine value. **There is no widening and no +coercion at the boundary**: `flan_dyn_need_f64` of an int traps. + +That is the asymmetry worth defending, because the operators *do* promote (§5). The two are different +questions. An operator has no stated expectation to violate — `(+ 1 2.5)` was written by somebody who +wanted a number and there is one obvious number. An annotation *is* a stated expectation, written down by +a person, and quietly turning their `i64` into an `f64` would make the boundary the one place in the +language where a type changed without anybody writing it. Typed Flan has no implicit widening; the +boundary into typed Flan should not invent some. + +The consequence for the compiler lane: a call from dyn code into `(defn f [x f64] ...)` with an integer +argument traps at run time rather than converting. If that turns out to be too sharp in practice, the +place to soften it is the *compiler*, by emitting a conversion where the checker can see both sides — not +here, where the only thing visible is a tag. + +--- + +## 7. Interop, which is out of scope for M1 and not precluded + +A typed `(Vec i64)` crossing into dyn code, without copying, is milestone 2. The layout leaves room for +it in three specific ways. + +**Four spare tags.** Bits 50..48 give eight box tags and four are used. Tag 4 is the natural home for a +*typed handle*: payload = pointer to a typed object, with the element type recovered from a side table or +from a word in the object's own header. Tag 5 can carry `u64` above 2^63, which is the other value typed +Flan holds and this ABI currently cannot name. + +**The object header is not the only thing the collector can trace.** `mark_push` dispatches on `kind`, +and a fourth kind whose tracer is "call a function pointer in a descriptor" is a local change — a handle +to a typed `(Vec Enemy)` would need the collector to know which fields of `Enemy` are dyn, and a +per-type descriptor emitted by the compiler is how that arrives. Nothing in the current layout has to +move for that: the `union` grows an arm. + +**A typed vec is not a `flan_obj` and does not need to become one.** The interop that matters is the +cheap direction — a typed vec is `{ptr, len, cap}` in memory the *arena* owns, and a dyn handle to it +should be a borrow, not a copy. That means the collector must be able to trace *into* memory it did not +allocate and must never free it. The `kind` byte is what distinguishes "I own these bytes" from "I am a +window onto someone else's", and the sweep already branches on it. + +What is genuinely open, and is stated here so the M2 lane does not discover it late: **a typed vec's +lifetime is its arena's, and the collector has no say in it.** A dyn value outliving the arena its handle +points into is a dangling read that the current design cannot detect. The allocation registry in +`flan_dev.c` already answers exactly that question for `Ptr` — `render.ml`'s pointer arm follows a live +one and mourns a dead one — so the shape of the answer exists. It is not built here. + +--- + +## 8. Dropping the collector + +`--no-gc` enforcement is the compiler lane's. This lane's contribution is that **it is possible**, which +is a property of the build and not a wish: + +- `flan_dyn.c` is its own translation unit and always has been. It is compiled from + `Runtime_src.dyn_source` in `lib/build.ml` (both `executable` and `macro_module`) and in `lib/dev.ml`, + beside `flan_rt.c` and `flan_dev.c` and never merged with them. +- **The dependency runs one way only.** `flan_dyn.c` calls `flan_write_stdout` and `flan_trap` in + `flan_rt.c`. Nothing in `flan_rt.c` or `flan_dev.c` names a symbol in `flan_dyn.c`. One + back-reference — `flan_rt_init` calling `flan_gc_init`, say, which was the obvious thing to write — + would make the collector unconditional and the refusal a lie, so the heap initialises itself lazily on + first allocation instead. +- Consequently a program that calls no dyn operation pulls nothing out of that object, and the linker + leaves it behind. + +The link line does **not** currently pass `-ffunction-sections`/`-Wl,--gc-sections`, and this document +will not claim a drop the build cannot perform. What the above buys is the cheaper mechanism: the object +is selected at the *file* level, so `--no-gc` is a one-line change at each of the three sites — the same +per-target selection `select_csrcs` already performs for a package's C — rather than an argument with the +linker about which sections are live. `flan_dev.c` is compiled into every build today for a reason its +comment gives at length (a package's C refers to it and package sources are collected whatever `main` +does); `flan_dyn.c` has no such entanglement and can genuinely be left out. + +The residual-dynamism refusal itself — deciding that a program is *not* fully annotated and saying which +form is not — is the compiler's, and is not attempted here. + +--- + +## 9. Cost sketch, per operation + +No microbenchmarks; these are counts of what the code does. + +| operation | cost | +|-----------|------| +| `from_f64`, `need_f64` | one 8-byte copy; one compare for the NaN canonicalisation | +| `from_i64` | one range compare, then a mask and an or — or an allocation past ±2^47 | +| `need_i64` | tag test, then a shift pair to sign-extend | +| `from_bool`, `nil`, `need_bool` | mask and or; tag test | +| `tag` | one mask-compare, one shift, and a load for the object case | +| `add`/`sub`/`mul` | two tag tests, the arithmetic, one `from_i64` (which may allocate at the extremes) | +| `div`/`rem` | the above plus a zero test and an overflow test | +| `lt`/`le`/`gt`/`ge` | two tag tests and a compare; text is `memcmp` | +| `eq` | word compare first; then tags, then bytes or elements — O(size) at worst | +| `len` | tag test and a load | +| `at` | two tag tests, a bounds compare, a load | +| `set_at` | the same, plus a store; **no write barrier**, because there is no generation to have one for | +| `push` | tag test, a capacity test, amortised O(1); the doubling is a `realloc` | +| `print` | O(size), streamed, no allocation | +| `root_push` / `root_pop` | a store and an increment; a `realloc` when the stack doubles | +| allocation | a trigger compare, a `malloc`, a header init, a ring store | +| collection | O(live) to mark, O(all) to sweep; amortised O(1) per byte allocated | + +The shape to take away: **every operation is a handful of instructions plus whatever the arithmetic +costs, and the only unbounded ones are `eq`, `print` and collection itself.** If that is not fast enough, +type the program. + +--- + +## 10. ABI extensions + +The header in `runtime/flan_dyn.h` is the agreed ABI with nothing removed and no signature changed. +Seven things are added; none is something the compiler lane must emit. + +| addition | why | +|----------|-----| +| `flan_dyn_root_reset()` | the merged dev build's `longjmp` re-entry, exactly as `flan_dev_frames_reset` | +| `flan_dyn_tag()` | the break loop and the inspector; the first question anyone asks a stopped dyn value | +| `flan_dyn_tag_name()` | the same table the trap messages are written from, so a message and an inspector cannot disagree | +| `FLAN_DYN_TAG_*` | the numbers `flan_dyn_tag` answers with | +| `flan_gc_count()` | the tests: a live-bytes figure alone cannot tell a collecting heap from one with small objects | +| `flan_gc_set_floor()` | the tests: a 1 MiB floor makes the million-allocation case slow and uninformative | +| `flan_trap()` in `flan_rt.c` | a thin exported wrapper over the existing static `rt_trap`, so a dyn type error takes the *same* path as `flan_bounds_fail` and the other six rather than re-implementing the hook, the flush, the socket and `_exit(134)` | + +One more thing the compiler lane should know about, which is a build fact rather than an ABI addition: +**`Build.compile_c` now drops `runtime/flan_dyn.h` into the directory it compiles each translation unit +in**, so a package's C — or an emitted shim — can `#include "flan_dyn.h"`. `flan_dyn.c` itself does not +include it and declares its own prototypes, because the object cache is keyed on source text and a header +edit would serve an object compiled against the previous one. The two copies are kept honest +mechanically: `test/dyn_ops.c` includes the header and names every function in it, so a divergence is a +compile or link error in `dune test`. + +--- + +## 11. Traps + +A dyn type error is a trap and not an abort: it takes `flan_trap`, which calls `flan_trap_hook` if one is +installed and then `rt_die`. In a dev session the hook parks the program for inspection; in a standalone +build nothing installs it and the program dies where it stands. The sentence is the same either way, +which is the point of routing through the hook rather than calling `abort` in the runtime. + +The sentence names the operation, both tags as **words**, and both values: + +``` +dyn +: int and text, and it takes two numbers — (+ 3 "hi") +dyn at: index 9 is out of bounds for text of length 2 — "hi" +dyn f64: int, and a float was wanted — (f64 1) +``` + +Tag names are always words — `int`, `float`, `text`, `vec`, `nil`, `bool` — and never numbers. They come +from one table that `flan_dyn_tag_name` also reads. Values are rendered into a bounded stack buffer with +a depth cap of 2, truncated rather than allocated: a trap is the one moment when allocating would be a +second thing to go wrong. + +Four trap names, because they are four different mistakes and somebody standing in one wants to know +which without reading the sentence twice: + +| name | when | +|------|------| +| `DynType` | a tag that is not what the operation wanted | +| `DynRange` | an index outside a vec or a text | +| `DynArith` | division by zero, or the one quotient that overflows | +| `DynHeap` | an allocation the host refused | + +The bounds case does **not** signal `BoundsError` the way typed indexing does, and that is a limitation +rather than a preference: `flan_bounds_error` takes a `loc` and a transfer channel, and a dyn operation +has neither in its hands. It is the same reason the six traps in `flan_rt.c` park rather than signal. If +the compiler lane threads a `loc` through — it knows one at every call site — the dyn bounds case can +join the condition system unchanged, and that is the obvious next increment. + +--- + +## 12. What is tested + +`test/dyn_ops.c`, driven by `test/test_dyn.ml` against `test/programs/dyn-host.flan` — a C main linked +against a Flan program with no `main`, the arrangement `dev_limits.c` and `reload_host.c` already use, +because these are C entry points with no Flan spelling. One binary, 29 runs, 0.42 s. + +| mode | what it establishes | +|------|--------------------| +| `ops` | every operation's happy path; every tag and its word; f64 round trips at `0`, `-0.0`, `1e308` and NaN; i64 at both inline edges, both boxed edges, `INT64_MIN` and `INT64_MAX`; arithmetic crossing into the box; NaN unordered in all four directions; text identity vs equality; embedded NULs; the empty text; vec growth past its initial capacity; a vec that contains itself, compared and printed; every printed form as an exact string | +| `gc` | a million allocations against a hundred rooted values; heap high-water under 512 KiB where a non-collecting heap would hold ~40 MiB; the live set intact afterwards | +| `unrooted` | **the positive control** — an object nothing points at is reclaimed. Without it every other case would pass against a collector that never freed | +| `nested` | a chain of vecs 64 deep traced through one root, across real collections | +| `sharing` | one vec in three slots: identity (not just equality), a write through one path read through another, survival when the direct root goes, and a single sweep when the last reference does | +| `refuse:*` | 24 refusals, one process each, asserted on the sentence as well as the exit status — a process that died some other way is not the guard firing, and the code cannot tell them apart | + +`dune build @sanitize` runs the same C under ASan and UBSan. That sweep matters more here than anywhere +else in the corpus: every other program in it allocates and never frees, which is a policy ASan can only +agree with, and this one frees — a mark-sweep collector is precisely a machine for freeing something that +is still reachable. A use-after-free is what a wrong marker looks like from outside, and it is invisible +to the assertions above, because the freed bytes are usually still the bytes that were there. Leaks stay +off, as they are for the whole file: the temporaries ring holds 64 objects alive at exit on purpose, and +every one of them would be reported. diff --git a/lib/build.ml b/lib/build.ml index 4cf82ad..738b7e8 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -688,6 +688,21 @@ let compile_c ~opts ?tflags ?(warn = []) ~src ~name () = if not (Sys.file_exists obj) then begin let dir = workdir () in let c = Filename.concat dir name in + (* The dyn runtime's header, beside the source about to be compiled. A + translation unit gets no include path at all — that is deliberate, and + is why the runtime's own .c files declare what they define — so this + directory is the whole of what an [#include "..."] can reach, and + putting the header in it is how a package's C, or a test, computes with + dyn values against one declaration rather than a copied-out list. It is + written on a cache miss and not on a hit because a hit does not run + clang; it is written unconditionally within that, because two sources in + one build share the directory and the second must not find it missing. + + flan_dyn.c does *not* include it. The object cache is keyed on the + source text, so a header edit would serve an object compiled against the + previous one, and the two copies of the declarations are kept honest by + test/dyn_ops.c naming every function instead. *) + write (Filename.concat dir "flan_dyn.h") Runtime_src.dyn_header; write c src; (* A distinct temporary target, renamed into place, so two builds running at once cannot see a half-written object. *) @@ -848,7 +863,16 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) cache key via [compile_c]'s [opt]/[tflags] digest — see [cflags]. *) let objs = cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c" - :: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c" ] + :: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c"; + (* The dynamic-value runtime. Compiled into every build for the + reason flan_dev.c is, and dropped by the same means: it is its own + translation unit and nothing in the other two names a symbol in + it, so a program with no dyn operation in it pulls nothing out of + this object and the linker leaves it behind. Selecting it away at + the file level — which is what `--no-gc` will do once the compiler + lane can prove a program is fully annotated — is then a one-line + change here rather than an argument with the linker. *) + cc ~warn:runtime_warnings Runtime_src.dyn_source "flan_dyn.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 @@ -1102,7 +1126,13 @@ let macro_module ?(opts = default) ?(csrcs = []) ?(lflags = []) ~macros let cc ?(warn = []) src name = compile_c ~opts ~tflags ~warn ~src ~name () in let objs = cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c" - :: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c" ] + :: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c"; + (* And here too. A macro module links its own copy of the runtime — + see the note above about binding [flan_rt_init] locally — so it + needs its own copy of the dyn half as well, or a macro body that + computes with a dyn value fails at the dlopen with an undefined + symbol, which reads as a compiler bug. *) + cc ~warn:runtime_warnings Runtime_src.dyn_source "flan_dyn.c" ] @ (match p.Tast.cshim with | [] -> [] | parts -> diff --git a/lib/dev.ml b/lib/dev.ml index 1cee547..34baa6e 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -4001,7 +4001,13 @@ let merged_executable ~opts ~csrcs ~lflags ~pnames (p : Tast.program) ~out ~ll = let cc src name = compile_c ~opts ~tflags ~src ~name () in let objs = (cc Runtime_src.source "flan_rt.c" - :: [ cc Runtime_src.dev_source "flan_dev.c" ]) + :: [ cc Runtime_src.dev_source "flan_dev.c"; + (* The dyn runtime, in the merged build too. A dev session is the + build that most needs it — an unannotated form typed at the REPL + is the whole of what dynamic-by-default is for — and it is also + the build where leaving it out fails latest: the link succeeds + until somebody evaluates something untyped. *) + cc Runtime_src.dyn_source "flan_dyn.c" ]) @ (match p.Tast.cshim with | [] -> [] | parts -> diff --git a/lib/dune b/lib/dune index 266f3ae..4bb39b7 100644 --- a/lib/dune +++ b/lib/dune @@ -26,11 +26,20 @@ ; so there is only ever one copy to edit. flan_dev.c goes into a dev build ; only — it is the run-time name lookup a REPL needs and a release build has ; no use for. +; +; flan_dyn.c is the third: the dynamic-value runtime, tagged values and the +; mark-sweep heap under them. It is carried the same way and for the same +; reason, and it is a *separate* string rather than being appended to +; [source] because it has to stay a separate translation unit — a program that +; calls no dyn operation references no symbol in it, which is what lets a +; build refuse to link it at all. See docs/SPIKE-DYNAMIC.md. (rule (target runtime_src.ml) (deps %{workspace_root}/runtime/flan_rt.c - %{workspace_root}/runtime/flan_dev.c) + %{workspace_root}/runtime/flan_dev.c + %{workspace_root}/runtime/flan_dyn.c + %{workspace_root}/runtime/flan_dyn.h) (action (with-stdout-to runtime_src.ml @@ -39,4 +48,14 @@ (cat %{workspace_root}/runtime/flan_rt.c) (echo "|c}\n\nlet dev_source = {c|\n") (cat %{workspace_root}/runtime/flan_dev.c) + (echo "|c}\n\nlet dyn_source = {c|\n") + (cat %{workspace_root}/runtime/flan_dyn.c) + ; And the header, which is *not* compiled: it is written into the + ; directory each translation unit is compiled in, so that a package's C — + ; and test/dyn_ops.c — can include it. flan_dyn.c does not include it and + ; declares its own prototypes instead, because the object cache is keyed + ; on the source text and a header change would not invalidate an object + ; compiled against the old one. + (echo "|c}\n\nlet dyn_header = {c|\n") + (cat %{workspace_root}/runtime/flan_dyn.h) (echo "|c}\n"))))) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c new file mode 100644 index 0000000..debba8c --- /dev/null +++ b/runtime/flan_dyn.c @@ -0,0 +1,1065 @@ +/* flan_dyn — tagged values, a mark-sweep heap, and the operations over them. + * + * Milestone 1 of dynamic-by-default: code nobody annotated computes with + * values that carry their type at run time, code that is fully annotated + * compiles to exactly what it compiled to before, and a build that asks for + * neither a collector nor a tag can be told that it has one. + * + * The argument for every decision in here — why NaN-boxing rather than low-bit + * tagging, why mark-sweep rather than anything cleverer, why the roots are + * pushed rather than found — is docs/SPIKE-DYNAMIC.md. This file carries the + * parts of it a reader needs *while reading the code*, and points at the doc + * for the rest. + * + * ── What this file may depend on ────────────────────────────────────── + * + * flan_rt.c, and nothing else in the tree. The dependency does not run the + * other way: no line of flan_rt.c or flan_dev.c names anything defined here. + * That is the whole of what makes a `--no-gc` build possible — a program that + * calls no dyn operation references no symbol in this translation unit, so the + * object contributes nothing but its own size, and the compiler lane is free + * to refuse to link it at all. A single back-reference from the release + * runtime would make the collector unconditional and the refusal a lie. See + * the doc's "Dropping the collector". + * + * ── Threads ─────────────────────────────────────────────────────────── + * + * There are none, and the globals below are plain globals for the reason the + * handler stack, the restart stack and the frame chain in the other two files + * are: one thread runs Flan. The dev agent's listener thread runs C and the + * loader and never enters a Flan body, so it never allocates and never marks. + * If the language grows threads, the heap needs a lock and the roots need to + * be thread-local, and that is one change in two places rather than a rewrite. + */ + +#include +#include +#include +#include + +/* ── What we borrow from flan_rt.c ───────────────────────────────────── + * + * Declared rather than included: the build hands clang each runtime .c on its + * own with no include path (see [Build.compile_c]), so a #include of + * flan_dyn.h would not resolve. runtime/flan_dyn.h says the same things a + * second time and test/dyn_ops.c includes it, which is what keeps the two + * copies honest. */ + +void flan_write_stdout(const uint8_t *p, int64_t n); + +/* The one non-local exit a dyn operation can take. flan_rt.c's [rt_trap] is + * static, and re-implementing what it does — the break-loop hook, the flush, + * the socket, [_exit(134)] — would be a second answer to "how does a Flan + * program die where it stands", which that file went to some trouble to have + * only one of. So flan_rt.c exports a thin wrapper and this calls it. */ +_Noreturn void flan_trap(const uint8_t *name, int64_t namelen); + +/* ── The representation ──────────────────────────────────────────────── + * + * NaN-boxed, in a word. A double is *itself*: the 2^64 minus a NaN's worth of + * bit patterns that are not quiet NaNs are read straight back as f64, at no + * cost, which is what a language where f64 is first class and where sand.flan + * runs a physics loop wants. Everything else hides inside the quiet-NaN space. + * + * The box is sign bit + all-ones exponent + quiet bit, which is + * 0xFFF8000000000000. Bits 50..48 are three tag bits; bits 47..0 are the + * payload, which is exactly the width of an x86-64 user-space pointer. + * + * 63 62..52 51 50..48 47..0 + * 1 1...1 1 tag payload + * + * The collision this scheme always has to answer for is a real f64 that is + * already a *negative* quiet NaN: those bits are indistinguishable from a box. + * [flan_dyn_from_f64] answers it by canonicalising every NaN to the positive + * quiet NaN on the way in. That is not a new rule invented here — flan_rt.c's + * [flan_f64_to_bytes] already renders every NaN as "nan" with no sign, and + * carries three paragraphs on why the sign bit of a NaN is not a fact about + * the arithmetic and should not be shown. A dyn value takes the same line one + * step further and does not *store* it. Nothing observable changes: NaN is not + * equal to itself, so no comparison can see which NaN it is, and the printer + * was already refusing to say. + * + * Integers. i64 is first class here and 48 bits is not 64, so an int that fits + * the payload is inline and one that does not is a heap box. The inline range + * is ±2^47, which is every array index, every counter and every timestamp in + * milliseconds until the year 6429; the box is what keeps the other end of the + * type honest rather than quietly wrapping. See the doc. + * + * Tags 6 and 7 are unspoken for, and that is where a typed handle goes when + * interop arrives — a (Vec i64) crossing into dyn without being copied. Again, + * the doc. */ + +typedef uint64_t flan_dyn; + +#define DYN_QNAN 0xFFF8000000000000ULL +#define DYN_TAGMASK 0x0007000000000000ULL +#define DYN_PAYMASK 0x0000FFFFFFFFFFFFULL +#define DYN_TAGSHIFT 48 + +/* The four box tags. Not the same numbers as FLAN_DYN_TAG_* in the header: + * those are what a *reader* is told (float and int are two answers), these are + * how the word is laid out (a float is not boxed at all, and a big int is a + * pointer). [flan_dyn_tag] is the translation. */ +#define BOX_NIL 0u +#define BOX_BOOL 1u +#define BOX_INT 2u +#define BOX_OBJ 3u + +/* Spelled as a negated positive rather than as a shift of -1: shifting a + * negative value left is undefined, and this file is swept by UBSan. */ +#define DYN_INT_MAX (((int64_t)1 << 47) - 1) +#define DYN_INT_MIN (-DYN_INT_MAX - 1) + +static inline int dyn_boxed(flan_dyn v) { return (v & DYN_QNAN) == DYN_QNAN; } +static inline unsigned dyn_box(flan_dyn v) { + return (unsigned)((v & DYN_TAGMASK) >> DYN_TAGSHIFT); +} +static inline uint64_t dyn_payload(flan_dyn v) { return v & DYN_PAYMASK; } + +static inline flan_dyn dyn_make(unsigned tag, uint64_t payload) { + return DYN_QNAN | ((uint64_t)tag << DYN_TAGSHIFT) | (payload & DYN_PAYMASK); +} + +/* ── The heap ────────────────────────────────────────────────────────── + * + * One header, three kinds, and a singly-linked list of everything ever + * allocated. The list is the sweep's; there is no other index, no free list + * and no size class, because the collector's stated job is to be small enough + * to read in one sitting. A heap that wants to be faster than this wants the + * program to be typed instead. + * + * [mark] is a byte and not a bit in a side table for the same reason. A side + * table is the right answer when the sweep is the cost, and the sweep is never + * going to be the cost here. + * + * A vec's elements live in a plain malloc block hanging off the header rather + * than in a GC object of their own. Two reasons: a growth is then a [realloc] + * and not a copy this file writes, and the elements are never reachable except + * through their vec, so giving them an identity would buy nothing and cost a + * header. Their bytes are counted in [gc_bytes] and freed when the vec is + * swept, which is the whole of their lifetime. */ + +#define OBJ_TEXT 0 +#define OBJ_VEC 1 +#define OBJ_INT 2 /* an i64 too wide for the payload */ + +typedef struct flan_obj { + struct flan_obj *next; /* every object ever allocated, newest first */ + uint8_t kind; + uint8_t mark; + int64_t len; /* bytes of a text, elements of a vec */ + union { + int64_t i; /* OBJ_INT */ + struct { flan_dyn *items; int64_t cap; } v; /* OBJ_VEC */ + /* OBJ_TEXT's bytes trail the header; see [obj_text_bytes]. */ + } u; +} flan_obj; + +static inline uint8_t *obj_text_bytes(flan_obj *o) { return (uint8_t *)(o + 1); } + +static flan_obj *gc_all; /* the sweep list */ +static int64_t gc_bytes; /* what the live objects hold, headers included */ +static int64_t gc_count; +static int64_t gc_next; /* collect when an allocation would pass this */ +static int64_t gc_floor = 1 << 20; +static int gc_ready; + +/* ── Roots ───────────────────────────────────────────────────────────── + * + * Addresses of slots, pushed by the code that owns them. Not a conservative + * scan of the C stack, and the reason is worth stating once here rather than + * only in the doc: a conservative scan has to decide whether an arbitrary word + * is a pointer, and NaN-boxing makes that decision *wrong* in both directions + * — a live double is bit-identical to a boxed pointer often enough to retain + * garbage, and a payload with the box stripped is not the pointer the scanner + * would look for. Precision here is cheaper than the arguments about it. + * + * Growable, because a deep recursion over dyn locals is an ordinary program + * and a fixed table would be a limit nobody could predict. The array holds + * [flan_dyn *], so growing it moves the array and not the slots. */ + +static flan_dyn **roots; +static int64_t roots_n, roots_cap; + +/* ── The temporaries ring ────────────────────────────────────────────── + * + * The hazard this exists for, plainly: mark-sweep frees what is unreachable, + * and a freshly allocated object is unreachable until somebody roots it. So + * + * flan_dyn_push(v, flan_dyn_add(flan_dyn_from_bytes(p, n), ...)); + * + * — or any expression with two allocating calls in it — can have the second + * allocation collect the result of the first, in the window before the + * compiler has stored either into a rooted slot. C's argument evaluation order + * is unspecified, so this is not even a window a careful emitter could close + * by ordering its calls. + * + * The answer is the smallest one that does not need the other lane to have + * read a document: every object this file allocates is written into a fixed + * ring, and the marker roots the whole ring unconditionally. Any expression + * making at most RING allocations before rooting its result is then safe, with + * no ABI change and no contract for anybody to get wrong. The cost is a store + * and a masked increment per allocation, and up to RING objects' worth of + * float in the heap — which the trigger absorbs, because the trigger is a + * fraction of live bytes and not a count. + * + * 64 slots. An expression with 65 allocating calls in it and no intervening + * root would be a single Flan form with 65 constructors in it, which is not a + * form anybody writes; if it ever is, the compiler roots its intermediates and + * this ring is belt on top of braces. */ + +#define RING 64 +static flan_obj *ring[RING]; +static unsigned ring_at; + +/* ── Tag words ───────────────────────────────────────────────────────── + * + * One table. The trap messages below and [flan_dyn_tag_name] read it, so a + * sentence a program dies with and a name an inspector shows cannot drift + * apart. Words and never numbers: "cannot add int and text" is a sentence + * somebody can act on and "tag 2 and tag 4" is a puzzle. */ + +static const char *const tag_words[] = { "nil", "bool", "int", "float", + "text", "vec" }; + +#define FLAN_DYN_TAG_NIL 0 +#define FLAN_DYN_TAG_BOOL 1 +#define FLAN_DYN_TAG_INT 2 +#define FLAN_DYN_TAG_FLOAT 3 +#define FLAN_DYN_TAG_TEXT 4 +#define FLAN_DYN_TAG_VEC 5 + +static inline flan_obj *dyn_obj(flan_dyn v) { + return (flan_obj *)(uintptr_t)dyn_payload(v); +} + +int32_t flan_dyn_tag(flan_dyn v) { + if (!dyn_boxed(v)) return FLAN_DYN_TAG_FLOAT; + switch (dyn_box(v)) { + case BOX_NIL: return FLAN_DYN_TAG_NIL; + case BOX_BOOL: return FLAN_DYN_TAG_BOOL; + case BOX_INT: return FLAN_DYN_TAG_INT; + default: { + flan_obj *o = dyn_obj(v); + if (o == NULL) return FLAN_DYN_TAG_NIL; + switch (o->kind) { + case OBJ_TEXT: return FLAN_DYN_TAG_TEXT; + case OBJ_VEC: return FLAN_DYN_TAG_VEC; + default: return FLAN_DYN_TAG_INT; + } + } + } +} + +const char *flan_dyn_tag_name(int32_t tag) { + if (tag < 0 || tag > FLAN_DYN_TAG_VEC) return "?"; + return tag_words[tag]; +} + +static inline const char *tag_of(flan_dyn v) { + return flan_dyn_tag_name(flan_dyn_tag(v)); +} + +/* ── Rendering, for messages and for print ───────────────────────────── + * + * One walk, two callers. [flan_dyn_print] writes to stdout through + * [flan_write_stdout], so a dyn print and a typed print interleave correctly + * in the one buffer; a trap message renders into a small buffer and puts the + * values in the sentence. + * + * What it renders, per tag, is what typed [print] renders for the + * corresponding type — captured from a running program rather than read off + * lib/render.ml, because that file is the REPL's inspector and not necessarily + * println's expansion: + * + * int %lld 42 + * float %g, and "nan" unsigned 3.5, 1, nan + * bool the word true / false + * text bare at the top level, hi / "a b" + * quoted and escaped inside + * vec a slice's spelling [ 1 2 3] + * + * The leading space before every element is not a slip: it is what + * lib/render.ml's slice loop emits and what a Flan program prints today, and + * an acceptance test comparing the two would notice a tidier answer. + * + * nil is the one tag with no typed counterpart, and it renders as `nil`. + * + * A typed Vec prints as `` rather than structurally, and a dyn vec does + * not: it prints the way a *slice* does. That is deliberate and is argued in + * the doc — the typed refusal is about borrowing storage the printer does not + * own, and a dyn vec's storage is the collector's, so there is nothing to + * borrow and nobody to ask. + * + * DEPTH is a cycle stop and nothing else. A typed value cannot contain itself, + * so the typed printer needs no run-time cap; [flan_dyn_set_at] makes a dyn + * vec that can, so this one does. Past the cap it prints render.ml's "...", + * which is the same mark that file uses for the same idea. */ + +#define PRINT_DEPTH 16 + +static void emit(const char *s) { + flan_write_stdout((const uint8_t *)s, (int64_t)strlen(s)); +} + +static void emit_n(const uint8_t *p, int64_t n) { flan_write_stdout(p, n); } + +/* A text inside a structure, quoted and escaped. The same table as + * flan_rt.c's [flan_escape_bytes] and flan_dev.c's [flan_dev_emit_str], and + * for the same reason those two are the same as each other: three printers + * that disagree about what a string looks like is three wire formats. If that + * table changes, change this one. Streamed rather than built, so there is no + * buffer to overrun and no length to cap. */ +static void emit_escaped(const uint8_t *p, int64_t n) { + int64_t i; + emit("\""); + for (i = 0; i < n; i++) { + unsigned char c = p[i]; + switch (c) { + case '"': emit("\\\""); break; + case '\\': emit("\\\\"); break; + case '\n': emit("\\n"); break; + case '\t': emit("\\t"); break; + case '\r': emit("\\r"); break; + default: + if (c < 0x20) { + char b[5]; + snprintf(b, sizeof b, "\\x%02x", c); + emit(b); + } else { + emit_n(&c, 1); + } + } + } + emit("\""); +} + +static int64_t dyn_int_value(flan_dyn v); /* forward: both int shapes */ +static double dyn_num_value(flan_dyn v); + +static void render(flan_dyn v, int depth, int nested) { + char buf[64]; + int32_t t = flan_dyn_tag(v); + if (depth > PRINT_DEPTH) { emit("..."); return; } + switch (t) { + case FLAN_DYN_TAG_NIL: + emit("nil"); + return; + case FLAN_DYN_TAG_BOOL: + emit(dyn_payload(v) ? "true" : "false"); + return; + case FLAN_DYN_TAG_INT: + snprintf(buf, sizeof buf, "%lld", (long long)dyn_int_value(v)); + emit(buf); + return; + case FLAN_DYN_TAG_FLOAT: { + double d; + memcpy(&d, &v, sizeof d); + /* x != x rather than isnan, which keeps math.h out of this file and is + * the comparison flan_rt.c and the prelude both use. */ + if (d != d) snprintf(buf, sizeof buf, "nan"); + else snprintf(buf, sizeof buf, "%g", d); + emit(buf); + return; + } + case FLAN_DYN_TAG_TEXT: { + flan_obj *o = dyn_obj(v); + if (nested) emit_escaped(obj_text_bytes(o), o->len); + else emit_n(obj_text_bytes(o), o->len); + return; + } + default: { + flan_obj *o = dyn_obj(v); + int64_t i; + emit("["); + for (i = 0; i < o->len; i++) { + emit(" "); + render(o->u.v.items[i], depth + 1, 1); + } + emit("]"); + return; + } + } +} + +void flan_dyn_print(flan_dyn v) { render(v, 0, 0); } + +/* The same walk into a buffer, for a trap's sentence. Bounded and truncated + * rather than allocating: a trap is the one moment when allocating would be a + * second thing to go wrong, and the message's job is to name the value, not to + * reproduce it. The depth is 2 rather than PRINT_DEPTH for the same reason. */ + +#define SAY_MAX 96 + +typedef struct { char *p; int64_t n, cap; } sayer; + +static void say_puts(sayer *s, const char *t) { + while (*t && s->n < s->cap - 1) s->p[s->n++] = *t++; + s->p[s->n] = '\0'; +} + +static void say_render(sayer *s, flan_dyn v, int depth) { + char buf[64]; + int32_t t = flan_dyn_tag(v); + if (s->n >= s->cap - 4) return; + switch (t) { + case FLAN_DYN_TAG_NIL: say_puts(s, "nil"); return; + case FLAN_DYN_TAG_BOOL: say_puts(s, dyn_payload(v) ? "true" : "false"); return; + case FLAN_DYN_TAG_INT: + snprintf(buf, sizeof buf, "%lld", (long long)dyn_int_value(v)); + say_puts(s, buf); + return; + case FLAN_DYN_TAG_FLOAT: { + double d; + memcpy(&d, &v, sizeof d); + if (d != d) snprintf(buf, sizeof buf, "nan"); + else snprintf(buf, sizeof buf, "%g", d); + say_puts(s, buf); + return; + } + case FLAN_DYN_TAG_TEXT: { + flan_obj *o = dyn_obj(v); + int64_t i; + say_puts(s, "\""); + for (i = 0; i < o->len && s->n < s->cap - 6; i++) { + char c[2]; + uint8_t b = obj_text_bytes(o)[i]; + c[0] = b >= 0x20 ? (char)b : '.'; + c[1] = '\0'; + say_puts(s, c); + } + say_puts(s, i < o->len ? "...\"" : "\""); + return; + } + default: { + flan_obj *o = dyn_obj(v); + int64_t i; + if (depth >= 2) { say_puts(s, "[...]"); return; } + say_puts(s, "["); + for (i = 0; i < o->len && s->n < s->cap - 8; i++) { + say_puts(s, " "); + say_render(s, o->u.v.items[i], depth + 1); + } + say_puts(s, i < o->len ? " ...]" : "]"); + return; + } + } +} + +static void say(char *buf, int64_t cap, flan_dyn v) { + sayer s; + s.p = buf; + s.n = 0; + s.cap = cap; + buf[0] = '\0'; + say_render(&s, v, 0); +} + +/* ── Traps ───────────────────────────────────────────────────────────── + * + * The shape of every message: the operation, then what was wrong in words, + * then the call as it would have been written. So a program that adds a number + * to a string stops with + * + * dyn +: int and text, and + wants two numbers — (+ 3 "hi") + * + * which names the operation, both tags, and both values, in that order, + * because that is the order somebody reads it in. [flan_trap] then parks the + * program in a dev session and ends it standing up in a standalone build; the + * sentence is the same either way, which is the point of routing through the + * hook rather than calling abort here. + * + * The trap *name* — what the break loop shows and what a `layout` op will say + * it cannot place — is "DynType" for a tag that was not what the operation + * wanted, "DynRange" for an index outside a vec or a text, "DynArith" for a + * division by zero or the one quotient that overflows, and "DynHeap" for an + * allocation the host refused. Four names rather than one because they are + * four different mistakes and a person stopped in one of them wants to know + * which without reading the sentence twice — and because the break loop lists + * them by name. */ + +static _Noreturn void trap2(const char *name, int64_t namelen, const char *op, + const char *why, flan_dyn a, flan_dyn b) { + char sa[SAY_MAX], sb[SAY_MAX]; + say(sa, SAY_MAX, a); + say(sb, SAY_MAX, b); + fflush(stdout); + fprintf(stderr, "dyn %s: %s and %s, and %s — (%s %s %s)\n", op, tag_of(a), + tag_of(b), why, op, sa, sb); + flan_trap((const uint8_t *)name, namelen); +} + +static _Noreturn void trap1(const char *name, int64_t namelen, const char *op, + const char *why, flan_dyn a) { + char sa[SAY_MAX]; + say(sa, SAY_MAX, a); + fflush(stdout); + fprintf(stderr, "dyn %s: %s, and %s — (%s %s)\n", op, tag_of(a), why, op, sa); + flan_trap((const uint8_t *)name, namelen); +} + +#define TYPE_TRAP "DynType", 7 +#define ARITH_TRAP "DynArith", 8 + +static _Noreturn void trap_range(const char *op, flan_dyn v, int64_t i, + int64_t len) { + char sv[SAY_MAX]; + say(sv, SAY_MAX, v); + fflush(stdout); + fprintf(stderr, + "dyn %s: index %lld is out of bounds for %s of length %lld — %s\n", + op, (long long)i, tag_of(v), (long long)len, sv); + flan_trap((const uint8_t *)"DynRange", 8); +} + +/* ── Allocation and collection ───────────────────────────────────────── + * + * Collection happens here and nowhere else, which is the fact the roots + * contract rests on: between two allocations nothing is swept, so a + * temporary living only in a C local survives the operation it was made in. + * A growing vec's element array is a [realloc] and not an allocation in this + * sense — it cannot collect, because the value being pushed may not be rooted + * yet. That means a program that only ever pushes can hold more than the + * trigger says before the next real allocation catches up, which is fine: what + * it is holding is the vec, and the vec is live. + * + * The trigger is the plainest one that works: collect when this allocation + * would carry the heap past a limit, then set the limit to twice what survived + * — with a floor, so a program with a tiny live set does not collect on every + * other allocation. That gives amortised O(1) collections per byte allocated + * and a heap bounded at twice the live set plus the floor, which is the + * property the million-allocation test asserts. + * + * "The answer to 'I need more performance' will never be a faster GC, it will + * be to type the whole program" — so there is no generation, no card table, no + * incremental phase, and no free list. */ + +static void gc_mark_all(void); +static void gc_sweep(void); + +void flan_gc_init(void) { + if (gc_ready) return; + gc_ready = 1; + gc_all = NULL; + gc_bytes = 0; + gc_count = 0; + gc_next = gc_floor; +} + +/* The trigger is recomputed from the new floor by the same formula the sweep + * uses, rather than only being raised to meet it. Raising alone left a heap + * that had been given a *lower* floor still running to the old one — the first + * collection then happened a megabyte in, and a test that had asked for 64K + * measured a megabyte. */ +void flan_gc_set_floor(int64_t bytes) { + gc_floor = bytes > 0 ? bytes : (1 << 20); + gc_next = gc_bytes * 2; + if (gc_next < gc_floor) gc_next = gc_floor; +} + +int64_t flan_gc_live_bytes(void) { return gc_bytes; } +int64_t flan_gc_count(void) { return gc_count; } + +void flan_gc_collect(void) { + gc_mark_all(); + gc_sweep(); + gc_next = gc_bytes * 2; + if (gc_next < gc_floor) gc_next = gc_floor; +} + +/* Out of memory is the one failure in here that is not the program's fault and + * not recoverable by anything this file can do. It takes the trap path like + * everything else, so a dev session parks on it and can be read, rather than + * the allocation quietly answering NULL and every caller below growing a null + * check for a case none of them can handle. */ +static _Noreturn void trap_oom(int64_t want) { + fflush(stdout); + fprintf(stderr, + "dyn heap: %lld bytes could not be allocated, with %lld live\n", + (long long)want, (long long)gc_bytes); + flan_trap((const uint8_t *)"DynHeap", 7); +} + +static flan_obj *gc_alloc(uint8_t kind, int64_t extra) { + int64_t need = (int64_t)sizeof(flan_obj) + extra; + flan_obj *o; + if (!gc_ready) flan_gc_init(); + if (gc_bytes + need > gc_next) flan_gc_collect(); + o = (flan_obj *)malloc((size_t)need); + if (o == NULL) trap_oom(need); + o->next = gc_all; + o->kind = kind; + o->mark = 0; + o->len = 0; + memset(&o->u, 0, sizeof o->u); + gc_all = o; + gc_bytes += need; + gc_count++; + /* Into the ring before anything else can allocate. See the ring's comment: + * this is the one line that makes an expression with two constructors in it + * safe without the other lane having agreed to anything. */ + ring[ring_at] = o; + ring_at = (ring_at + 1) % RING; + return o; +} + +/* The mark stack. Explicit rather than recursive, because a vec of a vec of a + * vec is an ordinary dyn value and its depth is the program's, not this + * file's: a recursive marker would put the heap's depth on the C stack and a + * long enough chain would overflow it during a collection, which is the worst + * possible moment. Grown on demand and kept between collections, so a steady + * program stops paying for it after the first one. */ +static flan_obj **mstack; +static int64_t mstack_n, mstack_cap; + +static void mark_push(flan_obj *o) { + if (o == NULL || o->mark) return; + o->mark = 1; + /* Only a vec has anything to trace. A text and a boxed int are leaves, and + * marking them is the whole of their visit. */ + if (o->kind != OBJ_VEC) return; + if (mstack_n == mstack_cap) { + int64_t cap = mstack_cap ? mstack_cap * 2 : 64; + flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m); + if (m == NULL) trap_oom(cap * (int64_t)sizeof *m); + mstack = m; + mstack_cap = cap; + } + mstack[mstack_n++] = o; +} + +static void mark_value(flan_dyn v) { + if (dyn_boxed(v) && dyn_box(v) == BOX_OBJ) mark_push(dyn_obj(v)); +} + +static void gc_mark_all(void) { + int64_t i; + unsigned k; + for (i = 0; i < roots_n; i++) mark_value(*roots[i]); + for (k = 0; k < RING; k++) mark_push(ring[k]); + while (mstack_n > 0) { + flan_obj *o = mstack[--mstack_n]; + for (i = 0; i < o->len; i++) mark_value(o->u.v.items[i]); + } +} + +static void gc_sweep(void) { + flan_obj **link = &gc_all; + flan_obj *o = gc_all; + while (o != NULL) { + flan_obj *next = o->next; + if (o->mark) { + o->mark = 0; + link = &o->next; + } else { + int64_t held = (int64_t)sizeof(flan_obj); + if (o->kind == OBJ_TEXT) held += o->len; + if (o->kind == OBJ_VEC) { + held += o->u.v.cap * (int64_t)sizeof(flan_dyn); + free(o->u.v.items); + } + gc_bytes -= held; + gc_count--; + *link = next; + free(o); + } + o = next; + } +} + +void flan_dyn_root_push(flan_dyn *slot) { + if (roots_n == roots_cap) { + int64_t cap = roots_cap ? roots_cap * 2 : 64; + flan_dyn **r = (flan_dyn **)realloc(roots, (size_t)cap * sizeof *r); + if (r == NULL) trap_oom(cap * (int64_t)sizeof *r); + roots = r; + roots_cap = cap; + } + roots[roots_n++] = slot; +} + +/* Clamped at empty rather than refused. A pop that outruns its pushes means + * the frame machinery is already out of step, and the useful thing at that + * point is a heap that still collects, not a second failure on top of the + * first. flan_rt.c's [flan_handler_pop] takes the same line for the same + * reason, by frame rather than by count. */ +void flan_dyn_root_pop(int64_t n) { + if (n <= 0) return; + roots_n = n < roots_n ? roots_n - n : 0; +} + +void flan_dyn_root_reset(void) { roots_n = 0; } + +/* ── Constructors ──────────────────────────────────────────────────────*/ + +flan_dyn flan_dyn_nil(void) { return dyn_make(BOX_NIL, 0); } + +flan_dyn flan_dyn_from_bool(uint8_t b) { + return dyn_make(BOX_BOOL, b ? 1u : 0u); +} + +flan_dyn flan_dyn_from_i64(int64_t x) { + flan_obj *o; + if (x >= DYN_INT_MIN && x <= DYN_INT_MAX) + return dyn_make(BOX_INT, (uint64_t)x); + /* Wider than the payload, so it goes on the heap. Rare by construction — + * see the representation note — and it is the case that keeps i64 an i64 + * rather than a 48-bit integer with a different name. */ + o = gc_alloc(OBJ_INT, 0); + o->u.i = x; + return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); +} + +flan_dyn flan_dyn_from_f64(double x) { + flan_dyn v; + /* Every NaN becomes the one positive quiet NaN, which is what keeps a + * negative quiet NaN from being read back as a box. The argument that this + * loses nothing is in the representation note above and in flan_rt.c's + * [flan_f64_to_bytes]. */ + if (x != x) return 0x7FF8000000000000ULL; + memcpy(&v, &x, sizeof v); + return v; +} + +flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n) { + flan_obj *o; + if (n < 0) n = 0; + o = gc_alloc(OBJ_TEXT, n); + o->len = n; + if (n > 0) memcpy(obj_text_bytes(o), p, (size_t)n); + return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); +} + +flan_dyn flan_dyn_vec_new(void) { + flan_obj *o = gc_alloc(OBJ_VEC, 0); + o->len = 0; + o->u.v.items = NULL; + o->u.v.cap = 0; + return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); +} + +/* ── Reading a value back ──────────────────────────────────────────────*/ + +static int64_t dyn_int_value(flan_dyn v) { + if (dyn_box(v) == BOX_INT) { + /* Sign-extend from 48 bits. The shift pair is the portable spelling; a + * bitfield would be one line shorter and implementation-defined. */ + uint64_t p = dyn_payload(v); + return (int64_t)(p << 16) >> 16; + } + return dyn_obj(v)->u.i; +} + +static double dyn_num_value(flan_dyn v) { + double d; + if (flan_dyn_tag(v) == FLAN_DYN_TAG_INT) return (double)dyn_int_value(v); + memcpy(&d, &v, sizeof d); + return d; +} + +static inline int is_num(flan_dyn v) { + int32_t t = flan_dyn_tag(v); + return t == FLAN_DYN_TAG_INT || t == FLAN_DYN_TAG_FLOAT; +} + +static inline int is_text(flan_dyn v) { + return flan_dyn_tag(v) == FLAN_DYN_TAG_TEXT; +} + +static inline int is_vec(flan_dyn v) { + return flan_dyn_tag(v) == FLAN_DYN_TAG_VEC; +} + +int64_t flan_dyn_need_i64(flan_dyn v) { + if (flan_dyn_tag(v) != FLAN_DYN_TAG_INT) + trap1(TYPE_TRAP, "i64", "an int was wanted", v); + return dyn_int_value(v); +} + +/* A float, and an int is not one. Refusing the widening is the decision, not + * an omission: typed Flan has no implicit widening anywhere — [(print-i64 x)] + * used to force an explicit [(i64 x)] at every site — and a boundary that + * quietly turned an int into a float would be the one place in the language + * where a type changed without anybody writing it down. The dyn *operators* + * promote, because arithmetic between a 2 and a 2.5 has an obvious answer and + * refusing it makes dynamic code worse; the boundary into a typed f64 + * parameter does not, because there the annotation is somebody's stated + * expectation and a mismatch is worth hearing about. That asymmetry is + * deliberate and is argued at length in the doc. */ +double flan_dyn_need_f64(flan_dyn v) { + if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) + trap1(TYPE_TRAP, "f64", "a float was wanted", v); + return dyn_num_value(v); +} + +uint8_t flan_dyn_need_bool(flan_dyn v) { + if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) + trap1(TYPE_TRAP, "bool", "a bool was wanted", v); + return (uint8_t)(dyn_payload(v) ? 1 : 0); +} + +/* ── Arithmetic ──────────────────────────────────────────────────────── + * + * Two ints answer an int; anything else numeric answers a float. The promotion + * is the one place dyn is more permissive than the typed language, and the + * case for it is that (+ 1 2.5) has exactly one sensible answer and a language + * that refuses it is not dynamic in any useful sense. A program that wants the + * refusal annotates, which is the whole bargain. + * + * Integer division and remainder by zero trap rather than answering. That + * matches typed Flan, which signals ArithError and dies with "divide by zero" + * if nothing handles it; the condition is not signalled here because a dyn + * operation has no [loc] to report and no transfer channel in its hands, which + * is the same reason the six traps in flan_rt.c park rather than signal. The + * float case is left to IEEE — 1.0/0.0 is inf and that is an answer, not a + * failure. + * + * The INT64_MIN / -1 pair overflows, and is the only pair that does. It gets + * its own sentence for the reason flan_rt.c's gives it one: somebody meeting + * it has probably never had to think about it. */ + +static void want_nums(const char *op, const char *why, flan_dyn a, flan_dyn b) { + if (!is_num(a) || !is_num(b)) trap2(TYPE_TRAP, op, why, a, b); +} + +#define ARITH_NUM "it takes two numbers" + +static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { + int64_t x, y; + want_nums(op, ARITH_NUM, a, b); + if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && + flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { + x = dyn_int_value(a); + y = dyn_int_value(b); + switch (op[0]) { + case '+': return flan_dyn_from_i64((int64_t)((uint64_t)x + (uint64_t)y)); + case '-': return flan_dyn_from_i64((int64_t)((uint64_t)x - (uint64_t)y)); + case '*': return flan_dyn_from_i64((int64_t)((uint64_t)x * (uint64_t)y)); + case '/': + if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b); + if (x == INT64_MIN && y == -1) + trap2(ARITH_TRAP, op, + "the quotient is one past the largest i64, which is true of " + "this pair of operands and no other", a, b); + return flan_dyn_from_i64(x / y); + default: + if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b); + if (x == INT64_MIN && y == -1) return flan_dyn_from_i64(0); + return flan_dyn_from_i64(x % y); + } + } + { + double p = dyn_num_value(a), q = dyn_num_value(b); + switch (op[0]) { + case '+': return flan_dyn_from_f64(p + q); + case '-': return flan_dyn_from_f64(p - q); + case '*': return flan_dyn_from_f64(p * q); + case '/': return flan_dyn_from_f64(p / q); + default: + /* No fmod, which would drag math.h in for one operator. The identity is + * the definition of the remainder, and the trunc is what C's [%] does + * for integers, so the two operators agree about sign. */ + if (q == 0.0) return flan_dyn_from_f64(p - p); /* nan, by 0/0 */ + { + double t = p / q; + double k; + /* A quotient past 2^63 has no integer part this can name, and the + * cast would be undefined rather than merely wrong. Every such + * remainder is zero to the precision a double has left, so that is + * what it answers — which is also fmod's answer. */ + if (!(t > -9.2233720368547758e18 && t < 9.2233720368547758e18)) + return flan_dyn_from_f64(t == t ? 0.0 : t); + k = (t < 0) ? -(double)(int64_t)(-t) : (double)(int64_t)t; + return flan_dyn_from_f64(p - k * q); + } + } + } +} + +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith("+", a, b); } +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith("-", a, b); } +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith("*", a, b); } +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith("/", a, b); } +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", a, b); } + +/* ── Ordering ────────────────────────────────────────────────────────── + * + * Numbers against numbers, text against text, and nothing else. Text orders + * bytewise, which is [memcmp] with the shorter one first on a tie — the same + * order a sort of a [(Vec string)] would want and the only order that needs no + * locale, no collation table and no argument. + * + * A number against a text traps rather than answering. The temptation is to + * order by tag so that every value is comparable and sorting never fails; the + * reason not to is that the resulting order is an artefact of this file's tag + * numbering, and a program that sorted a mixed vec would get a stable answer + * that means nothing. */ + +static int order(const char *op, flan_dyn a, flan_dyn b) { + if (is_num(a) && is_num(b)) { + if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && + flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { + int64_t x = dyn_int_value(a), y = dyn_int_value(b); + return x < y ? -1 : (x > y ? 1 : 0); + } + { + double p = dyn_num_value(a), q = dyn_num_value(b); + /* NaN is unordered, and the honest answer is that it is neither less + * than nor greater than anything. Reported as "greater" would make a + * sort loop; reported as 2 lets each operator below answer false, which + * is what IEEE says every one of them answers. */ + if (p != p || q != q) return 2; + return p < q ? -1 : (p > q ? 1 : 0); + } + } + if (is_text(a) && is_text(b)) { + flan_obj *x = dyn_obj(a), *y = dyn_obj(b); + int64_t n = x->len < y->len ? x->len : y->len; + int c = n > 0 ? memcmp(obj_text_bytes(x), obj_text_bytes(y), (size_t)n) : 0; + if (c != 0) return c < 0 ? -1 : 1; + return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0); + } + trap2(TYPE_TRAP, op, + "it compares two numbers or two texts, and these are neither", a, b); +} + +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) { + return flan_dyn_from_bool(order("<", a, b) == -1); +} +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) { + int c = order("<=", a, b); + return flan_dyn_from_bool(c == -1 || c == 0); +} +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) { + return flan_dyn_from_bool(order(">", a, b) == 1); +} +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) { + int c = order(">=", a, b); + return flan_dyn_from_bool(c == 1 || c == 0); +} + +/* ── Equality ────────────────────────────────────────────────────────── + * + * Structural, and the only operation here that never traps: two values of + * unrelated tags are unequal, which is an answer, and making it an error would + * mean a dyn program could not ask "is this the string I expected" without + * first checking that it is a string at all. + * + * A number equals a number by value across the two tags — (= 1 1.0) is true — + * which is the same promotion the operators do and for the same reason. Text + * is bytewise and not by identity: two separately built texts with the same + * bytes are equal, and the doc's "string identity" section says why that is + * the only defensible choice when a text is immutable. + * + * A vec is equal element by element, with an identity shortcut first. The + * depth cap is the cycle stop: [set_at] lets a vec contain itself, and past + * the cap two vecs are equal only if they are the same vec, which terminates + * and answers correctly for the case that actually arises (a cycle compared + * against itself). Two *distinct* cyclic vecs with the same shape answer + * false, which is a wrong answer to a question nobody has asked yet; the + * honest fix is a visited set and it can be added the day somebody needs it. */ + +#define EQ_DEPTH 64 + +static int dyn_equal(flan_dyn a, flan_dyn b, int depth) { + int32_t ta = flan_dyn_tag(a), tb = flan_dyn_tag(b); + if (a == b && ta != FLAN_DYN_TAG_FLOAT) return 1; + if (is_num(a) && is_num(b)) { + if (ta == FLAN_DYN_TAG_INT && tb == FLAN_DYN_TAG_INT) + return dyn_int_value(a) == dyn_int_value(b); + return dyn_num_value(a) == dyn_num_value(b); + } + if (ta != tb) return 0; + if (ta == FLAN_DYN_TAG_TEXT) { + flan_obj *x = dyn_obj(a), *y = dyn_obj(b); + if (x->len != y->len) return 0; + return x->len == 0 || + memcmp(obj_text_bytes(x), obj_text_bytes(y), (size_t)x->len) == 0; + } + if (ta == FLAN_DYN_TAG_VEC) { + flan_obj *x = dyn_obj(a), *y = dyn_obj(b); + int64_t i; + if (x == y) return 1; + if (depth >= EQ_DEPTH) return 0; + if (x->len != y->len) return 0; + for (i = 0; i < x->len; i++) + if (!dyn_equal(x->u.v.items[i], y->u.v.items[i], depth + 1)) return 0; + return 1; + } + /* nil and bool, whose whole content is the payload the identity test above + * already compared. Reached only when that test said no. */ + return 0; +} + +flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) { + return flan_dyn_from_bool((uint8_t)dyn_equal(a, b, 0)); +} + +/* ── Containers ────────────────────────────────────────────────────────*/ + +flan_dyn flan_dyn_len(flan_dyn v) { + if (is_text(v) || is_vec(v)) return flan_dyn_from_i64(dyn_obj(v)->len); + trap1(TYPE_TRAP, "len", "only a text or a vec has one", v); +} + +/* The index has to be an int, and that is a separate sentence from the + * container being wrong: (at v "1") and (at 3 1) are two different mistakes + * and telling somebody "these are the wrong types" names neither. */ +static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) { + if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT) + trap2(TYPE_TRAP, op, "an index must be an int", v, i); + return dyn_int_value(i); +} + +/* A text answers a byte, as an int. That is what [(at s i)] on a + * [(Slice u8)] does in the typed language, and a text is a run of bytes in + * both. Codepoints are utf8's job and stay there. */ +flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) { + int64_t k; + flan_obj *o; + if (!is_text(v) && !is_vec(v)) + trap2(TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); + k = need_index("at", v, i); + o = dyn_obj(v); + if (k < 0 || k >= o->len) trap_range("at", v, k, o->len); + if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]); + return o->u.v.items[k]; +} + +void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) { + int64_t k; + flan_obj *o; + (void)x; + if (is_text(v)) + trap2(TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); + if (!is_vec(v)) + trap2(TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); + k = need_index("set-at", v, i); + o = dyn_obj(v); + if (k < 0 || k >= o->len) trap_range("set-at", v, k, o->len); + o->u.v.items[k] = x; +} + +void flan_dyn_push(flan_dyn v, flan_dyn x) { + flan_obj *o; + if (!is_vec(v)) { + /* The value is in the sentence rather than the vec, because the vec is the + * thing that is wrong and the value is what says which push it was. */ + trap2(TYPE_TRAP, "push", "only a vec is pushed to", v, x); + } + o = dyn_obj(v); + if (o->len == o->u.v.cap) { + int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8; + flan_dyn *items = + (flan_dyn *)realloc(o->u.v.items, (size_t)cap * sizeof *items); + if (items == NULL) trap_oom(cap * (int64_t)sizeof *items); + /* The growth is charged to the heap so the trigger sees it, and it is + * charged *here* rather than at the next collection because a vec that + * doubles a dozen times between allocations would otherwise be invisible + * to the trigger until it was already large. */ + gc_bytes += (cap - o->u.v.cap) * (int64_t)sizeof *items; + o->u.v.items = items; + o->u.v.cap = cap; + } + o->u.v.items[o->len++] = x; +} diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h new file mode 100644 index 0000000..e30d56a --- /dev/null +++ b/runtime/flan_dyn.h @@ -0,0 +1,177 @@ +/* flan_dyn — the dynamic-value runtime's ABI. + * + * This header is not compiled into a program. The build embeds the runtime's + * .c files as strings and hands each one to clang on its own, with no include + * path (see [Build.compile_c]), so runtime/flan_dyn.c declares everything it + * defines and this file declares it a second time. That is the same standing + * arrangement flan_escape_bytes and flan_dev_emit_str already live under — + * "if either table changes, change both" — and it is made mechanical rather + * than hopeful: test/dyn_ops.c includes this header and names every function + * below, so a signature that drifts from the implementation is a link error in + * `dune test` rather than a surprise at someone else's call site. + * + * Who reads it: the compiler lane, which emits calls to these names, and the + * C tests. The whole of the boundary is here. What is behind it — the value + * representation, the heap layout, the collector — is flan_dyn.c's business + * and is argued in docs/SPIKE-DYNAMIC.md. + */ + +#ifndef FLAN_DYN_H +#define FLAN_DYN_H + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +/* A dynamic value. One machine word, always — the whole point of the type is + * that a dyn local is a register or a stack slot and never a struct the ABI + * has to agree about. NaN-boxed; see the design doc. */ +typedef uint64_t flan_dyn; + +/* ── Constructors ──────────────────────────────────────────────────── */ + +flan_dyn flan_dyn_nil(void); +flan_dyn flan_dyn_from_i64(int64_t x); +flan_dyn flan_dyn_from_f64(double x); +flan_dyn flan_dyn_from_bool(uint8_t b); + +/* Copies the bytes into the GC heap. The result is a text value, immutable + * from that moment: nothing in this ABI writes into one. [p] may point + * anywhere — a literal in .rodata, a frame slot, a slice the caller is about + * to drop — because the bytes are copied before this returns. */ +flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n); + +flan_dyn flan_dyn_vec_new(void); + +/* ── Operations ──────────────────────────────────────────────────────── + * + * Every one of these may trap, and a trap does not return: it prints a + * sentence naming the operation, the tags it was given and the values, and + * then takes flan_rt.c's [flan_trap] — which parks the program for inspection + * in a dev session and ends it in a standalone build. The three that cannot + * trap say so on their own line. */ + +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b); + +/* Answer a bool dyn. Numbers compare as numbers and text compares bytewise; + * a mixture of the two, or anything else, traps. */ +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b); + +/* Structural, and the one operation in this file that never traps: two values + * of unrelated tags are not an error, they are unequal. */ +flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b); + +/* Bytes of a text, elements of a vec. Anything else traps. */ +flan_dyn flan_dyn_len(flan_dyn v); + +/* Element of a vec, or the byte of a text as an int. Out of range traps. */ +flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i); + +/* Vec only — a text is immutable and says so rather than being copied. */ +void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x); +void flan_dyn_push(flan_dyn v, flan_dyn x); + +/* Structural, and per type it renders what typed [print] renders. Never + * traps: every tag has a rendering, including nil. */ +void flan_dyn_print(flan_dyn v); + +/* ── The typed boundary ──────────────────────────────────────────────── + * + * What an annotated parameter does with a dyn argument, and what a dyn + * expression does where the checker wants a machine value. A tag that is not + * the one asked for traps; there is no widening and no coercion here, which + * is deliberate — see the doc's boundary section. */ + +int64_t flan_dyn_need_i64(flan_dyn v); +double flan_dyn_need_f64(flan_dyn v); +uint8_t flan_dyn_need_bool(flan_dyn v); + +/* ── The collector ───────────────────────────────────────────────────── + * + * Mark-sweep, precise, and never moving. [flan_gc_init] is idempotent, and the + * first allocation calls it if nobody else has — deliberately, because + * flan_rt_init calling it would be flan_rt.c naming a symbol in flan_dyn.c, + * and the whole of the droppability argument is that the dependency runs one + * way only. So an emitted program need not call it at all; it is exported + * because a test that wants a heap in a known state wants to say so. + * + * [flan_gc_collect] is a full collection on demand, which nothing in an + * emitted program needs — collection happens inside allocation — and which + * the tests and a break loop want. [flan_gc_live_bytes] is what the heap holds + * after the last sweep, counted the way the trigger counts it. */ + +void flan_gc_init(void); +void flan_gc_collect(void); +int64_t flan_gc_live_bytes(void); + +/* Roots, shadow-stack style, exactly as flan_dev.c's frame chain is: the + * compiler emits a push per dyn local on entry and one pop for the lot on the + * way out. The address is remembered, not the value, so a local that is + * reassigned needs no second push. + * + * **The slot must hold a valid flan_dyn before it is pushed.** The collector + * reads every registered address on every mark, and an uninitialised slot is a + * word of stack garbage that will be decoded as a pointer. Storing nil first + * is the whole of the contract; the compiler lane zeroes a slot at its + * declaration anyway. + * + * Globals go through the same pair, pushed once at startup and never popped. + * + * [flan_dyn_root_pop] takes a count rather than an address because that is + * what a function epilogue knows cheaply. Popping more than are pushed is + * clamped at empty rather than being a second failure on top of the first. */ +void flan_dyn_root_push(flan_dyn *slot); +void flan_dyn_root_pop(int64_t n); + +/* ── Extensions ──────────────────────────────────────────────────────── + * + * Additions to the agreed ABI, none of which the compiler lane has to emit. + * They are here because something in this repository needs them; each says + * what. */ + +/* The root stack, emptied. The counterpart of flan_dev.c's + * [flan_dev_frames_reset] and there for its one caller: the merged dev build's + * [main] is re-entered by longjmp, which pops no frame, so every root the + * finished run pushed still points into stack the next run is about to write + * over. Marking through those addresses would decode whatever the new run put + * there. Called between runs, on the thread that runs them. */ +void flan_dyn_root_reset(void); + +/* The tag of a value, as a number and as the word that number is printed as. + * The numbers are FLAN_DYN_TAG_* below. The break loop and the inspector want + * both — a value's tag is the first thing anyone asks a stopped dyn program — + * and the trap messages in flan_dyn.c are written from the same table, so a + * message and an inspector cannot disagree about what to call a value. */ +#define FLAN_DYN_TAG_NIL 0 +#define FLAN_DYN_TAG_BOOL 1 +#define FLAN_DYN_TAG_INT 2 +#define FLAN_DYN_TAG_FLOAT 3 +#define FLAN_DYN_TAG_TEXT 4 +#define FLAN_DYN_TAG_VEC 5 + +int32_t flan_dyn_tag(flan_dyn v); +const char *flan_dyn_tag_name(int32_t tag); + +/* How many objects the heap holds, and the floor under the collection + * trigger. Both are the tests': a live-bytes figure alone cannot tell a heap + * that is collecting from one whose objects happen to be small, and a floor of + * a megabyte would make the million-allocation case a megabyte of arithmetic + * before it proved anything. Setting the floor takes effect at the next + * allocation and never shrinks a heap by itself; pass 0 for the default. */ +int64_t flan_gc_count(void); +void flan_gc_set_floor(int64_t bytes); + +#ifdef __cplusplus +} +#endif + +#endif /* FLAN_DYN_H */ diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 53b4bfc..3f9c3a8 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -573,6 +573,24 @@ static _Noreturn void rt_trap(const uint8_t *name, int64_t namelen) { rt_die(); } +/* The same thing, exported, for the one caller outside this file: flan_dyn.c, + * whose type mismatches are traps of exactly this kind and must park exactly + * the way these six do. [rt_trap] is static and stays static — what a second + * translation unit needs is the *behaviour*, and the alternative was + * flan_dyn.c reimplementing the hook, the flush, the socket and the exit code, + * which would be a second answer to "how does a Flan program die where it + * stands" and a guarantee that the two would drift. + * + * The dependency runs that way and only that way. Nothing in this file names + * anything in flan_dyn.c, which is what lets a build that wants no collector + * leave that object out entirely; a call in the other direction would make the + * collector unconditional. The sentence belongs to the caller: this prints + * nothing, because every site that reaches it has already said what happened + * in the words that site knows. */ +_Noreturn void flan_trap(const uint8_t *name, int64_t namelen) { + rt_trap(name, namelen); +} + /* Must agree with Check.type_id, byte for byte, or a name typed at the break * loop matches nothing. FNV-1a over the name, 32 bits. */ static uint32_t flan_name_id(const uint8_t *s, int64_t n) { diff --git a/test/dune b/test/dune index d8bff55..143edfb 100644 --- a/test/dune +++ b/test/dune @@ -1,11 +1,11 @@ (tests - (names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs test_repl test_cider) + (names test_flan test_acceptance test_reload test_agent test_session test_dev test_emacs test_repl test_cider test_dyn) ; Explicit because test_sanitize lives in this directory and is not one of ; these: two stanzas in one directory have to say which modules are whose. ; watchdog is every binary's clock: a hanging test reports nothing, so each ; of these arms an alarm that turns "for ever" into a failing run. (modules test_flan test_acceptance test_reload test_agent test_session - test_dev test_emacs test_repl test_cider watchdog) + test_dev test_emacs test_repl test_cider test_dyn watchdog) (libraries flan unix) ; The acceptance programs are part of the test corpus: if the reader, the ; parser or the checker regresses on them we want to know here, not at the CLI. @@ -73,6 +73,12 @@ ; The other C main: flan_dev.c's two fixed limits, which no Flan program ; reaches, driven directly. (file dev_limits.c) + ; And the third: the dynamic-value runtime, which has no Flan spelling yet + ; at all. Its host program is under programs/ and is picked up by the glob + ; above; the header dyn_ops.c includes is the compiler's, dropped into the + ; build directory beside each translation unit, so it is not a dependency + ; here. + (file dyn_ops.c) ; test_dev runs the compiler itself: flan dev launches and owns a program. (file %{workspace_root}/bin/main.exe) ; The Emacs client, which test_emacs drives against a real daemon. @@ -138,7 +144,12 @@ (glob_files %{workspace_root}/examples/*) (glob_files programs/*.flan) (glob_files programs/assets/*) - (glob_files programs/assets/edn/*)) + (glob_files programs/assets/edn/*) + ; The dyn runtime's C main, which is the one thing in this sweep that is not + ; a Flan program: flan_dyn.c has no Flan spelling yet. It is also the one + ; translation unit here that frees anything, which is what makes it worth a + ; sanitized run at all. See [dyn_sweep]. + (file dyn_ops.c)) (action (run ./test_sanitize.exe))) ; The corpus a third time, under Valgrind's memcheck. Its own alias for the diff --git a/test/dyn_ops.c b/test/dyn_ops.c new file mode 100644 index 0000000..e6e9b4a --- /dev/null +++ b/test/dyn_ops.c @@ -0,0 +1,631 @@ +/* dyn_ops.c — runtime/flan_dyn.c, driven directly. + * + * A C main, for the reason dev_limits.c and reload_host.c are C mains: the + * dynamic-value runtime's surface is a C ABI and has no Flan spelling yet, so + * there is no program that could reach it. The .flan this links against + * therefore has no [main] of its own; see programs/dyn-host.flan. + * + * This file includes runtime/flan_dyn.h and calls every function the header + * declares. That is not tidiness — the build compiles flan_dyn.c on its own + * with no include path, so the implementation declares its own prototypes and + * the header is a second copy of them. Including it *here* is what makes a + * divergence between the two a compile or link error in `dune test` rather + * than a surprise in the compiler lane's emitted code. + * + * One mode per run, chosen by argv, because most of the modes end in a trap + * and a trap ends the process. The happy paths share one run; each refusal + * gets its own. + */ + +#include +#include +#include +#include +#include + +/* Resolved because [Build] drops runtime/flan_dyn.h into the directory it + * compiles each translation unit in, beside the .c it writes there. That is + * the only include path a package's C — or this — ever gets, and it is there + * so that C which computes with dyn values has one declaration to agree with + * rather than a hand-copied list. */ +#include "flan_dyn.h" + +void flan_rt_init(int32_t argc, char **argv); + +static int failures; + +static void fail(const char *what) { + printf("FAIL %s\n", what); + failures++; +} + +static void check(int ok, const char *what) { + if (!ok) fail(what); +} + +/* A value's printed form, captured, so the print assertions can be exact + * strings rather than eyeballed. stdout is redirected into a pipe for the + * length of one call — cheaper and more honest than a second renderer that + * would have to be kept in step with the one under test. */ +static char shown[4096]; + +static void show(flan_dyn v) { + int saved = dup(1); + int fds[2]; + ssize_t n; + shown[0] = '\0'; + if (pipe(fds) != 0) { fail("pipe"); return; } + fflush(stdout); + dup2(fds[1], 1); + close(fds[1]); + flan_dyn_print(v); + fflush(stdout); + dup2(saved, 1); + close(saved); + n = read(fds[0], shown, sizeof shown - 1); + close(fds[0]); + shown[n > 0 ? (size_t)n : 0] = '\0'; +} + +static void prints(flan_dyn v, const char *want) { + show(v); + if (strcmp(shown, want) != 0) { + printf("FAIL print: got %s, wanted %s\n", shown, want); + failures++; + } +} + +static int truth(flan_dyn v) { return flan_dyn_need_bool(v) != 0; } +static int64_t num(flan_dyn v) { return flan_dyn_need_i64(v); } + +static flan_dyn text(const char *s) { + return flan_dyn_from_bytes((const uint8_t *)s, (int64_t)strlen(s)); +} + +/* ── The happy paths ───────────────────────────────────────────────────*/ + +static void ops(void) { + /* Six slots and one push of six, which is the shape the compiler lane + emits: a frame's dyn locals are rooted as a block on entry and popped as a + block on the way out. Every one is nil before it is pushed, which is the + contract the header states — the collector reads these addresses on every + mark, and an unwritten slot is a word of stack garbage. */ + flan_dyn a = flan_dyn_nil(), b = flan_dyn_nil(), c = flan_dyn_nil(); + flan_dyn v = flan_dyn_nil(), w = flan_dyn_nil(), s = flan_dyn_nil(); + flan_dyn_root_push(&a); + flan_dyn_root_push(&b); + flan_dyn_root_push(&c); + flan_dyn_root_push(&v); + flan_dyn_root_push(&w); + flan_dyn_root_push(&s); + + /* Tags, and the words they are called by. The words are what a trap message + says, so they are asserted here rather than only read. */ + check(flan_dyn_tag(flan_dyn_nil()) == FLAN_DYN_TAG_NIL, "tag nil"); + check(flan_dyn_tag(flan_dyn_from_bool(1)) == FLAN_DYN_TAG_BOOL, "tag bool"); + check(flan_dyn_tag(flan_dyn_from_i64(7)) == FLAN_DYN_TAG_INT, "tag int"); + check(flan_dyn_tag(flan_dyn_from_f64(1.5)) == FLAN_DYN_TAG_FLOAT, "tag float"); + check(flan_dyn_tag(text("x")) == FLAN_DYN_TAG_TEXT, "tag text"); + check(flan_dyn_tag(flan_dyn_vec_new()) == FLAN_DYN_TAG_VEC, "tag vec"); + check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_NIL), "nil") == 0, "word nil"); + check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_BOOL), "bool") == 0, "word bool"); + check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_INT), "int") == 0, "word int"); + check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_FLOAT), "float") == 0, "word float"); + check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_TEXT), "text") == 0, "word text"); + check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_VEC), "vec") == 0, "word vec"); + + /* Every double is itself, at both ends of the range and at the values a + NaN-box could get wrong. -0.0 is the one that would be lost by a scheme + that normalised more than NaN. */ + check(flan_dyn_need_f64(flan_dyn_from_f64(0.0)) == 0.0, "f64 zero"); + check(flan_dyn_need_f64(flan_dyn_from_f64(-1.25)) == -1.25, "f64 neg"); + check(flan_dyn_need_f64(flan_dyn_from_f64(1e308)) == 1e308, "f64 huge"); + { + double z = flan_dyn_need_f64(flan_dyn_from_f64(-0.0)); + check(z == 0.0 && 1.0 / z < 0, "f64 negative zero keeps its sign"); + } + { + /* A NaN survives as a NaN, which is all a NaN promises. Its *sign* does + not, on purpose: flan_rt.c already refuses to print it and the box + needs the bit. */ + double n = flan_dyn_need_f64(flan_dyn_from_f64(0.0 / 0.0)); + check(n != n, "f64 nan is still nan"); + } + + /* Integers, including the two that do not fit the payload and go to the + heap. The round trip is what says a boxed int is the same int. */ + check(num(flan_dyn_from_i64(0)) == 0, "i64 zero"); + check(num(flan_dyn_from_i64(-1)) == -1, "i64 minus one"); + check(num(flan_dyn_from_i64(140737488355327LL)) == 140737488355327LL, + "i64 largest inline"); + check(num(flan_dyn_from_i64(-140737488355328LL)) == -140737488355328LL, + "i64 smallest inline"); + check(num(flan_dyn_from_i64(140737488355328LL)) == 140737488355328LL, + "i64 first boxed"); + check(num(flan_dyn_from_i64(INT64_MAX)) == INT64_MAX, "i64 max"); + check(num(flan_dyn_from_i64(INT64_MIN)) == INT64_MIN, "i64 min"); + check(flan_dyn_tag(flan_dyn_from_i64(INT64_MAX)) == FLAN_DYN_TAG_INT, + "a boxed int is still an int"); + + /* Arithmetic. Two ints answer an int; a float anywhere answers a float. */ + check(num(flan_dyn_add(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 5, "+"); + check(num(flan_dyn_sub(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == -1, "-"); + check(num(flan_dyn_mul(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 6, "*"); + check(num(flan_dyn_div(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 3, "/"); + check(num(flan_dyn_rem(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 1, "%"); + check(num(flan_dyn_rem(flan_dyn_from_i64(-7), flan_dyn_from_i64(2))) == -1, + "% keeps the sign of the dividend"); + check(flan_dyn_need_f64( + flan_dyn_add(flan_dyn_from_i64(1), flan_dyn_from_f64(0.5))) == 1.5, + "int and float promote"); + check(flan_dyn_need_f64( + flan_dyn_div(flan_dyn_from_f64(1.0), flan_dyn_from_f64(4.0))) == 0.25, + "float /"); + check(flan_dyn_need_f64( + flan_dyn_rem(flan_dyn_from_f64(7.5), flan_dyn_from_f64(2.0))) == 1.5, + "float %"); + /* The boxed end of the range arithmetically, not only as a round trip. */ + check(num(flan_dyn_add(flan_dyn_from_i64(140737488355327LL), + flan_dyn_from_i64(1))) == 140737488355328LL, + "+ crosses into the box"); + + /* Ordering. Numbers against numbers across the two tags, text bytewise, and + a NaN that is none of less, equal or greater. */ + check(truth(flan_dyn_lt(flan_dyn_from_i64(1), flan_dyn_from_i64(2))), "<"); + check(!truth(flan_dyn_lt(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "< eq"); + check(truth(flan_dyn_le(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "<="); + check(truth(flan_dyn_gt(flan_dyn_from_f64(2.5), flan_dyn_from_i64(2))), ">"); + check(truth(flan_dyn_ge(flan_dyn_from_i64(2), flan_dyn_from_f64(2.0))), ">="); + check(truth(flan_dyn_lt(text("abc"), text("abd"))), "< text"); + check(truth(flan_dyn_lt(text("ab"), text("abc"))), "< text prefix"); + check(!truth(flan_dyn_lt(text("abc"), text("abc"))), "< text equal"); + { + flan_dyn n = flan_dyn_from_f64(0.0 / 0.0), one = flan_dyn_from_i64(1); + check(!truth(flan_dyn_lt(n, one)) && !truth(flan_dyn_gt(n, one)) + && !truth(flan_dyn_le(n, one)) && !truth(flan_dyn_ge(n, one)), + "nan is unordered in all four directions"); + } + + /* Equality. Structural, never a trap, and numeric across the tags. */ + check(truth(flan_dyn_eq(flan_dyn_nil(), flan_dyn_nil())), "= nil"); + check(truth(flan_dyn_eq(flan_dyn_from_bool(1), flan_dyn_from_bool(1))), "= bool"); + check(!truth(flan_dyn_eq(flan_dyn_from_bool(1), flan_dyn_from_bool(0))), "= bool no"); + check(truth(flan_dyn_eq(flan_dyn_from_i64(1), flan_dyn_from_f64(1.0))), + "= across int and float"); + check(truth(flan_dyn_eq(flan_dyn_from_i64(INT64_MAX), + flan_dyn_from_i64(INT64_MAX))), + "= two boxed ints"); + check(!truth(flan_dyn_eq(flan_dyn_from_i64(1), text("1"))), + "= on unrelated tags answers false rather than trapping"); + check(!truth(flan_dyn_eq(flan_dyn_nil(), flan_dyn_from_bool(0))), + "nil is not false"); + { + flan_dyn n = flan_dyn_from_f64(0.0 / 0.0); + check(!truth(flan_dyn_eq(n, n)), "nan is not equal to itself"); + } + + /* Text: identity is not equality, and equality is the bytes. + [a] and [b] are separately built from separate storage and must be equal; + they must also be *different objects*, because from_bytes copies and does + not intern, and a test that did not say so would pass against an + implementation that silently shared. */ + a = text("hello"); + b = text("hello"); + c = text("hellp"); + check(a != b, "two texts with the same bytes are two objects"); + check(truth(flan_dyn_eq(a, b)), "= text is bytewise"); + check(!truth(flan_dyn_eq(a, c)), "= text sees the last byte"); + check(truth(flan_dyn_eq(a, a)), "= text against itself"); + check(num(flan_dyn_len(a)) == 5, "len text"); + check(num(flan_dyn_at(a, flan_dyn_from_i64(0))) == 'h', "at text"); + check(num(flan_dyn_at(a, flan_dyn_from_i64(4))) == 'o', "at text last"); + { + /* Embedded NUL, because a length-prefixed text is the claim and strlen is + how that claim gets quietly broken. */ + flan_dyn z = flan_dyn_from_bytes((const uint8_t *)"a\0b", 3); + check(num(flan_dyn_len(z)) == 3, "len counts past a NUL"); + check(num(flan_dyn_at(z, flan_dyn_from_i64(2))) == 'b', "at past a NUL"); + check(!truth(flan_dyn_eq(z, text("a"))), "= does not stop at a NUL"); + } + { + flan_dyn e = flan_dyn_from_bytes((const uint8_t *)"", 0); + check(num(flan_dyn_len(e)) == 0, "len of the empty text"); + check(truth(flan_dyn_eq(e, flan_dyn_from_bytes(NULL, 0))), + "= two empty texts"); + } + + /* Vecs. */ + v = flan_dyn_vec_new(); + check(num(flan_dyn_len(v)) == 0, "len of a new vec"); + flan_dyn_push(v, flan_dyn_from_i64(1)); + flan_dyn_push(v, flan_dyn_from_i64(2)); + flan_dyn_push(v, flan_dyn_from_i64(3)); + check(num(flan_dyn_len(v)) == 3, "len after three pushes"); + check(num(flan_dyn_at(v, flan_dyn_from_i64(1))) == 2, "at vec"); + flan_dyn_set_at(v, flan_dyn_from_i64(1), text("two")); + check(truth(flan_dyn_eq(flan_dyn_at(v, flan_dyn_from_i64(1)), text("two"))), + "set-at vec"); + { + /* Past the initial capacity, so the growth path runs and the elements + survive the realloc. */ + int i; + flan_dyn big = flan_dyn_vec_new(); + flan_dyn_root_push(&big); + for (i = 0; i < 100; i++) flan_dyn_push(big, flan_dyn_from_i64(i)); + check(num(flan_dyn_len(big)) == 100, "len after a hundred pushes"); + check(num(flan_dyn_at(big, flan_dyn_from_i64(0))) == 0, "first survived"); + check(num(flan_dyn_at(big, flan_dyn_from_i64(99))) == 99, "last survived"); + flan_dyn_root_pop(1); + } + + /* Vecs compare structurally, element by element and one level down. */ + { + flan_dyn p = flan_dyn_vec_new(), q = flan_dyn_vec_new(); + flan_dyn_root_push(&p); + flan_dyn_root_push(&q); + flan_dyn_push(p, flan_dyn_from_i64(1)); + flan_dyn_push(p, text("x")); + flan_dyn_push(q, flan_dyn_from_i64(1)); + flan_dyn_push(q, text("x")); + check(p != q, "two vecs are two objects"); + check(truth(flan_dyn_eq(p, q)), "= vec is element by element"); + flan_dyn_push(q, flan_dyn_nil()); + check(!truth(flan_dyn_eq(p, q)), "= vec sees the length"); + flan_dyn_root_pop(2); + } + + /* A vec that contains itself. [=] must answer rather than recurse for + ever — the identity shortcut is what makes it answer — and [print] must + stop at its depth cap. */ + { + flan_dyn cyc = flan_dyn_vec_new(); + flan_dyn_root_push(&cyc); + flan_dyn_push(cyc, flan_dyn_from_i64(1)); + flan_dyn_push(cyc, cyc); + check(truth(flan_dyn_eq(cyc, cyc)), "= on a cycle answers"); + show(cyc); + check(strlen(shown) > 0 && strstr(shown, "...") != NULL, + "print stops at its depth cap on a cycle"); + flan_dyn_root_pop(1); + } + + /* Printing, per tag, against what a Flan program prints for the + corresponding type. Captured from a run of `flan run`, not read off + lib/render.ml — the leading space before each element is what the slice + printer emits and what an acceptance test would compare against. */ + prints(flan_dyn_nil(), "nil"); + prints(flan_dyn_from_bool(1), "true"); + prints(flan_dyn_from_bool(0), "false"); + prints(flan_dyn_from_i64(42), "42"); + prints(flan_dyn_from_i64(INT64_MIN), "-9223372036854775808"); + prints(flan_dyn_from_f64(3.5), "3.5"); + prints(flan_dyn_from_f64(1.0), "1"); + prints(flan_dyn_from_f64(0.0 / 0.0), "nan"); + prints(flan_dyn_from_f64(-(0.0 / 0.0)), "nan"); + prints(text("hi"), "hi"); + { + flan_dyn nums = flan_dyn_vec_new(); + flan_dyn strs = flan_dyn_vec_new(); + flan_dyn_root_push(&nums); + flan_dyn_root_push(&strs); + flan_dyn_push(nums, flan_dyn_from_i64(1)); + flan_dyn_push(nums, flan_dyn_from_i64(2)); + flan_dyn_push(nums, flan_dyn_from_i64(3)); + prints(nums, "[ 1 2 3]"); + /* A text inside a structure is quoted and escaped, and bare at the top + level. That is flan_rt.c's rule and the two have to agree, because the + REPL parses the printed form back. */ + flan_dyn_push(strs, text("x")); + flan_dyn_push(strs, text("a b")); + flan_dyn_push(strs, text("q\"\n")); + prints(strs, "[ \"x\" \"a b\" \"q\\\"\\n\"]"); + /* And a vec of vecs, nested twice. */ + { + flan_dyn outer = flan_dyn_vec_new(); + flan_dyn_root_push(&outer); + flan_dyn_push(outer, nums); + flan_dyn_push(outer, strs); + prints(outer, "[ [ 1 2 3] [ \"x\" \"a b\" \"q\\\"\\n\"]]"); + flan_dyn_root_pop(1); + } + prints(flan_dyn_vec_new(), "[]"); + flan_dyn_root_pop(2); + } + + /* The typed boundary, on the tags it accepts. What it refuses is three + separate modes below — each one ends the process. */ + check(flan_dyn_need_i64(flan_dyn_from_i64(-5)) == -5, "need-i64"); + check(flan_dyn_need_f64(flan_dyn_from_f64(2.5)) == 2.5, "need-f64"); + check(flan_dyn_need_bool(flan_dyn_from_bool(1)) == 1, "need-bool true"); + check(flan_dyn_need_bool(flan_dyn_from_bool(0)) == 0, "need-bool false"); + + s = text("kept"); + w = v; + flan_dyn_root_pop(6); + (void)w; + (void)s; +} + +/* ── The collector ─────────────────────────────────────────────────────*/ + +/* Allocate a great many, hold a few, and assert the heap does not grow. The + * live set is a hundred texts in a rooted vec, rewritten round and round; the + * million texts that fall out of it have nothing pointing at them from the + * moment the next iteration overwrites their slot. + * + * The assertion is on the *bound* and not on any particular number: a + * collector's exact high-water mark is a fact about its trigger, and pinning + * it would make a tuning change a test failure. What must hold is that the + * figure stops climbing — that is the whole claim — so the test takes the + * heap's high-water mark over the run and requires it to be within a small + * multiple of what the live set actually needs. + * + * The floor is dropped to 64K first. A megabyte of floor would make this a + * megabyte of arithmetic before the first collection and prove nothing faster. + */ +static void gc(void) { + enum { LIVE = 100, ROUNDS = 1000000 }; + flan_dyn keep = flan_dyn_nil(); + int64_t peak = 0, settled, i; + int collections_happened; + + flan_gc_init(); + flan_gc_set_floor(64 * 1024); + flan_dyn_root_push(&keep); + keep = flan_dyn_vec_new(); + for (i = 0; i < LIVE; i++) flan_dyn_push(keep, flan_dyn_nil()); + + for (i = 0; i < ROUNDS; i++) { + char buf[32]; + int n = snprintf(buf, sizeof buf, "item-%lld", (long long)i); + flan_dyn_set_at(keep, flan_dyn_from_i64(i % LIVE), + flan_dyn_from_bytes((const uint8_t *)buf, n)); + if (flan_gc_live_bytes() > peak) peak = flan_gc_live_bytes(); + } + + flan_gc_collect(); + settled = flan_gc_live_bytes(); + collections_happened = flan_gc_count() < LIVE + 64 + 8; + + /* A million texts of forty-odd bytes is some forty megabytes allocated. A + heap that never collected would hold all of it, so any bound under a + megabyte is a bound only a working collector can meet, and 512K is + comfortably above twice the live set plus the floor plus the ring. */ + printf("peak under 512K: %s\n", peak < 512 * 1024 ? "yes" : "no"); + printf("settled under 32K: %s\n", settled < 32 * 1024 ? "yes" : "no"); + printf("live objects bounded: %s\n", collections_happened ? "yes" : "no"); + + /* And the live set is intact: collecting a million times must not have lost + the hundred things that were rooted throughout. */ + { + int intact = 1; + for (i = 0; i < LIVE; i++) { + char buf[32]; + int64_t k = ROUNDS - LIVE + i; + int n = snprintf(buf, sizeof buf, "item-%lld", (long long)k); + flan_dyn got = flan_dyn_at(keep, flan_dyn_from_i64(k % LIVE)); + if (!flan_dyn_need_bool( + flan_dyn_eq(got, flan_dyn_from_bytes((const uint8_t *)buf, n)))) + intact = 0; + } + printf("live set intact: %s\n", intact ? "yes" : "no"); + } + flan_dyn_root_pop(1); +} + +/* Nested vecs, traced. A chain sixty-four deep reached through one root: every + * link has to survive a collection, which is what says the marker follows a + * vec's elements and not only its header. Sixty-four is also past the point + * where a recursive marker on a modest stack would be fine and a deeper one + * would not — the marker here is iterative, and this is the case that would + * notice if it stopped being. */ +static void nested(void) { + enum { DEEP = 64 }; + flan_dyn root = flan_dyn_nil(), cur; + int64_t i; + int ok = 1; + + flan_gc_init(); + flan_gc_set_floor(16 * 1024); + flan_dyn_root_push(&root); + root = flan_dyn_vec_new(); + cur = root; + for (i = 0; i < DEEP; i++) { + flan_dyn inner = flan_dyn_vec_new(); + flan_dyn_push(cur, flan_dyn_from_i64(i)); + flan_dyn_push(cur, inner); + cur = inner; + } + flan_dyn_push(cur, text("bottom")); + + /* Churn, so that collections certainly happen with the chain live, and then + one more by hand. */ + for (i = 0; i < 20000; i++) (void)text("noise"); + flan_gc_collect(); + + cur = root; + for (i = 0; i < DEEP; i++) { + if (flan_dyn_need_i64(flan_dyn_at(cur, flan_dyn_from_i64(0))) != i) ok = 0; + cur = flan_dyn_at(cur, flan_dyn_from_i64(1)); + } + if (!flan_dyn_need_bool( + flan_dyn_eq(flan_dyn_at(cur, flan_dyn_from_i64(0)), text("bottom")))) + ok = 0; + printf("chain of %d intact: %s\n", DEEP, ok ? "yes" : "no"); + flan_dyn_root_pop(1); +} + +/* Interior sharing: one vec held twice, and a text held from two places. + * Three things have to be true and none of them follows from the others — + * the shared object is swept once and not twice (a double free would show as + * a crash or as a live-bytes figure that went negative), a write through one + * path is visible through the other (it is one object, not a copy), and + * dropping one of the two references does not collect it. */ +static void sharing(void) { + flan_dyn holder = flan_dyn_nil(), shared = flan_dyn_nil(); + flan_dyn was; + int i; + + flan_gc_init(); + flan_gc_set_floor(16 * 1024); + flan_dyn_root_push(&holder); + flan_dyn_root_push(&shared); + + holder = flan_dyn_vec_new(); + shared = flan_dyn_vec_new(); + flan_dyn_push(shared, text("a")); + flan_dyn_push(holder, shared); + flan_dyn_push(holder, shared); + flan_dyn_push(holder, shared); + + /* Three slots, one object. Identity and not equality: two vecs holding the + same text are equal and are still two vecs, so a structural test would + pass against an implementation that had quietly copied. The dyn word of a + vec *is* its address, so comparing the words is comparing the objects. */ + printf("three slots hold one object: %s\n", + flan_dyn_at(holder, flan_dyn_from_i64(0)) + == flan_dyn_at(holder, flan_dyn_from_i64(2)) + ? "yes" : "no"); + + /* And writing through one path is read through another. */ + flan_dyn_set_at(flan_dyn_at(holder, flan_dyn_from_i64(0)), + flan_dyn_from_i64(0), text("b")); + printf("write through one path is seen through another: %s\n", + flan_dyn_need_bool( + flan_dyn_eq(flan_dyn_at(flan_dyn_at(holder, flan_dyn_from_i64(2)), + flan_dyn_from_i64(0)), + text("b"))) + ? "yes" : "no"); + + /* Dropping the direct root leaves it reachable through the holder, three + times over. It must still be there, at the same address — a collector + that swept it and handed the space to something else would answer this + with a different word, and one that swept it twice would be caught by the + sanitizer sweep rather than by an assertion. The churn in between is what + makes the collection real rather than a formality. */ + was = shared; + shared = flan_dyn_nil(); + for (i = 0; i < 5000; i++) (void)text("noise"); + flan_gc_collect(); + printf("shared object survives on the holder alone: %s\n", + flan_dyn_at(holder, flan_dyn_from_i64(1)) == was ? "yes" : "no"); + printf("still reachable: %s\n", + flan_dyn_need_bool( + flan_dyn_eq(flan_dyn_at(flan_dyn_at(holder, flan_dyn_from_i64(1)), + flan_dyn_from_i64(0)), + text("b"))) + ? "yes" : "no"); + + /* And dropping the holder collects the lot, once. A double free of the + thrice-held vec is what this is really asking about: it would crash here, + or under @sanitize, or leave the byte count below zero. */ + holder = flan_dyn_nil(); + was = flan_dyn_nil(); + for (i = 0; i < 5000; i++) (void)text("noise"); + flan_gc_collect(); + printf("live bytes after dropping everything: %s\n", + flan_gc_live_bytes() >= 0 && flan_gc_count() <= 64 ? "ok" : "wrong"); + flan_dyn_root_pop(2); +} + +/* An unrooted object is collected. The positive control for every assertion + * above: without this, a collector that never freed anything would pass the + * lot. The text is allocated, its object count noted, and then enough + * allocation happens to push it out of the temporaries ring — after which a + * collection must reclaim it. */ +static void unrooted(void) { + int64_t before, after; + int i; + flan_gc_init(); + flan_gc_set_floor(1 << 20); /* high, so only the explicit collect sweeps */ + flan_gc_collect(); + before = flan_gc_count(); + for (i = 0; i < 500; i++) (void)text("garbage"); + printf("allocated: %s\n", flan_gc_count() >= before + 500 ? "yes" : "no"); + flan_gc_collect(); + after = flan_gc_count(); + /* The ring holds the last 64, by design, so the survivors are bounded by it + and not by zero. */ + printf("reclaimed all but the ring: %s\n", + after <= before + 64 ? "yes" : "no"); +} + +/* ── The refusals ────────────────────────────────────────────────────── + * + * One per mode, because each ends the process. The driver asserts on the + * sentence as well as on the exit status: a process that died some other way + * is not this guard firing, and the status alone cannot tell them apart. */ + +static void refuse(const char *what) { + flan_dyn v = flan_dyn_vec_new(); + flan_dyn t = text("hi"); + if (strcmp(what, "add") == 0) (void)flan_dyn_add(flan_dyn_from_i64(3), t); + else if (strcmp(what, "sub") == 0) + (void)flan_dyn_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); + else if (strcmp(what, "mul") == 0) + (void)flan_dyn_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); + else if (strcmp(what, "div") == 0) + (void)flan_dyn_div(v, flan_dyn_from_i64(2)); + else if (strcmp(what, "rem") == 0) + (void)flan_dyn_rem(flan_dyn_from_i64(2), flan_dyn_nil()); + else if (strcmp(what, "divzero") == 0) + (void)flan_dyn_div(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); + else if (strcmp(what, "remzero") == 0) + (void)flan_dyn_rem(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); + else if (strcmp(what, "divover") == 0) + (void)flan_dyn_div(flan_dyn_from_i64(INT64_MIN), flan_dyn_from_i64(-1)); + else if (strcmp(what, "lt") == 0) + (void)flan_dyn_lt(flan_dyn_from_i64(1), t); + else if (strcmp(what, "le") == 0) (void)flan_dyn_le(t, flan_dyn_nil()); + else if (strcmp(what, "gt") == 0) (void)flan_dyn_gt(v, v); + else if (strcmp(what, "ge") == 0) + (void)flan_dyn_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1)); + else if (strcmp(what, "len") == 0) (void)flan_dyn_len(flan_dyn_from_i64(1)); + else if (strcmp(what, "at") == 0) + (void)flan_dyn_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0)); + else if (strcmp(what, "atindex") == 0) (void)flan_dyn_at(t, t); + else if (strcmp(what, "atrange") == 0) + (void)flan_dyn_at(t, flan_dyn_from_i64(9)); + else if (strcmp(what, "atnegative") == 0) + (void)flan_dyn_at(t, flan_dyn_from_i64(-1)); + else if (strcmp(what, "setattext") == 0) + flan_dyn_set_at(t, flan_dyn_from_i64(0), flan_dyn_from_i64(65)); + else if (strcmp(what, "setatnotvec") == 0) + flan_dyn_set_at(flan_dyn_from_i64(1), flan_dyn_from_i64(0), t); + else if (strcmp(what, "setatrange") == 0) + flan_dyn_set_at(v, flan_dyn_from_i64(0), t); + else if (strcmp(what, "push") == 0) flan_dyn_push(t, flan_dyn_from_i64(1)); + else if (strcmp(what, "needi64") == 0) (void)flan_dyn_need_i64(t); + else if (strcmp(what, "needf64") == 0) + (void)flan_dyn_need_f64(flan_dyn_from_i64(1)); + else if (strcmp(what, "needbool") == 0) + (void)flan_dyn_need_bool(flan_dyn_nil()); + else { + printf("no such refusal: %s\n", what); + exit(2); + } + /* Reached only if the operation returned, which is the failure this mode is + testing for. */ + printf("did not trap\n"); + exit(3); +} + +int main(int argc, char **argv) { + flan_rt_init(argc, argv); + if (argc < 2) { + printf("usage: dyn_ops \n"); + return 2; + } + if (strcmp(argv[1], "ops") == 0) { + ops(); + printf(failures == 0 ? "ops ok\n" : "ops failed\n"); + return failures == 0 ? 0 : 1; + } + if (strcmp(argv[1], "gc") == 0) { gc(); return 0; } + if (strcmp(argv[1], "nested") == 0) { nested(); return 0; } + if (strcmp(argv[1], "sharing") == 0) { sharing(); return 0; } + if (strcmp(argv[1], "unrooted") == 0) { unrooted(); return 0; } + if (strncmp(argv[1], "refuse:", 7) == 0) { refuse(argv[1] + 7); return 0; } + printf("no such mode: %s\n", argv[1]); + return 2; +} diff --git a/test/programs/dyn-host.flan b/test/programs/dyn-host.flan new file mode 100644 index 0000000..1fb01ca --- /dev/null +++ b/test/programs/dyn-host.flan @@ -0,0 +1,13 @@ +;;;; The dyn runtime's host, and deliberately almost nothing. +;;;; +;;;; There is no [main]: the entry point is test/dyn_ops.c, for the reason +;;;; dev_limits.c and reload_host.c are C mains. flan_dyn.c's surface is a C +;;;; ABI with no Flan spelling yet — the compiler lane is what gives it one — +;;;; so the only way to drive every operation, and every way each one refuses, +;;;; is from C. +;;;; +;;;; The one declaration below is here so that the file is a program the +;;;; checker accepts and [Build.executable] has something to lower. It is never +;;;; called. Everything the test links against comes from the runtime objects +;;;; the build attaches to every program. +(defn unused [x i64] i64 x) diff --git a/test/test_dyn.ml b/test/test_dyn.ml new file mode 100644 index 0000000..d0f49e2 --- /dev/null +++ b/test/test_dyn.ml @@ -0,0 +1,165 @@ +(* The dynamic-value runtime, driven from C. + + runtime/flan_dyn.c is a C ABI with no Flan spelling yet — the compiler lane + is what gives it one — so the only way to reach every operation, and every + way each one refuses, is a C main. test/dyn_ops.c is that main and + programs/dyn-host.flan is the program it is linked against, which has no + [main] of its own for the same reason programs/reload.flan does not. + + What is asserted here, and why each is its own thing: + + ops every operation's happy path, the tags, the printed form of + each, text identity against text equality, and a vec that + contains itself + gc a million allocations against a hundred live, and the heap's + high-water mark bounded + unrooted the positive control: an object nothing points at is reclaimed. + Without it a collector that never freed would pass everything + nested a chain of vecs sixty-four deep, traced through one root + sharing one object held three times — written through one path and read + through another, and swept once when the last goes + refuse:* twenty-four refusals, one process each, asserted on the sentence + as well as on the status: a process that died some other way is + not the guard firing, and the exit code cannot tell them apart + + One binary, built once, run twenty-nine times. The build is the expensive + part and the runs are milliseconds, which is what keeps this inside + `dune test` rather than behind an alias. *) + +open Flan + +(* The watchdog first: a hang is the one failure mode that reports nothing at + all. See watchdog.ml. *) +let () = Watchdog.arm ~seconds:600 "test_dyn" + +let failures = ref 0 +let fail fmt = + Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt + +let scratch = Filename.get_temp_dir_name () +let tmp name = Filename.concat scratch ("flan-dyn-" ^ name) + +let has hay needle = + let n = String.length needle and h = String.length hay in + let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in + go 0 + +let () = + match Sys.command "command -v clang > /dev/null 2>&1" with + | 0 -> + let p = + Check.program + (Load.program ~file:"programs/dyn-host.flan" + (Reader.read_file "programs/dyn-host.flan")).Load.decls + in + let exe = tmp "ops" in + ignore (Build.executable ~csrcs:[ "dyn_ops.c" ] p ~out:exe); + + let run mode = + let o = tmp (mode ^ ".out") and e = tmp (mode ^ ".err") in + let code = + Sys.command + (Printf.sprintf "%s %s > %s 2> %s" (Filename.quote exe) + (Filename.quote mode) (Filename.quote o) (Filename.quote e)) + in + let out = In_channel.with_open_bin o In_channel.input_all in + let err = In_channel.with_open_bin e In_channel.input_all in + List.iter (fun x -> try Sys.remove x with Sys_error _ -> ()) [ o; e ]; + (code, out, err) + in + + (* The happy paths. Each assertion inside prints its own FAIL line, so the + output is the report and this only has to notice that there was one. *) + let code, out, err = run "ops" in + if code <> 0 || out <> "ops ok\n" then + fail "the operations\n got: %S (exit %d, err %S)" out code err; + + (* The collector. Four sentences, each a yes: the high-water mark stayed + under half a megabyte across forty megabytes of allocation, the heap + settled small, the object count stayed bounded, and the hundred rooted + values were all still what they were set to. *) + let code, out, err = run "gc" in + let want_gc = + "peak under 512K: yes\nsettled under 32K: yes\n\ + live objects bounded: yes\nlive set intact: yes\n" + in + if code <> 0 || out <> want_gc then + fail "a million allocations against a hundred live\n\ + \ got: %S (exit %d, err %S)\n wanted: %S" + out code err want_gc; + + (* And the control. A collector that never freed anything would pass every + other case in this file; this is the one it cannot. *) + let code, out, _ = run "unrooted" in + let want_un = "allocated: yes\nreclaimed all but the ring: yes\n" in + if code <> 0 || out <> want_un then + fail "an unrooted object\n got: %S (exit %d)\n wanted: %S" + out code want_un; + + let code, out, _ = run "nested" in + if code <> 0 || out <> "chain of 64 intact: yes\n" then + fail "a chain of nested vecs\n got: %S (exit %d)" out code; + + let code, out, _ = run "sharing" in + let want_sh = + "three slots hold one object: yes\n\ + write through one path is seen through another: yes\n\ + shared object survives on the holder alone: yes\n\ + still reachable: yes\n\ + live bytes after dropping everything: ok\n" + in + if code <> 0 || out <> want_sh then + fail "interior sharing\n got: %S (exit %d)\n wanted: %S" + out code want_sh; + + (* Every refusal. The pair is (mode, a phrase the sentence must contain); + the phrase is chosen to be the part that says *which* mistake it was, + so a message that named the wrong operation or the wrong tag would not + pass by accident. + + The tag names are asserted here too, as words: "int" and "text" and not + 2 and 4. A message with a number in it is a puzzle, and the rule is + written down in flan_dyn.c beside the table the words come from. *) + let refusals = + [ ("add", "dyn +: int and text"); + ("sub", "dyn -: nil and int"); + ("mul", "dyn *: bool and int"); + ("div", "dyn /: vec and int"); + ("rem", "dyn %: int and nil"); + ("divzero", "does not divide by zero"); + ("remzero", "does not divide by zero"); + ("divover", "one past the largest i64"); + ("lt", "dyn <: int and text"); + ("le", "dyn <=: text and nil"); + ("gt", "dyn >: vec and vec"); + ("ge", "dyn >=: bool and bool"); + ("len", "dyn len: int"); + ("at", "dyn at: int and int"); + ("atindex", "an index must be an int"); + ("atrange", "index 9 is out of bounds for text of length 2"); + ("atnegative", "index -1 is out of bounds"); + ("setattext", "a text is immutable"); + ("setatnotvec", "only a vec is assigned into"); + ("setatrange", "index 0 is out of bounds for vec of length 0"); + ("push", "only a vec is pushed to"); + ("needi64", "dyn i64: text"); + ("needf64", "dyn f64: int"); + ("needbool", "dyn bool: nil") ] + in + List.iter + (fun (mode, phrase) -> + let code, out, err = run ("refuse:" ^ mode) in + if code = 0 then + fail "%s returned rather than trapping: %S" mode out + else if not (has err phrase) then + fail "%s did not say %S; it said %S" mode phrase err) + refusals; + + (try Sys.remove exe with Sys_error _ -> ()); + (* A line on the way out, because a test that says nothing when it passes + is a test nobody can tell from a test that did not run. *) + if !failures = 0 then + Printf.printf " ok the dyn runtime: %d refusals and five runs\n" + (List.length refusals) + else exit 1 + | _ -> print_endline "SKIP test_dyn: no clang" diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index 8405f11..72811c4 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -194,6 +194,50 @@ let sweep ~checks label = (try Sys.remove san with Sys_error _ -> ()))) corpus +(* The dyn runtime, under the same two sanitizers. It is not in [corpus] and + cannot be: there is no Flan program that reaches flan_dyn.c yet, so the + thing to build is test/dyn_ops.c against programs/dyn-host.flan — the same + pair test_dyn.ml builds, with [sanitize] on. + + This is the case the sweep is most likely to have something to say about. + Every other program in the corpus allocates and never frees, which is a + policy ASan can only agree with; this one frees, and a mark-sweep collector + is precisely a machine for freeing something that is still reachable. A + use-after-free here is what a wrong marker looks like from the outside, and + it is invisible to the assertions in test_dyn.ml — the freed bytes are + usually still the bytes that were there. + + The leak question is not asked, for the reason [env] gives: leaks are off + across this file because the runtime's allocations are allocate-once by + design. It would be the wrong question here anyway — the temporaries ring + holds the last sixty-four objects alive on purpose and at exit, and every + one of them would be reported. + + Only the modes that return are run. The refusals end in [_exit(134)], which + skips ASan's exit-time checks entirely, so running them would prove nothing + the checked build has not already proved. *) +let dyn_sweep () = + let exe = Filename.concat scratch "flan-san-dyn" in + let path = "programs/dyn-host.flan" in + let l = Load.program ~file:path (Reader.read_file path) in + let p = Check.program l.Load.decls in + let p, csrcs, lflags = Reach.link ~dev:false l p in + match + Build.executable + ~opts:{ Build.default with Build.sanitize = true } + ~csrcs:(csrcs @ [ "dyn_ops.c" ]) ~lflags p ~out:exe + with + | exception Failure m -> fail "dyn: sanitized build: %s" m + | _ -> + List.iter + (fun mode -> + let code, text = run exe [ mode ] in + if reported text then fail "dyn %s: sanitizer report\n%s" mode text + else if code <> 0 then + fail "dyn %s: exit %d under the sanitizers\n%s" mode code text) + [ "ops"; "gc"; "unrooted"; "nested"; "sharing" ]; + (try Sys.remove exe with Sys_error _ -> ()) + (* The positive controls, which are the only evidence that a clean sweep means anything. Both are written here rather than kept in test/programs because neither is a program anybody should build: one reads off the end of an @@ -317,6 +361,7 @@ let () = \ (println \"\"))\n\ \ 0)\n"; sweep ~checks:true "checked"; + dyn_sweep (); unchecked_controls (); if !failures = 0 then print_endline "sanitizer sweep: clean" else Printf.printf "%d sanitizer failure(s)\n" !failures; From 090054bee1391a98f9ff84ed941f98499aaf2b7f Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 05:58:52 +0700 Subject: [PATCH 2/2] The collector is not dropped by the linker, and a literal is where dyn is sharper Two claims corrected against the thing they claimed about. A named object is linked whole -- symbol-driven selection is an archive rule, and dropping unreached code inside an included object needs -ffunction-sections and --gc-sections, which the link line does not pass. nm on any corpus program finds flan_dyn_add and flan_gc_collect in it. So the file said something the build does not do. What makes --no-gc possible is the other half of the same argument and was already written beside it: nothing refers to flan_dyn.c, so not compiling it is a change at three sites and nowhere else. And the boundary. "Typed Flan has no implicit widening" is true of a value and not of a literal: (g 1) against (defn g [x f64] ...) compiles, because the checker gives the literal the type the parameter asks for, while (defn h [y i64] f64 (g y)) is refused. A dyn value written as 1 has been through flan_dyn_from_i64 and cannot remember, so the same source read as dyn traps where read as typed it does not. Stated where the compiler lane will find it, with the two ways to close it, both of them the compiler's. --- docs/SPIKE-DYNAMIC.md | 61 ++++++++++++++++++++++++++++++++----------- lib/build.ml | 21 +++++++++------ runtime/flan_dyn.c | 36 ++++++++++++++++--------- 3 files changed, 83 insertions(+), 35 deletions(-) diff --git a/docs/SPIKE-DYNAMIC.md b/docs/SPIKE-DYNAMIC.md index 52d4eef..f00d960 100644 --- a/docs/SPIKE-DYNAMIC.md +++ b/docs/SPIKE-DYNAMIC.md @@ -353,13 +353,39 @@ That is the asymmetry worth defending, because the operators *do* promote (§5). questions. An operator has no stated expectation to violate — `(+ 1 2.5)` was written by somebody who wanted a number and there is one obvious number. An annotation *is* a stated expectation, written down by a person, and quietly turning their `i64` into an `f64` would make the boundary the one place in the -language where a type changed without anybody writing it. Typed Flan has no implicit widening; the -boundary into typed Flan should not invent some. +language where a *value* changed type without anybody writing it. Typed Flan does not widen a value: -The consequence for the compiler lane: a call from dyn code into `(defn f [x f64] ...)` with an integer -argument traps at run time rather than converting. If that turns out to be too sharp in practice, the -place to soften it is the *compiler*, by emitting a conversion where the checker can see both sides — not -here, where the only thing visible is a tag. +```lisp +(defn g [x f64] f64 x) +(defn h [y i64] f64 (g y)) ; scratch.flan:2:24: expected f64, found i64 +``` + +### The one divergence the compiler lane has to know about + +Typed Flan does not widen a *value*, but a **literal adopts its expected type**. `(g 1)` compiles and +prints `1`, because the checker gives the literal `1` the `f64` the parameter asks for; `(vec-new i64)` +followed by `(push v 1)` works the same way. + +A dyn value has no such history. Once `1` has been through `flan_dyn_from_i64` it is tagged `int`, and +nothing downstream can recover that it was written as a literal in a position that wanted a float. So: + +```lisp +(g 1) ; typed: compiles, prints 1 +(g some-dyn) ; dyn, where some-dyn came from the literal 1: traps, "a float was wanted" +``` + +That is a real divergence between the same source read as typed and read as dyn, and it is stated here +rather than discovered later. Two ways out, both the compiler's and neither this file's: + +1. **Tag the literal at the constructor.** Where the checker can see that an unannotated literal flows to + a float context, emit `flan_dyn_from_f64` instead of `flan_dyn_from_i64`. This is the same inference + the checker already performs for typed literals and it keeps the boundary sharp. +2. **Emit a conversion at the call**, where both sides are visible, rather than softening + `flan_dyn_need_f64` — which sees only a tag and could not tell a literal-derived int from a computed + one. + +Softening the boundary itself is the option not to take: it would accept `(g (len xs))` as readily as +`(g 1)`, and those are not the same mistake. --- @@ -406,16 +432,21 @@ is a property of the build and not a wish: back-reference — `flan_rt_init` calling `flan_gc_init`, say, which was the obvious thing to write — would make the collector unconditional and the refusal a lie, so the heap initialises itself lazily on first allocation instead. -- Consequently a program that calls no dyn operation pulls nothing out of that object, and the linker - leaves it behind. +**The linker does not drop it today, and this document will not claim it does.** `flan_dyn.o` is a named +object on the link line, not an archive member, and `ld` includes a named object in full — symbol-driven +selection is a `.a` rule. Dead-code elimination *inside* an included object needs +`-ffunction-sections -fdata-sections -Wl,--gc-sections`, which the link line does not pass. Measured +rather than assumed: build any corpus program and `nm` it, and `flan_dyn_add` and `flan_gc_collect` are +both there as defined symbols. -The link line does **not** currently pass `-ffunction-sections`/`-Wl,--gc-sections`, and this document -will not claim a drop the build cannot perform. What the above buys is the cheaper mechanism: the object -is selected at the *file* level, so `--no-gc` is a one-line change at each of the three sites — the same -per-target selection `select_csrcs` already performs for a package's C — rather than an argument with the -linker about which sections are live. `flan_dev.c` is compiled into every build today for a reason its -comment gives at length (a package's C refers to it and package sources are collected whatever `main` -does); `flan_dyn.c` has no such entanglement and can genuinely be left out. +What the one-way dependency buys is the better mechanism anyway. The object is selected at the **file** +level: `--no-gc` is a one-line change at each of the three sites that name `Runtime_src.dyn_source` — the +same per-target selection `select_csrcs` already performs for a package's C — and once it is not +compiled, nothing has to be dropped. That only works because nothing else in the runtime refers to it; +`flan_dev.c` is compiled into every build today precisely because it *is* referred to (a package's C +names it, and package sources are collected whatever `main` does), and its own comment says so at length. +`flan_dyn.c` has no such entanglement, and keeping it that way is the constraint this section exists to +record. The residual-dynamism refusal itself — deciding that a program is *not* fully annotated and saying which form is not — is the compiler's, and is not attempted here. diff --git a/lib/build.ml b/lib/build.ml index 738b7e8..11b9593 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -864,14 +864,19 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) let objs = cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c" :: [ cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c"; - (* The dynamic-value runtime. Compiled into every build for the - reason flan_dev.c is, and dropped by the same means: it is its own - translation unit and nothing in the other two names a symbol in - it, so a program with no dyn operation in it pulls nothing out of - this object and the linker leaves it behind. Selecting it away at - the file level — which is what `--no-gc` will do once the compiler - lane can prove a program is fully annotated — is then a one-line - change here rather than an argument with the linker. *) + (* The dynamic-value runtime. Compiled into every build today, as + flan_dev.c is, but for a weaker reason: nothing refers to it. It is + its own translation unit and no line of flan_rt.c or flan_dev.c + names a symbol in it, so leaving it out is a change *here* and + nowhere else — which is what `--no-gc` will be, once the compiler + lane can prove a program is fully annotated. + + The linker is not the mechanism and would not be: a named object is + linked whole, and dropping unreached code inside one needs + -ffunction-sections and --gc-sections, which this line does not + pass. So the selection is at the file level, the same shape + [select_csrcs] applies to a package's C. See docs/SPIKE-DYNAMIC.md, + "Dropping the collector". *) cc ~warn:runtime_warnings Runtime_src.dyn_source "flan_dyn.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, diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index debba8c..a3001a9 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -15,12 +15,13 @@ * * flan_rt.c, and nothing else in the tree. The dependency does not run the * other way: no line of flan_rt.c or flan_dev.c names anything defined here. - * That is the whole of what makes a `--no-gc` build possible — a program that - * calls no dyn operation references no symbol in this translation unit, so the - * object contributes nothing but its own size, and the compiler lane is free - * to refuse to link it at all. A single back-reference from the release - * runtime would make the collector unconditional and the refusal a lie. See - * the doc's "Dropping the collector". + * That is the whole of what makes a `--no-gc` build possible — not because the + * linker drops this object (it does not; a named object is linked whole, and + * `nm` on any corpus program finds flan_dyn_add in it), but because nothing + * else needs it, so *not compiling it* is a change at the three sites that + * name it and nowhere else. A single back-reference from the release runtime + * would make the collector unconditional and the refusal a lie. See the doc's + * "Dropping the collector". * * ── Threads ─────────────────────────────────────────────────────────── * @@ -780,12 +781,23 @@ int64_t flan_dyn_need_i64(flan_dyn v) { * an omission: typed Flan has no implicit widening anywhere — [(print-i64 x)] * used to force an explicit [(i64 x)] at every site — and a boundary that * quietly turned an int into a float would be the one place in the language - * where a type changed without anybody writing it down. The dyn *operators* - * promote, because arithmetic between a 2 and a 2.5 has an obvious answer and - * refusing it makes dynamic code worse; the boundary into a typed f64 - * parameter does not, because there the annotation is somebody's stated - * expectation and a mismatch is worth hearing about. That asymmetry is - * deliberate and is argued at length in the doc. */ + * where a *value* changed type without anybody writing it down. The dyn + * *operators* promote, because arithmetic between a 2 and a 2.5 has an obvious + * answer and refusing it makes dynamic code worse; the boundary into a typed + * f64 parameter does not, because there the annotation is somebody's stated + * expectation and a mismatch is worth hearing about. + * + * Where this is sharper than the typed language is a *literal*. `(g 1)` + * against `(defn g [x f64] ...)` compiles, because the checker gives the + * literal the type the parameter asks for; a dyn value written as `1` has + * already been through flan_dyn_from_i64 and cannot remember that it was a + * literal. So the same source read as dyn traps where read as typed it does + * not. That is a real divergence, it is the compiler's to close — by tagging + * such a literal as a float where it can see the context — and it is written + * down in the doc's boundary section so that closing it is a decision somebody + * makes rather than a surprise somebody meets. Softening the check here is the + * option not to take: this function sees a tag and nothing else, so it could + * not tell (g 1) from (g (len xs)). */ double flan_dyn_need_f64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) trap1(TYPE_TRAP, "f64", "a float was wanted", v);