diff --git a/lib/render.ml b/lib/render.ml index 6d98c04..218c1e3 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -158,13 +158,23 @@ let rec render c depth (e : Tast.expr) : Tast.expr list = (match c.ptrs with | None -> [ lit "" ] | Some pt -> + (* Into a slot first, the slice arm's rule and for its reason: this + arm names the pointer three times — asked about, followed, and + mourned — and the expression it came from may be a call. An + [inspect] with a path reaches a leaf through [flan_vec_at], which + is a bounds check and a transfer guard; three of those to render + one pointer would be the walk paying for its own shape. *) + let pv = c.alloc e.Tast.ty in + let p () = { Tast.e = Tast.Local pv; ty = e.Tast.ty; loc } in let inner = do_ ([ lit "" ]) in - let gone = do_ [ lit "" ] in - [ unit_ (Tast.If (pt.live e, inner, gone)) ]) + let gone = do_ [ lit "" ] in + [ unit_ + (Tast.Let ([ (pv, e) ], + [ unit_ (Tast.If (pt.live (p ()), inner, gone)) ])) ]) (* Opaque on purpose, and for the same reason: its contents are the runtime's, its address is not stable across runs, and printing either would make an acceptance test's output depend on the heap. *) diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 82e6beb..c2011fd 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -862,7 +862,12 @@ typedef struct { int64_t died; /* when it was released, or 0 while it is live */ } flan_reg_entry; -static flan_reg_entry flan_reg[FLAN_REG_CAP]; +/* Allocated by flan_dev_reg_enable and null until then, which is the whole of + * what a release build carries: a null pointer, a zero flag, and the load and + * not-taken branch each of the hooks below begins with. A fixed array here + * instead would be a quarter of a megabyte of BSS in a shipped game, for a + * table nothing in that build ever writes. */ +static flan_reg_entry *flan_reg; static int64_t flan_reg_used; /* live + dead slots in use */ static int64_t flan_reg_seq; /* a monotonic clock, in events */ static int flan_reg_on; /* only a dev build turns this on */ @@ -874,7 +879,15 @@ static int flan_reg_full; /* something found no slot */ * second version of the allocator gated on a build flag is worse than a * branch. That is a real cost and not zero; BUILT.md says so rather than * repeating the claim that a release build carries nothing. */ -void flan_dev_reg_enable(void) { flan_reg_on = 1; } +void flan_dev_reg_enable(void) { + if (flan_reg_on) return; + flan_reg = (flan_reg_entry *)calloc(FLAN_REG_CAP, sizeof *flan_reg); + /* A registry that could not be made is not worth dying over; the flag stays + off and every question about an address answers "never heard of it", + which is what a release build answers too. */ + if (flan_reg == NULL) return; + flan_reg_on = 1; +} int flan_dev_reg_enabled(void) { return flan_reg_on; } @@ -889,10 +902,15 @@ static size_t flan_reg_slot(uintptr_t a) { * fills: in a long-running program the dead are the bulk of it, and losing * them is much cheaper than losing the live half. */ static void flan_reg_compact(void) { - static flan_reg_entry old[FLAN_REG_CAP]; /* static: 160KB is not stack */ + size_t bytes = FLAN_REG_CAP * sizeof(flan_reg_entry); + flan_reg_entry *old = (flan_reg_entry *)malloc(bytes); int64_t i; - memcpy(old, flan_reg, sizeof old); - memset(flan_reg, 0, sizeof flan_reg); + /* Borrowed rather than kept: a second permanent copy would double what a + dev build holds for a rearrangement that happens rarely. If it cannot be + had, the table simply stays as it is and says it is full. */ + if (old == NULL) { flan_reg_full = 1; return; } + memcpy(old, flan_reg, bytes); + memset(flan_reg, 0, bytes); flan_reg_used = 0; for (i = 0; i < FLAN_REG_CAP; i++) { size_t s; @@ -908,6 +926,7 @@ static void flan_reg_compact(void) { } } } + free(old); } /* One note per allocation. [base] replaces whatever was recorded there, live @@ -962,12 +981,27 @@ static flan_reg_entry *flan_reg_find(uintptr_t a) { } /* One block dies. The heap allocator's free calls this, and so does a resize, - * for the block it moved away from. */ + * for the block it moved away from. + * + * The probe, not the scan — and the difference matters because this is on the + * *writer's* side. A free hands back the base address the allocator gave out, + * which is what the slot is keyed on, so the question here is equality and + * never containment. Reaching for flan_reg_find would put a 4096-entry sweep + * on every free in a dev build, which is the cost the note was careful not to + * have. */ void flan_dev_reg_dead(void *base) { - flan_reg_entry *e; - if (!flan_reg_on) return; - e = flan_reg_find((uintptr_t)base); - if (e != NULL && e->died == 0) e->died = ++flan_reg_seq; + uintptr_t a = (uintptr_t)base; + size_t s; + int64_t probe; + if (!flan_reg_on || a == 0) return; + s = flan_reg_slot(a); + 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; /* never noted; nothing to mark */ + if (flan_reg[j].base != a) continue; + if (flan_reg[j].died == 0) flan_reg[j].died = ++flan_reg_seq; + return; + } } /* Every block inside [base, base+bytes) dies — which is an arena's free-all, @@ -1040,6 +1074,7 @@ int32_t flan_dev_reg_emit(const void *p) { * test, and for the breakdown-by-type listing that is not built yet. */ int64_t flan_dev_reg_count(int32_t live_only) { int64_t i, n = 0; + if (!flan_reg_on) return 0; for (i = 0; i < FLAN_REG_CAP; i++) { if (flan_reg[i].base == 0) continue; if (live_only && flan_reg[i].died != 0) continue; diff --git a/test/programs/dev-ptr.flan b/test/programs/dev-ptr.flan new file mode 100644 index 0000000..c88e768 --- /dev/null +++ b/test/programs/dev-ptr.flan @@ -0,0 +1,46 @@ +;;;; A stopped stack holding two pointers into Vec storage, one of which is +;;;; already dead. The allocation registry is what lets the inspector tell +;;;; them apart, and this is the program that shows it: +;;;; +;;;; ("live" "(Ptr Enemy)" "") +;;;; ("dead" "(Ptr Enemy)" "") +;;;; +;;;; Both lines are what `(:op "locals" :frame 1)` answers with today, and +;;;; both were read off a running session by hand. **No test drives this +;;;; program yet**: the case belongs beside the other `locals` and `inspect` +;;;; cases in test_dev.ml, which is another lane's file. NEXT.md says so +;;;; rather than letting the verification read as automated. +;;;; +;;;; Why a Vec rather than a struct on the stack: a stack address is not in +;;;; the registry by design — the shadow stack already answers for a local by +;;;; name — so a pointer to one renders , which is neither half of what +;;;; this is demonstrating. +(import agent "vendor:agent") + +(defstruct Boom [why i32]) +(defstruct Enemy [hp i32 x i32]) + +(defn deeper [] i64 + (restart-case + (do (error (Boom {.why 7})) 1) + (carry-on [] 5))) + +(defn outer [] i64 + (let [v (vec-new Enemy) + w (vec-new Enemy)] + (push v (Enemy {.hp 41 .x 2})) + (push w (Enemy {.hp 7 .x 9})) + (let [live (addr (at v 0)) + dead (addr (at w 0))] + (free w) + (deeper)))) + +(defvar ticks i64) + +(defn main [] i32 + (agent/start "/tmp/flan-ptr-fallback.sock") + (print (outer)) (println "") + (dotimes [i 4000] + (agent/wait 5) + (set ticks (+ ticks 1))) + 0)