A value carries its own type, and the heap under it collects
Milestone 1 of dynamic-by-default, the runtime half: NaN-boxed values in one machine word, a mark-sweep heap, and the operations over them. A double is itself, which is what a language with a physics loop and a float calculator in its corpus wants; everything else hides in the quiet-NaN space, three tag bits and a 48-bit payload that is exactly an x86-64 user pointer. The negative-NaN collision is answered by canonicalising every NaN on the way in, which flan_rt.c had already decided was the right thing to print. An i64 past the payload goes on the heap rather than becoming a 48-bit integer with a 64-bit name. The collector is mark-sweep and nothing else -- no generation, no barrier, no free list -- because the answer to wanting it faster is to type the program. Roots are pushed, not scanned: NaN-boxing makes a conservative guess wrong in both directions, and flan_dev.c's frame chain is the precedent. A fixed ring of the last sixty-four allocations is marked unconditionally, which closes the window where an expression with two constructors in it can collect its own first result before the compiler has rooted either. A type mismatch traps rather than aborting, through a flan_trap exported from flan_rt.c so it takes the same path the six existing traps take: parked for inspection in a dev session, dead where it stands otherwise. The sentence names the operation, both tags as words, and both values. flan_dyn.c is its own translation unit and nothing in the release runtime names a symbol in it, so a program with no dyn operation links no collector and --no-gc can be file-level selection rather than an argument with the linker. docs/SPIKE-DYNAMIC.md carries the argument. test/dyn_ops.c drives every operation and all twenty-four refusals from C, the way dev_limits.c does, including a million allocations against a hundred live and the control that says an unrooted object really is reclaimed.
This commit is contained in:
parent
4a8a78caac
commit
7d4bec521e
539
docs/SPIKE-DYNAMIC.md
Normal file
539
docs/SPIKE-DYNAMIC.md
Normal file
@ -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 `<vec>` 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.
|
||||
34
lib/build.ml
34
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 ->
|
||||
|
||||
@ -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 ->
|
||||
|
||||
21
lib/dune
21
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")))))
|
||||
|
||||
1065
runtime/flan_dyn.c
Normal file
1065
runtime/flan_dyn.c
Normal file
File diff suppressed because it is too large
Load Diff
177
runtime/flan_dyn.h
Normal file
177
runtime/flan_dyn.h
Normal file
@ -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 <stdint.h>
|
||||
|
||||
#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 */
|
||||
@ -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) {
|
||||
|
||||
17
test/dune
17
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
|
||||
|
||||
631
test/dyn_ops.c
Normal file
631
test/dyn_ops.c
Normal file
@ -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 <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
|
||||
/* 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 <mode>\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;
|
||||
}
|
||||
13
test/programs/dyn-host.flan
Normal file
13
test/programs/dyn-host.flan
Normal file
@ -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)
|
||||
165
test/test_dyn.ml
Normal file
165
test/test_dyn.ml
Normal file
@ -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"
|
||||
@ -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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user