Joseph Ferano
7d4bec521e
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.
632 lines
27 KiB
C
632 lines
27 KiB
C
/* 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;
|
|
}
|