diff --git a/TODO.org b/TODO.org index f5cdc00d..045ac539 100644 --- a/TODO.org +++ b/TODO.org @@ -1269,18 +1269,24 @@ live bytes, 0 for none, that a =retry= handler raises. The failure bullet says "raises the allocator's budget" where it said "grows the arena", since no arena grows. A growable arena is not ruled out; nothing here asks for one. -** NEXT The Vec header is not the size the spec fixes -Decided 2026-09-25: five words in every build, the epoch included, so a release build still traps on a container whose region was released. The spec changes to match the code; nothing else does. -Five words in every build rather than the spec's four, and for a stated reason: a -redefinition module is built separately from its host and nothing makes the two -agree on a struct size. Give the reload path a way to carry the build flags and -this falls out. +** DONE The Vec header is not the size the spec fixes +CLOSED: [2026-09-25] +Five words in every build, the epoch included, so a release build still traps on +a container whose region was released. spec-memory.md, "Every build detects a +released region", now says so. Rules out a four-word release layout. -** TODO arena-destroy under a live view reads freed memory -The epoch check that makes free-all safe under a live view does not survive -=arena-destroy=, which frees the block holding the epoch. It happens to trap in -practice because the freed block still holds the bumped value. A question about -=arena-destroy='s ordering, not about views, and the typed side has the same shape. +** DONE arena-destroy under a live view reads freed memory +CLOSED: [2026-09-25] +No ordering of the frees fixes it: the container holds a pointer to the header. +=arena-destroy= now frees the pages and the arena record and retires the +allocator header — epoch bumped, procedure trapping as =DestroyedAllocator=, +never freed — so the stale check reads live memory on every side that makes it. +The next =arena-new= takes a retired header back, epoch kept, so a loop of them +stays flat and a container made before the destroy still traps. An =Allocator= +value kept past its destroy names the new arena once its header is reused. +Rules out freeing the header while any container may hold it. The +=DestroyedAllocator= trap prints no site: the allocator procedure is given none. See +docs/BUILT.md, "Three amendments to a frozen spec". ** DONE Map removal costs a backward-shift loop Removal landed, with the loop the spec predicted as its cost. Deferring it was @@ -1353,20 +1359,36 @@ pops the live restart list, and the generation stamp keeps a nested break from claiming a choice made against the outer one. Rules out deleting them with the transport. -** TODO The seqlock's losing race has no test -The result read copies into the caller's buffer and checks the counter either -side; nothing drives the case where the counter moves. The one threaded test races -the registry table instead. +** DONE The seqlock's losing race has no test +CLOSED: [2026-09-25] +=flan_dev_result_read_hook= runs between the copy and the second counter read, +and dev_limits.c's =race= mode writes from inside that window: once (the read +retries and returns the new value), every attempt (it gives up with nothing), and +a write left open (it never copies). A hook rather than a second thread, so the +interleaving is the same on every run; rules out a timing-based stress test here. -** TODO The snapshot generation's racing stale claim has no test -The nested-break case is tested deterministically now. What is still absent is the -race: landing a request inside a two-millisecond poll from outside the process. It -wants a hook the test can drive, not a sleep. +** DONE The snapshot generation's racing stale claim has no test +CLOSED: [2026-09-25] +=flan_agent_break_poll_hook= runs on the stopped thread where a thunk from the +poll would, and test/agent_hooks.c uses it to choose at an outer break and then +nest a break on top before the outer one looks. The inner break turns past the +choice and resumes only on its own. Rules out a sleep-timed socket test for this. -** TODO SNAP_MAX and SNAP_NAMES are read rather than tested -Three of the four named buffers have evidence. Only this pair is still read rather -than driven, and sixty-five nested =restart-case=s are a lot of program for a -clamp. +** TODO A choice made at an outer break is lost to a nested one +=chosen_index=, =chosen_gen= and =chosen_ready= are one slot. A choice validated +against an outer break and met by a nested one survives the nested break's +turns, but the nested break can only resume on a choice of its own, which +overwrites it — so the outer break stays stopped after the listener answered ok +for it. test/agent_hooks.c's =stale= mode pins this as it is. A slot per +snapshot is the likely fix. + +** DONE SNAP_MAX and SNAP_NAMES are read rather than tested +CLOSED: [2026-09-25] +test/agent_hooks.c drives both through programs/agent-hooks.flan, which recurses +with one restart per level: 71 restarts list 64, and 31 with 200-byte names list +20, each whole, with the terminal counting the rest and a take by index landing +in the frame it names. The slot kept back for =abandon-evaluation= under +truncation is still not driven: it needs a thunk in progress. ** CANCELLED Probing for an interior overrun under memcheck CLOSED: [2026-09-12] @@ -1402,11 +1424,14 @@ argument passing at a call site whose register file is exactly full. The dev-sid half is different work: the trap hook hands control to a session in-process with the compiler, which can read the source. -** TODO trap_oom has no site -It is reached from the allocator, which has no site to be given. The range trap -already carries the location pair and every caller passes null, so giving =at=, -=set-at= and =push= a site is a call-site change rather than another round of -signature churn. +** DONE trap_oom has no site +CLOSED: [2026-09-25] +=flan_dyn_at=, =flan_dyn_set_at= and =flan_dyn_push= take the call's site as +ptr+len, like the arithmetic, and every trap they reach prints it — type, range, +a view's tag check, and push's growth failing. =trap_oom= takes a site and only +push gives one: its other callers are the collector's own allocations, which +have no line to name. A stale view's check prints the site when =at= or +=set-at= reaches it; reached from =length=, printing or equality, it has none. ** TODO A restart has no location The restart frame is mirrored across both backends and the runtime, so giving diff --git a/docs/BUILT.md b/docs/BUILT.md index 9230c1bc..fdd0dc3a 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -2829,6 +2829,16 @@ handing the pages back only to ask for them again is the unusual one. Taking the the table the spec froze at four names; a second operation does not. The epoch is bumped either way — the pages being the same does not make a container built before the reset valid, which is the whole point of the trap. +`arena-destroy` hands back the pages and the arena record but not the allocator header. A container made from the +arena still holds a pointer to that header and reads the epoch through it on its next operation, so freeing the header +turned the trap into a read of freed memory that happened to see the bumped value (memcheck reported it). The header is +retired instead — epoch bumped, procedure swapped for one that traps as `DestroyedAllocator`, never freed — and put on a +list that the next `arena-new` takes from. The epoch is kept on reuse: it only ever rises on a header, so a container +made before the destroy still records an older number and still traps. Keeping every retired header instead grew +without bound — ten million `arena-new`/`arena-destroy` rounds peaked at 626 MB against 1.7 MB. The cost of reuse is +an `Allocator` value kept past its destroy: while its header is on the list it traps, and once a later `arena-new` has +taken the header it names that new arena. A second `arena-destroy` of the same allocator, before reuse, does nothing. + **2. `context/allocator` and `context/temp` are dynamic variables with save and restore, not extra parameters.** The spec says the allocator is "part of the calling convention". The literal reading touches every function signature, the FFI shim, the dev trampolines and the reload ABI, for the same observable behaviour, and it collides with every other diff --git a/lib/check.ml b/lib/check.ml index 90cfd4bc..10140620 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3510,7 +3510,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = let i = check ctx ~want:Types.Dyn idx in let v = check ctx ~want:Types.Dyn v in expect ctx loc ~want - (rt loc Types.Unit "flan_dyn_set_at" [ target; i; v ]) + (rt loc Types.Unit "flan_dyn_set_at" [ target; i; v; here loc ]) else begin let p, pty = match target.Tast.ty with @@ -3553,7 +3553,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = List.map (fun x -> rt loc Types.Unit "flan_dyn_push" - [ vval; check ctx ~want:Types.Dyn x ]) + [ vval; check ctx ~want:Types.Dyn x; here loc ]) items in mk loc Types.Dyn @@ -7464,7 +7464,7 @@ and named_call ?(qualified = false) ctx ~want loc name args = if target.Tast.ty = Types.Dyn then expect ctx loc ~want (rt loc Types.Unit "flan_dyn_push" - [ target; check ctx ~want:Types.Dyn x ]) + [ target; check ctx ~want:Types.Dyn x; here loc ]) else begin let elem = vec_elem loc "push" target.Tast.ty in let x = check ctx ~want:elem x in @@ -8255,7 +8255,8 @@ and named_call ?(qualified = false) ctx ~want loc name args = (match idx with | [ i ] -> expect ctx loc ~want - (rt loc Types.Dyn "flan_dyn_at" [ target; check ctx ~want:Types.Dyn i ]) + (rt loc Types.Dyn "flan_dyn_at" + [ target; check ctx ~want:Types.Dyn i; here loc ]) | _ -> fail loc "(at ...) over a dyn takes one index — write (at (at x i) j)") diff --git a/lib/emit.ml b/lib/emit.ml index 08aff1c6..0af38526 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -4219,7 +4219,7 @@ declare i64 @flan_dyn_kw(ptr, i64) declare i64 @flan_dyn_map_get(i64, i64) declare void @flan_dyn_map_set(i64, i64, i64) declare i64 @flan_dyn_map_contains(i64, i64) -; The nine that trap carry the site as ptr+len, the way the bounds and +; The ones that trap carry the site as ptr+len, the way the bounds and ; arithmetic traps do: a dyn type error IS the type error in a dynamic ; program, and it used to print with no file and no line. [eq] never traps, ; so it has nowhere to put one. @@ -4234,9 +4234,9 @@ declare i64 @flan_dyn_gt(i64, i64, ptr, i64) declare i64 @flan_dyn_ge(i64, i64, ptr, i64) declare i64 @flan_dyn_eq(i64, i64) declare i64 @flan_dyn_len(i64) -declare i64 @flan_dyn_at(i64, i64) -declare void @flan_dyn_set_at(i64, i64, i64) -declare void @flan_dyn_push(i64, i64) +declare i64 @flan_dyn_at(i64, i64, ptr, i64) +declare void @flan_dyn_set_at(i64, i64, i64, ptr, i64) +declare void @flan_dyn_push(i64, i64, ptr, i64) declare void @flan_dyn_print(i64) declare void @flan_dyn_emit_dev(i64) declare void @flan_dyn_emit_watch(i64) diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 503e91b2..bbd914eb 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -429,6 +429,13 @@ void flan_dev_result_end(void) { * when it was sizing something to send through a socket. */ uint64_t flan_dev_result_cap(void) { return RESULT_MAX; } +/* Called between the copy and the second read of the counter, when set. It + * exists for test/dev_limits.c and nothing else sets it: the losing side of + * the race is a write landing inside that window, and a second thread cannot + * be made to land there on demand. A hook that writes a value from inside the + * window is the same interleaving, every time. */ +void (*flan_dev_result_read_hook)(void); + int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen, uint64_t *len) { for (int attempt = 0; attempt < 64; attempt++) { @@ -438,6 +445,7 @@ int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen, if (n > RESULT_MAX) n = RESULT_MAX; /* a torn read cannot overrun */ if ((uint64_t)n > cap) n = (size_t)cap; memcpy(dst, result, n); + if (flan_dev_result_read_hook != NULL) flan_dev_result_read_hook(); /* The copy must be ordered before the second read of the counter, or the * check is of a copy the compiler was free to make afterwards. */ __atomic_thread_fence(__ATOMIC_ACQUIRE); diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 9c67b115..c7a8c724 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -557,7 +557,8 @@ static double dyn_num_value(flan_dyn v); /* forward: the view helpers, needed by [render] and [say_render] above where * they are defined, alongside the container operations below */ -static int64_t view_len(const char *op, flan_obj *o); +static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op, + flan_obj *o); static void *view_base(flan_obj *o); static flan_dyn view_box(int32_t elem, const uint8_t *p); static int64_t view_elem_size(int32_t elem); @@ -633,7 +634,7 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) { } default: { flan_obj *o = dyn_obj(v); - int64_t i, n = o->kind == OBJ_VIEW ? view_len("print", o) : o->len; + int64_t i, n = o->kind == OBJ_VIEW ? view_len(NULL, 0, "print", o) : o->len; emit(w, "["); for (i = 0; i < n; i++) { emit(w, " "); @@ -750,7 +751,7 @@ static void say_render(sayer *s, flan_dyn v, int depth) { } default: { flan_obj *o = dyn_obj(v); - int64_t i, n = o->kind == OBJ_VIEW ? view_len("print", o) : o->len; + int64_t i, n = o->kind == OBJ_VIEW ? view_len(NULL, 0, "print", o) : o->len; if (depth >= 2) { say_puts(s, "[...]"); return; } say_puts(s, "["); for (i = 0; i < n && s->n < s->cap - 8; i++) { @@ -810,9 +811,9 @@ static void say(char *buf, int64_t cap, flan_dyn v) { * * A NULL [loc] prints nothing at all and the sentence after it is byte for * byte the one this file printed before: the entry points that have not been - * given a site yet (every one but the five arithmetic and four ordering ones) - * pass NULL, and so does test/dyn_ops.c, which calls the runtime directly and - * has no source position to offer. */ + * given a site (everything but the arithmetic, the ordering, [at], [set-at] + * and [push]) pass NULL, and so does test/dyn_ops.c, which calls the runtime + * directly and has no source position to offer. */ static void trap_where(const uint8_t *loc, int64_t loclen) { if (loc != NULL && loclen > 0) fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc); @@ -845,10 +846,7 @@ static _Noreturn void trap1(const uint8_t *loc, int64_t loclen, #define TYPE_TRAP "DynType", 7 #define ARITH_TRAP "DynArith", 8 -/* No site reaches these two yet: [at], [set-at], [push] and the allocator - * paths are not among the nine entry points this pass gave a location to. The - * parameter is here so that giving them one later is a call-site change and - * not another round of signature churn. */ +/* [at] and [set-at]'s, with the site their call was written at. */ static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen, const char *op, flan_dyn v, int64_t i, int64_t len) { @@ -921,9 +919,16 @@ void flan_gc_collect(void) { * not recoverable by anything this file can do. It takes the trap path like * everything else, so a dev session parks on it and can be read, rather than * the allocation quietly answering NULL and every caller below growing a null - * check for a case none of them can handle. */ -static _Noreturn void trap_oom(int64_t want) { + * check for a case none of them can handle. + * + * [push] is the one caller with a site to give: its growth is the allocation + * a program's own line asked for. Every other caller is the collector's own + * bookkeeping — an object, a class table, the keyword table — and passes + * NULL, which prints no prefix. */ +static _Noreturn void trap_oom(const uint8_t *loc, int64_t loclen, + int64_t want) { fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn heap: %lld bytes could not be allocated, with %lld live\n", (long long)want, (long long)gc_bytes); @@ -936,7 +941,7 @@ static flan_obj *gc_alloc(uint8_t kind, int64_t extra) { if (!gc_ready) flan_gc_init(); if (gc_bytes + need > gc_next) flan_gc_collect(); o = (flan_obj *)malloc((size_t)need); - if (o == NULL) trap_oom(need); + if (o == NULL) trap_oom(NULL, 0, need); o->next = gc_all; o->kind = kind; o->mark = 0; @@ -972,7 +977,7 @@ static void mark_push(flan_obj *o) { if (mstack_n == mstack_cap) { int64_t cap = mstack_cap ? mstack_cap * 2 : 64; flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m); - if (m == NULL) trap_oom(cap * (int64_t)sizeof *m); + if (m == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *m); mstack = m; mstack_cap = cap; } @@ -1032,7 +1037,7 @@ static void root_add(void *base, const flan_desc *d) { if (roots_n == roots_cap) { int64_t cap = roots_cap ? roots_cap * 2 : 64; flan_root *r = (flan_root *)realloc(roots, (size_t)cap * sizeof *r); - if (r == NULL) trap_oom(cap * (int64_t)sizeof *r); + if (r == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *r); roots = r; roots_cap = cap; } @@ -1274,7 +1279,7 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { } if (count > 0) { list = (kw_entry **)malloc((size_t)count * sizeof *list); - if (list == NULL) trap_oom(count * (int64_t)sizeof *list); + if (list == NULL) trap_oom(NULL, 0, count * (int64_t)sizeof *list); count = 0; for (i = 0, start = 0; i <= n; i++) if (i == n ? i > start : slots[i] == '\n') { @@ -1304,7 +1309,7 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { int64_t cap = classes_cap ? classes_cap * 2 : 8; class_entry *t = (class_entry *)realloc(classes, (size_t)cap * sizeof *t); - if (t == NULL) trap_oom(cap * (int64_t)sizeof *t); + if (t == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *t); classes = t; classes_cap = cap; } @@ -1349,7 +1354,7 @@ static void class_sync(flan_obj *o) { if (e == NULL || e->gen == o->gen) return; if (e->nslots > 0) { fresh = (flan_dyn *)malloc((size_t)e->nslots * 2 * sizeof *fresh); - if (fresh == NULL) trap_oom(e->nslots * 2 * (int64_t)sizeof *fresh); + if (fresh == NULL) trap_oom(NULL, 0, e->nslots * 2 * (int64_t)sizeof *fresh); } for (j = 0; j < e->nslots; j++) { flan_dyn v = dyn_make(BOX_NIL, 0); @@ -1442,12 +1447,12 @@ flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n) { if (kws_n == kws_cap) { int64_t cap = kws_cap ? kws_cap * 2 : 32; kw_entry **t = (kw_entry **)realloc(kws, (size_t)cap * sizeof *t); - if (t == NULL) trap_oom(cap * (int64_t)sizeof *t); + if (t == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *t); kws = t; kws_cap = cap; } k = (kw_entry *)malloc(sizeof(kw_entry) + (size_t)n); - if (k == NULL) trap_oom((int64_t)sizeof(kw_entry) + n); + if (k == NULL) trap_oom(NULL, 0, (int64_t)sizeof(kw_entry) + n); k->len = n; if (n > 0) memcpy(kw_bytes(k), p, (size_t)n); kws[kws_n++] = k; @@ -1975,11 +1980,13 @@ static int64_t view_elem_size(int32_t elem) { * nothing about depth or a visited set closes it — the fix is that a * stale-container check must never read the container it has just refused * to trust, not even to describe it in the sentence explaining why. */ -static void view_vec_check(const char *op, flan_dyn_vec_hdr *h) { +static void view_vec_check(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn_vec_hdr *h) { if (h->alloc) { flan_dyn_alloc_hdr *a = (flan_dyn_alloc_hdr *)h->alloc; if ((int64_t)a->epoch != h->epoch) { fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: this view's container's allocator was released — the " "Vec was made at epoch %lld and the allocator is at %lld now\n", @@ -1992,10 +1999,11 @@ static void view_vec_check(const char *op, flan_dyn_vec_hdr *h) { /* [len] and [base], read live for a Vec view (so a push that grows and * moves the underlying Vec is seen the very next operation) and read from * the snapshot for a flat one. */ -static int64_t view_len(const char *op, flan_obj *o) { +static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op, + flan_obj *o) { if (o->u.view.is_vec) { flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)o->u.view.base; - view_vec_check(op, h); + view_vec_check(loc, loclen, op, h); return h->len; } return o->u.view.len; @@ -2027,7 +2035,7 @@ static flan_dyn view_box(int32_t elem, const uint8_t *p) { * alias [u.view.base] reinterpreted as dyn words rather than the native * bytes they are. */ static int64_t vecish_len(flan_obj *o) { - return o->kind == OBJ_VIEW ? view_len("=", o) : o->len; + return o->kind == OBJ_VIEW ? view_len(NULL, 0, "=", o) : o->len; } static flan_dyn vecish_at(flan_obj *o, int64_t i) { @@ -2042,13 +2050,13 @@ static flan_dyn vecish_at(flan_obj *o, int64_t i) { * view's element type wants, or this traps by name and never coerces or * truncates a mismatched value into the slot. [v] is the view, for the * sentence's container half; [x] is the value that was refused. */ -static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, - uint8_t *p) { +static void view_unbox(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn v, int32_t elem, flan_dyn x, uint8_t *p) { switch (elem) { case FLAN_VIEW_I64: { int64_t n; if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) - trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are int", v, x); + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x); n = dyn_int_value(x); memcpy(p, &n, 8); return; @@ -2056,7 +2064,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, case FLAN_VIEW_F64: { double d; if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) - trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are float", v, x); + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x); d = dyn_num_value(x); memcpy(p, &d, 8); return; @@ -2064,7 +2072,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, default: { uint8_t b; if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) - trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are bool", v, x); + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x); b = dyn_payload(x) ? 1 : 0; *p = b; return; @@ -2102,7 +2110,7 @@ flan_dyn flan_dyn_len(flan_dyn v) { } if (is_vec(v)) { flan_obj *o = dyn_obj(v); - if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len("length", o)); + if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len(NULL, 0, "length", o)); return flan_dyn_from_i64(o->len); } trap1(NULL, 0, TYPE_TRAP, "length", "only a text, a vec or a map has one", v); @@ -2111,81 +2119,89 @@ flan_dyn flan_dyn_len(flan_dyn v) { /* The index has to be an int, and that is a separate sentence from the * container being wrong: (at v "1") and (at 3 1) are two different mistakes * and telling somebody "these are the wrong types" names neither. */ -static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) { +static int64_t need_index(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn v, flan_dyn i) { if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT) - trap2(NULL, 0, TYPE_TRAP, op, "an index must be an int", v, i); + trap2(loc, loclen, TYPE_TRAP, op, "an index must be an int", v, i); return dyn_int_value(i); } /* A text answers a byte, as an int. That is what [(at s i)] on a * [(Slice u8)] does in the typed language, and a text is a run of bytes in * both. Codepoints are utf8's job and stay there. */ -flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) { +flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc, + int64_t loclen) { int64_t k; flan_obj *o; if (!is_text(v) && !is_vec(v)) - trap2(NULL, 0, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); - k = need_index("at", v, i); + trap2(loc, loclen, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); + k = need_index(loc, loclen, "at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { - int64_t len = view_len("at", o); - if (k < 0 || k >= len) trap_range(NULL, 0, "at", v, k, len); + int64_t len = view_len(loc, loclen, "at", o); + if (k < 0 || k >= len) trap_range(loc, loclen, "at", v, k, len); return view_box(o->u.view.elem, (const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem)); } - if (k < 0 || k >= o->len) trap_range(NULL, 0, "at", v, k, o->len); + if (k < 0 || k >= o->len) trap_range(loc, loclen, "at", v, k, o->len); if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]); return o->u.v.items[k]; } -void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) { +void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc, + int64_t loclen) { int64_t k; flan_obj *o; if (is_text(v)) - trap2(NULL, 0, TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); + trap2(loc, loclen, TYPE_TRAP, "set-at", + "a text is immutable — build another one", v, i); if (!is_vec(v)) - trap2(NULL, 0, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); - k = need_index("set-at", v, i); + trap2(loc, loclen, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); + k = need_index(loc, loclen, "set-at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { - int64_t len = view_len("set-at", o); + int64_t len = view_len(loc, loclen, "set-at", o); uint8_t *p; - if (k < 0 || k >= len) trap_range(NULL, 0, "set-at", v, k, len); + if (k < 0 || k >= len) trap_range(loc, loclen, "set-at", v, k, len); p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem); - view_unbox("set-at", v, o->u.view.elem, x, p); + view_unbox(loc, loclen, "set-at", v, o->u.view.elem, x, p); return; } - if (k < 0 || k >= o->len) trap_range(NULL, 0, "set-at", v, k, o->len); + if (k < 0 || k >= o->len) trap_range(loc, loclen, "set-at", v, k, o->len); o->u.v.items[k] = x; } -void flan_dyn_push(flan_dyn v, flan_dyn x) { +void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) { flan_obj *o; if (!is_vec(v)) { /* The value is in the sentence rather than the vec, because the vec is the * thing that is wrong and the value is what says which push it was. */ - trap2(NULL, 0, TYPE_TRAP, "push", "only a vec is pushed to", v, x); + trap2(loc, loclen, TYPE_TRAP, "push", "only a vec is pushed to", v, x); } o = dyn_obj(v); if (o->kind == OBJ_VIEW) { uint8_t buf[8]; + /* The typed Vec's own traps print a site too, and without one from the + * caller the best this can name is the operation. */ static const uint8_t push_loc[] = "(dyn push)"; + const uint8_t *site = loc != NULL && loclen > 0 ? loc : push_loc; + int64_t sitelen = loc != NULL && loclen > 0 ? loclen + : (int64_t)sizeof(push_loc) - 1; int64_t size; if (!o->u.view.is_vec) - trap2(NULL, 0, TYPE_TRAP, "push", + trap2(loc, loclen, TYPE_TRAP, "push", "this view is a slice or an array and cannot grow", v, x); size = view_elem_size(o->u.view.elem); - view_unbox("push", v, o->u.view.elem, x, buf); - if (!flan_vec_push(o->u.view.base, buf, size, size, push_loc, - (int64_t)sizeof(push_loc) - 1)) - trap_oom(size); + view_unbox(loc, loclen, "push", v, o->u.view.elem, x, buf); + if (!flan_vec_push(o->u.view.base, buf, size, size, site, sitelen)) + trap_oom(loc, loclen, size); return; } if (o->len == o->u.v.cap) { int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8; flan_dyn *items = (flan_dyn *)realloc(o->u.v.items, (size_t)cap * sizeof *items); - if (items == NULL) trap_oom(cap * (int64_t)sizeof *items); + if (items == NULL) trap_oom(loc, loclen, cap * (int64_t)sizeof *items); /* The growth is charged to the heap so the trigger sees it, and it is * charged *here* rather than at the next collection because a vec that * doubles a dozen times between allocations would otherwise be invisible @@ -2260,7 +2276,7 @@ void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) { int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8; flan_dyn *items = (flan_dyn *)realloc(o->u.v.items, (size_t)cap * 2 * sizeof *items); - if (items == NULL) trap_oom(cap * 2 * (int64_t)sizeof *items); + if (items == NULL) trap_oom(NULL, 0, cap * 2 * (int64_t)sizeof *items); /* Charged now for the reason push's growth is: the trigger has to see * the block while it is growing, not after. */ gc_bytes += (cap - o->u.v.cap) * 2 * (int64_t)sizeof *items; diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index eea4c87f..889be2e7 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -166,12 +166,16 @@ 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); +/* Element of a vec, or the byte of a text as an int. Out of range traps. + * [loc] is where the call was written, printed ahead of a trap's sentence; NULL + * prints none. The same pair [flan_dyn_add] takes. */ +flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc, + int64_t loclen); /* 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); +void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc, + int64_t loclen); +void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen); /* Map only; anything else traps by name. Keys and values are both dyn and a * key is compared structurally, so a keyword, a text, an int, or a whole map diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 986cc6a0..51639a60 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1107,7 +1107,7 @@ struct flan_allocator { void *data; uint32_t caps; /* Bumped on every free-all. A container records it and traps if it moved: - * spec-memory.md, "Dev builds detect a released region". */ + * spec-memory.md, "Every build detects a released region". */ uint64_t epoch; /* Dev accounting for the general-purpose tier: "did you forget to free" is * an allocator-tier question and this is the allocator's answer. */ @@ -1438,15 +1438,37 @@ void flan_context_restore(flan_allocator *a) { if (a) flan_ctx_alloc = a; } +/* Allocator headers [flan_arena_destroy] retired, linked through [data]. See + * there for why a header is never freed; this is why that does not grow. */ +static flan_allocator *flan_retired; + +/* A retired header is taken back rather than a new one made. Its epoch is + * kept, never reset: it only ever rises on a header, so a container made from + * the arena this header used to serve still records an older number and still + * traps. Only the bookkeeping a new arena starts from is cleared. */ +static flan_allocator *flan_header_new(void) { + flan_allocator *a = flan_retired; + if (a == NULL) return (flan_allocator *)calloc(1, sizeof *a); + flan_retired = (flan_allocator *)a->data; + a->data = NULL; + a->live_blocks = 0; + a->live_bytes = 0; + a->budget = 0; + return a; +} + +static void flan_header_retire(flan_allocator *a); + flan_allocator *flan_arena_new(int64_t cap) { flan_allocator *a; flan_arena *ar; if (cap <= 0) cap = FLAN_TEMP_DEFAULT; - a = (flan_allocator *)calloc(1, sizeof *a); ar = (flan_arena *)calloc(1, sizeof *ar); - if (!a || !ar) { free(a); free(ar); return NULL; } + if (!ar) return NULL; ar->base = (uint8_t *)malloc((size_t)cap); - if (!ar->base) { free(a); free(ar); return NULL; } + if (!ar->base) { free(ar); return NULL; } + a = flan_header_new(); + if (!a) { free(ar->base); free(ar); return NULL; } ar->cap = cap; a->proc = flan_arena_proc; a->data = ar; @@ -1456,6 +1478,33 @@ flan_allocator *flan_arena_new(int64_t cap) { return a; } +/* What an allocator's procedure becomes once [flan_arena_destroy] has handed + * its arena back. Every request traps, because there is nothing left to serve + * it from and answering NULL would read as exhaustion — which a retry handler + * that raises the budget would then retry for ever. */ +static void *flan_destroyed_proc(flan_allocator *a, int32_t mode, void *p, + int64_t old_size, int64_t size, int64_t align) { + (void)a; (void)mode; (void)p; (void)old_size; (void)size; (void)align; + rt_flush_out(); + fprintf(stderr, + "this allocator was destroyed by arena-destroy, so nothing can be " + "allocated from it or released through it\n"); + rt_trap((const uint8_t *)"DestroyedAllocator", 18); +} + +/* The pages and the arena record go; the allocator itself does not. Every + * container made from it holds this pointer and reads [epoch] through it on + * its next operation — that read is the whole of the stale-region trap — so + * freeing the header would turn the trap into a read of freed memory that + * happens to see the bumped value. The header is retired instead: epoch + * bumped, procedure swapped for one that refuses, never freed. Retired + * headers go on a list that [flan_arena_new] takes from, so a program that + * makes and destroys arenas in a loop holds as many headers as it ever had + * arenas alive at once. + * + * A second destroy finds the retired procedure and does nothing — while the + * header is still on the list. Once a later arena-new has taken it back, the + * old Allocator value names the new arena. */ void flan_arena_destroy(flan_allocator *a) { flan_arena *ar; if (!a || a->proc != flan_arena_proc) return; @@ -1466,7 +1515,15 @@ void flan_arena_destroy(flan_allocator *a) { flan_dev_reg_dead_range(ar->base, ar->cap); free(ar->base); free(ar); - free(a); + flan_header_retire(a); +} + +static void flan_header_retire(flan_allocator *a) { + a->proc = flan_destroyed_proc; + a->live_blocks = 0; + a->live_bytes = 0; + a->data = flan_retired; + flan_retired = a; } flan_allocator *flan_heap_allocator(void) { return &flan_heap; } @@ -1682,7 +1739,7 @@ _Noreturn void flan_vec_bounds_fail(const uint8_t *loc, int64_t loclen, rt_die(); } -/* spec-memory.md, "Dev builds detect a released region". This is the check +/* spec-memory.md, "Every build detects a released region". This is the check * that makes the epoch word worth carrying, and it runs on every operation, * not only in a dev build — see the header on why the words are unconditional. * A Vec that never allocated has no allocator and nothing to check. */ diff --git a/spec-memory.md b/spec-memory.md index 1220f8f3..ac5e57d2 100644 --- a/spec-memory.md +++ b/spec-memory.md @@ -594,15 +594,16 @@ Whatever the dead element owned stays allocated until `free-all`. That is a region leak bounded by the region, which is what a region already is; it is not a use-after-free, because nothing was released. -### Dev builds detect a released region +### Every build detects a released region -A `Vec` or `Map` records its allocator (see above). In a dev build it also -records that allocator's **epoch** — a counter the allocator bumps on every -`free-all`. Any operation on a container whose recorded epoch has moved traps, -naming the allocation site and the release site. This is a second and separate -counter from the per-`Vec` generation word that catches stale slices; the two -answer different questions and must not be conflated. Both are dev-only: the -release layout of a `Vec` is `ptr + len + cap + allocator` and nothing more. +A `Vec` or `Map` records its allocator (see above) and that allocator's +**epoch** — a counter the allocator bumps on every `free-all` and on +`arena-destroy`. Any operation on a container whose recorded epoch has moved +traps, naming the site of the operation. The epoch is in every build, release +included, so the layout of a `Vec` is `ptr + len + cap + allocator + epoch` — +five words — whatever the build flags. One layout is also what lets a +redefinition module, built separately from its host, agree with it on the size +of a struct holding a `Vec`. This is what covers a use after `free-all`, including the case the section above makes reachable: an inner container's header copied *out* of an diff --git a/test/agent_hooks.c b/test/agent_hooks.c new file mode 100644 index 00000000..e8fb923d --- /dev/null +++ b/test/agent_hooks.c @@ -0,0 +1,204 @@ +/* agent_hooks.c — the break loop's snapshot and its choice handoff, driven + * from inside the stopped thread. + * + * Every other break-loop test talks to a program from outside it, over the + * socket, and so can only ever see the interleavings a 2ms poll happens to + * produce. Two properties need a specific one: + * + * - a choice validated against one break and then met by a *different* + * break, nested inside the first, before the first looks for it; + * - a restart list longer than the snapshot holds, by count and by bytes. + * + * [flan_agent_break_poll_hook] runs on the stopped thread once per turn of + * the loop, where a thunk from the poll would run. Requests go through + * [flan_agent_request], the in-process path, which is the same verb table the + * socket reaches. The program under the hook is test/programs/agent-hooks.flan, + * which has no [main]; this file is the entry point, as reload_host.c is. + * + * argv: the mode, and the socket path the agent binds (it binds one to + * install its hooks, and nothing here ever connects to it). + */ + +#include +#include +#include +#include + +void flan_rt_init(int32_t argc, char **argv); +int32_t flan_agent_start(const uint8_t *path, int64_t len); +char *flan_agent_request(const char *line, uint64_t *len); +void flan_agent_request_free(char *p); +extern void (*flan_agent_break_poll_hook)(void); +extern void (*flan_break_hook)(const uint8_t *name, int64_t namelen, + void *condition, void *xfer); +void *flan_restart_push_c(const uint8_t *name, int64_t namelen); +void flan_restart_pop_c(void *frame); + +/* The trailing ptr is the transfer channel every Flan signature carries. */ +extern int32_t flan_deep(int32_t n, void *xfer) __asm__("flan.deep"); +extern int32_t flan_wide(int32_t n, void *xfer) __asm__("flan.wide"); + +/* One request, its reply printed to [buf] and returned. */ +static char reply_buf[1 << 16]; + +static const char *ask(const char *line) { + uint64_t n = 0; + char *r = flan_agent_request(line, &n); + if (n >= sizeof reply_buf) n = sizeof reply_buf - 1; + memcpy(reply_buf, r ? r : "", (size_t)n); + reply_buf[n] = '\0'; + flan_agent_request_free(r); + return reply_buf; +} + +/* ── The snapshot's two caps ───────────────────────────────────────── + * + * SNAP_MAX is 64 entries and SNAP_NAMES is 4096 bytes of names. [deep 70] + * puts 71 restarts on the stack with one-letter names, so the count is what + * runs out; [wide 30] puts 31 with 200-byte names, so the bytes run out after + * twenty. What is checked is that the listing stops cleanly at the cap — + * every entry it does list is whole and takeable — and that the terminal + * says how many were left out. The take is the proof that the indices in + * the truncated listing still name the frames they claim to. */ +static int listed, longest, shortest, taken_once; +static const char *take_line; + +static void list_and_take(void) { + const char *r, *p; + if (taken_once) return; + taken_once = 1; + r = ask("restarts"); + listed = 0; + longest = 0; + shortest = 1 << 30; + for (p = r; *p != '\0' && *p != '.';) { + const char *nl = strchr(p, '\n'); + const char *name; + int len; + if (nl == NULL) break; + /* "I F NAME" */ + name = strchr(p, ' '); + name = name ? strchr(name + 1, ' ') : NULL; + len = name ? (int)(nl - name - 1) : -1; + if (len > longest) longest = len; + if (len < shortest) shortest = len; + listed++; + p = nl + 1; + } + printf("listed %d\n", listed); + printf("names %d..%d\n", shortest, longest); + printf("take %s", ask(take_line)); + fflush(stdout); +} + +static int snapmax(void) { + void *xfer = NULL; + int32_t v; + take_line = "restart-at 5 retry"; + flan_agent_break_poll_hook = list_and_take; + v = flan_deep(70, &xfer); + flan_agent_break_poll_hook = NULL; + printf("returned %d\n", v); + return 0; +} + +static int snapnames(void) { + void *xfer = NULL; + int32_t v; + take_line = "restart-at 19"; + flan_agent_break_poll_hook = list_and_take; + v = flan_wide(30, &xfer); + flan_agent_break_poll_hook = NULL; + printf("returned %d\n", v); + return 0; +} + +/* ── A choice that lands inside the poll, with a break nested under it ── + * + * The outer break offers outer-b (0) and outer-a (1). On its first turn the + * hook chooses outer-a — validated against the outer snapshot, stamped with + * its generation — and then, still inside that turn, a second break starts + * on top, which is what a thunk that errors does. The inner break's list + * begins with [inner] and has outer-a at index 2, so an index 1 read without + * its generation would resume the inner break into outer-b: the wrong break, + * and the wrong frame. + * + * What must happen instead: the inner break turns past the choice that is + * not addressed to it, for as many turns as it is left alone, and resumes + * only on a choice made against its own list. + * + * What happens after that is pinned as it is, not as it ought to be: the + * choice slot is one slot, so the inner choice overwrote the outer one, and + * the outer break has to be asked again. TODO.org, "A choice made at an outer + * break is lost to a nested one". */ +static int level, inner_turns, outer_turns, reasked; +static void *outer_a, *outer_b, *inner; + +static void stale_hook(void) { + if (level == 1) { + outer_turns++; + if (outer_turns == 1) { + void *xin = NULL; + printf("outer choice %s", ask("restart-at 1 outer-a")); + inner = flan_restart_push_c((const uint8_t *)"inner", 5); + level = 2; + flan_break_hook((const uint8_t *)"Inner", 5, NULL, &xin); + level = 1; + printf("inner turns %d\n", inner_turns); + printf("inner resumed into %s\n", + xin == inner ? "inner" + : xin == outer_a ? "outer-a" + : xin == outer_b ? "outer-b" + : "nothing"); + flan_restart_pop_c(inner); + fflush(stdout); + return; + } + /* The outer break is still here, so its choice did not survive. */ + reasked++; + ask("restart-at 1 outer-a"); + return; + } + inner_turns++; + if (inner_turns == 5) { + printf("status %s", ask("status")); + printf("inner choice %s", ask("restart-at 0 inner")); + fflush(stdout); + } +} + +static int stale(void) { + void *xout = NULL; + outer_a = flan_restart_push_c((const uint8_t *)"outer-a", 7); + outer_b = flan_restart_push_c((const uint8_t *)"outer-b", 7); + level = 1; + flan_agent_break_poll_hook = stale_hook; + flan_break_hook((const uint8_t *)"Outer", 5, NULL, &xout); + flan_agent_break_poll_hook = NULL; + printf("outer re-asked %d\n", reasked); + printf("outer resumed into %s\n", + xout == outer_a ? "outer-a" + : xout == outer_b ? "outer-b" + : "nothing"); + flan_restart_pop_c(outer_b); + flan_restart_pop_c(outer_a); + return 0; +} + +int main(int argc, char **argv) { + flan_rt_init(argc, argv); + if (argc < 3) { + fprintf(stderr, "usage: %s snapmax|snapnames|stale SOCKET\n", argv[0]); + return 2; + } + if (flan_agent_start((const uint8_t *)argv[2], (int64_t)strlen(argv[2])) != 0) { + fprintf(stderr, "the agent did not start on %s\n", argv[2]); + return 2; + } + setvbuf(stdout, NULL, _IOLBF, 0); + if (strcmp(argv[1], "snapmax") == 0) return snapmax(); + if (strcmp(argv[1], "snapnames") == 0) return snapnames(); + if (strcmp(argv[1], "stale") == 0) return stale(); + fprintf(stderr, "unknown mode %s\n", argv[1]); + return 2; +} diff --git a/test/dev_limits.c b/test/dev_limits.c index 49e49bd6..06ba770a 100644 --- a/test/dev_limits.c +++ b/test/dev_limits.c @@ -363,15 +363,91 @@ static int regrace(void) { return 0; } +/* ── The seqlock's losing side ─────────────────────────────────────── + * + * [flan_dev_result_read] copies, then checks the counter has not moved. The + * single-threaded reads above only ever take the winning side. These take the + * other one, deterministically: [flan_dev_result_read_hook] runs inside the + * window between the copy and the check, and what it does there is a write. + * + * Three writers. One that publishes a value once: the read must throw its + * copy away and come back with the new value, numbered one higher — a read + * that did not check would return the old bytes under the old number, which + * is a stale answer described as current. One that publishes on every + * attempt: the read runs out of attempts and says so, with no bytes and the + * number of the last complete value. And one that opens a write and never + * closes it: every attempt sees an odd counter, so the copy never happens and + * the hook never runs. */ +extern void (*flan_dev_result_read_hook)(void); + +static int race_calls; + +static void publish(const char *v) { + flan_dev_result_begin(); + flan_dev_emit((const uint8_t *)v, (int64_t)strlen(v)); + flan_dev_result_end(); +} + +static void race_once(void) { + race_calls++; + flan_dev_result_read_hook = NULL; + publish("second"); +} + +static void race_every(void) { + race_calls++; + publish("again"); +} + +static int race(void) { + uint64_t gen0, gen, len; + int ok; + + publish("first"); + (void)result_read(&gen0, &len); + + race_calls = 0; + flan_dev_result_read_hook = race_once; + ok = flan_dev_result_read(rbuf, sizeof rbuf, &gen, &len); + printf("once ok %d calls %d gen +%llu value %.*s\n", ok, race_calls, + (unsigned long long)(gen - gen0), (int)len, rbuf); + + race_calls = 0; + flan_dev_result_read_hook = race_every; + ok = flan_dev_result_read(rbuf, sizeof rbuf, &gen, &len); + flan_dev_result_read_hook = NULL; + { + uint64_t now, nlen; + (void)result_read(&now, &nlen); + printf("every ok %d calls %d len %llu gen %s\n", ok, race_calls, + (unsigned long long)len, + gen == now ? "last complete" : "not the last complete"); + } + + race_calls = 0; + (void)result_read(&gen0, &len); + flan_dev_result_read_hook = race_every; + flan_dev_result_begin(); + ok = flan_dev_result_read(rbuf, sizeof rbuf, &gen, &len); + flan_dev_result_read_hook = NULL; + printf("open ok %d calls %d len %llu gen +%llu\n", ok, race_calls, + (unsigned long long)len, (unsigned long long)(gen - gen0)); + flan_dev_result_end(); + (void)result_read(&gen, &len); + printf("closed gen +%llu\n", (unsigned long long)(gen - gen0)); + return 0; +} + int main(int argc, char **argv) { flan_rt_init(argc, argv); if (argc < 2) { fprintf(stderr, - "usage: %s cap|names|regfull|regchurn|regrace|regoverflow\n", + "usage: %s cap|race|names|regfull|regchurn|regrace|regoverflow\n", argv[0]); return 2; } if (strcmp(argv[1], "cap") == 0) return cap(); + if (strcmp(argv[1], "race") == 0) return race(); if (strcmp(argv[1], "names") == 0) return names(); if (strcmp(argv[1], "regfull") == 0) return regfull(); if (strcmp(argv[1], "regchurn") == 0) return regchurn(); diff --git a/test/dune b/test/dune index a252d01d..187be30f 100644 --- a/test/dune +++ b/test/dune @@ -63,6 +63,9 @@ ; The other C main: flan_dev.c's two fixed limits, which no Flan program ; reaches, driven directly. (file dev_limits.c) + ; The break loop driven from inside the stopped thread, through the agent's + ; poll hook. + (file agent_hooks.c) ; And the third: the dynamic-value runtime, which has no Flan spelling yet ; at all. Its host program is under programs/ and comes in with the ; corpus; the header dyn_ops.c includes is the compiler's, dropped into the diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 75fc7946..dd9eb728 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -40,10 +40,13 @@ * rather than a hand-copied list. */ #include "flan_dyn.h" -/* The nine trapping operators took a site — (loc, len) — when flan_dyn.c's - * traps learned to print a file and a line. This file calls the runtime - * directly and has no source position to offer, so it passes (NULL, 0), which - * prints the sentence exactly as it printed before. */ +/* The trapping operators take a site — (loc, len) — which flan_dyn.c's traps + * print as a file and a line. This file calls the runtime directly and has no + * source position to offer, so it passes (NULL, 0), which prints the sentence + * with no prefix. */ +#define FDYN_at(v, i) flan_dyn_at((v), (i), NULL, 0) +#define FDYN_set_at(v, i, x) flan_dyn_set_at((v), (i), (x), NULL, 0) +#define FDYN_push(v, x) flan_dyn_push((v), (x), NULL, 0) #define FDYN_add(a, b) flan_dyn_add((a), (b), NULL, 0) #define FDYN_sub(a, b) flan_dyn_sub((a), (b), NULL, 0) #define FDYN_mul(a, b) flan_dyn_mul((a), (b), NULL, 0) @@ -244,14 +247,14 @@ static void ops(void) { 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"); + check(num(FDYN_at(a, flan_dyn_from_i64(0))) == 'h', "at text"); + check(num(FDYN_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(num(FDYN_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"); } { @@ -264,13 +267,13 @@ static void ops(void) { /* 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)); + FDYN_push(v, flan_dyn_from_i64(1)); + FDYN_push(v, flan_dyn_from_i64(2)); + FDYN_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"))), + check(num(FDYN_at(v, flan_dyn_from_i64(1))) == 2, "at vec"); + FDYN_set_at(v, flan_dyn_from_i64(1), text("two")); + check(truth(flan_dyn_eq(FDYN_at(v, flan_dyn_from_i64(1)), text("two"))), "set-at vec"); { /* Past the initial capacity, so the growth path runs and the elements @@ -278,10 +281,10 @@ static void ops(void) { 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)); + for (i = 0; i < 100; i++) FDYN_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"); + check(num(FDYN_at(big, flan_dyn_from_i64(0))) == 0, "first survived"); + check(num(FDYN_at(big, flan_dyn_from_i64(99))) == 99, "last survived"); flan_dyn_root_pop(1); } @@ -290,13 +293,13 @@ static void ops(void) { 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")); + FDYN_push(p, flan_dyn_from_i64(1)); + FDYN_push(p, text("x")); + FDYN_push(q, flan_dyn_from_i64(1)); + FDYN_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()); + FDYN_push(q, flan_dyn_nil()); check(!truth(flan_dyn_eq(p, q)), "= vec sees the length"); flan_dyn_root_pop(2); } @@ -307,8 +310,8 @@ static void ops(void) { { 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); + FDYN_push(cyc, flan_dyn_from_i64(1)); + FDYN_push(cyc, cyc); check(truth(flan_dyn_eq(cyc, cyc)), "= on a cycle answers"); show(cyc); check(strlen(shown) > 0 && strstr(shown, "...") != NULL, @@ -335,23 +338,23 @@ static void ops(void) { 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)); + FDYN_push(nums, flan_dyn_from_i64(1)); + FDYN_push(nums, flan_dyn_from_i64(2)); + FDYN_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")); + FDYN_push(strs, text("x")); + FDYN_push(strs, text("a b")); + FDYN_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); + FDYN_push(outer, nums); + FDYN_push(outer, strs); prints(outer, "[ [ 1 2 3] [ \"x\" \"a b\" \"q\\\"\\n\"]]"); flan_dyn_root_pop(1); } @@ -430,11 +433,11 @@ static void view(void) { flat = flan_dyn_view_flat(buf, 4, FLAN_VIEW_I64); check(flan_dyn_tag(flat) == FLAN_DYN_TAG_VEC, "a view tags as a vec"); check(num(flan_dyn_len(flat)) == 4, "flat view len"); - check(num(flan_dyn_at(flat, flan_dyn_from_i64(2))) == 30, "flat view at"); - flan_dyn_set_at(flat, flan_dyn_from_i64(2), flan_dyn_from_i64(99)); + check(num(FDYN_at(flat, flan_dyn_from_i64(2))) == 30, "flat view at"); + FDYN_set_at(flat, flan_dyn_from_i64(2), flan_dyn_from_i64(99)); check(buf[2] == 99, "flat view write reaches the array"); buf[3] = 7; - check(num(flan_dyn_at(flat, flan_dyn_from_i64(3))) == 7, + check(num(FDYN_at(flat, flan_dyn_from_i64(3))) == 7, "the array's own write reaches the view — it is not a copy"); prints(flat, "[ 10 20 99 7]"); @@ -458,13 +461,13 @@ static void view(void) { "two views over equal bytes are equal"); check(!truth(flan_dyn_eq(flat, other)), "two views over different bytes are not equal"); - flan_dyn_push(heap, flan_dyn_from_i64(10)); - flan_dyn_push(heap, flan_dyn_from_i64(20)); - flan_dyn_push(heap, flan_dyn_from_i64(99)); - flan_dyn_push(heap, flan_dyn_from_i64(7)); + FDYN_push(heap, flan_dyn_from_i64(10)); + FDYN_push(heap, flan_dyn_from_i64(20)); + FDYN_push(heap, flan_dyn_from_i64(99)); + FDYN_push(heap, flan_dyn_from_i64(7)); check(truth(flan_dyn_eq(flat, heap)), "a view and an equal heap vec are equal"); - flan_dyn_set_at(heap, flan_dyn_from_i64(3), flan_dyn_from_i64(0)); + FDYN_set_at(heap, flan_dyn_from_i64(3), flan_dyn_from_i64(0)); check(!truth(flan_dyn_eq(flat, heap)), "a view and a differing heap vec are not equal"); flan_dyn_root_pop(3); @@ -480,17 +483,17 @@ static void view(void) { check(num(flan_dyn_len(vv)) == 0, "vec view starts empty"); { int i; - for (i = 0; i < 20; i++) flan_dyn_push(vv, flan_dyn_from_i64(i)); + for (i = 0; i < 20; i++) FDYN_push(vv, flan_dyn_from_i64(i)); } check(num(flan_dyn_len(vv)) == 20, "vec view len after growth"); - check(num(flan_dyn_at(vv, flan_dyn_from_i64(0))) == 0, + check(num(FDYN_at(vv, flan_dyn_from_i64(0))) == 0, "first element survived the growth and the move"); - check(num(flan_dyn_at(vv, flan_dyn_from_i64(19))) == 19, + check(num(FDYN_at(vv, flan_dyn_from_i64(19))) == 19, "pushed element reachable after the header's ptr moved"); /* [hv]'s own fields moved under the view's feet, by construction — the view never captured [hv.ptr]; it captured [&hv]. */ check(hv.len == 20 && hv.cap >= 20, "the hand-built header itself grew"); - flan_dyn_set_at(vv, flan_dyn_from_i64(0), flan_dyn_from_i64(-1)); + FDYN_set_at(vv, flan_dyn_from_i64(0), flan_dyn_from_i64(-1)); check(((int64_t *)hv.ptr)[0] == -1, "write through the view reaches hv"); flan_vec_free(&hv, 8, 8, (const uint8_t *)"view", 4); } @@ -502,13 +505,13 @@ static void view(void) { double floats[2] = { 1.5, -2.0 }; flan_dyn bv = flan_dyn_view_flat(bools, 2, FLAN_VIEW_BOOL); flan_dyn fv = flan_dyn_view_flat(floats, 2, FLAN_VIEW_F64); - check(truth(flan_dyn_at(bv, flan_dyn_from_i64(0))), "bool view at true"); - check(!truth(flan_dyn_at(bv, flan_dyn_from_i64(1))), "bool view at false"); - flan_dyn_set_at(bv, flan_dyn_from_i64(1), flan_dyn_from_bool(1)); + check(truth(FDYN_at(bv, flan_dyn_from_i64(0))), "bool view at true"); + check(!truth(FDYN_at(bv, flan_dyn_from_i64(1))), "bool view at false"); + FDYN_set_at(bv, flan_dyn_from_i64(1), flan_dyn_from_bool(1)); check(bools[1] == 1, "bool view write"); - check(flan_dyn_need_f64(flan_dyn_at(fv, flan_dyn_from_i64(0))) == 1.5, + check(flan_dyn_need_f64(FDYN_at(fv, flan_dyn_from_i64(0))) == 1.5, "float view at"); - flan_dyn_set_at(fv, flan_dyn_from_i64(0), flan_dyn_from_f64(3.25)); + FDYN_set_at(fv, flan_dyn_from_i64(0), flan_dyn_from_f64(3.25)); check(floats[0] == 3.25, "float view write"); } @@ -524,21 +527,21 @@ static void refuse_view(const char *what) { flan_dyn v; if (strcmp(what, "range") == 0) { v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64); - (void)flan_dyn_at(v, flan_dyn_from_i64(2)); + (void)FDYN_at(v, flan_dyn_from_i64(2)); } else if (strcmp(what, "wrongwrite") == 0) { v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64); - flan_dyn_set_at(v, flan_dyn_from_i64(0), text("nope")); + FDYN_set_at(v, flan_dyn_from_i64(0), text("nope")); } else if (strcmp(what, "wrongbool") == 0) { static uint8_t bb[1]; v = flan_dyn_view_flat(bb, 1, FLAN_VIEW_BOOL); - flan_dyn_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1)); + FDYN_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1)); } else if (strcmp(what, "wrongfloat") == 0) { static double ff[1]; v = flan_dyn_view_flat(ff, 1, FLAN_VIEW_F64); - flan_dyn_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1)); + FDYN_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1)); } else if (strcmp(what, "flatpush") == 0) { v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64); - flan_dyn_push(v, flan_dyn_from_i64(9)); + FDYN_push(v, flan_dyn_from_i64(9)); } else if (strcmp(what, "stalelen") == 0) { /* A Vec view whose allocator has moved on, asked for its length. The * operator name is what this mode is for: the sentence is built from the @@ -624,12 +627,12 @@ static void gc(void) { 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 < LIVE; i++) FDYN_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), + FDYN_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(); } @@ -654,7 +657,7 @@ static void gc(void) { 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)); + flan_dyn got = FDYN_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; @@ -683,11 +686,11 @@ static void nested(void) { 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); + FDYN_push(cur, flan_dyn_from_i64(i)); + FDYN_push(cur, inner); cur = inner; } - flan_dyn_push(cur, text("bottom")); + FDYN_push(cur, text("bottom")); /* Churn, so that collections certainly happen with the chain live, and then one more by hand. */ @@ -696,11 +699,11 @@ static void nested(void) { 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_i64(FDYN_at(cur, flan_dyn_from_i64(0))) != i) ok = 0; + cur = FDYN_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")))) + flan_dyn_eq(FDYN_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); @@ -724,26 +727,26 @@ static void sharing(void) { 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); + FDYN_push(shared, text("a")); + FDYN_push(holder, shared); + FDYN_push(holder, shared); + FDYN_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)) + FDYN_at(holder, flan_dyn_from_i64(0)) + == FDYN_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)), + FDYN_set_at(FDYN_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_eq(FDYN_at(FDYN_at(holder, flan_dyn_from_i64(2)), flan_dyn_from_i64(0)), text("b"))) ? "yes" : "no"); @@ -759,10 +762,10 @@ static void sharing(void) { 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"); + FDYN_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_eq(FDYN_at(FDYN_at(holder, flan_dyn_from_i64(1)), flan_dyn_from_i64(0)), text("b"))) ? "yes" : "no"); @@ -839,7 +842,7 @@ static void park(void) { config = text("hello"); flan_dyn_root_push(&frame); frame = flan_dyn_vec_new(); - for (i = 0; i < HELD; i++) flan_dyn_push(frame, text("frame")); + for (i = 0; i < HELD; i++) FDYN_push(frame, text("frame")); flan_gc_collect(); before = flan_gc_count(); @@ -914,10 +917,10 @@ static void desc(void) { flan_dyn_root_push_desc(&row, &row_desc); row.label = flan_dyn_vec_new(); - flan_dyn_push(row.label, text("held")); + FDYN_push(row.label, text("held")); row.inner.note = text("nested"); row.tail = flan_dyn_vec_new(); - flan_dyn_push(row.tail, flan_dyn_from_i64(99)); + FDYN_push(row.tail, flan_dyn_from_i64(99)); was_label = row.label; was_note = row.inner.note; @@ -926,10 +929,10 @@ static void desc(void) { if (row.label != was_label || row.inner.note != was_note) ok = 0; if (!flan_dyn_need_bool( - flan_dyn_eq(flan_dyn_at(row.label, flan_dyn_from_i64(0)), + flan_dyn_eq(FDYN_at(row.label, flan_dyn_from_i64(0)), text("held")))) ok = 0; if (!flan_dyn_need_bool(flan_dyn_eq(row.inner.note, text("nested")))) ok = 0; - if (flan_dyn_need_i64(flan_dyn_at(row.tail, flan_dyn_from_i64(0))) != 99) + if (flan_dyn_need_i64(FDYN_at(row.tail, flan_dyn_from_i64(0))) != 99) ok = 0; printf("aggregate root survives collection: %s\n", ok ? "yes" : "no"); @@ -949,7 +952,7 @@ static void desc(void) { question is about. */ flan_dyn_root_push(&row.hidden); row.hidden = flan_dyn_vec_new(); - for (i = 0; i < 500; i++) flan_dyn_push(row.hidden, text("hidden")); + for (i = 0; i < 500; i++) FDYN_push(row.hidden, text("hidden")); flan_dyn_root_pop(1); for (i = 0; i < 200; i++) (void)text("noise"); flan_gc_collect(); @@ -1002,19 +1005,19 @@ static void refuse(const char *what) { (void)FDYN_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); + (void)FDYN_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0)); + else if (strcmp(what, "atindex") == 0) (void)FDYN_at(t, t); else if (strcmp(what, "atrange") == 0) - (void)flan_dyn_at(t, flan_dyn_from_i64(9)); + (void)FDYN_at(t, flan_dyn_from_i64(9)); else if (strcmp(what, "atnegative") == 0) - (void)flan_dyn_at(t, flan_dyn_from_i64(-1)); + (void)FDYN_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)); + FDYN_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); + FDYN_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)); + FDYN_set_at(v, flan_dyn_from_i64(0), t); + else if (strcmp(what, "push") == 0) FDYN_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)); @@ -1208,10 +1211,10 @@ static void classes(void) { flan_gc_set_floor(16 * 1024); define("point", "x\ny"); keep = flan_dyn_vec_new(); - for (i = 0; i < 2000; i++) flan_dyn_push(keep, a_point(i, i + 1)); + for (i = 0; i < 2000; i++) FDYN_push(keep, a_point(i, i + 1)); define("point", "y\nx\ndeep"); for (i = 0; i < 2000; i++) { - flan_dyn e = flan_dyn_at(keep, flan_dyn_from_i64(i)); + flan_dyn e = FDYN_at(keep, flan_dyn_from_i64(i)); /* Allocation between each migration, so a collection lands part-way through the set and has both shapes to mark. */ flan_dyn_map_set(e, flan_dyn_kw((const uint8_t *)"deep", 4), @@ -1221,7 +1224,7 @@ static void classes(void) { { int ok = 1; for (i = 0; i < 2000; i++) { - flan_dyn e = flan_dyn_at(keep, flan_dyn_from_i64(i)); + flan_dyn e = FDYN_at(keep, flan_dyn_from_i64(i)); if (num(slot(e, "x")) != i || num(slot(e, "y")) != i + 1) ok = 0; if (flan_dyn_tag(slot(e, "deep")) != FLAN_DYN_TAG_VEC) ok = 0; if (num(flan_dyn_len(e)) != 3) ok = 0; diff --git a/test/programs/agent-hooks.flan b/test/programs/agent-hooks.flan new file mode 100644 index 00000000..827b025e --- /dev/null +++ b/test/programs/agent-hooks.flan @@ -0,0 +1,23 @@ +;;;; The Flan half of test/agent_hooks.c, which is the program's entry point: +;;;; this file has no [main]. It exists to put restart frames on the stack in +;;;; numbers no hand-written program would, and then stop. +;;;; +;;;; One restart per level of recursion, so the depth is the number of frames +;;;; a break loop is offered. Taking the restart at a level returns that +;;;; level's own number, which is how the harness sees which frame it landed +;;;; in. +(import agent "vendor:agent") + +(defstruct Deep [n i32]) + +(defn deep [n i32] i32 + (restart-case + (if (= n 0) (do (error (Deep {.n n})) 0) (deep (- n 1))) + (retry [] n))) + +;;; The same, with a name two hundred bytes long, so the snapshot's name +;;; buffer fills before its entry count does. +(defn wide [n i32] i32 + (restart-case + (if (= n 0) (do (error (Deep {.n n})) 0) (wide (- n 1))) + (retry-with-a-name-long-enough-that-twenty-of-them-fill-the-four-kilobytes-a-break-loop-keeps-for-the-names-of-its-restarts-and-the-twenty-first-does-not-fit-anywhere-in-the-buffer-at-all-xxx-and-so-on [] n))) diff --git a/test/programs/destroy-region.flan b/test/programs/destroy-region.flan new file mode 100644 index 00000000..680be7eb --- /dev/null +++ b/test/programs/destroy-region.flan @@ -0,0 +1,52 @@ +;;;; stale-region.flan's trap, reached through arena-destroy rather than +;;;; free-all. The difference is what the check reads: free-all keeps the +;;;; allocator and bumps its epoch, while arena-destroy hands the arena back, +;;;; and a container made from it still points at the allocator to read the +;;;; epoch from. The allocator therefore outlives its arena, so that read is of +;;;; memory that is still there and the trap names the site. +;;;; +;;;; Argument 1 is the other use of a destroyed arena: a new container made +;;;; from it, which has no stale epoch to catch and reaches the allocator +;;;; itself. +;;;; +;;;; Argument 2 is a destroyed allocator taken back by the next arena-new. The +;;;; container made before the destroy still traps, because the epoch on a +;;;; header only ever rises. +;;;; +;;;; Argument 3 makes and destroys arenas in a loop, as many times as the +;;;; second argument says. A retired allocator is reused rather than kept, so +;;;; the loop's memory stays flat however long it runs. +(defn main [args [string]] i32 + (let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0) + a (arena-new 4096)] + (cond + (= which 1) + (do + (arena-destroy a) + (let [w (vec-new i32 a)] + (push w 1) + (println (length w)))) + (= which 2) + (let [v (vec-new i32 a)] + (push v 1) + (arena-destroy a) + (let [b (arena-new 4096) + w (vec-new i32 b)] + (push w 5) + (println (at w 0)) + (println (at v 0)))) + (= which 3) + (let [n (bytes->i64 (bytes-view (at args 2)))] + (arena-destroy a) + (dotimes [i (i32 n)] + (let [b (arena-new 64)] + (arena-destroy b))) + (println "done")) + :else + (let [v (vec-new i32 a)] + (push v 1) + (push v 2) + (println (at v 1)) + (arena-destroy a) + (println (at v 1))))) + 0) diff --git a/test/programs/dyn-index-site.flan b/test/programs/dyn-index-site.flan new file mode 100644 index 00000000..a89d54c5 --- /dev/null +++ b/test/programs/dyn-index-site.flan @@ -0,0 +1,31 @@ +;;;; dyn-trap-site.flan's prefix, for the three container operations: at, +;;;; set-at and push. Each trap prints the file, line and column of the call +;;;; that failed, ahead of its sentence. +;;;; +;;;; The argument chooses which one fails, one per run, because each ends the +;;;; process. The line numbers are asserted by the test, so an edit above them +;;;; moves them. Modes 3 and 4 reach at and set-at through a view of a typed +;;;; Vec whose arena was released, which is a different trap on the same call. +(defn as-dyn [d dyn] dyn d) + +(defonce tv (Vec i64)) + +(defn main [args [string]] i32 + (let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0) + v (vec-new dyn) + ar (arena-new 4096)] + (push v 1) + (set tv (vec-new i64 ar)) + (push tv 7) + (println "before") + (cond + (= which 0) (println (at v 5)) + (= which 1) (set (at v 5) 2) + (= which 2) (let [n (at v 0)] (push n 3)) + :else + (let [dv (as-dyn tv)] + (free-all ar) + (if (= which 3) + (println (at dv 0)) + (set (at dv 0) 8))))) + 0) diff --git a/test/programs/map-stale-region.flan b/test/programs/map-stale-region.flan index ec39ece9..3bb85892 100644 --- a/test/programs/map-stale-region.flan +++ b/test/programs/map-stale-region.flan @@ -1,4 +1,4 @@ -;;;; spec-memory.md, "Dev builds detect a released region" — the Map's half. +;;;; spec-memory.md, "Every build detects a released region" — the Map's half. ;;;; ;;;; A Map records the epoch of the allocator it was made with, exactly as a ;;;; Vec does, and free-all bumps that counter. Any operation on a container diff --git a/test/programs/stale-region.flan b/test/programs/stale-region.flan index fbc1bffc..6dbaf3f0 100644 --- a/test/programs/stale-region.flan +++ b/test/programs/stale-region.flan @@ -1,4 +1,4 @@ -;;;; spec-memory.md, "Dev builds detect a released region". +;;;; spec-memory.md, "Every build detects a released region". ;;;; ;;;; A Vec records the epoch of the allocator it was made with, and free-all ;;;; bumps that counter. Any operation on a container whose recorded epoch has diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index c92484a2..d89aed51 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1876,6 +1876,79 @@ let () = end; (try Sys.remove exe with Sys_error _ -> ()); + (* The same trap after arena-destroy, which hands the arena back: the + container's allocator pointer has to still be readable for the epoch + check to run at all, so the allocator outlives its arena. A new + container made from the destroyed arena has no stale epoch, and what + stops it is the allocator itself. Both are also clean under memcheck, + which is where reading a freed allocator showed up. *) + let exe = compile "programs/destroy-region.flan" in + let code, text = run exe None in + if code <> 134 || not (contains text "programs/destroy-region.flan:") + || not (contains text "allocator was released") + then begin + incr failures; + Printf.printf + "FAIL a container used after its arena was destroyed\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" + text code + end; + let code, text = run exe (Some "1") in + if code <> 134 || not (contains text "destroyed by arena-destroy") then begin + incr failures; + Printf.printf + "FAIL allocating from a destroyed arena\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming arena-destroy\n" + text code + end; + (* The retired allocator taken back by the next arena-new: the new + arena's container works, and the one made before the destroy still + traps, because the epoch on a header only rises. *) + let code, text = run exe (Some "2") in + if code <> 134 || not (contains text "5\n") + || not (contains text "programs/destroy-region.flan:37:") + || not (contains text "allocator was released") + then begin + incr failures; + Printf.printf + "FAIL a container whose destroyed allocator was reused\n\ + \ got: %S (exit %d)\n wanted: 5, then the trap at 37 (exit 134)\n" + text code + end; + (* And the reuse is what keeps a make-and-destroy loop flat: two million + rounds peak where a thousand do. Without it each round kept a header, + about 130 MB here. Peak resident size comes from /usr/bin/time, and the + case is skipped without one. *) + if Sys.file_exists "/usr/bin/time" then begin + let peak n = + let o = Filename.temp_file "flan-destroy" ".rss" in + let code = + Sys.command + (Printf.sprintf "/usr/bin/time -f %%M -o %s %s 3 %d > /dev/null 2>&1" + (Filename.quote o) (Filename.quote exe) n) + in + let kb = + try int_of_string (String.trim (In_channel.with_open_bin o + In_channel.input_all)) + with _ -> -1 + in + (try Sys.remove o with Sys_error _ -> ()); + (code, kb) + in + let c1, small = peak 1000 and c2, large = peak 2_000_000 in + if c1 <> 0 || c2 <> 0 || small < 0 || large < 0 + || large - small > 20_000 + then begin + incr failures; + Printf.printf + "FAIL arena-new and arena-destroy in a loop\n\ + \ got: %d KB after 1000 rounds, %d KB after 2000000 (exits %d, %d)\n\ + \ wanted: within 20 MB of each other\n" + small large c1 c2 + end + end; + (try Sys.remove exe with Sys_error _ -> ()); + (try Sys.remove exe with Sys_error _ -> ()); @@ -4805,6 +4878,34 @@ level "1" trap_site ~opt:"-O0" (); trap_site ~x86:true (); + (* The same prefix on at, set-at and push, which take the site as an + ordinary argument just as the arithmetic does. One run per operation, + on both backends. *) + let index_site ?x86 () = + let exe = compile ?x86 "programs/dyn-index-site.flan" in + List.iter + (fun (arg, want) -> + let code, text = run exe (Some arg) in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf + "FAIL dyn: a container trap says where%s\n got: %S \ + (exit %d)\n wanted: %S (exit 134)\n" + (match x86 with Some true -> ", --x86" | _ -> "") + text code want + end) + [ ("0", "dyn-index-site.flan:22:28: dyn at: index 5 is out of bounds"); + ("1", "dyn-index-site.flan:23:19: dyn set-at: index 5 is out of bounds"); + ("2", "dyn-index-site.flan:24:37: dyn push: int and int"); + ("3", "dyn-index-site.flan:29:22: dyn at: this view's container's \ + allocator was released"); + ("4", "dyn-index-site.flan:30:13: dyn set-at: this view's \ + container's allocator was released") ]; + (try Sys.remove exe with Sys_error _ -> ()) + in + index_site (); + index_site ~x86:true (); + (* A numeric cast opening a dyn box — TODO.org, "A numeric cast opens a dyn box". programs/dyn-cast.flan is one program because the three behaviours are one story told in order: the same-kind casts print, the diff --git a/test/test_agent.ml b/test/test_agent.ml index 4d04b60a..91a2489f 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -780,5 +780,77 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ exe; so1; so2; sock; out; bsock; bout; bexe; qexe; qso; qsock; qout; noinstall; lexe; lsock; lout ]; + + (* ── The snapshot's caps and the choice handoff, from inside ──────── *) + + (* agent_hooks.c is the entry point and drives the break loop through + [flan_agent_break_poll_hook], on the stopped thread, so each case below + is one fixed interleaving rather than a race against the loop's 2ms + sleep. One process per mode: each ends with a restart stack the next + would inherit. *) + let ht, hl = Session.create ~file:"programs/agent-hooks.flan" () in + let hexe = tmp "hooks" in + ignore + (Build.executable ~opts:dev ~csrcs:("agent_hooks.c" :: hl.Load.csrcs) + ~lflags:hl.Load.lflags ht.Session.host ~out:hexe); + let hook_mode m = + let o = tmp ("hooks-" ^ m ^ ".out") and e = tmp ("hooks-" ^ m ^ ".err") + and s = tmp ("hooks-" ^ m ^ ".sock") in + let code = + Sys.command + (Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote hexe) m + (Filename.quote s) (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 p -> try Sys.remove p with Sys_error _ -> ()) [ o; e; s ]; + (code, out, err) + in + let contains s sub = + let n = String.length sub in + let rec go i = + i + n <= String.length s && (String.sub s i n = sub || go (i + 1)) + in + go 0 + in + (* SNAP_MAX. 71 restarts on the stack, 64 listed, every listed one whole, + and the terminal saying how many were left out. Taking index 5 lands in + the frame five levels up from the one that erred, which returns 5: the + indices of a truncated list still name the frames they say. *) + let code, out, err = hook_mode "snapmax" in + let want = "listed 64\nnames 5..5\ntake ok\nreturned 5\n" in + if code <> 0 || out <> want then + fail "a break with more restarts than the snapshot holds\n got: %S (exit %d, err %S)\n wanted: %S" + out code err want; + if not (contains err "... and 7 more, not listed") then + fail "the break did not say how many restarts it left out: %S" err; + (* SNAP_NAMES. 31 restarts whose names are 200 bytes each: twenty fit in + 4096 bytes with their terminators, the twenty-first does not, and no + name is cut short to squeeze it in. *) + let code, out, err = hook_mode "snapnames" in + let want = "listed 20\nnames 200..200\ntake ok\nreturned 19\n" in + if code <> 0 || out <> want then + fail "a break whose restart names outgrow the snapshot\n got: %S (exit %d, err %S)\n wanted: %S" + out code err want; + if not (contains err "... and 11 more, not listed") then + fail "the break did not say how many long-named restarts it left out: %S" + err; + (* A choice made against the outer break, then a break nested on top of it + before the outer one looks. The inner break turns past it five times + and resumes only on its own choice, into its own frame; index 1 read + without its generation would have sent it to outer-b. The last two lines + are the outer break needing to be asked again, because the choice slot + is one slot — TODO.org, "A choice made at an outer break is lost to a + nested one". *) + let code, out, err = hook_mode "stale" in + let want = + "outer choice ok\nstatus stopped Inner\ninner choice ok\ninner turns 5\n\ + inner resumed into inner\nouter re-asked 1\nouter resumed into outer-a\n" + in + if code <> 0 || out <> want then + fail "a choice addressed to an outer break, met by a nested one\n got: %S (exit %d, err %S)\n wanted: %S" + out code err want; + (try Sys.remove hexe with Sys_error _ -> ()); + Test_support.report ~label:"agent" () | _ -> print_endline "agent: skipped (no clang or llc on PATH)" diff --git a/test/test_reload.ml b/test/test_reload.ml index 857406b3..57e1080c 100644 --- a/test/test_reload.ml +++ b/test/test_reload.ml @@ -547,6 +547,22 @@ let () = if code <> 0 || out <> want_cap then fail "the 4K result cap\n got: %S (exit %d)\n wanted: %S" out code want_cap; + (* The seqlock's losing side, driven by a hook inside the window between + the copy and the check. A write landing there once makes the read come + back with the new value, numbered one higher, on its second attempt. A + write landing there every time exhausts the 64 attempts and answers + nothing, under the number of the last complete value. A write left open + is refused before any copy, so the hook never runs. *) + let code, out, err = mode "race" in + let want_race = + "once ok 1 calls 1 gen +1 value second\n\ + every ok 0 calls 64 len 0 gen last complete\n\ + open ok 0 calls 0 len 0 gen +0\n\ + closed gen +1\n" + in + if code <> 0 || out <> want_race then + fail "the result read losing its race\n got: %S (exit %d, err %S)\n wanted: %S" + out code err want_race; (* 4096 distinct names fit; the next one stops the process. The table is fixed and never moves, because a loaded module holds the address of a cell in it, so growing is not available and overrunning is the only diff --git a/test/test_valgrind.ml b/test/test_valgrind.ml index ecce3a92..9b8c4419 100644 --- a/test/test_valgrind.ml +++ b/test/test_valgrind.ml @@ -186,7 +186,7 @@ let check label path args ~checks = - shadow-pkg.flan, which is a package fragment with no main and does not link on its own. - The seven programs here that abort by design — error, exhausted-unhandled, + The programs here that abort by design — destroy-region, error, exhausted-unhandled, free-all-refused, map-stale-region, slurp-unhandled, stale-region — are kept. A trap is a controlled abort after an fprintf, and "the trap still @@ -246,6 +246,12 @@ let corpus = "programs/slurp.flan", []; "programs/slurp-unhandled.flan", []; "programs/stale-region.flan", []; + (* The same trap after arena-destroy, which read the freed allocator for + its epoch until the allocator was made to outlive its arena. *) + "programs/destroy-region.flan", []; + "programs/destroy-region.flan", [ "1" ]; + "programs/destroy-region.flan", [ "2" ]; + "programs/destroy-region.flan", [ "3"; "1000" ]; "programs/string-of-bytes.flan", []; "programs/text.flan", []; "programs/time.flan", []; diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index c6ad7e7b..2ca2aadb 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -813,6 +813,14 @@ static _Noreturn void die_now(void) { * all still there to be looked at, and only the resume is refused. That is * strictly more than the alternative, which was the whole process exiting * before anyone could ask a question. */ +/* Called on the stopped thread once per turn of the loop below, after the poll + * and before the loop looks for a choice — the same place a thunk the poll ran + * would be. It exists for test/agent_hooks.c and nothing else sets it: a + * request that lands inside a poll, or a break nested inside one, is a race + * against a two-millisecond sleep from outside the process, and from in here + * it is the same interleaving on every run. */ +void (*flan_agent_break_poll_hook)(void); + static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition, void *xfer, int resumable) { struct timespec step = { 0, 2000000 }; /* 2ms */ @@ -887,6 +895,7 @@ static void break_loop_at(const uint8_t *name, int64_t namelen, void *condition, } for (;;) { flan_agent_poll(); + if (flan_agent_break_poll_hook != NULL) flan_agent_break_poll_hook(); if (atomic_load(&aborting)) { fflush(stdout); fprintf(stderr, "flan: aborted at the break loop\n");