/* dyn_ops.c — runtime/flan_dyn.c, driven directly. * * A C main, for the reason dev_limits.c and reload_host.c are C mains: the * dynamic-value runtime's surface is a C ABI and has no Flan spelling yet, so * there is no program that could reach it. The .flan this links against * therefore has no [main] of its own; see programs/dyn-host.flan. * * This file includes runtime/flan_dyn.h and calls every function the header * declares. That is not tidiness — the build compiles flan_dyn.c on its own * with no include path, so the implementation declares its own prototypes and * the header is a second copy of them. Including it *here* is what makes a * divergence between the two a compile or link error in `dune test` rather * than a surprise in the compiler lane's emitted code. * * One mode per run, chosen by argv, because most of the modes end in a trap * and a trap ends the process. The happy paths share one run; each refusal * gets its own. */ #include #include #include #include #include /* Resolved because [Build] drops runtime/flan_dyn.h into the directory it * compiles each translation unit in, beside the .c it writes there. That is * the only include path a package's C — or this — ever gets, and it is there * so that C which computes with dyn values has one declaration to agree with * rather than a hand-copied list. */ #include "flan_dyn.h" void flan_rt_init(int32_t argc, char **argv); static int failures; static void fail(const char *what) { printf("FAIL %s\n", what); failures++; } static void check(int ok, const char *what) { if (!ok) fail(what); } /* A value's printed form, captured, so the print assertions can be exact * strings rather than eyeballed. stdout is redirected into a pipe for the * length of one call — cheaper and more honest than a second renderer that * would have to be kept in step with the one under test. */ static char shown[4096]; static void show(flan_dyn v) { int saved = dup(1); int fds[2]; ssize_t n; shown[0] = '\0'; if (pipe(fds) != 0) { fail("pipe"); return; } fflush(stdout); dup2(fds[1], 1); close(fds[1]); flan_dyn_print(v); fflush(stdout); dup2(saved, 1); close(saved); n = read(fds[0], shown, sizeof shown - 1); close(fds[0]); shown[n > 0 ? (size_t)n : 0] = '\0'; } static void prints(flan_dyn v, const char *want) { show(v); if (strcmp(shown, want) != 0) { printf("FAIL print: got %s, wanted %s\n", shown, want); failures++; } } static int truth(flan_dyn v) { return flan_dyn_need_bool(v) != 0; } static int64_t num(flan_dyn v) { return flan_dyn_need_i64(v); } static flan_dyn text(const char *s) { return flan_dyn_from_bytes((const uint8_t *)s, (int64_t)strlen(s)); } /* ── The happy paths ───────────────────────────────────────────────────*/ static void ops(void) { /* Six slots and one push of six, which is the shape the compiler lane emits: a frame's dyn locals are rooted as a block on entry and popped as a block on the way out. Every one is nil before it is pushed, which is the contract the header states — the collector reads these addresses on every mark, and an unwritten slot is a word of stack garbage. */ flan_dyn a = flan_dyn_nil(), b = flan_dyn_nil(), c = flan_dyn_nil(); flan_dyn v = flan_dyn_nil(), w = flan_dyn_nil(), s = flan_dyn_nil(); flan_dyn_root_push(&a); flan_dyn_root_push(&b); flan_dyn_root_push(&c); flan_dyn_root_push(&v); flan_dyn_root_push(&w); flan_dyn_root_push(&s); /* Tags, and the words they are called by. The words are what a trap message says, so they are asserted here rather than only read. */ check(flan_dyn_tag(flan_dyn_nil()) == FLAN_DYN_TAG_NIL, "tag nil"); check(flan_dyn_tag(flan_dyn_from_bool(1)) == FLAN_DYN_TAG_BOOL, "tag bool"); check(flan_dyn_tag(flan_dyn_from_i64(7)) == FLAN_DYN_TAG_INT, "tag int"); check(flan_dyn_tag(flan_dyn_from_f64(1.5)) == FLAN_DYN_TAG_FLOAT, "tag float"); check(flan_dyn_tag(text("x")) == FLAN_DYN_TAG_TEXT, "tag text"); check(flan_dyn_tag(flan_dyn_vec_new()) == FLAN_DYN_TAG_VEC, "tag vec"); check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_NIL), "nil") == 0, "word nil"); check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_BOOL), "bool") == 0, "word bool"); check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_INT), "int") == 0, "word int"); check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_FLOAT), "float") == 0, "word float"); check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_TEXT), "text") == 0, "word text"); check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_VEC), "vec") == 0, "word vec"); /* Every double is itself, at both ends of the range and at the values a NaN-box could get wrong. -0.0 is the one that would be lost by a scheme that normalised more than NaN. */ check(flan_dyn_need_f64(flan_dyn_from_f64(0.0)) == 0.0, "f64 zero"); check(flan_dyn_need_f64(flan_dyn_from_f64(-1.25)) == -1.25, "f64 neg"); check(flan_dyn_need_f64(flan_dyn_from_f64(1e308)) == 1e308, "f64 huge"); { double z = flan_dyn_need_f64(flan_dyn_from_f64(-0.0)); check(z == 0.0 && 1.0 / z < 0, "f64 negative zero keeps its sign"); } { /* A NaN survives as a NaN, which is all a NaN promises. Its *sign* does not, on purpose: flan_rt.c already refuses to print it and the box needs the bit. */ double n = flan_dyn_need_f64(flan_dyn_from_f64(0.0 / 0.0)); check(n != n, "f64 nan is still nan"); } /* Integers, including the two that do not fit the payload and go to the heap. The round trip is what says a boxed int is the same int. */ check(num(flan_dyn_from_i64(0)) == 0, "i64 zero"); check(num(flan_dyn_from_i64(-1)) == -1, "i64 minus one"); check(num(flan_dyn_from_i64(140737488355327LL)) == 140737488355327LL, "i64 largest inline"); check(num(flan_dyn_from_i64(-140737488355328LL)) == -140737488355328LL, "i64 smallest inline"); check(num(flan_dyn_from_i64(140737488355328LL)) == 140737488355328LL, "i64 first boxed"); check(num(flan_dyn_from_i64(INT64_MAX)) == INT64_MAX, "i64 max"); check(num(flan_dyn_from_i64(INT64_MIN)) == INT64_MIN, "i64 min"); check(flan_dyn_tag(flan_dyn_from_i64(INT64_MAX)) == FLAN_DYN_TAG_INT, "a boxed int is still an int"); /* Arithmetic. Two ints answer an int; a float anywhere answers a float. */ check(num(flan_dyn_add(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 5, "+"); check(num(flan_dyn_sub(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == -1, "-"); check(num(flan_dyn_mul(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 6, "*"); check(num(flan_dyn_div(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 3, "/"); check(num(flan_dyn_rem(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 1, "%"); check(num(flan_dyn_rem(flan_dyn_from_i64(-7), flan_dyn_from_i64(2))) == -1, "% keeps the sign of the dividend"); check(flan_dyn_need_f64( flan_dyn_add(flan_dyn_from_i64(1), flan_dyn_from_f64(0.5))) == 1.5, "int and float promote"); check(flan_dyn_need_f64( flan_dyn_div(flan_dyn_from_f64(1.0), flan_dyn_from_f64(4.0))) == 0.25, "float /"); check(flan_dyn_need_f64( flan_dyn_rem(flan_dyn_from_f64(7.5), flan_dyn_from_f64(2.0))) == 1.5, "float %"); /* The boxed end of the range arithmetically, not only as a round trip. */ check(num(flan_dyn_add(flan_dyn_from_i64(140737488355327LL), flan_dyn_from_i64(1))) == 140737488355328LL, "+ crosses into the box"); /* Ordering. Numbers against numbers across the two tags, text bytewise, and a NaN that is none of less, equal or greater. */ check(truth(flan_dyn_lt(flan_dyn_from_i64(1), flan_dyn_from_i64(2))), "<"); check(!truth(flan_dyn_lt(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "< eq"); check(truth(flan_dyn_le(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "<="); check(truth(flan_dyn_gt(flan_dyn_from_f64(2.5), flan_dyn_from_i64(2))), ">"); check(truth(flan_dyn_ge(flan_dyn_from_i64(2), flan_dyn_from_f64(2.0))), ">="); check(truth(flan_dyn_lt(text("abc"), text("abd"))), "< text"); check(truth(flan_dyn_lt(text("ab"), text("abc"))), "< text prefix"); check(!truth(flan_dyn_lt(text("abc"), text("abc"))), "< text equal"); { flan_dyn n = flan_dyn_from_f64(0.0 / 0.0), one = flan_dyn_from_i64(1); check(!truth(flan_dyn_lt(n, one)) && !truth(flan_dyn_gt(n, one)) && !truth(flan_dyn_le(n, one)) && !truth(flan_dyn_ge(n, one)), "nan is unordered in all four directions"); } /* Equality. Structural, never a trap, and numeric across the tags. */ check(truth(flan_dyn_eq(flan_dyn_nil(), flan_dyn_nil())), "= nil"); check(truth(flan_dyn_eq(flan_dyn_from_bool(1), flan_dyn_from_bool(1))), "= bool"); check(!truth(flan_dyn_eq(flan_dyn_from_bool(1), flan_dyn_from_bool(0))), "= bool no"); check(truth(flan_dyn_eq(flan_dyn_from_i64(1), flan_dyn_from_f64(1.0))), "= across int and float"); check(truth(flan_dyn_eq(flan_dyn_from_i64(INT64_MAX), flan_dyn_from_i64(INT64_MAX))), "= two boxed ints"); check(!truth(flan_dyn_eq(flan_dyn_from_i64(1), text("1"))), "= on unrelated tags answers false rather than trapping"); check(!truth(flan_dyn_eq(flan_dyn_nil(), flan_dyn_from_bool(0))), "nil is not false"); { flan_dyn n = flan_dyn_from_f64(0.0 / 0.0); check(!truth(flan_dyn_eq(n, n)), "nan is not equal to itself"); } /* Text: identity is not equality, and equality is the bytes. [a] and [b] are separately built from separate storage and must be equal; they must also be *different objects*, because from_bytes copies and does not intern, and a test that did not say so would pass against an implementation that silently shared. */ a = text("hello"); b = text("hello"); c = text("hellp"); check(a != b, "two texts with the same bytes are two objects"); check(truth(flan_dyn_eq(a, b)), "= text is bytewise"); check(!truth(flan_dyn_eq(a, c)), "= text sees the last byte"); check(truth(flan_dyn_eq(a, a)), "= text against itself"); check(num(flan_dyn_len(a)) == 5, "len text"); check(num(flan_dyn_at(a, flan_dyn_from_i64(0))) == 'h', "at text"); check(num(flan_dyn_at(a, flan_dyn_from_i64(4))) == 'o', "at text last"); { /* Embedded NUL, because a length-prefixed text is the claim and strlen is how that claim gets quietly broken. */ flan_dyn z = flan_dyn_from_bytes((const uint8_t *)"a\0b", 3); check(num(flan_dyn_len(z)) == 3, "len counts past a NUL"); check(num(flan_dyn_at(z, flan_dyn_from_i64(2))) == 'b', "at past a NUL"); check(!truth(flan_dyn_eq(z, text("a"))), "= does not stop at a NUL"); } { flan_dyn e = flan_dyn_from_bytes((const uint8_t *)"", 0); check(num(flan_dyn_len(e)) == 0, "len of the empty text"); check(truth(flan_dyn_eq(e, flan_dyn_from_bytes(NULL, 0))), "= two empty texts"); } /* Vecs. */ v = flan_dyn_vec_new(); check(num(flan_dyn_len(v)) == 0, "len of a new vec"); flan_dyn_push(v, flan_dyn_from_i64(1)); flan_dyn_push(v, flan_dyn_from_i64(2)); flan_dyn_push(v, flan_dyn_from_i64(3)); check(num(flan_dyn_len(v)) == 3, "len after three pushes"); check(num(flan_dyn_at(v, flan_dyn_from_i64(1))) == 2, "at vec"); flan_dyn_set_at(v, flan_dyn_from_i64(1), text("two")); check(truth(flan_dyn_eq(flan_dyn_at(v, flan_dyn_from_i64(1)), text("two"))), "set-at vec"); { /* Past the initial capacity, so the growth path runs and the elements survive the realloc. */ int i; flan_dyn big = flan_dyn_vec_new(); flan_dyn_root_push(&big); for (i = 0; i < 100; i++) flan_dyn_push(big, flan_dyn_from_i64(i)); check(num(flan_dyn_len(big)) == 100, "len after a hundred pushes"); check(num(flan_dyn_at(big, flan_dyn_from_i64(0))) == 0, "first survived"); check(num(flan_dyn_at(big, flan_dyn_from_i64(99))) == 99, "last survived"); flan_dyn_root_pop(1); } /* Vecs compare structurally, element by element and one level down. */ { flan_dyn p = flan_dyn_vec_new(), q = flan_dyn_vec_new(); flan_dyn_root_push(&p); flan_dyn_root_push(&q); flan_dyn_push(p, flan_dyn_from_i64(1)); flan_dyn_push(p, text("x")); flan_dyn_push(q, flan_dyn_from_i64(1)); flan_dyn_push(q, text("x")); check(p != q, "two vecs are two objects"); check(truth(flan_dyn_eq(p, q)), "= vec is element by element"); flan_dyn_push(q, flan_dyn_nil()); check(!truth(flan_dyn_eq(p, q)), "= vec sees the length"); flan_dyn_root_pop(2); } /* A vec that contains itself. [=] must answer rather than recurse for ever — the identity shortcut is what makes it answer — and [print] must stop at its depth cap. */ { flan_dyn cyc = flan_dyn_vec_new(); flan_dyn_root_push(&cyc); flan_dyn_push(cyc, flan_dyn_from_i64(1)); flan_dyn_push(cyc, cyc); check(truth(flan_dyn_eq(cyc, cyc)), "= on a cycle answers"); show(cyc); check(strlen(shown) > 0 && strstr(shown, "...") != NULL, "print stops at its depth cap on a cycle"); flan_dyn_root_pop(1); } /* Printing, per tag, against what a Flan program prints for the corresponding type. Captured from a run of `flan run`, not read off lib/render.ml — the leading space before each element is what the slice printer emits and what an acceptance test would compare against. */ prints(flan_dyn_nil(), "nil"); prints(flan_dyn_from_bool(1), "true"); prints(flan_dyn_from_bool(0), "false"); prints(flan_dyn_from_i64(42), "42"); prints(flan_dyn_from_i64(INT64_MIN), "-9223372036854775808"); prints(flan_dyn_from_f64(3.5), "3.5"); prints(flan_dyn_from_f64(1.0), "1"); prints(flan_dyn_from_f64(0.0 / 0.0), "nan"); prints(flan_dyn_from_f64(-(0.0 / 0.0)), "nan"); prints(text("hi"), "hi"); { flan_dyn nums = flan_dyn_vec_new(); flan_dyn strs = flan_dyn_vec_new(); flan_dyn_root_push(&nums); flan_dyn_root_push(&strs); flan_dyn_push(nums, flan_dyn_from_i64(1)); flan_dyn_push(nums, flan_dyn_from_i64(2)); flan_dyn_push(nums, flan_dyn_from_i64(3)); prints(nums, "[ 1 2 3]"); /* A text inside a structure is quoted and escaped, and bare at the top level. That is flan_rt.c's rule and the two have to agree, because the REPL parses the printed form back. */ flan_dyn_push(strs, text("x")); flan_dyn_push(strs, text("a b")); flan_dyn_push(strs, text("q\"\n")); prints(strs, "[ \"x\" \"a b\" \"q\\\"\\n\"]"); /* And a vec of vecs, nested twice. */ { flan_dyn outer = flan_dyn_vec_new(); flan_dyn_root_push(&outer); flan_dyn_push(outer, nums); flan_dyn_push(outer, strs); prints(outer, "[ [ 1 2 3] [ \"x\" \"a b\" \"q\\\"\\n\"]]"); flan_dyn_root_pop(1); } prints(flan_dyn_vec_new(), "[]"); flan_dyn_root_pop(2); } /* The typed boundary, on the tags it accepts. What it refuses is three separate modes below — each one ends the process. */ check(flan_dyn_need_i64(flan_dyn_from_i64(-5)) == -5, "need-i64"); check(flan_dyn_need_f64(flan_dyn_from_f64(2.5)) == 2.5, "need-f64"); check(flan_dyn_need_bool(flan_dyn_from_bool(1)) == 1, "need-bool true"); check(flan_dyn_need_bool(flan_dyn_from_bool(0)) == 0, "need-bool false"); s = text("kept"); w = v; flan_dyn_root_pop(6); (void)w; (void)s; } /* ── The collector ─────────────────────────────────────────────────────*/ /* Allocate a great many, hold a few, and assert the heap does not grow. The * live set is a hundred texts in a rooted vec, rewritten round and round; the * million texts that fall out of it have nothing pointing at them from the * moment the next iteration overwrites their slot. * * The assertion is on the *bound* and not on any particular number: a * collector's exact high-water mark is a fact about its trigger, and pinning * it would make a tuning change a test failure. What must hold is that the * figure stops climbing — that is the whole claim — so the test takes the * heap's high-water mark over the run and requires it to be within a small * multiple of what the live set actually needs. * * The floor is dropped to 64K first. A megabyte of floor would make this a * megabyte of arithmetic before the first collection and prove nothing faster. */ static void gc(void) { enum { LIVE = 100, ROUNDS = 1000000 }; flan_dyn keep = flan_dyn_nil(); int64_t peak = 0, settled, i; int collections_happened; flan_gc_init(); flan_gc_set_floor(64 * 1024); flan_dyn_root_push(&keep); keep = flan_dyn_vec_new(); for (i = 0; i < LIVE; i++) flan_dyn_push(keep, flan_dyn_nil()); for (i = 0; i < ROUNDS; i++) { char buf[32]; int n = snprintf(buf, sizeof buf, "item-%lld", (long long)i); flan_dyn_set_at(keep, flan_dyn_from_i64(i % LIVE), flan_dyn_from_bytes((const uint8_t *)buf, n)); if (flan_gc_live_bytes() > peak) peak = flan_gc_live_bytes(); } flan_gc_collect(); settled = flan_gc_live_bytes(); collections_happened = flan_gc_count() < LIVE + 64 + 8; /* A million texts of forty-odd bytes is some forty megabytes allocated. A heap that never collected would hold all of it, so any bound under a megabyte is a bound only a working collector can meet, and 512K is comfortably above twice the live set plus the floor plus the ring. */ printf("peak under 512K: %s\n", peak < 512 * 1024 ? "yes" : "no"); printf("settled under 32K: %s\n", settled < 32 * 1024 ? "yes" : "no"); printf("live objects bounded: %s\n", collections_happened ? "yes" : "no"); /* And the live set is intact: collecting a million times must not have lost the hundred things that were rooted throughout. */ { int intact = 1; for (i = 0; i < LIVE; i++) { char buf[32]; int64_t k = ROUNDS - LIVE + i; int n = snprintf(buf, sizeof buf, "item-%lld", (long long)k); flan_dyn got = flan_dyn_at(keep, flan_dyn_from_i64(k % LIVE)); if (!flan_dyn_need_bool( flan_dyn_eq(got, flan_dyn_from_bytes((const uint8_t *)buf, n)))) intact = 0; } printf("live set intact: %s\n", intact ? "yes" : "no"); } flan_dyn_root_pop(1); } /* Nested vecs, traced. A chain sixty-four deep reached through one root: every * link has to survive a collection, which is what says the marker follows a * vec's elements and not only its header. Sixty-four is also past the point * where a recursive marker on a modest stack would be fine and a deeper one * would not — the marker here is iterative, and this is the case that would * notice if it stopped being. */ static void nested(void) { enum { DEEP = 64 }; flan_dyn root = flan_dyn_nil(), cur; int64_t i; int ok = 1; flan_gc_init(); flan_gc_set_floor(16 * 1024); flan_dyn_root_push(&root); root = flan_dyn_vec_new(); cur = root; for (i = 0; i < DEEP; i++) { flan_dyn inner = flan_dyn_vec_new(); flan_dyn_push(cur, flan_dyn_from_i64(i)); flan_dyn_push(cur, inner); cur = inner; } flan_dyn_push(cur, text("bottom")); /* Churn, so that collections certainly happen with the chain live, and then one more by hand. */ for (i = 0; i < 20000; i++) (void)text("noise"); flan_gc_collect(); cur = root; for (i = 0; i < DEEP; i++) { if (flan_dyn_need_i64(flan_dyn_at(cur, flan_dyn_from_i64(0))) != i) ok = 0; cur = flan_dyn_at(cur, flan_dyn_from_i64(1)); } if (!flan_dyn_need_bool( flan_dyn_eq(flan_dyn_at(cur, flan_dyn_from_i64(0)), text("bottom")))) ok = 0; printf("chain of %d intact: %s\n", DEEP, ok ? "yes" : "no"); flan_dyn_root_pop(1); } /* Interior sharing: one vec held twice, and a text held from two places. * Three things have to be true and none of them follows from the others — * the shared object is swept once and not twice (a double free would show as * a crash or as a live-bytes figure that went negative), a write through one * path is visible through the other (it is one object, not a copy), and * dropping one of the two references does not collect it. */ static void sharing(void) { flan_dyn holder = flan_dyn_nil(), shared = flan_dyn_nil(); flan_dyn was; int i; flan_gc_init(); flan_gc_set_floor(16 * 1024); flan_dyn_root_push(&holder); flan_dyn_root_push(&shared); holder = flan_dyn_vec_new(); shared = flan_dyn_vec_new(); flan_dyn_push(shared, text("a")); flan_dyn_push(holder, shared); flan_dyn_push(holder, shared); flan_dyn_push(holder, shared); /* Three slots, one object. Identity and not equality: two vecs holding the same text are equal and are still two vecs, so a structural test would pass against an implementation that had quietly copied. The dyn word of a vec *is* its address, so comparing the words is comparing the objects. */ printf("three slots hold one object: %s\n", flan_dyn_at(holder, flan_dyn_from_i64(0)) == flan_dyn_at(holder, flan_dyn_from_i64(2)) ? "yes" : "no"); /* And writing through one path is read through another. */ flan_dyn_set_at(flan_dyn_at(holder, flan_dyn_from_i64(0)), flan_dyn_from_i64(0), text("b")); printf("write through one path is seen through another: %s\n", flan_dyn_need_bool( flan_dyn_eq(flan_dyn_at(flan_dyn_at(holder, flan_dyn_from_i64(2)), flan_dyn_from_i64(0)), text("b"))) ? "yes" : "no"); /* Dropping the direct root leaves it reachable through the holder, three times over. It must still be there, at the same address — a collector that swept it and handed the space to something else would answer this with a different word, and one that swept it twice would be caught by the sanitizer sweep rather than by an assertion. The churn in between is what makes the collection real rather than a formality. */ was = shared; shared = flan_dyn_nil(); for (i = 0; i < 5000; i++) (void)text("noise"); flan_gc_collect(); printf("shared object survives on the holder alone: %s\n", flan_dyn_at(holder, flan_dyn_from_i64(1)) == was ? "yes" : "no"); printf("still reachable: %s\n", flan_dyn_need_bool( flan_dyn_eq(flan_dyn_at(flan_dyn_at(holder, flan_dyn_from_i64(1)), flan_dyn_from_i64(0)), text("b"))) ? "yes" : "no"); /* And dropping the holder collects the lot, once. A double free of the thrice-held vec is what this is really asking about: it would crash here, or under @sanitize, or leave the byte count below zero. */ holder = flan_dyn_nil(); was = flan_dyn_nil(); for (i = 0; i < 5000; i++) (void)text("noise"); flan_gc_collect(); printf("live bytes after dropping everything: %s\n", flan_gc_live_bytes() >= 0 && flan_gc_count() <= 64 ? "ok" : "wrong"); flan_dyn_root_pop(2); } /* An unrooted object is collected. The positive control for every assertion * above: without this, a collector that never freed anything would pass the * lot. The text is allocated, its object count noted, and then enough * allocation happens to push it out of the temporaries ring — after which a * collection must reclaim it. */ static void unrooted(void) { int64_t before, after; int i; flan_gc_init(); flan_gc_set_floor(1 << 20); /* high, so only the explicit collect sweeps */ flan_gc_collect(); before = flan_gc_count(); for (i = 0; i < 500; i++) (void)text("garbage"); printf("allocated: %s\n", flan_gc_count() >= before + 500 ? "yes" : "no"); flan_gc_collect(); after = flan_gc_count(); /* The ring holds the last 64, by design, so the survivors are bounded by it and not by zero. */ printf("reclaimed all but the ring: %s\n", after <= before + 64 ? "yes" : "no"); } /* ── The refusals ────────────────────────────────────────────────────── * * One per mode, because each ends the process. The driver asserts on the * sentence as well as on the exit status: a process that died some other way * is not this guard firing, and the status alone cannot tell them apart. */ static void refuse(const char *what) { flan_dyn v = flan_dyn_vec_new(); flan_dyn t = text("hi"); if (strcmp(what, "add") == 0) (void)flan_dyn_add(flan_dyn_from_i64(3), t); else if (strcmp(what, "sub") == 0) (void)flan_dyn_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); else if (strcmp(what, "mul") == 0) (void)flan_dyn_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); else if (strcmp(what, "div") == 0) (void)flan_dyn_div(v, flan_dyn_from_i64(2)); else if (strcmp(what, "rem") == 0) (void)flan_dyn_rem(flan_dyn_from_i64(2), flan_dyn_nil()); else if (strcmp(what, "divzero") == 0) (void)flan_dyn_div(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); else if (strcmp(what, "remzero") == 0) (void)flan_dyn_rem(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); else if (strcmp(what, "divover") == 0) (void)flan_dyn_div(flan_dyn_from_i64(INT64_MIN), flan_dyn_from_i64(-1)); else if (strcmp(what, "lt") == 0) (void)flan_dyn_lt(flan_dyn_from_i64(1), t); else if (strcmp(what, "le") == 0) (void)flan_dyn_le(t, flan_dyn_nil()); else if (strcmp(what, "gt") == 0) (void)flan_dyn_gt(v, v); else if (strcmp(what, "ge") == 0) (void)flan_dyn_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1)); else if (strcmp(what, "len") == 0) (void)flan_dyn_len(flan_dyn_from_i64(1)); else if (strcmp(what, "at") == 0) (void)flan_dyn_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0)); else if (strcmp(what, "atindex") == 0) (void)flan_dyn_at(t, t); else if (strcmp(what, "atrange") == 0) (void)flan_dyn_at(t, flan_dyn_from_i64(9)); else if (strcmp(what, "atnegative") == 0) (void)flan_dyn_at(t, flan_dyn_from_i64(-1)); else if (strcmp(what, "setattext") == 0) flan_dyn_set_at(t, flan_dyn_from_i64(0), flan_dyn_from_i64(65)); else if (strcmp(what, "setatnotvec") == 0) flan_dyn_set_at(flan_dyn_from_i64(1), flan_dyn_from_i64(0), t); else if (strcmp(what, "setatrange") == 0) flan_dyn_set_at(v, flan_dyn_from_i64(0), t); else if (strcmp(what, "push") == 0) flan_dyn_push(t, flan_dyn_from_i64(1)); else if (strcmp(what, "needi64") == 0) (void)flan_dyn_need_i64(t); else if (strcmp(what, "needf64") == 0) (void)flan_dyn_need_f64(flan_dyn_from_i64(1)); else if (strcmp(what, "needbool") == 0) (void)flan_dyn_need_bool(flan_dyn_nil()); else { printf("no such refusal: %s\n", what); exit(2); } /* Reached only if the operation returned, which is the failure this mode is testing for. */ printf("did not trap\n"); exit(3); } int main(int argc, char **argv) { flan_rt_init(argc, argv); if (argc < 2) { printf("usage: dyn_ops \n"); return 2; } if (strcmp(argv[1], "ops") == 0) { ops(); printf(failures == 0 ? "ops ok\n" : "ops failed\n"); return failures == 0 ? 0 : 1; } if (strcmp(argv[1], "gc") == 0) { gc(); return 0; } if (strcmp(argv[1], "nested") == 0) { nested(); return 0; } if (strcmp(argv[1], "sharing") == 0) { sharing(); return 0; } if (strcmp(argv[1], "unrooted") == 0) { unrooted(); return 0; } if (strncmp(argv[1], "refuse:", 7) == 0) { refuse(argv[1] + 7); return 0; } printf("no such mode: %s\n", argv[1]); return 2; }