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;