A dyn view's record is collected with it, a dev build ties a view of a stack address to its owning frame and finds a heap block through an address index, and a view's traps name the field, the operation and the site.
This commit is contained in:
parent
7991e00e76
commit
497c9f470f
@ -3076,10 +3076,15 @@ A typed container crosses into dyn as a view of its storage wherever that storag
|
||||
- `check.ml`'s `frame_root` says when the storage is the calling function's own frame — a local, a parameter, a
|
||||
field or array element of one, a slice cut straight from a local array, or a temporary `box` bound to a slot of its
|
||||
own — and passes that as the view's `here` flag.
|
||||
- `emit.ml` and `x86.ml` zero a `serial` word in every shadow frame at the push.
|
||||
- `emit.ml` and `x86.ml` zero a `serial` word in every shadow frame at the push, and store the frame's address
|
||||
(`llvm.frameaddress`, or `rbp`).
|
||||
- `flan_dyn.c`'s `view_make` claims a serial for the frame at the crossing (`flan_dev_frame_claim`, which numbers a
|
||||
frame once) and keeps the frame's address, its serial and the function's name. Otherwise it asks the allocation
|
||||
registry for the smallest live block holding the address and keeps that block's base and note sequence.
|
||||
frame once) and keeps the frame's address, its serial and the function's name. Without `here` it first asks
|
||||
`flan_dev_frame_owner` whether the address is on the stack: every local of a frame lies below that frame's address
|
||||
and above everything its callees push, so the owner is the innermost frame whose address is above it. That is how a
|
||||
slice of a local, or a slice parameter over a caller's array, is tied to the right activation. Otherwise it asks
|
||||
the allocation registry, through its address index (64 KiB chunks to the bases that overlap them), for the
|
||||
smallest live block holding the address and keeps that block's base and note sequence.
|
||||
- Every read or write checks first. A frame is alive when it is still on the chain from `flan_frame_head` *and* has
|
||||
the same serial: the walk is needed because dead stack keeps its old bytes, serial included, and the serial is
|
||||
needed because the next call at the same depth lands at the same address. A block is alive when the registry probe
|
||||
@ -3088,8 +3093,8 @@ A typed container crosses into dyn as a view of its storage wherever that storag
|
||||
|
||||
A view's aggregate element inherits its parent's record, except inside a `Vec` (checked against the `Vec`'s block,
|
||||
since growth moves it) and through a slice (looked up afresh). What neither table knows is not checked: a global,
|
||||
rodata, C memory, and a caller's local reached through a slice parameter. That last one is deliberate — stamping it
|
||||
with the callee's frame would trap on a live array after the callee returns. A release build records nothing and
|
||||
rodata, C memory. Nor is a local's scope inside a live frame: a view of a `let` that has ended, whose slot a later
|
||||
`let` in the same call reuses, reads the new value. A release build records nothing and
|
||||
checks nothing; a stale view there reads whatever the memory holds now. One case is refused at compile time instead:
|
||||
a dyn global's initialiser taking a view of what it built, which is gone before anything can read it.
|
||||
|
||||
|
||||
23
lib/check.ml
23
lib/check.ml
@ -3759,11 +3759,10 @@ let view_not_yet loc (e : Tast.expr) (inner : Types.t) =
|
||||
activation and traps if the view is used after the call returns. A local,
|
||||
a parameter (copied into the frame, an array parameter too), a field or
|
||||
an array element of one, a slice cut directly from a local array, and a
|
||||
temporary [box] has bound to a slot of its own are all the frame's. A
|
||||
slice's data, and anything reached through a [Ptr] or a global, is not:
|
||||
there the runtime looks the address up in the allocation registry instead,
|
||||
and storage the registry does not know — a global, or a caller's local
|
||||
seen through a slice parameter — is not checked. *)
|
||||
temporary [box] has bound to a slot of its own are all the frame's. For
|
||||
anything else — a slice's data, a [Ptr]'s target, a global — the dev
|
||||
runtime finds the frame that owns a stack address by the address itself,
|
||||
or else the registry block that holds it. *)
|
||||
let rec frame_root (e : Tast.expr) : bool =
|
||||
let rec all_array ty = function
|
||||
| [] -> true
|
||||
@ -4348,7 +4347,8 @@ let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
(* [=] over a dyn pair, answering a bool. Shared by the [=] builtin and a
|
||||
literal [match] over a dyn, which is (= t lit) by definition. *)
|
||||
let dyn_eq loc u v =
|
||||
unbox loc Types.Bool (rt loc Types.Dyn "flan_dyn_eq" [ box loc u; box loc v ])
|
||||
unbox loc Types.Bool
|
||||
(rt loc Types.Dyn "flan_dyn_eq_at" [ box loc u; box loc v; here loc ])
|
||||
|
||||
let unbox_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
let oty = Types.Option t in
|
||||
@ -10908,7 +10908,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
| "<" -> "flan_dyn_lt" | "<=" -> "flan_dyn_le"
|
||||
| ">" -> "flan_dyn_gt" | _ -> "flan_dyn_ge"
|
||||
in
|
||||
(* [eq] never traps and takes no site; the four orderings do, and get
|
||||
(* [eq] traps only on a view whose storage is gone, and [dyn_eq] gives
|
||||
it the site for that; the four orderings trap on a mismatch, and get
|
||||
one, for the reason [dyn_fold] gives. Every pair of a chain gets the
|
||||
same site — the whole comparison is written at one place, and a trap
|
||||
from any of its pairs happened there. *)
|
||||
@ -12105,8 +12106,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
if target.Tast.ty = Types.Dyn then
|
||||
expect ctx loc ~want
|
||||
(unbox loc Types.Bool
|
||||
(rt loc Types.Dyn "flan_dyn_map_contains"
|
||||
[ target; check ctx ~want:Types.Dyn k ]))
|
||||
(rt loc Types.Dyn "flan_dyn_map_contains_at"
|
||||
[ target; check ctx ~want:Types.Dyn k; here loc ]))
|
||||
else begin
|
||||
let kt, vt = map_kv loc "has-key?" target.Tast.ty in
|
||||
let k = check ctx ~want:kt k in
|
||||
@ -12432,7 +12433,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
pair of allocations per iteration. The runtime answers a dyn; it is unboxed at
|
||||
once and narrowed the way the Vec's i64 above is. *)
|
||||
| Types.Dyn ->
|
||||
let n = unbox loc (Types.Int Types.I64) (rt loc Types.Dyn "flan_dyn_len" [ a ]) in
|
||||
let n = unbox loc (Types.Int Types.I64) (rt loc Types.Dyn "flan_dyn_len_at" [ a; here loc ]) in
|
||||
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
||||
| other ->
|
||||
fail loc
|
||||
@ -12957,7 +12958,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
ei64 = (fun x -> write (conv Tast.I64ToBytes x));
|
||||
eu64 = (fun x -> write (conv Tast.U64ToBytes x));
|
||||
ef64 = (fun x -> write (conv Tast.F64ToBytes x));
|
||||
edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print", [ x ]))) }
|
||||
edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_at", [ x; here loc ]))) }
|
||||
in
|
||||
let rc = render_ctx ctx emitter in
|
||||
let render_one a =
|
||||
|
||||
16
lib/emit.ml
16
lib/emit.ml
@ -251,7 +251,7 @@ module Rt = struct
|
||||
let flanframe =
|
||||
{ sname = "flanframe";
|
||||
fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr;
|
||||
"serial", I64 ] }
|
||||
"serial", I64; "fp", Ptr ] }
|
||||
|
||||
let align_up n a = (n + a - 1) / a * a
|
||||
|
||||
@ -4481,6 +4481,15 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
|
||||
"%%frame.n = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "serial");
|
||||
"store i64 0, ptr %frame.n";
|
||||
(* The frame address: every local lies below it, so the dev runtime
|
||||
can tell which frame a stack address belongs to
|
||||
([flan_dev_frame_owner]). Asking for it keeps this function's
|
||||
frame pointer, which only a dev build pays. *)
|
||||
"%frame.fpv = call ptr @llvm.frameaddress.p0(i32 0)";
|
||||
Printf.sprintf
|
||||
"%%frame.f = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "fp");
|
||||
"store ptr %frame.fpv, ptr %frame.f";
|
||||
"store ptr %frame, ptr @flan_frame_head" ];
|
||||
f.frame <- Some prev;
|
||||
(* The parameters are bound before the body starts, so they are recorded
|
||||
@ -4922,6 +4931,7 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
|
||||
|
||||
declare void @llvm.memset.p0.i64(ptr nocapture writeonly, i8, i64, i1 immarg)
|
||||
declare i32 @llvm.bswap.i32(i32)
|
||||
declare ptr @llvm.frameaddress.p0(i32 immarg)
|
||||
declare void @flan_rt_init(i32, ptr)
|
||||
declare void @flan_argv(ptr)
|
||||
declare void @flan_write_stdout(ptr, i64)
|
||||
@ -5013,6 +5023,7 @@ declare i64 @flan_dyn_map_get(i64, i64)
|
||||
declare i64 @flan_dyn_get(i64, i64, ptr, i64)
|
||||
declare void @flan_dyn_map_set(i64, i64, i64)
|
||||
declare i64 @flan_dyn_map_contains(i64, i64)
|
||||
declare i64 @flan_dyn_map_contains_at(i64, i64, ptr, i64)
|
||||
; 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,
|
||||
@ -5029,11 +5040,14 @@ 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_eq_at(i64, i64, ptr, i64)
|
||||
declare i64 @flan_dyn_len_at(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_at(i64, i64, ptr, i64)
|
||||
declare i64 @flan_dyn_slice(i64, 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_print_at(i64, ptr, i64)
|
||||
declare void @flan_dyn_emit_dev(i64)
|
||||
declare void @flan_dyn_emit_watch(i64)
|
||||
; The watch table, which (watch "name" v) renders into. flan_dev.c is linked
|
||||
|
||||
@ -4219,6 +4219,10 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
|
||||
store_int f.b
|
||||
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "serial"))
|
||||
~size:8;
|
||||
(* The frame address, as emit.ml stores it: every local lies below it. *)
|
||||
store_int f.b
|
||||
~src:rbp ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "fp"))
|
||||
~size:8;
|
||||
lea f.b ~dst:rax ~mm:(Frame fr);
|
||||
store_int f.b ~src:rax ~mm:(lmem f head ~scratch:r11) ~size:8;
|
||||
(* The parameters are bound before the body starts, so they are recorded
|
||||
|
||||
@ -1116,6 +1116,11 @@ typedef struct flan_frame {
|
||||
* this activation from the next call to land at the same address, which a
|
||||
* view kept past the return would otherwise take for its own. */
|
||||
uint64_t serial;
|
||||
/* The function's frame address (its rbp), stored at the push. Every local
|
||||
* of the function lies below it and above everything its callees push, so
|
||||
* a stack address belongs to the innermost frame whose [fp] is above it
|
||||
* ([flan_dev_frame_owner]). */
|
||||
const void *fp;
|
||||
} flan_frame;
|
||||
|
||||
/* The compiler names this symbol directly. A redefinition module reaches it
|
||||
@ -1168,6 +1173,23 @@ int32_t flan_dev_frame_alive(const void *frame, uint64_t serial) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* The frame whose storage holds the stack address [p], for a view the
|
||||
* compiler could not tie to its own frame: a slice of a local, or a slice
|
||||
* parameter over a caller's. The stack grows down, so [p] is on it only when
|
||||
* it is above this function's own frame, and it is the innermost Flan frame
|
||||
* whose frame address is above it that owns it. NULL for anything else — the
|
||||
* heap, a global, or stack above every Flan frame. */
|
||||
void *flan_dev_frame_owner(const void *p) {
|
||||
uintptr_t a = (uintptr_t)p;
|
||||
flan_frame *f;
|
||||
if (flan_frame_head == NULL
|
||||
|| a <= (uintptr_t)__builtin_frame_address(0))
|
||||
return NULL;
|
||||
for (f = flan_frame_head; f != NULL; f = f->prev)
|
||||
if (f->fp != NULL && (uintptr_t)f->fp > a) return f;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* [i] counts from the innermost. NULL past the end, which is how a caller
|
||||
* learns the depth without a second walk. */
|
||||
void *flan_dev_frame_at(int32_t i) {
|
||||
@ -1556,6 +1578,122 @@ static size_t flan_reg_slot(uintptr_t a) {
|
||||
& (FLAN_REG_CAP - 1);
|
||||
}
|
||||
|
||||
/* ── The registry by address ──────────────────────────────────────────
|
||||
*
|
||||
* The table above answers "which block starts here"; a dyn view crossing
|
||||
* asks "which live block holds this address", once per crossing, and a scan
|
||||
* of every slot for that cost microseconds a crossing. So each live block's
|
||||
* base is also filed under every 64 KiB chunk it overlaps, and the question
|
||||
* reads one chunk's short list. A block wider than FLAN_IX_WIDE chunks goes
|
||||
* on one list of its own, read every time; there are few such blocks. Only
|
||||
* the game thread reads or writes it.
|
||||
*
|
||||
* A base is filed when its note is written and taken out when the block dies.
|
||||
* An entry here is a hint, not a fact: the list names bases, and the answer
|
||||
* is always the table's entry for that base, checked live and containing. */
|
||||
#define FLAN_IX_SHIFT 16
|
||||
#define FLAN_IX_WIDE 64
|
||||
|
||||
typedef struct {
|
||||
uintptr_t key; /* chunk + 1; 0 for an empty bucket */
|
||||
int32_t n, cap;
|
||||
uintptr_t *bases;
|
||||
} flan_ix_bucket;
|
||||
|
||||
static flan_ix_bucket *flan_ix;
|
||||
static size_t flan_ix_cap, flan_ix_used;
|
||||
static uintptr_t *flan_ix_wide;
|
||||
static int32_t flan_ix_widen, flan_ix_widecap;
|
||||
|
||||
static size_t flan_ix_hash(uintptr_t key) {
|
||||
return (size_t)((key * 11400714819323198485ULL) >> 20);
|
||||
}
|
||||
|
||||
static flan_ix_bucket *flan_ix_find(uintptr_t chunk, int make) {
|
||||
uintptr_t key = chunk + 1;
|
||||
size_t i, mask;
|
||||
if (flan_ix_cap == 0) {
|
||||
if (!make) return NULL;
|
||||
flan_ix = (flan_ix_bucket *)calloc(1024, sizeof *flan_ix);
|
||||
if (flan_ix == NULL) return NULL;
|
||||
flan_ix_cap = 1024;
|
||||
}
|
||||
if (make && (flan_ix_used + 1) * 2 > flan_ix_cap) {
|
||||
size_t ncap = flan_ix_cap * 2, j;
|
||||
flan_ix_bucket *n = (flan_ix_bucket *)calloc(ncap, sizeof *n);
|
||||
if (n == NULL) return NULL;
|
||||
for (j = 0; j < flan_ix_cap; j++) {
|
||||
size_t k;
|
||||
if (flan_ix[j].key == 0) continue;
|
||||
for (k = flan_ix_hash(flan_ix[j].key) & (ncap - 1); n[k].key != 0;
|
||||
k = (k + 1) & (ncap - 1)) {}
|
||||
n[k] = flan_ix[j];
|
||||
}
|
||||
free(flan_ix);
|
||||
flan_ix = n;
|
||||
flan_ix_cap = ncap;
|
||||
}
|
||||
mask = flan_ix_cap - 1;
|
||||
for (i = flan_ix_hash(key) & mask;; i = (i + 1) & mask) {
|
||||
if (flan_ix[i].key == key) return &flan_ix[i];
|
||||
if (flan_ix[i].key == 0) {
|
||||
if (!make) return NULL;
|
||||
flan_ix[i].key = key;
|
||||
flan_ix_used++;
|
||||
return &flan_ix[i];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void flan_ix_list_add(uintptr_t **v, int32_t *n, int32_t *cap,
|
||||
uintptr_t base) {
|
||||
int32_t i;
|
||||
for (i = 0; i < *n; i++) if ((*v)[i] == base) return;
|
||||
if (*n == *cap) {
|
||||
int32_t ncap = *cap ? *cap * 2 : 4;
|
||||
uintptr_t *nv = (uintptr_t *)realloc(*v, (size_t)ncap * sizeof **v);
|
||||
if (nv == NULL) return;
|
||||
*v = nv;
|
||||
*cap = ncap;
|
||||
}
|
||||
(*v)[(*n)++] = base;
|
||||
}
|
||||
|
||||
static void flan_ix_list_del(uintptr_t *v, int32_t *n, uintptr_t base) {
|
||||
int32_t i;
|
||||
for (i = 0; i < *n; i++)
|
||||
if (v[i] == base) { v[i] = v[--*n]; return; }
|
||||
}
|
||||
|
||||
static void flan_ix_file(uintptr_t base, int64_t bytes, int add) {
|
||||
uintptr_t c, lo = base >> FLAN_IX_SHIFT,
|
||||
hi = (base + (uintptr_t)bytes - 1) >> FLAN_IX_SHIFT;
|
||||
if (bytes <= 0) return;
|
||||
if (hi - lo >= FLAN_IX_WIDE) {
|
||||
if (add) flan_ix_list_add(&flan_ix_wide, &flan_ix_widen, &flan_ix_widecap, base);
|
||||
else flan_ix_list_del(flan_ix_wide, &flan_ix_widen, base);
|
||||
return;
|
||||
}
|
||||
for (c = lo; c <= hi; c++) {
|
||||
flan_ix_bucket *b = flan_ix_find(c, add);
|
||||
if (b == NULL) continue;
|
||||
if (add) flan_ix_list_add(&b->bases, &b->n, &b->cap, base);
|
||||
else flan_ix_list_del(b->bases, &b->n, base);
|
||||
}
|
||||
}
|
||||
|
||||
/* The live entry for [base], by the probe a free takes. */
|
||||
static flan_reg_entry *flan_reg_live_at(uintptr_t base) {
|
||||
size_t s = flan_reg_slot(base);
|
||||
int64_t probe;
|
||||
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
|
||||
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
|
||||
if (flan_reg[j].base == 0) return NULL;
|
||||
if (flan_reg[j].base == base && flan_reg[j].died == 0) return &flan_reg[j];
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Drop every dead entry and re-insert the live ones. Called when the table is
|
||||
* filling *and* there is a worthwhile number of dead in it: in a long-running
|
||||
* program the dead are the bulk of it, and losing them is much cheaper than
|
||||
@ -1678,6 +1816,7 @@ static void flan_reg_note_full(void *base, int64_t bytes, int64_t elem,
|
||||
flan_reg[j].owner = owner;
|
||||
flan_reg[j].sliced = sliced;
|
||||
flan_reg_end(&flan_reg[j]);
|
||||
flan_ix_file(a, bytes, 1);
|
||||
return;
|
||||
}
|
||||
/* Every slot in use, and the compaction above declined to run because what
|
||||
@ -1770,6 +1909,7 @@ void flan_dev_reg_dead(void *base) {
|
||||
flan_reg[j].died = ++flan_reg_seq;
|
||||
flan_reg_end(&flan_reg[j]);
|
||||
flan_reg_dead++;
|
||||
flan_ix_file(a, flan_reg[j].bytes, 0);
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -1794,6 +1934,7 @@ void flan_dev_reg_dead_range(void *base, int64_t bytes) {
|
||||
e->died = now;
|
||||
flan_reg_end(e);
|
||||
flan_reg_dead++;
|
||||
flan_ix_file(e->base, e->bytes, 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1814,18 +1955,25 @@ int32_t flan_dev_reg_live(const void *p) {
|
||||
* same note is still alive. The smallest, because an arena's own region can
|
||||
* be a block too, and it outlives the allocation inside it that a free-all
|
||||
* ends. 0 when no live block holds [p] — a global, a frame, C memory — and
|
||||
* always in a release build. A scan, once per crossing, in a dev build. */
|
||||
* always in a release build. Read through the address index above. */
|
||||
int32_t flan_dev_reg_claim(const void *p, uintptr_t *base, int64_t *seq,
|
||||
const char **type, int64_t *typelen) {
|
||||
uintptr_t a = (uintptr_t)p;
|
||||
flan_reg_entry *best = NULL;
|
||||
int64_t i;
|
||||
flan_ix_bucket *b;
|
||||
int32_t i, pass;
|
||||
if (!flan_reg_on || a == 0) return 0;
|
||||
for (i = 0; i < FLAN_REG_CAP; i++) {
|
||||
flan_reg_entry *e = &flan_reg[i];
|
||||
if (e->base == 0 || e->died != 0) continue;
|
||||
if (a < e->base || a >= e->base + (uintptr_t)e->bytes) continue;
|
||||
if (best == NULL || e->bytes < best->bytes) best = e;
|
||||
b = flan_ix_find(a >> FLAN_IX_SHIFT, 0);
|
||||
for (pass = 0; pass < 2; pass++) {
|
||||
uintptr_t *v = pass == 0 ? (b ? b->bases : NULL) : flan_ix_wide;
|
||||
int32_t n = pass == 0 ? (b ? b->n : 0) : flan_ix_widen;
|
||||
for (i = 0; i < n; i++) {
|
||||
flan_reg_entry *e;
|
||||
if (a < v[i]) continue;
|
||||
e = flan_reg_live_at(v[i]);
|
||||
if (e == NULL || a >= e->base + (uintptr_t)e->bytes) continue;
|
||||
if (best == NULL || e->bytes < best->bytes) best = e;
|
||||
}
|
||||
}
|
||||
if (best == NULL) return 0;
|
||||
*base = best->base;
|
||||
|
||||
@ -392,6 +392,20 @@ static inline int64_t obj_words(flan_obj *o) {
|
||||
|
||||
static inline uint8_t *obj_text_bytes(flan_obj *o) { return (uint8_t *)(o + 1); }
|
||||
|
||||
/* What trails an OBJ_VIEW's header: the dev check's record of its storage,
|
||||
* explained with the view helpers below. Allocated with every view, and
|
||||
* charged to the heap and taken back by the sweep with it. */
|
||||
typedef struct view_guard {
|
||||
const void *frame; /* NULL when no frame is checked */
|
||||
uint64_t serial;
|
||||
const char *fname; /* whose frame, for the sentence */
|
||||
int64_t fnamelen;
|
||||
uintptr_t rbase; /* 0 when no block is checked */
|
||||
int64_t rseq;
|
||||
const char *rtype;
|
||||
int64_t rtypelen;
|
||||
} view_guard;
|
||||
|
||||
static flan_obj *gc_all; /* the sweep list */
|
||||
static int64_t gc_bytes; /* what the live objects hold, headers included */
|
||||
static int64_t gc_count;
|
||||
@ -635,11 +649,18 @@ static double dyn_num_value(flan_dyn v);
|
||||
* they are defined, alongside the container operations below */
|
||||
static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_obj *o);
|
||||
static void view_guard_check(const uint8_t *loc, int64_t loclen,
|
||||
const char *op, flan_obj *o);
|
||||
/* A struct view's fields, for the map arms of the printers. */
|
||||
static int64_t view_nfields(flan_obj *o);
|
||||
static flan_dyn view_field_key(flan_obj *o, int64_t i);
|
||||
static flan_dyn view_field_val(flan_obj *o, int64_t i);
|
||||
static void view_struct_name(flan_obj *o, const char **name, int64_t *len);
|
||||
/* 1 when element (or, with [field], field) [i] of view [o] is a u64 above
|
||||
* the largest dyn int: it has no dyn value, and the printers write its
|
||||
* digits instead of reading it. */
|
||||
static int view_big_u64(flan_obj *o, int64_t i, int field,
|
||||
unsigned long long *out);
|
||||
|
||||
/* forward: needed by [dyn_equal] below, defined alongside the view helpers
|
||||
* further down — a length and an element reader that answer correctly
|
||||
@ -647,6 +668,26 @@ static void view_struct_name(flan_obj *o, const char **name, int64_t *len);
|
||||
static int64_t vecish_len(flan_obj *o);
|
||||
static flan_dyn vecish_at(flan_obj *o, int64_t i);
|
||||
|
||||
/* The site and operation a walk over a view reports a trap at — a print, an
|
||||
* equality, a length — set by the entry point that has them and read by the
|
||||
* element readers the walk calls. NULL when the entry point has no site. */
|
||||
static const uint8_t *walk_loc;
|
||||
static int64_t walk_len;
|
||||
static const char *walk_op = "print";
|
||||
|
||||
typedef struct { const uint8_t *loc; int64_t len; const char *op; } walk_site;
|
||||
|
||||
static walk_site walk_enter(const uint8_t *loc, int64_t len, const char *op) {
|
||||
walk_site was;
|
||||
was.loc = walk_loc; was.len = walk_len; was.op = walk_op;
|
||||
walk_loc = loc; walk_len = loc != NULL ? len : 0; walk_op = op;
|
||||
return was;
|
||||
}
|
||||
|
||||
static void walk_leave(walk_site was) {
|
||||
walk_loc = was.loc; walk_len = was.len; walk_op = was.op;
|
||||
}
|
||||
|
||||
static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
char buf[64];
|
||||
int32_t t = flan_dyn_tag(v);
|
||||
@ -706,7 +747,12 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
if (i > 0) emit(w, " ");
|
||||
render(w, view_field_key(o, i), depth + 1, 1);
|
||||
emit(w, " ");
|
||||
render(w, view_field_val(o, i), depth + 1, 1);
|
||||
unsigned long long big;
|
||||
if (view_big_u64(o, i, 1, &big)) {
|
||||
snprintf(buf, sizeof buf, "%llu", big);
|
||||
emit(w, buf);
|
||||
} else
|
||||
render(w, view_field_val(o, i), depth + 1, 1);
|
||||
}
|
||||
emit(w, "}");
|
||||
return;
|
||||
@ -734,7 +780,12 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
emit(w, "[");
|
||||
for (i = 0; i < n; i++) {
|
||||
if (i > 0) emit(w, " ");
|
||||
render(w, vecish_at(o, i), depth + 1, 1);
|
||||
unsigned long long big;
|
||||
if (o->kind == OBJ_VIEW && view_big_u64(o, i, 0, &big)) {
|
||||
snprintf(buf, sizeof buf, "%llu", big);
|
||||
emit(w, buf);
|
||||
} else
|
||||
render(w, vecish_at(o, i), depth + 1, 1);
|
||||
}
|
||||
emit(w, "]");
|
||||
return;
|
||||
@ -742,19 +793,31 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
}
|
||||
}
|
||||
|
||||
void flan_dyn_print(flan_dyn v) { render(flan_write_stdout, v, 0, 0); }
|
||||
static void print_walk(flan_dyn v) { render(flan_write_stdout, v, 0, 0); }
|
||||
|
||||
/* The same rendering into an evaluated expression's value, and into the watch
|
||||
* slot [flan_dev_watch_begin] opened. lib/render.ml's dyn arm calls these on
|
||||
* the inspecting side and [flan_dyn_print] on [println]'s. A text is quoted
|
||||
* even at the top, because the typed side's renderer quotes a string there:
|
||||
* the value "5" and the value 5 must not read alike. */
|
||||
void flan_dyn_emit_dev(flan_dyn v) { render(flan_dev_emit, v, 0, 1); }
|
||||
void flan_dyn_emit_watch(flan_dyn v) { render(flan_dev_watch_emit, v, 0, 1); }
|
||||
void flan_dyn_emit_dev(flan_dyn v) {
|
||||
walk_site was = walk_enter(NULL, 0, "print");
|
||||
render(flan_dev_emit, v, 0, 1);
|
||||
walk_leave(was);
|
||||
}
|
||||
void flan_dyn_emit_watch(flan_dyn v) {
|
||||
walk_site was = walk_enter(NULL, 0, "print");
|
||||
render(flan_dev_watch_emit, v, 0, 1);
|
||||
walk_leave(was);
|
||||
}
|
||||
|
||||
/* And into a condition's message, which flan_rt.c's sink bounds. */
|
||||
void flan_msg_emit(const uint8_t *p, int64_t n);
|
||||
void flan_dyn_emit_msg(flan_dyn v) { render(flan_msg_emit, v, 0, 1); }
|
||||
void flan_dyn_emit_msg(flan_dyn v) {
|
||||
walk_site was = walk_enter(NULL, 0, "print");
|
||||
render(flan_msg_emit, v, 0, 1);
|
||||
walk_leave(was);
|
||||
}
|
||||
|
||||
/* The same walk into a buffer, for a trap's sentence. Bounded and truncated
|
||||
* rather than allocating: a trap is the one moment when allocating would be a
|
||||
@ -836,7 +899,13 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
if (i > 0) say_puts(s, " ");
|
||||
say_render(s, view_field_key(o, i), depth + 1);
|
||||
say_puts(s, " ");
|
||||
say_render(s, view_field_val(o, i), depth + 1);
|
||||
unsigned long long big;
|
||||
if (view_big_u64(o, i, 1, &big)) {
|
||||
char nb[32];
|
||||
snprintf(nb, sizeof nb, "%llu", big);
|
||||
say_puts(s, nb);
|
||||
} else
|
||||
say_render(s, view_field_val(o, i), depth + 1);
|
||||
}
|
||||
say_puts(s, i == n ? "}" : i > 0 ? " ...}" : "...}");
|
||||
return;
|
||||
@ -871,7 +940,13 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
say_puts(s, "[");
|
||||
for (i = 0; i < n && s->n < s->cap - 8; i++) {
|
||||
if (i > 0) say_puts(s, " ");
|
||||
say_render(s, vecish_at(o, i), depth + 1);
|
||||
unsigned long long big;
|
||||
if (o->kind == OBJ_VIEW && view_big_u64(o, i, 0, &big)) {
|
||||
char nb[32];
|
||||
snprintf(nb, sizeof nb, "%llu", big);
|
||||
say_puts(s, nb);
|
||||
} else
|
||||
say_render(s, vecish_at(o, i), depth + 1);
|
||||
}
|
||||
say_puts(s, i == n ? "]" : i > 0 ? " ...]" : "...]");
|
||||
return;
|
||||
@ -1466,6 +1541,7 @@ static void gc_sweep(void) {
|
||||
} else {
|
||||
int64_t held = (int64_t)sizeof(flan_obj);
|
||||
if (o->kind == OBJ_TEXT || o->kind == OBJ_ENV) held += o->len;
|
||||
if (o->kind == OBJ_VIEW) held += (int64_t)sizeof(view_guard);
|
||||
if (o->kind == OBJ_ENV) envset_del((uintptr_t)(o + 1));
|
||||
if (o->kind == OBJ_VEC || o->kind == OBJ_MAP) {
|
||||
int64_t per = o->kind == OBJ_MAP ? 2 : 1;
|
||||
@ -2896,7 +2972,15 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) {
|
||||
static flan_dyn eq_walk(flan_dyn a, flan_dyn b) {
|
||||
/* A view is checked before the identity shortcut, so a gone one traps
|
||||
even compared with itself. */
|
||||
if (dyn_boxed(a) && dyn_box(a) == BOX_OBJ && dyn_obj(a) != NULL
|
||||
&& dyn_obj(a)->kind == OBJ_VIEW)
|
||||
view_guard_check(walk_loc, walk_len, walk_op, dyn_obj(a));
|
||||
if (dyn_boxed(b) && dyn_box(b) == BOX_OBJ && dyn_obj(b) != NULL
|
||||
&& dyn_obj(b)->kind == OBJ_VIEW)
|
||||
view_guard_check(walk_loc, walk_len, walk_op, dyn_obj(b));
|
||||
return flan_dyn_from_bool((uint8_t)dyn_equal(a, b, 0));
|
||||
}
|
||||
|
||||
@ -3107,19 +3191,12 @@ static void desc_spell(const uint8_t *d, char *buf, size_t cap) {
|
||||
* which a free, a free-all, an arena's destroy and a Vec's
|
||||
* growth (for the block it left) all end.
|
||||
*
|
||||
* A release build keeps neither table, so a view there records nothing and
|
||||
* checks nothing. Storage neither table knows — a global, rodata, C memory,
|
||||
* a caller's local reached through a slice parameter — is not checked. */
|
||||
typedef struct view_guard {
|
||||
const void *frame; /* NULL when no frame is checked */
|
||||
uint64_t serial;
|
||||
const char *fname; /* whose frame, for the sentence */
|
||||
int64_t fnamelen;
|
||||
uintptr_t rbase; /* 0 when no block is checked */
|
||||
int64_t rseq;
|
||||
const char *rtype;
|
||||
int64_t rtypelen;
|
||||
} view_guard;
|
||||
* A frame is found by the compiler's word ([here]) or, for a stack address
|
||||
* it could not tie to the calling frame, by address (flan_dev.c,
|
||||
* [flan_dev_frame_owner]). A release build keeps neither table, so a view
|
||||
* there records nothing and checks nothing. Storage neither table knows — a
|
||||
* global, rodata, C memory — is not checked. */
|
||||
/* [view_guard] is defined beside [flan_obj], since the sweep charges it. */
|
||||
|
||||
uint64_t flan_dev_frame_claim(void *frame, const char **name, int64_t *namelen);
|
||||
int32_t flan_dev_frame_alive(const void *frame, uint64_t serial);
|
||||
@ -3136,12 +3213,26 @@ extern struct flan_frame *flan_frame_head; /* runtime/flan_dev.c */
|
||||
static inline view_guard *view_g(flan_obj *o) { return (view_guard *)(o + 1); }
|
||||
static inline int view_shape(flan_obj *o) { return (int)o->gen; }
|
||||
|
||||
static void guard_block(view_guard *g, const void *p) {
|
||||
void *flan_dev_frame_owner(const void *p);
|
||||
|
||||
/* What a dev build records of storage the compiler could not tie to the
|
||||
* calling frame: the frame that owns it when it is on the stack (a slice of
|
||||
* a local, a slice parameter over a caller's), else the registry block that
|
||||
* holds it. Neither, and nothing is checked. */
|
||||
static void guard_storage(view_guard *g, const void *p) {
|
||||
void *f;
|
||||
g->frame = NULL;
|
||||
g->rbase = 0;
|
||||
if (p != NULL)
|
||||
flan_dev_reg_claim(p, &g->rbase, &g->rseq, &g->rtype, &g->rtypelen);
|
||||
if (p == NULL) return;
|
||||
if ((f = flan_dev_frame_owner(p)) != NULL) {
|
||||
g->frame = f;
|
||||
g->serial = flan_dev_frame_claim(f, &g->fname, &g->fnamelen);
|
||||
return;
|
||||
}
|
||||
flan_dev_reg_claim(p, &g->rbase, &g->rseq, &g->rtype, &g->rtypelen);
|
||||
}
|
||||
|
||||
|
||||
/* A new view record, its guard empty. */
|
||||
static flan_obj *view_new(void *base, int64_t len, const uint8_t *desc,
|
||||
int shape) {
|
||||
@ -3232,7 +3323,7 @@ static flan_dyn view_child(flan_obj *parent, const uint8_t *d, uint8_t *p) {
|
||||
memcpy(&data, p, 8);
|
||||
memcpy(&n, p + 8, 8);
|
||||
c = view_new(data, n, d + 1, VIEW_FLAT);
|
||||
guard_block(view_g(c), data);
|
||||
guard_storage(view_g(c), data);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c);
|
||||
}
|
||||
case 'a': {
|
||||
@ -3244,7 +3335,7 @@ static flan_dyn view_child(flan_obj *parent, const uint8_t *d, uint8_t *p) {
|
||||
case 'v': c = view_new(p, 0, d + 1, VIEW_VEC); break;
|
||||
default: c = view_new(p, 0, d, VIEW_STRUCT); break;
|
||||
}
|
||||
if (view_shape(parent) == VIEW_VEC) guard_block(view_g(c), p);
|
||||
if (view_shape(parent) == VIEW_VEC) guard_storage(view_g(c), p);
|
||||
else *view_g(c) = *view_g(parent);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c);
|
||||
}
|
||||
@ -3309,25 +3400,103 @@ static int int_range(uint8_t c, int64_t *lo, int64_t *hi) {
|
||||
* holds it exactly, the rule a class's typed float slot follows, and traps
|
||||
* when it does not. A float into an f32 narrows, as (f32 x) does. [v] is the
|
||||
* view and [x] the value, for the sentence. */
|
||||
/* "an" before a word said with a vowel sound: an i8, an f32, an Item; a
|
||||
* u8, a bool, a [3 i32]. */
|
||||
static const char *an(const char *w) {
|
||||
if (w[0] == 'u' && w[1] >= '0' && w[1] <= '9') return "a";
|
||||
if (w[0] != '\0' && strchr("aeiouAEIOU", w[0]) != NULL) return "an";
|
||||
if (w[0] == 'f' && w[1] >= '0' && w[1] <= '9') return "an";
|
||||
return "a";
|
||||
}
|
||||
|
||||
/* A write into a struct field that the field refuses: the field by name, its
|
||||
* type, what was wrong, and the call with the key in it. [why] finishes the
|
||||
* sentence after the field's type. */
|
||||
static _Noreturn void field_refuse(const uint8_t *loc, int64_t loclen,
|
||||
const char *op, flan_dyn v, flan_dyn key,
|
||||
const uint8_t *d, flan_dyn x,
|
||||
const char *trap, const char *why) {
|
||||
char ty[128], sn[96], sv[SAY_MAX], sx[SAY_MAX];
|
||||
const char *nm;
|
||||
int64_t nl;
|
||||
kw_entry *k = dyn_kw(key);
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
view_struct_name(dyn_obj(v), &nm, &nl);
|
||||
snprintf(sn, sizeof sn, "%.*s", (int)nl, nm);
|
||||
say(sv, SAY_MAX, v);
|
||||
say(sx, SAY_MAX, x);
|
||||
said_len = 0;
|
||||
said_add("dyn %s: field :%.*s of %s %s is %s %s%s — ", op, (int)k->len,
|
||||
(const char *)kw_bytes(k), an(sn), sn, an(ty), ty, why);
|
||||
if (strcmp(op, "set") == 0)
|
||||
said_add("(set (get %s :%.*s) %s)", sv, (int)k->len,
|
||||
(const char *)kw_bytes(k), sx);
|
||||
else
|
||||
said_add("(put %s :%.*s %s)", sv, (int)k->len, (const char *)kw_bytes(k),
|
||||
sx);
|
||||
flan_say(loc, loclen, "%s", said_buf);
|
||||
flan_trap((const uint8_t *)trap, (int64_t)strlen(trap));
|
||||
}
|
||||
|
||||
/* ", and 1.5 is a float": what the refused value is, for a field's sentence. */
|
||||
static void value_is(char *buf, size_t cap, flan_dyn x) {
|
||||
char sx[SAY_MAX];
|
||||
const char *t = tag_of(x);
|
||||
if (flan_dyn_tag(x) == FLAN_DYN_TAG_NIL) {
|
||||
snprintf(buf, cap, ", and the value is nil");
|
||||
return;
|
||||
}
|
||||
say(sx, SAY_MAX, x);
|
||||
snprintf(buf, cap, ", and %s is %s %s", sx, an(t), t);
|
||||
}
|
||||
|
||||
/* One element or field, unboxed on the way in. The dyn value's tag must be
|
||||
* the one the element's type wants, or this traps by name and never coerces a
|
||||
* mismatched value into the slot; an int the element's width cannot hold
|
||||
* traps too, naming both. An int goes into a float element when the float
|
||||
* holds it exactly, the rule a class's typed float slot follows, and traps
|
||||
* when it does not. A float into an f32 narrows, as (f32 x) does. [v] is the
|
||||
* view and [x] the value, for the sentence; [key] is the field's keyword
|
||||
* when [v] is a struct's view and nil for an element, and a field's refusal
|
||||
* names the field. */
|
||||
static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
flan_dyn v, const uint8_t *d, flan_dyn x, uint8_t *p) {
|
||||
char ty[128];
|
||||
flan_dyn v, flan_dyn key, const uint8_t *d, flan_dyn x,
|
||||
uint8_t *p) {
|
||||
char ty[128], why[160];
|
||||
int64_t lo, hi;
|
||||
int field = flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD;
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (int_range(*d, &lo, &hi)) {
|
||||
int64_t n;
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT)
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) {
|
||||
if (field) {
|
||||
value_is(why, sizeof why, x);
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynType", why);
|
||||
}
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x);
|
||||
}
|
||||
n = dyn_int_value(x);
|
||||
if (n < lo || n > hi) {
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (field) {
|
||||
if (*d == 'L')
|
||||
snprintf(why, sizeof why,
|
||||
", which holds no negative number, and %lld does not fit",
|
||||
(long long)n);
|
||||
else
|
||||
snprintf(why, sizeof why,
|
||||
", which holds %lld to %lld, and %lld does not fit",
|
||||
(long long)lo, (long long)hi, (long long)n);
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why);
|
||||
}
|
||||
if (*d == 'L')
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: %lld does not fit a u64 element, which holds no "
|
||||
"negative number", op, (long long)n);
|
||||
else
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: %lld does not fit a %s element, which holds %lld "
|
||||
"to %lld", op, (long long)n, ty, (long long)lo, (long long)hi);
|
||||
"dyn %s: %lld does not fit %s %s element, which holds %lld "
|
||||
"to %lld", op, (long long)n, an(ty), ty, (long long)lo,
|
||||
(long long)hi);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
switch (*d) {
|
||||
@ -3347,7 +3516,12 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
f = *d == 'f' ? (double)(float)n : (double)n;
|
||||
if (!(f >= -9223372036854775808.0 && f < 9223372036854775808.0)
|
||||
|| (int64_t)f != n) {
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (field) {
|
||||
snprintf(why, sizeof why,
|
||||
", and %lld has no exact %s. Write it as a float, as in "
|
||||
"%lld.0", (long long)n, ty, (long long)n);
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why);
|
||||
}
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: %lld has no exact %s, so it does not go into this "
|
||||
"element. Write it as a float, as in %lld.0",
|
||||
@ -3356,29 +3530,45 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
}
|
||||
} else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT)
|
||||
f = dyn_num_value(x);
|
||||
else
|
||||
else {
|
||||
if (field) {
|
||||
value_is(why, sizeof why, x);
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynType", why);
|
||||
}
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x);
|
||||
}
|
||||
if (*d == 'f') { float g = (float)f; memcpy(p, &g, 4); }
|
||||
else memcpy(p, &f, 8);
|
||||
return;
|
||||
}
|
||||
case '?':
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL)
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) {
|
||||
if (field) {
|
||||
value_is(why, sizeof why, x);
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynType", why);
|
||||
}
|
||||
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x);
|
||||
}
|
||||
*p = dyn_payload(x) ? 1 : 0;
|
||||
return;
|
||||
case 't':
|
||||
if (field)
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynType",
|
||||
", which is read-only through a dyn view");
|
||||
trap2(loc, loclen, TYPE_TRAP, op,
|
||||
"a str element is read-only through a dyn view", v, x);
|
||||
default: {
|
||||
char sx[SAY_MAX];
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (field)
|
||||
field_refuse(loc, loclen, op, v, key, d, x, "DynType",
|
||||
", which a dyn view does not replace whole. Write into "
|
||||
"its own elements or fields instead");
|
||||
say(sx, SAY_MAX, x);
|
||||
flan_say(loc, loclen,
|
||||
"dyn %s: this element is a %s, and a dyn view does not replace "
|
||||
"dyn %s: this element is %s %s, and a dyn view does not replace "
|
||||
"it whole — write into its own elements or fields instead of "
|
||||
"storing %s",
|
||||
op, ty, sx);
|
||||
op, an(ty), ty, sx);
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
}
|
||||
@ -3394,12 +3584,13 @@ static uint8_t *view_elem_at(flan_obj *o, int64_t i) {
|
||||
* typed container (OBJ_VIEW, native bytes boxed on the way out) — the pair
|
||||
* [dyn_equal]'s VEC arm and the printers need. */
|
||||
static int64_t vecish_len(flan_obj *o) {
|
||||
return o->kind == OBJ_VIEW ? view_len(NULL, 0, "=", o) : o->len;
|
||||
return o->kind == OBJ_VIEW ? view_len(walk_loc, walk_len, walk_op, o) : o->len;
|
||||
}
|
||||
|
||||
static flan_dyn vecish_at(flan_obj *o, int64_t i) {
|
||||
if (o->kind == OBJ_VIEW)
|
||||
return view_read(NULL, 0, "print", o, o->u.view.desc, view_elem_at(o, i));
|
||||
return view_read(walk_loc, walk_len, walk_op, o, o->u.view.desc,
|
||||
view_elem_at(o, i));
|
||||
return o->u.v.items[i];
|
||||
}
|
||||
|
||||
@ -3433,8 +3624,8 @@ static uint8_t *view_field(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
* array's or the struct's first byte) or a slice's data, [len] a flat
|
||||
* view's element count, [desc] the element's descriptor (the struct's own,
|
||||
* for a struct view). [here] is the checker's word that the storage is the
|
||||
* calling function's own frame; otherwise a dev build looks the address up
|
||||
* in the allocation registry. */
|
||||
* calling function's own frame; otherwise a dev build finds the frame that
|
||||
* owns a stack address, or the registry block that holds a heap one. */
|
||||
static flan_dyn view_make(void *base, int64_t len, const uint8_t *desc,
|
||||
int shape, int32_t here) {
|
||||
flan_obj *o = view_new(base, len, desc, shape);
|
||||
@ -3446,7 +3637,7 @@ static flan_dyn view_make(void *base, int64_t len, const uint8_t *desc,
|
||||
flan_dev_frame_claim(flan_frame_head, &g->fname, &g->fnamelen);
|
||||
}
|
||||
} else
|
||||
guard_block(g, base);
|
||||
guard_storage(g, base);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
}
|
||||
|
||||
@ -3464,7 +3655,7 @@ flan_dyn flan_dyn_view_at(void *addr, int64_t len, const uint8_t *desc,
|
||||
|
||||
/* A struct view's fields by position, for the printers and equality. */
|
||||
static int64_t view_nfields(flan_obj *o) {
|
||||
view_guard_check(NULL, 0, "print", o);
|
||||
view_guard_check(walk_loc, walk_len, walk_op, o);
|
||||
return desc_nfields(o->u.view.desc);
|
||||
}
|
||||
|
||||
@ -3488,7 +3679,28 @@ static flan_dyn view_field_val(flan_obj *o, int64_t i) {
|
||||
const uint8_t *name, *fty;
|
||||
int64_t namelen, foff;
|
||||
if (!view_nth(o, i, &name, &namelen, &foff, &fty)) return flan_dyn_nil();
|
||||
return view_read(NULL, 0, "print", o, fty, (uint8_t *)o->u.view.base + foff);
|
||||
return view_read(walk_loc, walk_len, walk_op, o, fty,
|
||||
(uint8_t *)o->u.view.base + foff);
|
||||
}
|
||||
|
||||
static int view_big_u64(flan_obj *o, int64_t i, int field,
|
||||
unsigned long long *out) {
|
||||
const uint8_t *d, *p;
|
||||
uint64_t x;
|
||||
if (field) {
|
||||
const uint8_t *name;
|
||||
int64_t namelen, foff;
|
||||
if (!view_nth(o, i, &name, &namelen, &foff, &d)) return 0;
|
||||
p = (const uint8_t *)o->u.view.base + foff;
|
||||
} else {
|
||||
d = o->u.view.desc;
|
||||
p = view_elem_at(o, i);
|
||||
}
|
||||
if (*d != 'L') return 0;
|
||||
memcpy(&x, p, 8);
|
||||
if (x <= (uint64_t)INT64_MAX) return 0;
|
||||
*out = (unsigned long long)x;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static void view_struct_name(flan_obj *o, const char **name, int64_t *len) {
|
||||
@ -3498,6 +3710,54 @@ static void view_struct_name(flan_obj *o, const char **name, int64_t *len) {
|
||||
*len = (int64_t)(e - d - 2);
|
||||
}
|
||||
|
||||
/* print, =, length and has-key? with the site they were written at, so a
|
||||
* view that traps inside one — gone, or a u64 too wide to compare — says
|
||||
* where, and names the operation. The compiler calls these; the site-less
|
||||
* ones stay for test/dyn_ops.c and the runtime's own callers. */
|
||||
static flan_dyn len_walk(flan_dyn v);
|
||||
static flan_dyn contains_walk(flan_dyn m, flan_dyn k);
|
||||
|
||||
void flan_dyn_print_at(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
walk_site was = walk_enter(loc, loclen, "print");
|
||||
print_walk(v);
|
||||
walk_leave(was);
|
||||
}
|
||||
|
||||
void flan_dyn_print(flan_dyn v) { flan_dyn_print_at(v, NULL, 0); }
|
||||
|
||||
flan_dyn flan_dyn_eq_at(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
walk_site was = walk_enter(loc, loclen, "=");
|
||||
flan_dyn r = eq_walk(a, b);
|
||||
walk_leave(was);
|
||||
return r;
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) {
|
||||
return flan_dyn_eq_at(a, b, NULL, 0);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_len_at(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
walk_site was = walk_enter(loc, loclen, "length");
|
||||
flan_dyn r = len_walk(v);
|
||||
walk_leave(was);
|
||||
return r;
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_len(flan_dyn v) { return flan_dyn_len_at(v, NULL, 0); }
|
||||
|
||||
flan_dyn flan_dyn_map_contains_at(flan_dyn m, flan_dyn k, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
walk_site was = walk_enter(loc, loclen, "has-key?");
|
||||
flan_dyn r = contains_walk(m, k);
|
||||
walk_leave(was);
|
||||
return r;
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) {
|
||||
return flan_dyn_map_contains_at(m, k, NULL, 0);
|
||||
}
|
||||
|
||||
/* The first ABI, kept for test/dyn_ops.c: FLAN_VIEW_I64/F64/BOOL. */
|
||||
static const uint8_t *old_elem_desc(int32_t elem) {
|
||||
return (const uint8_t *)(elem == FLAN_VIEW_I64 ? "l"
|
||||
@ -3512,23 +3772,21 @@ flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) {
|
||||
return view_make(data, len, old_elem_desc(elem), VIEW_FLAT, 0);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_len(flan_dyn v) {
|
||||
static flan_dyn len_walk(flan_dyn v) {
|
||||
if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->len);
|
||||
/* A map's length is its slot count, so a stale instance would answer the
|
||||
count of a definition that no longer exists. Migrated first for the same
|
||||
reason [get] is. */
|
||||
if (is_map(v)) {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
view_guard_check(NULL, 0, "length", o);
|
||||
return flan_dyn_from_i64(view_nfields(o));
|
||||
}
|
||||
if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_nfields(o));
|
||||
class_sync(o);
|
||||
return flan_dyn_from_i64(o->len);
|
||||
}
|
||||
if (is_vec(v)) {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len(NULL, 0, "length", o));
|
||||
if (o->kind == OBJ_VIEW)
|
||||
return flan_dyn_from_i64(view_len(walk_loc, walk_len, walk_op, 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);
|
||||
@ -3616,7 +3874,8 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
int64_t len = view_len(loc, loclen, "set-at", o);
|
||||
if (k < 0 || k >= len) trap_range(loc, loclen, "set-at", v, k, len);
|
||||
view_write(loc, loclen, "set-at", v, o->u.view.desc, x, view_elem_at(o, k));
|
||||
view_write(loc, loclen, "set-at", v, flan_dyn_nil(), o->u.view.desc, x,
|
||||
view_elem_at(o, k));
|
||||
return;
|
||||
}
|
||||
if (k < 0 || k >= o->len) trap_range(loc, loclen, "set-at", v, k, o->len);
|
||||
@ -3648,7 +3907,7 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) {
|
||||
/* Only a number or a bool is ever written, and [view_write] refuses the
|
||||
rest before a byte of [buf] is used. */
|
||||
memset(buf, 0, sizeof buf);
|
||||
view_write(loc, loclen, "push", v, o->u.view.desc, x, buf);
|
||||
view_write(loc, loclen, "push", v, flan_dyn_nil(), o->u.view.desc, x, buf);
|
||||
if (!flan_vec_push(o->u.view.base, buf, size, align, site, sitelen))
|
||||
trap_oom(loc, loclen, size);
|
||||
return;
|
||||
@ -3745,11 +4004,11 @@ flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc,
|
||||
return flan_dyn_map_get(m, k);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) {
|
||||
static flan_dyn contains_walk(flan_dyn m, flan_dyn k) {
|
||||
flan_obj *o = want_map("has-key?", m, k);
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
int64_t off;
|
||||
view_guard_check(NULL, 0, "has-key?", o);
|
||||
view_guard_check(walk_loc, walk_len, walk_op, o);
|
||||
return flan_dyn_from_bool(desc_field(o->u.view.desc, k, &off) != NULL);
|
||||
}
|
||||
return flan_dyn_from_bool(map_find(o, k) >= 0);
|
||||
@ -3878,7 +4137,7 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
|
||||
if (is_map(m) && dyn_obj(m)->kind == OBJ_VIEW) {
|
||||
const uint8_t *fty;
|
||||
uint8_t *p = view_field(loc, loclen, "set", dyn_obj(m), k, &fty);
|
||||
view_write(loc, loclen, "set", m, fty, v, p);
|
||||
view_write(loc, loclen, "set", m, k, fty, v, p);
|
||||
return;
|
||||
}
|
||||
if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) {
|
||||
@ -3909,7 +4168,7 @@ static void map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc,
|
||||
if (o->kind == OBJ_VIEW) {
|
||||
const uint8_t *fty;
|
||||
uint8_t *p = view_field(loc, loclen, "put", o, k, &fty);
|
||||
view_write(loc, loclen, "put", m, fty, v, p);
|
||||
view_write(loc, loclen, "put", m, k, fty, v, p);
|
||||
return;
|
||||
}
|
||||
e = class_sync(o);
|
||||
|
||||
@ -22,6 +22,13 @@
|
||||
(defstruct Mix [a u8 b i64 c f32 d bool e [3 u16] f i32])
|
||||
(defstruct Point [x f32 y i32])
|
||||
(defstruct Named [name str id u32])
|
||||
(defstruct Wide [a u64 b i64])
|
||||
(defstruct Small [x i8 z bool])
|
||||
|
||||
(declare gc-collect [] () "flan_gc_collect")
|
||||
(declare gc-live-bytes [] i64 "flan_gc_live_bytes")
|
||||
(defonce g3 [3 i64])
|
||||
(defn first-of [d] dyn (at d 0))
|
||||
|
||||
(defn make-point [] Point (Point {.x 1.5 .y 2}))
|
||||
|
||||
@ -40,6 +47,19 @@
|
||||
(let [a [1 2 3]]
|
||||
(set held (keep a))))
|
||||
|
||||
(defn stash [d] () (set held d))
|
||||
|
||||
;; A slice of a local, crossing where the compiler cannot tie it to a frame:
|
||||
;; bound to a local first, and passed through a slice parameter.
|
||||
(defn leak-slice-local [] ()
|
||||
(let [a [(i64 5) 6 7]
|
||||
s (slice a 0 3)]
|
||||
(stash s)))
|
||||
(defn via-slice [xs [i64]] () (stash xs))
|
||||
(defn leak-slice-param [] ()
|
||||
(let [a [(i64 5) 6 7]]
|
||||
(via-slice (slice a 0 3))))
|
||||
|
||||
(defn clobber [] i64
|
||||
(let [b [(i64 7) 8 9 10 11 12]]
|
||||
(+ (at b 0) (at b 5))))
|
||||
@ -233,4 +253,40 @@
|
||||
(let [p (Point {.x 1.0 .y 2})]
|
||||
(set (.z (keep p)) 3)
|
||||
0)
|
||||
;; A million views made and dropped: the collector takes back every
|
||||
;; byte it charged for them.
|
||||
(= n 11)
|
||||
(let [s (i64 0)]
|
||||
(set (at g3 0) 1)
|
||||
(dotimes [i 300000] (set s (+ s (i64 (first-of g3)))))
|
||||
(gc-collect)
|
||||
(println s (< (gc-live-bytes) 1000000))
|
||||
0)
|
||||
;; Stale through a slice bound to a local, and through a slice parameter.
|
||||
(= n 12)
|
||||
(do (leak-slice-local) (println (clobber)) (println (at held 0)) 0)
|
||||
(= n 13)
|
||||
(do (leak-slice-param) (println (clobber)) (println (at held 0)) 0)
|
||||
;; A field given a value of the wrong type, or nil, or out of range.
|
||||
(= n 14)
|
||||
(let [p (Small {.x 1 .z true})] (set (.x (keep p)) 1.5) 0)
|
||||
(= n 15)
|
||||
(let [p (Small {.x 1 .z true})] (set (.z (keep p)) nil) 0)
|
||||
(= n 16)
|
||||
(let [p (Small {.x 1 .z true})] (set (.x (keep p)) 200) 0)
|
||||
;; A stale view printed, measured and asked for a key, at their sites.
|
||||
(= n 17)
|
||||
(do (leak-local) (println (clobber)) (println held) 0)
|
||||
(= n 18)
|
||||
(do (leak-local) (println (clobber)) (println (length held)) 0)
|
||||
;; A u64 above the dyn int range prints, and reading it traps here.
|
||||
(= n 19)
|
||||
(let [w (Wide {.a 18000000000000000000 .b 1})
|
||||
d (keep w)]
|
||||
(println d)
|
||||
(println (.a d))
|
||||
0)
|
||||
;; An element's range, with its article.
|
||||
(= n 20)
|
||||
(let [a [(i8 1)]] (set (at (keep a) 0) 200) 0)
|
||||
:else (do (println "?") 1))))
|
||||
|
||||
@ -5933,15 +5933,34 @@ level "1"
|
||||
("2", "this u64 element is 18000000000000000000, above the largest \
|
||||
dyn int");
|
||||
("3", "a Point has no field :z. Its fields are :x :y");
|
||||
("8", "a str element is read-only through a dyn view");
|
||||
("8", "field :name of a Named is a str, which is read-only through \
|
||||
a dyn view");
|
||||
("9", "16777217 has no exact f32");
|
||||
("10", "dyn put: a Point has no field :z. Its fields are :x :y") ]
|
||||
("10", "dyn put: a Point has no field :z. Its fields are :x :y");
|
||||
("14", "dyn-view-any.flan:272:39: dyn put: field :x of a Small is an \
|
||||
i8, and 1.5 is a float — (put #Small{:x 1 :z true} :x 1.5)");
|
||||
("15", "dyn put: field :z of a Small is a bool, and the value is nil \
|
||||
— (put #Small{:x 1 :z true} :z nil)");
|
||||
("16", "dyn put: field :x of a Small is an i8, which holds -128 to \
|
||||
127, and 200 does not fit");
|
||||
("19", "#Wide{:a 18000000000000000000 :b 1}\n");
|
||||
("19", "dyn-view-any.flan:287:18: dyn get: this u64 element is \
|
||||
18000000000000000000");
|
||||
("20", "200 does not fit an i8 element, which holds -128 to 127") ]
|
||||
and any_stale =
|
||||
[ ("4", "this view points into a local of leak-local, and that call \
|
||||
has returned");
|
||||
("5", "this view's storage, a block of i64, has been released");
|
||||
("6", "this view's storage, a block of i64, has been released");
|
||||
("7", "this view's storage, a block of i32, has been released") ]
|
||||
("7", "this view's storage, a block of i32, has been released");
|
||||
("12", "this view points into a local of leak-slice-local, and that \
|
||||
call has returned");
|
||||
("13", "this view points into a local of leak-slice-param, and that \
|
||||
call has returned");
|
||||
("17", "dyn-view-any.flan:279:44: dyn print: this view points into a \
|
||||
local of leak-local");
|
||||
("18", "dyn-view-any.flan:281:53: dyn length: this view points into \
|
||||
a local of leak-local") ]
|
||||
in
|
||||
let dyn_view_any ?opt ?(x86 = false) ?(dev = false) () =
|
||||
let exe = compile ?opt ~x86 ~dev "programs/dyn-view-any.flan" in
|
||||
@ -5966,6 +5985,14 @@ level "1"
|
||||
saying %S\n" (name (", mode " ^ mode)) text code needle
|
||||
end)
|
||||
(any_traps @ if dev then any_stale else []);
|
||||
(* The collector takes back what it charged for a view: a leak here
|
||||
once doubled the heap's trigger forever. *)
|
||||
let code, text = run exe (Some "11") in
|
||||
if code <> 0 || text <> "300000 true\n" then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n got: %S (exit %d)\n"
|
||||
(name ", views are collected") text code
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ())
|
||||
in
|
||||
dyn_view_any ();
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user