JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A dyn at, set-at or push that traps names the file, line and column it was written at

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 10:25:28 +07:00
parent 4d10f3c327
commit 5581bafacb
9 changed files with 231 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
TODO.org
View File

@ -1259,6 +1259,14 @@ Five words in every build rather than the spec's four, and for a stated reason:
redefinition module is built separately from its host and nothing makes the two 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 agree on a struct size. Give the reload path a way to carry the build flags and
this falls out. this falls out.
Decision needed first: a four-word release header means release builds no longer
trap on a released region (the epoch check is what reads the fifth word), where
today every build does. Checked 2026-09-25 and not contained either way: the
reload side is already consistent (modules and their hosts are both dev builds),
but the runtime C is compiled with no dev define, so the change is a
dev-conditional =flan_vec= in flan_rt.c, its mirror in flan_dyn.c and
test/dyn_ops.c, =%vec= and the Vec's size in both emitters and the debug info,
and the Map, whose header carries the same word.
** DONE arena-destroy under a live view reads freed memory ** DONE arena-destroy under a live view reads freed memory
CLOSED: [2026-09-25] CLOSED: [2026-09-25]
@ -1403,11 +1411,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 half is different work: the trap hook hands control to a session in-process with
the compiler, which can read the source. the compiler, which can read the source.
** TODO trap_oom has no site ** DONE trap_oom has no site
It is reached from the allocator, which has no site to be given. The range trap CLOSED: [2026-09-25]
already carries the location pair and every caller passes null, so giving =at=, =flan_dyn_at=, =flan_dyn_set_at= and =flan_dyn_push= take the call's site as
=set-at= and =push= a site is a call-site change rather than another round of ptr+len, like the arithmetic, and every trap they reach prints it — type, range,
signature churn. 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, reached through =view_len= from the
printers as well, stays siteless.
** TODO A restart has no location ** TODO A restart has no location
The restart frame is mirrored across both backends and the runtime, so giving The restart frame is mirrored across both backends and the runtime, so giving

9
lib/check.ml
View File

@ -3519,7 +3519,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let i = check ctx ~want:Types.Dyn idx in let i = check ctx ~want:Types.Dyn idx in
let v = check ctx ~want:Types.Dyn v in let v = check ctx ~want:Types.Dyn v in
expect ctx loc ~want 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 else begin
let p, pty = let p, pty =
match target.Tast.ty with match target.Tast.ty with
@ -3562,7 +3562,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
List.map List.map
(fun x -> (fun x ->
rt loc Types.Unit "flan_dyn_push" rt loc Types.Unit "flan_dyn_push"
[ vval; check ctx ~want:Types.Dyn x ]) [ vval; check ctx ~want:Types.Dyn x; here loc ])
items items
in in
mk loc Types.Dyn mk loc Types.Dyn
@ -7473,7 +7473,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
if target.Tast.ty = Types.Dyn then if target.Tast.ty = Types.Dyn then
expect ctx loc ~want expect ctx loc ~want
(rt loc Types.Unit "flan_dyn_push" (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 else begin
let elem = vec_elem loc "push" target.Tast.ty in let elem = vec_elem loc "push" target.Tast.ty in
let x = check ctx ~want:elem x in let x = check ctx ~want:elem x in
@ -8264,7 +8264,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
(match idx with (match idx with
| [ i ] -> | [ i ] ->
expect ctx loc ~want 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 fail loc
"(at ...) over a dyn takes one index — write (at (at x i) j)") "(at ...) over a dyn takes one index — write (at (at x i) j)")

8
lib/emit.ml
View File

@ -4230,7 +4230,7 @@ declare i64 @flan_dyn_kw(ptr, i64)
declare i64 @flan_dyn_map_get(i64, i64) declare i64 @flan_dyn_map_get(i64, i64)
declare void @flan_dyn_map_set(i64, i64, i64) declare void @flan_dyn_map_set(i64, i64, i64)
declare i64 @flan_dyn_map_contains(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 ; 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, ; program, and it used to print with no file and no line. [eq] never traps,
; so it has nowhere to put one. ; so it has nowhere to put one.
@ -4245,9 +4245,9 @@ declare i64 @flan_dyn_gt(i64, i64, ptr, i64)
declare i64 @flan_dyn_ge(i64, i64, ptr, i64) declare i64 @flan_dyn_ge(i64, i64, ptr, i64)
declare i64 @flan_dyn_eq(i64, i64) declare i64 @flan_dyn_eq(i64, i64)
declare i64 @flan_dyn_len(i64) declare i64 @flan_dyn_len(i64)
declare i64 @flan_dyn_at(i64, i64) declare i64 @flan_dyn_at(i64, i64, ptr, i64)
declare void @flan_dyn_set_at(i64, i64, i64) declare void @flan_dyn_set_at(i64, i64, i64, ptr, i64)
declare void @flan_dyn_push(i64, i64) declare void @flan_dyn_push(i64, i64, ptr, i64)
declare void @flan_dyn_print(i64) declare void @flan_dyn_print(i64)
declare void @flan_dyn_emit_dev(i64) declare void @flan_dyn_emit_dev(i64)
declare void @flan_dyn_emit_watch(i64) declare void @flan_dyn_emit_watch(i64)

102
runtime/flan_dyn.c
View File

@ -810,9 +810,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 * 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 * 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) * given a site (everything but the arithmetic, the ordering, [at], [set-at]
* pass NULL, and so does test/dyn_ops.c, which calls the runtime directly and * and [push]) pass NULL, and so does test/dyn_ops.c, which calls the runtime
* has no source position to offer. */ * directly and has no source position to offer. */
static void trap_where(const uint8_t *loc, int64_t loclen) { static void trap_where(const uint8_t *loc, int64_t loclen) {
if (loc != NULL && loclen > 0) if (loc != NULL && loclen > 0)
fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc); fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc);
@ -845,10 +845,7 @@ static _Noreturn void trap1(const uint8_t *loc, int64_t loclen,
#define TYPE_TRAP "DynType", 7 #define TYPE_TRAP "DynType", 7
#define ARITH_TRAP "DynArith", 8 #define ARITH_TRAP "DynArith", 8
/* No site reaches these two yet: [at], [set-at], [push] and the allocator /* [at] and [set-at]'s, with the site their call was written at. */
* 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. */
static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen, static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen,
const char *op, flan_dyn v, int64_t i, const char *op, flan_dyn v, int64_t i,
int64_t len) { int64_t len) {
@ -921,9 +918,16 @@ void flan_gc_collect(void) {
* not recoverable by anything this file can do. It takes the trap path like * 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 * 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 * the allocation quietly answering NULL and every caller below growing a null
* check for a case none of them can handle. */ * check for a case none of them can handle.
static _Noreturn void trap_oom(int64_t want) { *
* [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); fflush(stdout);
trap_where(loc, loclen);
fprintf(stderr, fprintf(stderr,
"dyn heap: %lld bytes could not be allocated, with %lld live\n", "dyn heap: %lld bytes could not be allocated, with %lld live\n",
(long long)want, (long long)gc_bytes); (long long)want, (long long)gc_bytes);
@ -936,7 +940,7 @@ static flan_obj *gc_alloc(uint8_t kind, int64_t extra) {
if (!gc_ready) flan_gc_init(); if (!gc_ready) flan_gc_init();
if (gc_bytes + need > gc_next) flan_gc_collect(); if (gc_bytes + need > gc_next) flan_gc_collect();
o = (flan_obj *)malloc((size_t)need); 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->next = gc_all;
o->kind = kind; o->kind = kind;
o->mark = 0; o->mark = 0;
@ -972,7 +976,7 @@ static void mark_push(flan_obj *o) {
if (mstack_n == mstack_cap) { if (mstack_n == mstack_cap) {
int64_t cap = mstack_cap ? mstack_cap * 2 : 64; int64_t cap = mstack_cap ? mstack_cap * 2 : 64;
flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m); 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 = m;
mstack_cap = cap; mstack_cap = cap;
} }
@ -1032,7 +1036,7 @@ static void root_add(void *base, const flan_desc *d) {
if (roots_n == roots_cap) { if (roots_n == roots_cap) {
int64_t cap = roots_cap ? roots_cap * 2 : 64; int64_t cap = roots_cap ? roots_cap * 2 : 64;
flan_root *r = (flan_root *)realloc(roots, (size_t)cap * sizeof *r); 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 = r;
roots_cap = cap; roots_cap = cap;
} }
@ -1274,7 +1278,7 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
} }
if (count > 0) { if (count > 0) {
list = (kw_entry **)malloc((size_t)count * sizeof *list); 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; count = 0;
for (i = 0, start = 0; i <= n; i++) for (i = 0, start = 0; i <= n; i++)
if (i == n ? i > start : slots[i] == '\n') { if (i == n ? i > start : slots[i] == '\n') {
@ -1304,7 +1308,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; int64_t cap = classes_cap ? classes_cap * 2 : 8;
class_entry *t = class_entry *t =
(class_entry *)realloc(classes, (size_t)cap * sizeof *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 = t;
classes_cap = cap; classes_cap = cap;
} }
@ -1349,7 +1353,7 @@ static void class_sync(flan_obj *o) {
if (e == NULL || e->gen == o->gen) return; if (e == NULL || e->gen == o->gen) return;
if (e->nslots > 0) { if (e->nslots > 0) {
fresh = (flan_dyn *)malloc((size_t)e->nslots * 2 * sizeof *fresh); 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++) { for (j = 0; j < e->nslots; j++) {
flan_dyn v = dyn_make(BOX_NIL, 0); flan_dyn v = dyn_make(BOX_NIL, 0);
@ -1442,12 +1446,12 @@ flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n) {
if (kws_n == kws_cap) { if (kws_n == kws_cap) {
int64_t cap = kws_cap ? kws_cap * 2 : 32; int64_t cap = kws_cap ? kws_cap * 2 : 32;
kw_entry **t = (kw_entry **)realloc(kws, (size_t)cap * sizeof *t); 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 = t;
kws_cap = cap; kws_cap = cap;
} }
k = (kw_entry *)malloc(sizeof(kw_entry) + (size_t)n); 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; k->len = n;
if (n > 0) memcpy(kw_bytes(k), p, (size_t)n); if (n > 0) memcpy(kw_bytes(k), p, (size_t)n);
kws[kws_n++] = k; kws[kws_n++] = k;
@ -2042,13 +2046,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 * 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 * truncates a mismatched value into the slot. [v] is the view, for the
* sentence's container half; [x] is the value that was refused. */ * 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, static void view_unbox(const uint8_t *loc, int64_t loclen, const char *op,
uint8_t *p) { flan_dyn v, int32_t elem, flan_dyn x, uint8_t *p) {
switch (elem) { switch (elem) {
case FLAN_VIEW_I64: { case FLAN_VIEW_I64: {
int64_t n; int64_t n;
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) 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); n = dyn_int_value(x);
memcpy(p, &n, 8); memcpy(p, &n, 8);
return; return;
@ -2056,7 +2060,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x,
case FLAN_VIEW_F64: { case FLAN_VIEW_F64: {
double d; double d;
if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) 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); d = dyn_num_value(x);
memcpy(p, &d, 8); memcpy(p, &d, 8);
return; return;
@ -2064,7 +2068,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x,
default: { default: {
uint8_t b; uint8_t b;
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) 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; b = dyn_payload(x) ? 1 : 0;
*p = b; *p = b;
return; return;
@ -2111,81 +2115,89 @@ flan_dyn flan_dyn_len(flan_dyn v) {
/* The index has to be an int, and that is a separate sentence from the /* 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 * container being wrong: (at v "1") and (at 3 1) are two different mistakes
* and telling somebody "these are the wrong types" names neither. */ * 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) 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); return dyn_int_value(i);
} }
/* A text answers a byte, as an int. That is what [(at s i)] on a /* 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 * [(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. */ * 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; int64_t k;
flan_obj *o; flan_obj *o;
if (!is_text(v) && !is_vec(v)) if (!is_text(v) && !is_vec(v))
trap2(NULL, 0, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); trap2(loc, loclen, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i);
k = need_index("at", v, i); k = need_index(loc, loclen, "at", v, i);
o = dyn_obj(v); o = dyn_obj(v);
if (o->kind == OBJ_VIEW) { if (o->kind == OBJ_VIEW) {
int64_t len = view_len("at", o); int64_t len = view_len("at", o);
if (k < 0 || k >= len) trap_range(NULL, 0, "at", v, k, len); if (k < 0 || k >= len) trap_range(loc, loclen, "at", v, k, len);
return view_box(o->u.view.elem, return view_box(o->u.view.elem,
(const uint8_t *)view_base(o) + k * view_elem_size(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]); if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]);
return o->u.v.items[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; int64_t k;
flan_obj *o; flan_obj *o;
if (is_text(v)) 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)) if (!is_vec(v))
trap2(NULL, 0, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); trap2(loc, loclen, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i);
k = need_index("set-at", v, i); k = need_index(loc, loclen, "set-at", v, i);
o = dyn_obj(v); o = dyn_obj(v);
if (o->kind == OBJ_VIEW) { if (o->kind == OBJ_VIEW) {
int64_t len = view_len("set-at", o); int64_t len = view_len("set-at", o);
uint8_t *p; 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); 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; 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; 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; flan_obj *o;
if (!is_vec(v)) { if (!is_vec(v)) {
/* The value is in the sentence rather than the vec, because the vec is the /* 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. */ * 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); o = dyn_obj(v);
if (o->kind == OBJ_VIEW) { if (o->kind == OBJ_VIEW) {
uint8_t buf[8]; 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)"; 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; int64_t size;
if (!o->u.view.is_vec) 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); "this view is a slice or an array and cannot grow", v, x);
size = view_elem_size(o->u.view.elem); size = view_elem_size(o->u.view.elem);
view_unbox("push", v, o->u.view.elem, x, buf); view_unbox(loc, loclen, "push", v, o->u.view.elem, x, buf);
if (!flan_vec_push(o->u.view.base, buf, size, size, push_loc, if (!flan_vec_push(o->u.view.base, buf, size, size, site, sitelen))
(int64_t)sizeof(push_loc) - 1)) trap_oom(loc, loclen, size);
trap_oom(size);
return; return;
} }
if (o->len == o->u.v.cap) { if (o->len == o->u.v.cap) {
int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8; int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8;
flan_dyn *items = flan_dyn *items =
(flan_dyn *)realloc(o->u.v.items, (size_t)cap * sizeof *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 /* 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 * charged *here* rather than at the next collection because a vec that
* doubles a dozen times between allocations would otherwise be invisible * doubles a dozen times between allocations would otherwise be invisible
@ -2260,7 +2272,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; int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8;
flan_dyn *items = flan_dyn *items =
(flan_dyn *)realloc(o->u.v.items, (size_t)cap * 2 * sizeof *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 /* Charged now for the reason push's growth is: the trigger has to see
* the block while it is growing, not after. */ * the block while it is growing, not after. */
gc_bytes += (cap - o->u.v.cap) * 2 * (int64_t)sizeof *items; gc_bytes += (cap - o->u.v.cap) * 2 * (int64_t)sizeof *items;

12
runtime/flan_dyn.h
View File

@ -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. */ /* Bytes of a text, elements of a vec. Anything else traps. */
flan_dyn flan_dyn_len(flan_dyn v); 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. */ /* 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); * [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. */ /* 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_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
void flan_dyn_push(flan_dyn v, flan_dyn x); 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 /* 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 * key is compared structurally, so a keyword, a text, an int, or a whole map

11
runtime/flan_dyn_stub.c
View File

@ -263,21 +263,26 @@ flan_dyn flan_dyn_len(flan_dyn v) {
return flan_dyn_from_i64(need_vec(v)->u.v.len); return flan_dyn_from_i64(need_vec(v)->u.v.len);
} }
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) {
(void)loc; (void)loclen;
cell *c = need_vec(v); cell *c = need_vec(v);
int64_t k = need_index(i); int64_t k = need_index(i);
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds"); if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
return word(c->u.v.items[k]); return word(c->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) {
(void)loc; (void)loclen;
cell *c = need_vec(v); cell *c = need_vec(v);
int64_t k = need_index(i); int64_t k = need_index(i);
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds"); if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
c->u.v.items[k] = as(x); c->u.v.items[k] = as(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) {
(void)loc; (void)loclen;
cell *c = need_vec(v); cell *c = need_vec(v);
if (c->u.v.len == c->u.v.cap) { if (c->u.v.len == c->u.v.cap) {
int64_t cap = c->u.v.cap * 2; int64_t cap = c->u.v.cap * 2;

181
test/dyn_ops.c
View File

@ -40,10 +40,13 @@
* rather than a hand-copied list. */ * rather than a hand-copied list. */
#include "flan_dyn.h" #include "flan_dyn.h"
/* The nine trapping operators took a site — (loc, len) — when flan_dyn.c's /* The trapping operators take a site — (loc, len) — which flan_dyn.c's traps
* traps learned to print a file and a line. This file calls the runtime * print as a file and a line. This file calls the runtime directly and has no
* directly and has no source position to offer, so it passes (NULL, 0), which * source position to offer, so it passes (NULL, 0), which prints the sentence
* prints the sentence exactly as it printed before. */ * 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_add(a, b) flan_dyn_add((a), (b), NULL, 0)
#define FDYN_sub(a, b) flan_dyn_sub((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) #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, c)), "= text sees the last byte");
check(truth(flan_dyn_eq(a, a)), "= text against itself"); check(truth(flan_dyn_eq(a, a)), "= text against itself");
check(num(flan_dyn_len(a)) == 5, "len text"); 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(FDYN_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(4))) == 'o', "at text last");
{ {
/* Embedded NUL, because a length-prefixed text is the claim and strlen is /* Embedded NUL, because a length-prefixed text is the claim and strlen is
how that claim gets quietly broken. */ how that claim gets quietly broken. */
flan_dyn z = flan_dyn_from_bytes((const uint8_t *)"a\0b", 3); 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_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"); check(!truth(flan_dyn_eq(z, text("a"))), "= does not stop at a NUL");
} }
{ {
@ -264,13 +267,13 @@ static void ops(void) {
/* Vecs. */ /* Vecs. */
v = flan_dyn_vec_new(); v = flan_dyn_vec_new();
check(num(flan_dyn_len(v)) == 0, "len of a new vec"); check(num(flan_dyn_len(v)) == 0, "len of a new vec");
flan_dyn_push(v, flan_dyn_from_i64(1)); FDYN_push(v, flan_dyn_from_i64(1));
flan_dyn_push(v, flan_dyn_from_i64(2)); FDYN_push(v, flan_dyn_from_i64(2));
flan_dyn_push(v, flan_dyn_from_i64(3)); FDYN_push(v, flan_dyn_from_i64(3));
check(num(flan_dyn_len(v)) == 3, "len after three pushes"); 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"); check(num(FDYN_at(v, flan_dyn_from_i64(1))) == 2, "at vec");
flan_dyn_set_at(v, flan_dyn_from_i64(1), text("two")); FDYN_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(truth(flan_dyn_eq(FDYN_at(v, flan_dyn_from_i64(1)), text("two"))),
"set-at vec"); "set-at vec");
{ {
/* Past the initial capacity, so the growth path runs and the elements /* Past the initial capacity, so the growth path runs and the elements
@ -278,10 +281,10 @@ static void ops(void) {
int i; int i;
flan_dyn big = flan_dyn_vec_new(); flan_dyn big = flan_dyn_vec_new();
flan_dyn_root_push(&big); 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_len(big)) == 100, "len after a hundred pushes");
check(num(flan_dyn_at(big, flan_dyn_from_i64(0))) == 0, "first survived"); check(num(FDYN_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(99))) == 99, "last survived");
flan_dyn_root_pop(1); 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 p = flan_dyn_vec_new(), q = flan_dyn_vec_new();
flan_dyn_root_push(&p); flan_dyn_root_push(&p);
flan_dyn_root_push(&q); flan_dyn_root_push(&q);
flan_dyn_push(p, flan_dyn_from_i64(1)); FDYN_push(p, flan_dyn_from_i64(1));
flan_dyn_push(p, text("x")); FDYN_push(p, text("x"));
flan_dyn_push(q, flan_dyn_from_i64(1)); FDYN_push(q, flan_dyn_from_i64(1));
flan_dyn_push(q, text("x")); FDYN_push(q, text("x"));
check(p != q, "two vecs are two objects"); check(p != q, "two vecs are two objects");
check(truth(flan_dyn_eq(p, q)), "= vec is element by element"); 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"); check(!truth(flan_dyn_eq(p, q)), "= vec sees the length");
flan_dyn_root_pop(2); flan_dyn_root_pop(2);
} }
@ -307,8 +310,8 @@ static void ops(void) {
{ {
flan_dyn cyc = flan_dyn_vec_new(); flan_dyn cyc = flan_dyn_vec_new();
flan_dyn_root_push(&cyc); flan_dyn_root_push(&cyc);
flan_dyn_push(cyc, flan_dyn_from_i64(1)); FDYN_push(cyc, flan_dyn_from_i64(1));
flan_dyn_push(cyc, cyc); FDYN_push(cyc, cyc);
check(truth(flan_dyn_eq(cyc, cyc)), "= on a cycle answers"); check(truth(flan_dyn_eq(cyc, cyc)), "= on a cycle answers");
show(cyc); show(cyc);
check(strlen(shown) > 0 && strstr(shown, "...") != NULL, check(strlen(shown) > 0 && strstr(shown, "...") != NULL,
@ -335,23 +338,23 @@ static void ops(void) {
flan_dyn strs = flan_dyn_vec_new(); flan_dyn strs = flan_dyn_vec_new();
flan_dyn_root_push(&nums); flan_dyn_root_push(&nums);
flan_dyn_root_push(&strs); flan_dyn_root_push(&strs);
flan_dyn_push(nums, flan_dyn_from_i64(1)); FDYN_push(nums, flan_dyn_from_i64(1));
flan_dyn_push(nums, flan_dyn_from_i64(2)); FDYN_push(nums, flan_dyn_from_i64(2));
flan_dyn_push(nums, flan_dyn_from_i64(3)); FDYN_push(nums, flan_dyn_from_i64(3));
prints(nums, "[ 1 2 3]"); prints(nums, "[ 1 2 3]");
/* A text inside a structure is quoted and escaped, and bare at the top /* 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 level. That is flan_rt.c's rule and the two have to agree, because the
REPL parses the printed form back. */ REPL parses the printed form back. */
flan_dyn_push(strs, text("x")); FDYN_push(strs, text("x"));
flan_dyn_push(strs, text("a b")); FDYN_push(strs, text("a b"));
flan_dyn_push(strs, text("q\"\n")); FDYN_push(strs, text("q\"\n"));
prints(strs, "[ \"x\" \"a b\" \"q\\\"\\n\"]"); prints(strs, "[ \"x\" \"a b\" \"q\\\"\\n\"]");
/* And a vec of vecs, nested twice. */ /* And a vec of vecs, nested twice. */
{ {
flan_dyn outer = flan_dyn_vec_new(); flan_dyn outer = flan_dyn_vec_new();
flan_dyn_root_push(&outer); flan_dyn_root_push(&outer);
flan_dyn_push(outer, nums); FDYN_push(outer, nums);
flan_dyn_push(outer, strs); FDYN_push(outer, strs);
prints(outer, "[ [ 1 2 3] [ \"x\" \"a b\" \"q\\\"\\n\"]]"); prints(outer, "[ [ 1 2 3] [ \"x\" \"a b\" \"q\\\"\\n\"]]");
flan_dyn_root_pop(1); flan_dyn_root_pop(1);
} }
@ -430,11 +433,11 @@ static void view(void) {
flat = flan_dyn_view_flat(buf, 4, FLAN_VIEW_I64); 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(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_len(flat)) == 4, "flat view len");
check(num(flan_dyn_at(flat, flan_dyn_from_i64(2))) == 30, "flat view at"); check(num(FDYN_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)); FDYN_set_at(flat, flan_dyn_from_i64(2), flan_dyn_from_i64(99));
check(buf[2] == 99, "flat view write reaches the array"); check(buf[2] == 99, "flat view write reaches the array");
buf[3] = 7; 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"); "the array's own write reaches the view — it is not a copy");
prints(flat, "[ 10 20 99 7]"); prints(flat, "[ 10 20 99 7]");
@ -458,13 +461,13 @@ static void view(void) {
"two views over equal bytes are equal"); "two views over equal bytes are equal");
check(!truth(flan_dyn_eq(flat, other)), check(!truth(flan_dyn_eq(flat, other)),
"two views over different bytes are not equal"); "two views over different bytes are not equal");
flan_dyn_push(heap, flan_dyn_from_i64(10)); FDYN_push(heap, flan_dyn_from_i64(10));
flan_dyn_push(heap, flan_dyn_from_i64(20)); FDYN_push(heap, flan_dyn_from_i64(20));
flan_dyn_push(heap, flan_dyn_from_i64(99)); FDYN_push(heap, flan_dyn_from_i64(99));
flan_dyn_push(heap, flan_dyn_from_i64(7)); FDYN_push(heap, flan_dyn_from_i64(7));
check(truth(flan_dyn_eq(flat, heap)), check(truth(flan_dyn_eq(flat, heap)),
"a view and an equal heap vec are equal"); "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)), check(!truth(flan_dyn_eq(flat, heap)),
"a view and a differing heap vec are not equal"); "a view and a differing heap vec are not equal");
flan_dyn_root_pop(3); flan_dyn_root_pop(3);
@ -480,17 +483,17 @@ static void view(void) {
check(num(flan_dyn_len(vv)) == 0, "vec view starts empty"); check(num(flan_dyn_len(vv)) == 0, "vec view starts empty");
{ {
int i; 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_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"); "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"); "pushed element reachable after the header's ptr moved");
/* [hv]'s own fields moved under the view's feet, by construction — the /* [hv]'s own fields moved under the view's feet, by construction — the
view never captured [hv.ptr]; it captured [&hv]. */ view never captured [hv.ptr]; it captured [&hv]. */
check(hv.len == 20 && hv.cap >= 20, "the hand-built header itself grew"); 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"); check(((int64_t *)hv.ptr)[0] == -1, "write through the view reaches hv");
flan_vec_free(&hv, 8, 8, (const uint8_t *)"view", 4); 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 }; double floats[2] = { 1.5, -2.0 };
flan_dyn bv = flan_dyn_view_flat(bools, 2, FLAN_VIEW_BOOL); flan_dyn bv = flan_dyn_view_flat(bools, 2, FLAN_VIEW_BOOL);
flan_dyn fv = flan_dyn_view_flat(floats, 2, FLAN_VIEW_F64); 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(FDYN_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"); check(!truth(FDYN_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)); FDYN_set_at(bv, flan_dyn_from_i64(1), flan_dyn_from_bool(1));
check(bools[1] == 1, "bool view write"); 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"); "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"); check(floats[0] == 3.25, "float view write");
} }
@ -524,21 +527,21 @@ static void refuse_view(const char *what) {
flan_dyn v; flan_dyn v;
if (strcmp(what, "range") == 0) { if (strcmp(what, "range") == 0) {
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64); 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) { } else if (strcmp(what, "wrongwrite") == 0) {
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64); 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) { } else if (strcmp(what, "wrongbool") == 0) {
static uint8_t bb[1]; static uint8_t bb[1];
v = flan_dyn_view_flat(bb, 1, FLAN_VIEW_BOOL); 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) { } else if (strcmp(what, "wrongfloat") == 0) {
static double ff[1]; static double ff[1];
v = flan_dyn_view_flat(ff, 1, FLAN_VIEW_F64); 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) { } else if (strcmp(what, "flatpush") == 0) {
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64); 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) { } else if (strcmp(what, "stalelen") == 0) {
/* A Vec view whose allocator has moved on, asked for its length. The /* 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 * 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_gc_set_floor(64 * 1024);
flan_dyn_root_push(&keep); flan_dyn_root_push(&keep);
keep = flan_dyn_vec_new(); 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++) { for (i = 0; i < ROUNDS; i++) {
char buf[32]; char buf[32];
int n = snprintf(buf, sizeof buf, "item-%lld", (long long)i); 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)); flan_dyn_from_bytes((const uint8_t *)buf, n));
if (flan_gc_live_bytes() > peak) peak = flan_gc_live_bytes(); if (flan_gc_live_bytes() > peak) peak = flan_gc_live_bytes();
} }
@ -654,7 +657,7 @@ static void gc(void) {
char buf[32]; char buf[32];
int64_t k = ROUNDS - LIVE + i; int64_t k = ROUNDS - LIVE + i;
int n = snprintf(buf, sizeof buf, "item-%lld", (long long)k); 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( if (!flan_dyn_need_bool(
flan_dyn_eq(got, flan_dyn_from_bytes((const uint8_t *)buf, n)))) flan_dyn_eq(got, flan_dyn_from_bytes((const uint8_t *)buf, n))))
intact = 0; intact = 0;
@ -683,11 +686,11 @@ static void nested(void) {
cur = root; cur = root;
for (i = 0; i < DEEP; i++) { for (i = 0; i < DEEP; i++) {
flan_dyn inner = flan_dyn_vec_new(); flan_dyn inner = flan_dyn_vec_new();
flan_dyn_push(cur, flan_dyn_from_i64(i)); FDYN_push(cur, flan_dyn_from_i64(i));
flan_dyn_push(cur, inner); FDYN_push(cur, inner);
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 /* Churn, so that collections certainly happen with the chain live, and then
one more by hand. */ one more by hand. */
@ -696,11 +699,11 @@ static void nested(void) {
cur = root; cur = root;
for (i = 0; i < DEEP; i++) { for (i = 0; i < DEEP; i++) {
if (flan_dyn_need_i64(flan_dyn_at(cur, flan_dyn_from_i64(0))) != i) ok = 0; if (flan_dyn_need_i64(FDYN_at(cur, flan_dyn_from_i64(0))) != i) ok = 0;
cur = flan_dyn_at(cur, flan_dyn_from_i64(1)); cur = FDYN_at(cur, flan_dyn_from_i64(1));
} }
if (!flan_dyn_need_bool( 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; ok = 0;
printf("chain of %d intact: %s\n", DEEP, ok ? "yes" : "no"); printf("chain of %d intact: %s\n", DEEP, ok ? "yes" : "no");
flan_dyn_root_pop(1); flan_dyn_root_pop(1);
@ -724,26 +727,26 @@ static void sharing(void) {
holder = flan_dyn_vec_new(); holder = flan_dyn_vec_new();
shared = flan_dyn_vec_new(); shared = flan_dyn_vec_new();
flan_dyn_push(shared, text("a")); FDYN_push(shared, text("a"));
flan_dyn_push(holder, shared); FDYN_push(holder, shared);
flan_dyn_push(holder, shared); FDYN_push(holder, shared);
flan_dyn_push(holder, shared); FDYN_push(holder, shared);
/* Three slots, one object. Identity and not equality: two vecs holding the /* 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 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 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. */ vec *is* its address, so comparing the words is comparing the objects. */
printf("three slots hold one object: %s\n", printf("three slots hold one object: %s\n",
flan_dyn_at(holder, flan_dyn_from_i64(0)) FDYN_at(holder, flan_dyn_from_i64(0))
== flan_dyn_at(holder, flan_dyn_from_i64(2)) == FDYN_at(holder, flan_dyn_from_i64(2))
? "yes" : "no"); ? "yes" : "no");
/* And writing through one path is read through another. */ /* 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")); flan_dyn_from_i64(0), text("b"));
printf("write through one path is seen through another: %s\n", printf("write through one path is seen through another: %s\n",
flan_dyn_need_bool( 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)), flan_dyn_from_i64(0)),
text("b"))) text("b")))
? "yes" : "no"); ? "yes" : "no");
@ -759,10 +762,10 @@ static void sharing(void) {
for (i = 0; i < 5000; i++) (void)text("noise"); for (i = 0; i < 5000; i++) (void)text("noise");
flan_gc_collect(); flan_gc_collect();
printf("shared object survives on the holder alone: %s\n", 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", printf("still reachable: %s\n",
flan_dyn_need_bool( 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)), flan_dyn_from_i64(0)),
text("b"))) text("b")))
? "yes" : "no"); ? "yes" : "no");
@ -839,7 +842,7 @@ static void park(void) {
config = text("hello"); config = text("hello");
flan_dyn_root_push(&frame); flan_dyn_root_push(&frame);
frame = flan_dyn_vec_new(); 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(); flan_gc_collect();
before = flan_gc_count(); before = flan_gc_count();
@ -914,10 +917,10 @@ static void desc(void) {
flan_dyn_root_push_desc(&row, &row_desc); flan_dyn_root_push_desc(&row, &row_desc);
row.label = flan_dyn_vec_new(); 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.inner.note = text("nested");
row.tail = flan_dyn_vec_new(); 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_label = row.label;
was_note = row.inner.note; 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 (row.label != was_label || row.inner.note != was_note) ok = 0;
if (!flan_dyn_need_bool( 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; text("held")))) ok = 0;
if (!flan_dyn_need_bool(flan_dyn_eq(row.inner.note, text("nested")))) 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; ok = 0;
printf("aggregate root survives collection: %s\n", ok ? "yes" : "no"); printf("aggregate root survives collection: %s\n", ok ? "yes" : "no");
@ -949,7 +952,7 @@ static void desc(void) {
question is about. */ question is about. */
flan_dyn_root_push(&row.hidden); flan_dyn_root_push(&row.hidden);
row.hidden = flan_dyn_vec_new(); 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); flan_dyn_root_pop(1);
for (i = 0; i < 200; i++) (void)text("noise"); for (i = 0; i < 200; i++) (void)text("noise");
flan_gc_collect(); 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)); (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, "len") == 0) (void)flan_dyn_len(flan_dyn_from_i64(1));
else if (strcmp(what, "at") == 0) else if (strcmp(what, "at") == 0)
(void)flan_dyn_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0)); (void)FDYN_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, "atindex") == 0) (void)FDYN_at(t, t);
else if (strcmp(what, "atrange") == 0) 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) 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) 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) 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) else if (strcmp(what, "setatrange") == 0)
flan_dyn_set_at(v, flan_dyn_from_i64(0), t); FDYN_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, "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, "needi64") == 0) (void)flan_dyn_need_i64(t);
else if (strcmp(what, "needf64") == 0) else if (strcmp(what, "needf64") == 0)
(void)flan_dyn_need_f64(flan_dyn_from_i64(1)); (void)flan_dyn_need_f64(flan_dyn_from_i64(1));
@ -1208,10 +1211,10 @@ static void classes(void) {
flan_gc_set_floor(16 * 1024); flan_gc_set_floor(16 * 1024);
define("point", "x\ny"); define("point", "x\ny");
keep = flan_dyn_vec_new(); 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"); define("point", "y\nx\ndeep");
for (i = 0; i < 2000; i++) { 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 /* Allocation between each migration, so a collection lands part-way
through the set and has both shapes to mark. */ through the set and has both shapes to mark. */
flan_dyn_map_set(e, flan_dyn_kw((const uint8_t *)"deep", 4), flan_dyn_map_set(e, flan_dyn_kw((const uint8_t *)"deep", 4),
@ -1221,7 +1224,7 @@ static void classes(void) {
{ {
int ok = 1; int ok = 1;
for (i = 0; i < 2000; i++) { 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 (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 (flan_dyn_tag(slot(e, "deep")) != FLAN_DYN_TAG_VEC) ok = 0;
if (num(flan_dyn_len(e)) != 3) ok = 0; if (num(flan_dyn_len(e)) != 3) ok = 0;

17
test/programs/dyn-index-site.flan Normal file
View File

@ -0,0 +1,17 @@
;;;; 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.
(defn main [args [string]] i32
(let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0)
v (vec-new dyn)]
(push v 1)
(println "before")
(cond
(= which 0) (println (at v 5))
(= which 1) (set (at v 5) 2)
:else (let [n (at v 0)] (push n 3))))
0)

24
test/test_acceptance.ml
View File

@ -4807,6 +4807,30 @@ level "1"
trap_site ~opt:"-O0" (); trap_site ~opt:"-O0" ();
trap_site ~x86:true (); 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:14:28: dyn at: index 5 is out of bounds");
("1", "dyn-index-site.flan:15:19: dyn set-at: index 5 is out of bounds");
("2", "dyn-index-site.flan:16:31: dyn push: int and int") ];
(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 (* 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 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 behaviours are one story told in order: the same-kind casts print, the