flan/runtime/flan_dev.c
Joseph Ferano a64bee6d96 Review follow-ups: a new def's image, the keyword that cannot change, and the sweep
Three defects, all from lifting every def initialiser, none of which the
suite caught:

A def typed fresh into a live session came up zero and stayed zero. The
image flan_dev_global copies on the allocation is the only value a new
global ever gets — the host's .init-globals never calls its initialiser —
and both backends chose that image with Tast.const_init, which a def's
lifted Call fails by construction. Emit.initial_image reads the constant
back out of the lifted body; the x86 twin had the same bug.

Changing a global between def and defonce was silently ineffective: the
guard lives in the startup function compiled into the host, which a reload
cannot republish. Session.compatible refuses both directions and says to
restart; editing the value stays allowed.

And global/<n> no longer leaks into the signature refusal when a def is
retyped — the global loop names the same fact in words a reader can act on.

flan check prints def, defonce or defconst off grerun; (defvar) with no
arguments names the shapes rather than offering (defonce ); the docs,
plan.org, runtime comments and valgrind.supp are swept; BUILT.md states
the release-build cost and the uninit caveat.
2026-09-21 07:19:33 +07:00

2066 lines
98 KiB
C

/* flan_dev — the part of the host ABI that only a dev build has.
*
* A redefinition module reaches the host's functions and globals through
* symbols the host already exports: a cell for each function, the storage for
* each global. That covers everything the program was *built* with. It does
* not cover a name the module introduces — a defn or a defonce typed into the
* REPL after the process started — because there is no symbol in the host to
* bind to and ELF cannot grow one.
*
* So a name that is new at run time is keyed by string instead. This file is
* the two lookups that make that work, and deliberately nothing else:
*
* flan_dev_cell(name) the cell a new function lives in
* flan_dev_global(name, size, init) the storage a new global lives in
* flan_dev_emit(...) where an evaluated expression's rendering
* goes, piece by piece, to be read back
*
* Both are idempotent: the second module to mention a name gets what the first
* one got. That is the whole point. Two modules that each define their own
* copy of a new function would each call their own, and redefining it would
* update one of them.
*
* The table never moves. A module holds the address of a cell for as long as
* it is loaded, so a growable table would leave those addresses pointing into
* a freed allocation. Fixed capacity and a loud failure instead.
*
* Never dlclose a module. A cell holds an address inside that module's text,
* and unloading it leaves every call site pointing at unmapped memory. There
* is no unload path here on purpose.
*/
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
/* For the one wait in this file: the pause between a listing's attempts at
* reading the table. See flan_reg_scan_wait. Nothing on the writer's side
* waits for anything. */
#include <time.h>
#define FLAN_DEV_MAX 4096
typedef struct {
const char *name; /* strdup'd: the module that passed it may go away */
void *cell; /* a function's cell, or a global's storage */
size_t size; /* a global's size; 0 for a function */
} entry;
static entry table[FLAN_DEV_MAX];
static size_t used;
static void die(const char *what, const char *name) {
fprintf(stderr, "flan_dev: %s: %s\n", what, name);
fflush(stderr);
abort();
}
static entry *find(const char *name) {
for (size_t i = 0; i < used; i++)
if (strcmp(table[i].name, name) == 0) return &table[i];
return NULL;
}
static entry *intern(const char *name) {
if (used == FLAN_DEV_MAX) die("out of dev name slots", name);
entry *e = &table[used++];
e->name = strdup(name);
if (e->name == NULL) die("out of memory", name);
e->cell = NULL;
e->size = 0;
return e;
}
/* The cell a run-time-introduced function is called through. One indirection
* more than a function the host was built with, whose cell is a symbol the
* module can name directly — the compiler picks per name, so the common case
* stays a single load. */
void **flan_dev_cell(const char *name) {
entry *e = find(name);
if (e == NULL) e = intern(name);
return &e->cell;
}
/* Storage for a run-time-introduced global, allocated once.
*
* [init] is its declared initial value, or NULL for all-zero. It is copied on
* the allocation and ignored on every call after it, which is where "a reload
* must not reset the program's state" lives: the second module to mention this
* name is a redefinition, and re-running an initialiser would throw away
* exactly what the reload exists to preserve. Doing it here rather than by a
* branch in the caller means the rule cannot be got wrong at one call site.
*
* A size mismatch is the layout-drift failure, caught at its first chance: the
* running process has already laid this memory out, and handing back the old
* allocation for a differently shaped type means the new body reads fields at
* the wrong offsets and nothing ever says so. Retyping a var needs a restart. */
void *flan_dev_global(const char *name, uint64_t size, const void *init) {
entry *e = find(name);
if (e == NULL) {
e = intern(name);
e->cell = calloc(1, size ? (size_t)size : 1);
if (e->cell == NULL) die("out of memory", name);
e->size = (size_t)size;
if (init != NULL && size > 0) memcpy(e->cell, init, (size_t)size);
return e->cell;
}
if (e->size != (size_t)size) die("size changed; restart to retype", name);
return e->cell;
}
/* ── The value of an evaluated expression ──────────────────────────── */
/* C-x C-e compiles a thunk that renders one expression and emits it here, a
* piece at a time. It is not written to stdout: stdout belongs to the program,
* it is in the hot path for anything that prints, and a dev-only feature must
* not put a branch in it. The daemon reads this back over the agent's socket.
*
* Emitting piece by piece rather than returning one string is what makes a
* composite renderer possible at all — a struct is its fields with punctuation
* between them, and concatenating that in the generated IR would mean an
* allocator the language does not have.
*
* The output bound lives here and nowhere else. A slice of a million elements
* renders with a loop the compiler cannot bound, so [emit] truncates and
* [end] says so with an ellipsis. One place enforcing it means no renderer has
* to carry a budget.
*
* [generation] is what makes the read safe without a handshake. The thunk runs
* on the game thread at a frame boundary, whenever that happens to be; the
* daemon waits for the counter to move rather than guessing it has.
*
* It is a *seqlock*, and it has to be a real one, because the reader is the
* agent's listener thread and the writer is the game thread and neither waits
* for the other. The counter is odd for exactly as long as a value is being
* written, so a reader that sees an odd count, or a different count either
* side of its copy, has read a value that was being overwritten underneath it
* and reads again. A count of 2k means k complete values; the count the
* outside world is given is that k, so that the daemon's "has it moved" keeps
* meaning "is there a new value".
*
* The copy is what makes it safe, and the API is shaped around that: a reader
* gets *bytes of its own*, not a pointer into [result]. The pointer version of
* this was the bug — it read the generation, then a length, then handed back
* the buffer itself, and the caller sent it down a socket some time later
* while the game thread was free to be a hundred bytes into the next value.
* A seqlock cannot validate a read that happens after it returns. */
/* Fixed, and it stays fixed. This was expected to go with the socket — a 4K
* cap reads like a transport buffer — and it is not one. This is the buffer
* the *game thread* writes into, from a render thunk at a frame boundary, and
* a growable one would mean the frame thread calling realloc: an allocation in
* the one place this whole design exists to keep allocation out of. It would
* also break the seqlock above, which is a protocol about torn *contents* and
* assumes the address it memcpys from does not move or go away underneath it;
* growing on the writer's side is a use-after-free the counter cannot see.
*
* So the cap is a render budget, not a wire size, and what did go is the
* agent's second copy of the number. Removing the bound itself is a redesign
* of the read — probe, allocate, re-read, validate, retry — and belongs with
* moving the read to a frame boundary, which is the seqlock's own decision. */
#define RESULT_MAX 4096
static char result[RESULT_MAX];
static size_t result_len;
static int result_full;
static uint64_t generation;
void flan_dev_result_begin(void) {
/* Odd first, and only then the reset: the counter has to say "in progress"
* before the buffer stops being the value it used to be.
*
* The fence is the half of that a release *store* cannot do. A release store
* orders what comes before it, not what comes after, so the writes below —
* and every memcpy in [emit] — would be free to become visible ahead of the
* odd count, and a reader could see an even count either side of a copy it
* made while the buffer was being overwritten. Which is the bug this
* replaced, with more ceremony. So: mark it relaxed, fence, then write.
*
* Setting the low bit rather than incrementing, because a [begin] with no
* [end] is reachable and must not poison the counter for the life of the
* process. A render thunk that signals is stopped inside this window, and a
* restart taken from that break transfers past the thunk — [end] never runs.
* Repairing it here costs nothing in the ordinary case (2k, 2k+1, 2k+2) and
* means an abandoned write is over as soon as the next evaluation starts,
* rather than leaving every later read reporting "in progress" forever.
*
* What it does not fix, because the buffer cannot: an evaluation that runs
* while another is stopped mid-render shares this one buffer, so the inner
* value is the one that survives and the outer thunk, if it is ever resumed,
* appends to it. That was true before the counter was a seqlock. */
__atomic_store_n(&generation, generation | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
result_len = 0;
result_full = 0;
}
void flan_dev_emit(const uint8_t *bytes, int64_t len) {
size_t n = len < 0 ? 0 : (size_t)len;
if (result_len + n > RESULT_MAX) {
n = RESULT_MAX - result_len;
result_full = 1;
}
memcpy(result + result_len, bytes, n);
result_len += n;
}
/* ── Rendering a scalar, into whichever buffer is being written ──────── */
/* This file has two buffers a rendered value can go into: the result buffer
* above, which an evaluated expression's rendering streams into for the REPL
* to read back, and the current watch slot further down. What they hold is
* the same four renderings — an i64, a u64, an f64, a quoted string — and the
* only thing that differed was which of [flan_dev_emit] and
* [flan_dev_watch_emit] the bytes went to. So that is the parameter, and the
* eight exported entry points are eight one-line calls into these four.
*
* The exports stay eight. The compiler emits the result four by name — see
* [Session.externs] — and the watch four are exported C, which a program can
* reach through declare-c and which the [(watch ...)] arm described further
* down would be pointed at. They are ABI, and ABI does not collapse just
* because the bodies did. */
typedef void (*sink)(const uint8_t *, int64_t);
static void put(sink out, const char *s) {
out((const uint8_t *)s, (int64_t)strlen(s));
}
/* Rendered in C so that u64 is not a lie: the language's own i64->bytes is
* signed, and anything past 2^63 would come back negative. */
static void put_u64(sink out, uint64_t x) {
char buf[32];
snprintf(buf, sizeof buf, "%llu", (unsigned long long)x);
put(out, buf);
}
static void put_i64(sink out, int64_t x) {
char buf[32];
snprintf(buf, sizeof buf, "%lld", (long long)x);
put(out, buf);
}
/* Unsigned NaN, and the rule is flan_rt.c's rather than a second statement of
* it: [flan_f64_format] is what println renders through, and the REPL, a watch
* row and println must not disagree about what one value looks like. A NaN's
* sign bit is decided by whether the value was folded or computed, so showing
* it would make the printed form depend on the backend and the optimisation
* level rather than on the number. */
extern int flan_f64_format(double x, char *buf, size_t cap);
/* Quoted and escaped, in C, because doing it in the generated IR would be a
* loop per string and the language has no allocator to build the result in.
* A string whose content is not escaped does not round-trip and reads as a
* framing bug rather than as the value it is — and a newline in a watched
* string would become a second row of the table on the wire.
*
* The table is flan_rt.c's [flan_escape_char], which is also what println's
* [flan_escape_bytes] escapes through: one table, and the two callers differ
* only in how they frame what comes out of it. flan_dyn.c has a copy of the
* table rather than a call to it, deliberately and for a reason argued there
* and in docs/SPIKE-DUPLICITY.md §9. */
extern int flan_escape_char(unsigned char c, char *out);
/* The two [extern]s above are this file's hand copies of prototypes flan_rt.c
* owns, and nothing in the build compares the two: each translation unit is
* compiled on its own with no include path (see [Build.compile_c]), and the
* link that joins them matches names and not types. A parameter added on one
* side, a [size_t] cap that becomes an [int], a return that stops being a
* length — all of those build clean and then go wrong here, inside a render,
* with nothing pointing at the cause.
*
* So they are checked the way the tree checks its other cross-file agreement
* it cannot #include its way out of — by value, at run time, loudly. That is
* [flan_vec_layout] and test/dyn_ops.c's "layout" mode for the vec header;
* this is the same idea one function wide. Two calls with known answers, once
* per process, on the first value this file renders: if the callee is not the
* function these declarations describe, the answers do not come back right
* and the process stops here rather than emitting a wrong wire format.
*
* Not a constructor, because flan_dev.c is linked into every build and not
* only a dev one, and nothing should run in a release image that its program
* did not ask for. On the first render instead: the branch is one predictable
* test per value, and it runs in the dev paths only, which are the only paths
* that reach these two functions from here. */
static void check_shared(void) {
static int checked;
char buf[64];
char e[4];
if (checked) return;
checked = 1;
if (flan_f64_format(1.5, buf, sizeof buf) != 3 || strcmp(buf, "1.5") != 0)
die("flan_f64_format is not the function this file declares", "1.5");
if (flan_escape_char('\n', e) != 2 || e[0] != '\\' || e[1] != 'n')
die("flan_escape_char is not the function this file declares", "newline");
}
static void put_f64(sink out, double x) {
char buf[64];
check_shared();
flan_f64_format(x, buf, sizeof buf);
put(out, buf);
}
static void put_str(sink out, const uint8_t *bytes, int64_t len) {
size_t n = len < 0 ? 0 : (size_t)len;
check_shared();
put(out, "\"");
for (size_t i = 0; i < n; i++) {
char e[4];
int k = flan_escape_char(bytes[i], e);
out((const uint8_t *)e, (int64_t)k);
}
put(out, "\"");
}
/* Closing a value, in the two halves the seqlock needs it in. Shared by
* [flan_dev_result_end] and [flan_dev_watch_end], which is the same seqlock
* twice over two different buffers.
*
* The first half is the ellipsis a full buffer earns. Room for it is made
* rather than assumed: the buffer is full by definition when [full] is set.
*
* They are two functions and not one because everything a reader will look at
* has to be stored before the generation is, and a caller may have a length
* of its own to write back — the watch slot keeps its length in 32 bits and
* so cannot pass its own field here. Splitting lets that write-back land
* inside the odd window where it belongs, rather than after the release
* store, where it would be a tear the day a length actually changed. */
static void truncate_value(char *buf, size_t *len, size_t cap, int full) {
if (full) {
const char *ell = "...";
size_t k = strlen(ell);
if (*len > cap - k) *len = cap - k;
memcpy(buf + *len, ell, k);
*len += k;
}
}
/* The second half: the counter last, and back to even, so a reader that sees
* the new generation sees the whole value. [| 1] first for the same reason
* [begin] sets rather than increments: this must land on an even count
* whatever state an abandoned write left behind. Nothing a reader reads may
* be written after this returns. */
static void close_value(uint64_t *gen) {
__atomic_store_n(gen, (*gen | 1) + 1, __ATOMIC_RELEASE);
}
void flan_dev_emit_u64(uint64_t x) { put_u64(flan_dev_emit, x); }
void flan_dev_emit_i64(int64_t x) { put_i64(flan_dev_emit, x); }
void flan_dev_emit_f64(double x) { put_f64(flan_dev_emit, x); }
void flan_dev_emit_str(const uint8_t *bytes, int64_t len) {
put_str(flan_dev_emit, bytes, len);
}
/* The character half of a u8, appended after the number: " (\a)", or nothing
* for a byte with no spelling a reader would accept.
*
* A u8 is a number and prints as one — [println] is unchanged. But a *reader*
* looking at a frame is in the asymmetric position the author named: [u8]
* already renders as text, so a lone byte showing 97 is the one place the
* same data reads two ways. This is the inspecting half, and only the
* inspecting renderers call it.
*
* The spellings are lib/reader.ml's [read_byte], which is the authority: the
* five named ones, and any single character that is not a delimiter there —
* so what is shown could be typed back. A delimiter has no single-character
* spelling and no name, and a control byte has neither; both get the number
* alone rather than an invented escape or a raw control byte written into a
* buffer someone is about to read. Done here rather than as emitted
* comparisons because the value is only known at run time: a chain over
* ninety-odd bytes per rendered u8 would be the walk paying for its own
* shape, and the table belongs in one place. */
/* No [check_shared] here, deliberately: that guard checks [flan_f64_format]
* and [flan_escape_char] are the functions this file declares, and this uses
* neither — same as [put_u64] and [put_i64], which do not call it either. */
void flan_dev_emit_u8_char(int64_t x) {
const char *name = NULL;
char one[2];
if (x < 0 || x > 255) return;
switch (x) {
case 32: name = "space"; break;
case 9: name = "tab"; break;
case 10: name = "newline"; break;
case 13: name = "return"; break;
case 0: name = "nul"; break;
default: break;
}
if (name == NULL) {
/* Printable and not one of the reader's delimiters. */
if (x < 33 || x > 126) return;
switch ((char)x) {
case '(': case ')': case '[': case ']': case '{': case '}':
case '"': case ';': case '`': case '~': case ',':
return;
default: break;
}
one[0] = (char)x;
one[1] = '\0';
name = one;
}
/* [put] and not [put_str]: this is punctuation around a spelling, not a
* string value, so it must not be quoted or escaped a second time. Every
* byte written here is one [read_byte] would accept back. */
put(flan_dev_emit, " (\\");
put(flan_dev_emit, name);
put(flan_dev_emit, ")");
}
void flan_dev_result_end(void) {
truncate_value(result, &result_len, RESULT_MAX, result_full);
close_value(&generation);
}
/* Copy the current value out, with the counter that says which one it is.
*
* Returns 1 having copied a value that was complete for the whole of the copy,
* 0 if the game thread was in the middle of writing one — in which case [gen]
* is the last *complete* value's number and [len] is 0, so a caller polling
* for a new one keeps polling instead of being handed half of it. Spinning
* here is bounded: the writer is a render thunk between frames, not a loop,
* and the reader is the listener thread, which has nothing better to do.
*
* [cap] is the caller's buffer. A value longer than it is truncated, which is
* the only failure this can have and is a clamp rather than an overrun; every
* caller sizes its buffer from [flan_dev_result_cap] so it does not arise. */
/* What a caller's buffer has to be for the copy never to be truncated. One
* declaration, asked for rather than written down twice — the agent carried
* its own copy of the number and a check that the two had not drifted, back
* when it was sizing something to send through a socket. */
uint64_t flan_dev_result_cap(void) { return RESULT_MAX; }
int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
uint64_t *len) {
for (int attempt = 0; attempt < 64; attempt++) {
uint64_t g1 = __atomic_load_n(&generation, __ATOMIC_ACQUIRE);
if (g1 & 1) continue; /* a write is in progress */
size_t n = __atomic_load_n(&result_len, __ATOMIC_RELAXED);
if (n > RESULT_MAX) n = RESULT_MAX; /* a torn read cannot overrun */
if ((uint64_t)n > cap) n = (size_t)cap;
memcpy(dst, result, n);
/* The copy must be ordered before the second read of the counter, or the
* check is of a copy the compiler was free to make afterwards. */
__atomic_thread_fence(__ATOMIC_ACQUIRE);
if (__atomic_load_n(&generation, __ATOMIC_ACQUIRE) == g1) {
*gen = g1 / 2;
*len = (uint64_t)n;
return 1;
}
}
/* Integer division is the same answer either side of a write in progress:
* during value k the counter is 2k-1 and k-1 are complete. */
*gen = __atomic_load_n(&generation, __ATOMIC_ACQUIRE) / 2;
*len = 0;
return 0;
}
/* ── The watch table ────────────────────────────────────────────────── */
/* A HUD, pushed rather than polled, and the push is why it exists at all.
*
* The watch buffer's obvious shape is the one the author's Clojure version
* has: Emacs polls a render function on a timer and paints what it returns.
* That does not port. Here an evaluation *compiles a module and dlopens it* —
* tens of milliseconds and a new .so each time, in a directory nothing sweeps
* — so a 5Hz poll is hundreds of shared objects a minute for a value that was
* already sitting in a register.
*
* So the direction is inverted. The program writes: it calls
* [flan_dev_watch_*] from inside its own loop, which renders the value to text
* and stores it under a name. Emacs reads the *table*, which is memory. Both
* halves are cheap for opposite reasons, the values update at frame rate
* rather than at timer rate, and — the part a poll cannot do at all — the last
* frame's values are still here while the program is stopped in a break loop,
* because nothing has to run to produce them.
*
* Everything below is written for one caller: the game thread, mid-frame.
* That is the same constraint the rest of this file is under and it is
* stricter here, because this runs every frame rather than once per
* evaluation:
*
* - No allocation. Names are fixed char arrays inside the table, not
* strdup'd the way [intern] above does it. [intern] runs at module load
* and may malloc; this runs at 60fps and may not.
* - No lock. The reader is the agent's listener thread and the writer is the
* game thread; neither waits for the other.
* - No call into OCaml, which is the rule that keeps the collector off the
* frame thread. Nothing here is OCaml.
*
* Deliberately NOT sharing [result] and [generation] above. It was tempting —
* the renderers are the same shape — and it is wrong: [result] is written once
* per C-x C-e and this is written every frame, so watch traffic would overwrite
* the value of every expression anyone evaluated. The two are separate storage
* with separate counters and that is not an accident.
*/
/* The three bounds, and what happens past each one.
*
* [WATCH_MAX] slots. Past it, a name is **dropped**, not fatal. The house
* style elsewhere in this file is [die], and this is the one place it would be
* wrong: a watch is a diagnostic, and killing the program because somebody
* watched a 65th value is the diagnostic shooting the patient. It is not
* silent either — [flan_dev_watch_overflowed] is read back with the table and
* the buffer says so, so an overflow is visible rather than a value that
* mysteriously never appears.
*
* A flag and **not a count**, which is the correction worth recording. A
* counter here would be incremented from the write path, and the write path
* runs once per watched value per *frame* — so one name too many at 60fps
* reads back as "3847 names found no slot" within a minute, which is a false
* sentence about a true problem. What a reader needs is "the table is full and
* something is not being shown", which is one bit, and one bit cannot drift
* into a wrong number. Counting *distinct* names that missed would mean
* remembering which ones had, which is exactly the bookkeeping the frame
* thread has no room for.
*
* [WATCH_NAME] bytes of name, [WATCH_VAL] bytes of rendered value. Both
* truncate; the value's truncation shows as an ellipsis, the same as
* [result_end] does, so a clipped value does not read as a complete one. */
#define WATCH_MAX 64
#define WATCH_NAME 32
#define WATCH_VAL 192
typedef struct {
char name[WATCH_NAME]; /* NUL-terminated, truncated to fit */
char val[WATCH_VAL];
uint32_t len;
int full; /* the value did not fit */
/* An accumulator slot. [val]/[len] are unused; the five doubles below are
* the value, and the *reader* turns them into text. See "A number sampled
* thousands of times a frame" below. */
int num;
uint64_t epoch; /* the window [n]/[lo]/[hi]/[sum] belong to */
double n, lo, hi, last, sum;
uint64_t gen; /* this slot's own seqlock */
} watch_slot;
static watch_slot watch_table[WATCH_MAX];
static uint32_t watch_used; /* claimed slots; only ever grows */
static int watch_overflowed; /* some name found no slot; see above */
/* The current accumulation window. Bumped by [flan_dev_watch_reset], which is
* the editor saying "start again from here"; a slot notices on its next
* sample. The counter is the reader's to move and the slots are the writer's
* to clear, so no thread ever writes the other's memory. */
static uint64_t watch_epoch;
/* One counter per slot rather than one for the table.
*
* A table-wide counter would make a read all-or-nothing: the reader would have
* to copy every slot inside a single even generation, which means catching the
* gap *between* two frames' worth of writes — a window that at 60fps is
* whatever the game does after its last watch call, and may be nothing.
* Per-slot, the reader retries one slot at a time and always gets somewhere,
* and the worst it can produce is a snapshot whose entries come from adjacent
* frames. For a HUD that is not a defect: a frame counter one ahead of a
* position read a millisecond earlier is what a HUD looks like anyway. It
* would be a defect for anything where two values have to agree, and if that
* is ever wanted it is a different op, not a bigger counter. */
/* Is anyone looking?
*
* Set when a watch buffer opens and cleared when it closes, so the cost of a
* watch call in a program nobody is debugging is one relaxed load and a
* not-taken branch. That is what "watching costs nothing when nobody is
* watching" means here, and it is the same number in a dev build and a release
* build — [flan_dev.c] is linked into both (see [Build], which says why) so the
* symbols resolve either way and there is no second version of this file.
*
* What it is *not*: free. Eliding the call entirely needs the compiler to know
* the form, which is a [check.ml] arm this does not have. A load and a branch
* per watched value per frame is the honest number, and it is the same number
* in both builds rather than a dev-only tax. */
static int watch_on;
void flan_dev_watch_enable(int on) {
__atomic_store_n(&watch_on, on ? 1 : 0, __ATOMIC_RELAXED);
}
/* The slot a name owns, or NULL if the table is full.
*
* Linear, because the table is 64 long and a hash would need a policy for
* collisions that a scan does not. A HUD with twenty values does twenty
* strcmps of a handful of bytes per frame; if that ever shows up in a profile
* the answer is to watch fewer things.
*
* [watch_used] only ever grows and a slot's name never changes once set, so a
* reader can walk [0, watch_used) without synchronising against this: the
* worst it sees is a slot whose name is written and whose value is not yet,
* which that slot's own seqlock catches. */
static watch_slot *watch_find(const char *name) {
uint32_t used = __atomic_load_n(&watch_used, __ATOMIC_RELAXED);
for (uint32_t i = 0; i < used; i++)
if (strncmp(watch_table[i].name, name, WATCH_NAME - 1) == 0)
return &watch_table[i];
if (used == WATCH_MAX) {
__atomic_store_n(&watch_overflowed, 1, __ATOMIC_RELAXED);
return NULL;
}
watch_slot *s = &watch_table[used];
size_t n = strlen(name);
if (n > WATCH_NAME - 1) n = WATCH_NAME - 1;
memcpy(s->name, name, n);
s->name[n] = '\0';
s->len = 0;
s->full = 0;
/* Published last, so a reader that sees this index sees a finished name. */
__atomic_store_n(&watch_used, used + 1, __ATOMIC_RELEASE);
return s;
}
/* The slot the emitters below are writing into. A plain static and not an
* atomic, because begin/emit/end is one uninterrupted run on the one thread
* that writes — the same assumption [result_len] above is written under. */
static watch_slot *watch_cur;
/* Open a slot for writing; 0 if nobody is watching or the table is full, in
* which case the emitters below are no-ops and the caller need not branch.
*
* Odd first, then the reset, for [flan_dev_result_begin]'s reason: the counter
* has to say "in progress" before the buffer stops being the value it used to
* be, and a release *store* orders only what precedes it, so the fence is the
* half it cannot do. Setting the low bit rather than incrementing means a
* begin whose end never runs — a break taken inside a render — is repaired by
* the next write rather than poisoning the slot for the life of the process. */
int flan_dev_watch_begin(const char *name) {
if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) { watch_cur = NULL; return 0; }
watch_slot *s = watch_find(name);
watch_cur = s;
if (s == NULL) return 0;
__atomic_store_n(&s->gen, s->gen | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
s->len = 0;
s->full = 0;
/* A name written as text is a text slot from now on. The table's rule
* everywhere else is that the last writer wins and this is the same rule;
* a program that watches one name both ways gets whichever ran last, and
* that is not worth a guard on the frame thread. */
s->num = 0;
return 1;
}
void flan_dev_watch_emit(const uint8_t *bytes, int64_t len) {
watch_slot *s = watch_cur;
if (s == NULL) return;
size_t n = len < 0 ? 0 : (size_t)len;
if (s->len + n > WATCH_VAL) {
n = WATCH_VAL - s->len;
s->full = 1;
}
memcpy(s->val + s->len, bytes, n);
s->len += (uint32_t)n;
}
/* The four renderings, aimed at the watch slot instead of the result buffer.
* The bodies are [put_i64] and friends above — see the note there for why the
* entry points stay four while the rendering is one. */
void flan_dev_watch_emit_i64(int64_t x) { put_i64(flan_dev_watch_emit, x); }
void flan_dev_watch_emit_u64(uint64_t x) { put_u64(flan_dev_watch_emit, x); }
void flan_dev_watch_emit_f64(double x) { put_f64(flan_dev_watch_emit, x); }
void flan_dev_watch_emit_str(const uint8_t *bytes, int64_t len) {
put_str(flan_dev_watch_emit, bytes, len);
}
void flan_dev_watch_end(void) {
watch_slot *s = watch_cur;
watch_cur = NULL;
if (s == NULL) return;
/* [len] widened and narrowed around the shared truncate, which counts in
* size_t because the result buffer does; a slot's own length is 32 bits
* and [WATCH_VAL] is 192, so neither conversion can lose anything.
*
* The narrowing write-back goes before [close_value] and not after it: a
* reader takes [len] and [val] together under the generation, so a length
* stored after the release store is a length the reader is entitled to
* have missed. It happens to write back the same bit pattern today — only
* a [full] slot is truncated, and a full slot's length is already
* [WATCH_VAL] — but that is a fact about the current cap arithmetic and
* not a rule anyone reading this would keep. */
size_t len = s->len;
truncate_value(s->val, &len, WATCH_VAL, s->full);
s->len = (uint32_t)len;
close_value(&s->gen);
}
/* ── Watching one scalar, with no compiler change ───────────────────── */
/* These are the whole feature for a scalar, and they are what a program can
* use today:
*
* (declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
* ...
* (watch-i64 "ticks" ticks)
*
* No arm in the checker, no new special form, nothing the compiler has to
* learn — which is the point, because the checker is not a file this change
* owns.
*
* They return i32 rather than nothing for a blunt reason: [declare-c] refuses
* a void return outright — "which is not a value C can carry", shim.ml — so a
* function a program can declare has to return something. Since it must, it
* returns the useful thing: 1 if the value was written, 0 if it was not,
* which is either nobody watching or a full table. A caller is free to ignore
* it and normally does.
*
* A composite — a struct, a slice, a union — cannot be done this way, and that
* is not a shortcoming of these four: a Flan value carries no header, so
* nothing at run time can say what it is, and rendering one is a compile-time
* walk over its *type*. The walk already exists — [Render.render] — and the
* four [flan_dev_watch_emit_*] above are the emitter it would be pointed at,
* shaped exactly like the [print] arm's. What is missing is the
* [(watch "hp" hp)] arm in check.ml that joins the two, which is a file this
* change does not own. docs/BUILT.md says what that arm is. */
int32_t flan_dev_watch_i64(const char *name, int64_t x) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_i64(x);
flan_dev_watch_end();
return 1;
}
int32_t flan_dev_watch_f64(const char *name, double x) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_f64(x);
flan_dev_watch_end();
return 1;
}
int32_t flan_dev_watch_str(const char *name, const char *s) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_str((const uint8_t *)s, (int64_t)strlen(s));
flan_dev_watch_end();
return 1;
}
/* ── A number sampled thousands of times a frame ─────────────────────── */
/* The scalar watch above keeps one value per name, and from a hot inner loop
* that is nearly useless: you see whichever of the 91,200 cells happened to
* run last. This is the other half — the port of [spy-num] from the author's
* watch.clj, which exists for exactly that reason and is the piece docs/PORTING.md
* calls the least obvious and the most valuable.
*
* **What a slot keeps: count, min, max, last, mean.** Five numbers, and the
* argument for them is that they are the ones you can ask for without building
* a query. [n] says how many times the expression ran, which is the first
* thing that is wrong when a loop is wrong. [min] and [max] are the range,
* which is what you are looking for when you suspect an index or a velocity is
* leaving the region it should stay in — and a range is the thing a single
* sample can never show you. [last] is the one sample, kept because it is what
* the scalar watch would have given you and losing it would be a regression.
* [mean] is carried as a running [sum] and divided at read time, because a
* mean accumulated as a mean drifts and a sum does not.
*
* **What it deliberately does not keep: a ring, or a history.** A small ring
* of the last N samples was the other candidate. It loses on the only ground
* that matters here: N samples out of 91,200 is a sample of the *tail* of the
* loop, not of the loop, so it answers "what did the last few cells do" when
* the question is "what did the cells do". Every richer answer than five
* numbers is a UI for building a query, and a query builder is the one thing
* this design exists not to be.
*
* **The write path does no formatting.** That is the entire point and is where
* the naive version dies: an [snprintf] per sample at thousands of samples per
* frame is a HUD that costs more than the game. A sample here is a load, five
* compares and stores, and the slot's seqlock. The *reader* — the agent's
* listener thread, once per editor tick — turns the five numbers into text.
* watch.clj reaches the same place with a double-array per label and a render
* function Emacs calls; the reasoning is the author's, not ours.
*
* **The window is since the last reset, not since the program started.** This
* is the one place this deliberately *diverges* from watch.clj, whose stats
* are cumulative until [reset-spies!] is called by hand. Cumulative is the
* wrong default for a frame loop: a min and a max over a whole session reach
* the session's extremes within a few seconds of play and then never move
* again, so the two most useful of the five go dead exactly when you start
* interacting with the thing you are debugging. This tool exists to show you a
* number while you drag the mouse. So the editor bumps
* [flan_dev_watch_reset] on its tick and each slot clears itself on its next
* sample, which makes the displayed range "since you last looked" — a fifth of
* a second, a dozen frames — and keeps it tracking the present. A caller that
* wants cumulative numbers gets them by not resetting; that is the setting,
* and it lives in the editor rather than here.
*
* **i64 accumulates as a double**, so a magnitude past 2^53 loses precision in
* the sum and in the ends of the range. Said rather than designed around: a
* count, a coordinate and a tile index are what this is pointed at, and a
* second integer accumulator to cover the case nobody has would be two code
* paths for one tool. */
static void watch_record(watch_slot *s, double v) {
uint64_t e = __atomic_load_n(&watch_epoch, __ATOMIC_RELAXED);
/* Odd first, then the change, then even — [flan_dev_watch_begin]'s protocol
* exactly, and the epoch check is *inside* the odd window so a reader can
* never catch a half-cleared slot. */
__atomic_store_n(&s->gen, s->gen | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
s->num = 1;
if (s->epoch != e) { s->epoch = e; s->n = 0; s->sum = 0; }
if (s->n == 0) { s->lo = v; s->hi = v; }
else { if (v < s->lo) s->lo = v; if (v > s->hi) s->hi = v; }
s->n += 1;
s->sum += v;
s->last = v;
__atomic_store_n(&s->gen, (s->gen | 1) + 1, __ATOMIC_RELEASE);
}
/* Start a new window. Called by the editor beside its table read, never by the
* program. It moves one counter and touches no slot, which is what keeps the
* game thread the only writer of the table. */
void flan_dev_watch_reset(void) {
__atomic_add_fetch(&watch_epoch, 1, __ATOMIC_RELEASE);
}
/* Reachable from a program by [declare-c], the same as the four scalars and
* for the same reason — no arm in the checker, nothing the compiler learns:
*
* (declare-c watch-num-i64 [name string x i64] i32 "flan_dev_watch_num_i64")
* ...
* (watch-num-i64 "cell" (at grid i))
*
* Two entry points rather than one so a program need not cast an i64 to an f64
* at the call site, which is noise in the one place this is meant to be
* droppable into. */
int32_t flan_dev_watch_num_i64(const char *name, int64_t x) {
if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) return 0;
watch_slot *s = watch_find(name);
if (s == NULL) return 0;
watch_record(s, (double)x);
return 1;
}
int32_t flan_dev_watch_num_f64(const char *name, double x) {
if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) return 0;
watch_slot *s = watch_find(name);
if (s == NULL) return 0;
watch_record(s, x);
return 1;
}
/* A whole number prints as one. watch.clj's [fmt-num] does this and the reason
* is worth keeping: a spy on an array index that reads 66.0000 makes you look
* for a rounding bug that is not there. */
static void watch_num_str(char *out, size_t cap, double d) {
if (d >= -9.0e15 && d <= 9.0e15 && d == (double)(long long)d)
snprintf(out, cap, "%lld", (long long)d);
else
snprintf(out, cap, "%.4f", d);
}
/* Rendered on the listener thread, from numbers already copied out of the
* slot, so nothing here races and nothing here runs per sample. Comfortably
* inside [WATCH_VAL]: five numbers at %.4f and their labels is well under 192
* bytes, and [snprintf] truncates rather than overruns if a caller's buffer is
* smaller than [flan_dev_watch_val_cap].
*
* **[n] is at least 1 whenever this runs**, so there is no empty-window arm
* and [sum / n] cannot divide by zero. A slot only becomes a num slot inside
* [watch_record], which always falls through to [s->n += 1], and the clear on
* an epoch change sits in the same odd-generation window as that increment, so
* no reader can catch a num slot at zero.
*
* There used to be an "n=0 last=..." arm here, for the window a reset opens
* before the program's next sample. It is deleted rather than kept, because
* the only way to reach it is to compare [s->epoch] with [watch_epoch] in
* [flan_dev_watch_read] — and that is the one thing the reader must not do. A
* stopped program does not sample. An epoch-aware reader would blank the watch
* for as long as the program stayed stopped, and looking at the numbers from
* the moment you stopped is the whole point of stopping. The lazy clear is
* right there; its cost is one stale tick in a *running* program, and the
* editor keeps even that honest by not sending [:reset] while the program is
* stopped. See [flan-watch--tick]. */
static uint64_t watch_render_num(double n, double lo, double hi, double last,
double sum, char *vd, uint64_t vcap) {
if (vcap == 0) return 0;
char b[4][40];
int k;
watch_num_str(b[0], sizeof b[0], lo);
watch_num_str(b[1], sizeof b[1], hi);
watch_num_str(b[2], sizeof b[2], last);
watch_num_str(b[3], sizeof b[3], sum / n);
k = snprintf(vd, (size_t)vcap, "n=%lld min=%s max=%s last=%s mean=%s",
(long long)n, b[0], b[1], b[2], b[3]);
if (k < 0) return 0;
if ((uint64_t)k > vcap - 1) return vcap - 1;
return (uint64_t)k;
}
/* ── Reading the table back ─────────────────────────────────────────── */
/* How many slots have ever been claimed. Only grows, so a reader walking
* [0, n) is walking names that are all finished. */
uint32_t flan_dev_watch_count(void) {
return __atomic_load_n(&watch_used, __ATOMIC_ACQUIRE);
}
/* Whether any name ever found no slot. Never cleared: a table that overflowed
* once is a table whose contents are incomplete, and a name that was refused a
* slot does not get one later. */
int flan_dev_watch_overflowed(void) {
return __atomic_load_n(&watch_overflowed, __ATOMIC_RELAXED);
}
/* Copy slot [i] out: its name into [nd], its value into [vd].
*
* Returns 1 having copied a value that was complete for the whole of the copy,
* 0 if the game thread was in the middle of writing one — in which case [vlen]
* is 0 and the caller keeps whatever it showed last, which for a HUD is the
* right failure: a value that flickers to blank for one tick is worse than one
* that is a frame stale.
*
* The name needs no seqlock. It is written once, before [watch_used] is
* published with a release store, and never again.
*
* The copy is what makes this safe, and the API is shaped around it: the
* caller gets bytes of its own, never a pointer into the table. A seqlock
* cannot validate a read that happens after it returns — the bug
* [flan_dev_result_read] was rewritten for. */
int flan_dev_watch_read(uint32_t i, char *nd, uint64_t ncap,
char *vd, uint64_t vcap, uint64_t *vlen) {
*vlen = 0;
if (i >= __atomic_load_n(&watch_used, __ATOMIC_ACQUIRE)) return 0;
watch_slot *s = &watch_table[i];
if (ncap > 0) {
size_t n = strlen(s->name);
if (n > ncap - 1) n = (size_t)ncap - 1;
memcpy(nd, s->name, n);
nd[n] = '\0';
}
for (int attempt = 0; attempt < 64; attempt++) {
uint64_t g1 = __atomic_load_n(&s->gen, __ATOMIC_ACQUIRE);
if (g1 & 1) continue; /* a write is in progress */
/* An accumulator slot carries five doubles rather than rendered text, so
* what is copied under the seqlock is the numbers; the formatting happens
* *after* the counter check, out of locals, which is why it is safe to do
* it here at all. See "A number sampled thousands of times a frame". */
int isnum = __atomic_load_n(&s->num, __ATOMIC_RELAXED);
double an = s->n, alo = s->lo, ahi = s->hi, alast = s->last, asum = s->sum;
size_t n = __atomic_load_n(&s->len, __ATOMIC_RELAXED);
if (n > WATCH_VAL) n = WATCH_VAL; /* a torn read cannot overrun */
if ((uint64_t)n > vcap) n = (size_t)vcap;
if (!isnum) memcpy(vd, s->val, n);
/* Ordered before the second read of the counter, or the check is of a copy
* the compiler was free to make afterwards. */
__atomic_thread_fence(__ATOMIC_ACQUIRE);
if (__atomic_load_n(&s->gen, __ATOMIC_ACQUIRE) == g1) {
*vlen = isnum ? watch_render_num(an, alo, ahi, alast, asum, vd, vcap)
: (uint64_t)n;
return 1;
}
}
return 0;
}
/* What a caller's buffers have to be for a copy never to be truncated. Asked
* for rather than written down twice, the same as [flan_dev_result_cap]. The
* value's is [WATCH_VAL] plus the ellipsis [end] may append. */
uint64_t flan_dev_watch_name_cap(void) { return WATCH_NAME; }
uint64_t flan_dev_watch_val_cap(void) { return WATCH_VAL + 4; }
/* ── The shadow stack ───────────────────────────────────────────────── */
/* plan.org's "Dev vs release builds" has had *Frames: shadow stack* in the dev
* column since the beginning. This is it, and it exists for one reason: the
* more a break loop can show, the less often a real debugger is needed. A
* stopped program that cannot say where it is sends someone to lldb.
*
* Native unwinding would be the other route and is deliberately not taken:
* plan.org lowers every non-local exit explicitly rather than through platform
* unwinding, so there is no .eh_frame walk to borrow, and a frame pointer walk
* gives addresses that only DWARF can turn back into names. A pushed record
* carries the name itself, is the same on wasm32 as it is here, and needs no
* agreement with the optimiser about what a frame looks like.
*
* The compiler emits the push and the pop inline (emit.ml, [emit_fn]) rather
* than calling in here: this is on every call in a dev build, and a call to
* record a call would double the thing being measured.
*
* A plain global, not a _Thread_local. It matches what the handler stack and
* the restart stack in flan_rt.c already assume — one thread runs Flan; the
* listener thread runs C and the loader and never enters a Flan body. If the
* language ever grows threads this becomes thread-local and the compiler's
* two stores become TLS-relative, which is the only change.
*
* Nothing in here walks the chain while the game thread is running. The break
* loop snapshots it on the stopped thread, exactly as it snapshots the restart
* list and for exactly the same reason: a chain read by another thread is a
* chain that can be popped underneath the reader. The accessors below are the
* snapshot's, and take the frame they were given rather than re-reading the
* head. */
typedef struct {
const char *name; /* the Flan name, qualified; not NUL-terminated */
int64_t namelen;
const char *loc; /* file:line:col, as Loc spells it */
int64_t loclen;
int32_t nslots;
/* What the two ends compare about a frame's slots, from
[Emit.slot_fingerprint]: a hash over every slot's name and the spelling of
its type. The frame carries the one belonging to the body it was compiled
from; the daemon recomputes it from the body it now holds, and a
difference means the frame is running a superseded body. A count alone
cannot see a rename, which is the case this exists for. */
int32_t slotsig;
/* And the globals half, from [Reach.ref_fingerprint]: a hash over the set of
globals the body names. Separate from [slotsig] on purpose — a body can
name different globals while binding identical locals, so a frame's locals
can be trustworthy while its contribution to the globals section is not,
and one number over both would refuse a frame that reads perfectly. */
int32_t refsig;
} flan_fninfo;
typedef struct flan_frame {
struct flan_frame *prev;
const flan_fninfo *info;
/* One entry per slot, each null until the binding that fills that slot has
* run — so "not bound yet at the point this frame stopped" is a null and
* needs no liveness analysis to work out. Null altogether for a function
* with no named slot, and in a release build there is no frame at all.
* Read through [flan_dev_frame_slot], which is where the bound is checked. */
void **slots;
} flan_frame;
/* The compiler names this symbol directly. A redefinition module reaches it
* the same way it reaches any other host global — through the dynamic symbol
* table, which [--dev] links with -rdynamic. */
flan_frame *flan_frame_head;
/* The chain, dropped. The counterpart of flan_rt.c's
* [flan_condition_stacks_reset] and there for the same one caller: the merged
* dev build's [main] can be entered a second time, and it gets back there by
* longjmp rather than by returning, so every frame the finished run pushed is
* still on this chain and every one of them is an alloca in stack that the
* next run is about to reuse. A backtrace taken after that would walk records
* whose [name] and [loc] pointers are whatever the new run happens to have
* written there — a listing that looks like a listing and names nothing real,
* which is the failure this whole file exists to avoid. */
void flan_dev_frames_reset(void) { flan_frame_head = 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) {
flan_frame *f = flan_frame_head;
while (f != NULL && i > 0) { f = f->prev; i--; }
return f;
}
int32_t flan_dev_frame_count(void) {
int32_t n = 0;
for (flan_frame *f = flan_frame_head; f != NULL; f = f->prev) {
n++;
if (n > 100000) break; /* a corrupt chain says so rather than hanging */
}
return n;
}
const char *flan_dev_frame_name(const void *frame, int64_t *len) {
const flan_frame *f = frame;
if (f == NULL || f->info == NULL) { *len = 0; return NULL; }
*len = f->info->namelen;
return f->info->name;
}
const char *flan_dev_frame_loc(const void *frame, int64_t *len) {
const flan_frame *f = frame;
if (f == NULL || f->info == NULL) { *len = 0; return NULL; }
*len = f->info->loclen;
return f->info->loc;
}
int32_t flan_dev_frame_nslots(const void *frame) {
const flan_frame *f = frame;
return (f == NULL || f->info == NULL) ? 0 : f->info->nslots;
}
/* The fingerprint of the body this frame was compiled from. Zero for a frame
* with no description, which is the same "nothing to compare" a zero slot
* count already means. */
int32_t flan_dev_frame_slotsig(const void *frame) {
const flan_frame *f = frame;
return (f == NULL || f->info == NULL) ? 0 : f->info->slotsig;
}
/* The fingerprint of the globals that body names. Zero for a frame with no
* description, the same "nothing to compare" the slot count and the slot
* fingerprint already mean. */
int32_t flan_dev_frame_refsig(const void *frame) {
const flan_frame *f = frame;
return (f == NULL || f->info == NULL) ? 0 : f->info->refsig;
}
/* Where slot [i] of this frame lives, or NULL — which means one of three
* things, all of which are "there is nothing to read here": this build records
* no slots, the index is not one of them, or the binding that fills it had not
* run when the frame stopped. A caller renders what it is given and refuses
* what it is not; nothing here guesses. */
void *flan_dev_frame_slot(const void *frame, int32_t i) {
const flan_frame *f = frame;
if (f == NULL || f->info == NULL || f->slots == NULL) return NULL;
if (i < 0 || i >= f->info->nslots) return NULL;
return f->slots[i];
}
/* ── The allocation registry: an address answers with a type ───────────
*
* A Flan struct is exactly its C layout: no header, no tag word. That is
* deliberate — it is what makes a struct free and the FFI work — and it is
* also why "what is at this address" has no run-time answer. A tag cannot be
* added without breaking raylib.
*
* The registry sidesteps the question rather than answering it. The
* allocator's *caller* knows the type at the moment it asks for memory, and
* the compiler is standing right there: a dev build emits one note after every
* allocating call, naming the type the memory was asked for. Nothing about a
* value's layout changes. A release build emits no note and this table stays
* empty for the life of the process.
*
* What a note records is a *block*, not a value: base, extent, and the size of
* one element. So a lookup is containment rather than equality, and that is
* not an optimisation — every pointer a program can hold into heap storage is
* interior. (at v i) is v->ptr + i*size and (resolve p h) is an item in the
* middle of a pool's array; neither is ever a base address. A table that
* answered only exact hits would answer nothing anybody can ask it.
*
* Dead entries are kept, which is the second thing this buys: an address that
* was freed still names what died. An entry is dropped only when the allocator
* hands the same address out again, which is exactly when the old answer stops
* being true.
*
* The type name is a pointer into read-only data, not a copy. The strings are
* the ones the compiler already emits beside the call site, and this file's
* header says a module is never dlclose'd, so they outlive the table.
*/
/* A power of two: the probe wraps with a mask. Fixed, and full is not fatal —
* see flan_dev_reg_note. */
#define FLAN_REG_CAP 4096
/* How many dead entries make a compaction worth running. Not a tuning knob: it
* is the difference between a diagnostic that works on a big program and one
* that lies to it.
*
* The high-water mark alone said "three quarters full, rearrange". But a
* compaction reclaims *dead* entries and nothing else, so a program holding
* more than three quarters of the table in live blocks met that mark on every
* allocation for the rest of its life, and every one of those allocations
* dragged the table-wide epoch odd and back. A listing racing that loop lost
* all eight of its attempts and answered "nothing is held" about a program
* holding three thousand blocks — measured at 198 wrong answers in 200. The
* verb that exists to find a leak reported the absence of one.
*
* So the trigger asks the question the work can actually answer: is there
* enough dead here to be worth the sweep. An eighth of the table is the floor,
* which bounds the cost from the other side too — a compaction that runs
* reclaims at least 512 slots, so it cannot run more than once per 512
* allocations, and the epoch is quiet in between. A table that is full of
* genuinely live blocks now stops rearranging itself and says it is full,
* which is the truth and was always the truth. */
#define FLAN_REG_RECLAIM (FLAN_REG_CAP / 8)
typedef struct {
const char *type; /* the Flan spelling, e.g. "Enemy" or "(Vec i32)" */
int64_t typelen;
uintptr_t base; /* 0 for an empty slot */
int64_t bytes; /* the extent of the block */
int64_t elem; /* one element's size, or 0 if it is not an array */
int64_t seq; /* when it was made */
int64_t died; /* when it was released, or 0 while it is live */
uint64_t gen; /* this slot's own seqlock; odd while it is written */
} flan_reg_entry;
/* ── Why this table has a seqlock and the watch table's is the model ───
*
* The writer is the game thread, inside every allocation and every free. The
* reader is the agent's listener thread, on a program that is *running* — the
* two listing verbs answer "where did the memory go" and "what is still held",
* and the second of those is asked in the last moment before a game is killed,
* which is a moment the program is not stopped in. So the frame chain's answer
* — snapshot it while the thread is parked — is not available to this table,
* and a plain read of it is a read of eight words another thread is in the
* middle of writing.
*
* The consequence is not a slightly wrong number. [type] and [typelen] are a
* pointer and a length that are only meaningful together, and a reader that
* takes the new pointer with the old length reads off the end of a string
* literal. That is the failure this closes.
*
* Per slot, exactly as [watch_slot] does it: odd while a write is in flight,
* even when it is whole, and a reader copies the slot and re-reads the counter
* to find out whether what it copied ever existed. The compaction is the one
* thing a per-slot counter cannot describe, because it moves entries between
* slots — so it bumps a table-wide counter around itself and a scan that sees
* that counter move starts again. Nothing here blocks the writer: a reader
* that cannot get a clean read gives up after a bounded number of attempts,
* which is the rule everywhere else in this file. */
static uint64_t flan_reg_epoch; /* odd while the table is being compacted */
static void flan_reg_begin(flan_reg_entry *e) {
__atomic_store_n(&e->gen, e->gen | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
}
/* Back to even, so a reader that sees the new count sees the whole entry. The
* [| 1] is [watch]'s: a write abandoned by a break taken inside it must still
* land on an even count. */
static void flan_reg_end(flan_reg_entry *e) {
__atomic_store_n(&e->gen, (e->gen | 1) + 1, __ATOMIC_RELEASE);
}
/* One slot, copied whole or not at all. 0 means the writer kept winning, which
* a caller reports as a slot it could not read rather than as an empty one.
*
* [flan_dev_reg_by_type] keeps that: it counts the slots it could not copy and
* refuses the whole listing rather than describing a table it only partly saw,
* because "no rows" is exactly what a program that had freed everything would
* look like. [flan_dev_reg_at] steps past them instead, and is allowed to
* because it is asking a different question — it wants the one block that
* contains an address, and a slot it could not read either did not hold that
* block, in which case skipping it costs nothing, or did, in which case the
* whole call answers "never heard of this address", which is the answer it
* already gives for a stack local and the daemon already gates it to a stopped
* program. */
static int flan_reg_snap(flan_reg_entry *e, flan_reg_entry *out) {
int attempt;
for (attempt = 0; attempt < 64; attempt++) {
uint64_t g1 = __atomic_load_n(&e->gen, __ATOMIC_ACQUIRE);
if (g1 & 1) continue; /* a write is in progress */
*out = *e;
/* Ordered before the second read of the counter, or the check is of a copy
* the compiler was free to make afterwards. */
__atomic_thread_fence(__ATOMIC_ACQUIRE);
if (__atomic_load_n(&e->gen, __ATOMIC_ACQUIRE) == g1) return 1;
}
return 0;
}
/* The table-wide counter, read on the way into a scan and again on the way
* out: a compaction between the two moved entries, so the scan saw some of
* them twice and some not at all. */
static int flan_reg_scan_open(uint64_t *at) {
uint64_t g = __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE);
if (g & 1) return 0;
*at = g;
return 1;
}
static int flan_reg_scan_ok(uint64_t at) {
__atomic_thread_fence(__ATOMIC_ACQUIRE);
return __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE) == at;
}
/* And a pause between a reader's attempts, which is most of what makes eight
* attempts worth more than one.
*
* Retrying immediately looks like eight chances and is not. A walk that bails
* at the epoch check costs almost nothing, so eight of them back to back fit
* inside the single compaction they are all losing to, and the reader refuses
* having waited for nothing. Measured, with a writer allocating and freeing on
* top of three thousand live blocks: without this pause 8 answers in 200 were
* right and 192 were refusals; with it, 200 of 200. The rate matters and the
* pause is not magic — a writer rearranging the table more than half the time
* still gets refused, which is the honest answer to a question asked of a
* table that is never still, and is what the refusal sentence is for.
*
* Waiting is legal here and only here. The reader is the agent's listener
* thread, or the exiting program's own; the writer is a game loop and never
* reaches this. A quarter of a millisecond is well over one compaction and far
* under what a person waiting for a keypress to answer would notice, and eight
* of them bound the whole refusal at two milliseconds. It is [flan_agent.c]'s
* break-loop idiom — nanosleep a step, look again — for its reason too: a spin
* would take a core from the thread being waited on. */
static void flan_reg_scan_wait(void) {
struct timespec step;
step.tv_sec = 0;
step.tv_nsec = 250000; /* 250us */
nanosleep(&step, NULL);
}
/* 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_dead; /* how many of those have died */
static int64_t flan_reg_seq; /* a monotonic clock, in events */
static int flan_reg_on; /* only a dev build turns this on */
static int flan_reg_full; /* something found no slot */
/* The table filled, and whoever is reading a listing is told twice: by this
* flag, which every listing carries so that its numbers are read as a floor,
* and once on stderr at the moment it happens.
*
* The line is here because the flag alone is only seen by someone who asks.
* A note that finds no slot is dropped — killing a game because its
* diagnostic ran out of room would be the diagnostic shooting the patient —
* and a drop that nobody is told about is the table quietly becoming a
* different table than the one its reader thinks they are reading.
*
* Once, not per note, and the difference is not tidiness. This runs on the
* game thread inside the allocation hook, and stderr in a dev build is a pipe
* the daemon reads; one bounded write is what a frame can afford, and a line
* per note would be sixty a second into a pipe nobody is draining while a
* request is being served. The second line would carry nothing the first did
* not anyway.
*
* [why] is the caller's sentence because the two ways to get here are not the
* same fact and neither is "the table is full of live blocks": a probe that
* ran out of slots found every slot *in use*, which is not the same as every
* slot live, and the caller is the one holding the count that says which. */
static void flan_reg_say_full(const char *why) {
if (flan_reg_full) return;
flan_reg_full = 1;
fprintf(stderr,
"flan: the allocation registry is full (%d blocks) — %s. Blocks "
"noted from here on are dropped, so every listing is a floor and "
"not a count.\n",
FLAN_REG_CAP, why);
}
/* Armed by the program's entry in a dev build. The free-side hooks in
* flan_rt.c are called unconditionally and begin with this load and a
* not-taken branch, because flan_dev.c is linked into every build and a
* second version of the allocator gated on a build flag is worse than a
* branch. That is a real cost and not zero; docs/BUILT.md says so rather than
* repeating the claim that a release build carries nothing. */
static void flan_reg_report(void); /* the exit report, at the bottom */
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;
/* Here and not at file scope: a destructor attribute would run in every
build, since this file is linked into every build, and that would be a
third place a release build is not free. Registered from inside the one
function only a dev build's constructor calls, a release binary still
carries a null pointer, a zero flag and the declarations. */
if (getenv("FLAN_DEV_LEAKS") != NULL) atexit(flan_reg_report);
}
int flan_dev_reg_enabled(void) { return flan_reg_on; }
/* Knuth's multiplicative hash over the address, which is what an allocator
* hands out: aligned, and therefore dense in its low bits. */
static size_t flan_reg_slot(uintptr_t a) {
return (size_t)(((a >> 3) * 11400714819323198485ULL) >> 40)
& (FLAN_REG_CAP - 1);
}
/* 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
* losing the live half. When they are not the bulk of it this does nothing but
* move live entries around and hold the epoch odd while it does — see
* FLAN_REG_RECLAIM for the wrong answers that bought. */
static void flan_reg_compact(void) {
size_t bytes = FLAN_REG_CAP * sizeof(flan_reg_entry);
flan_reg_entry *old = (flan_reg_entry *)malloc(bytes);
int64_t i;
/* 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_say_full("there was no room to make the scratch copy a "
"rearrangement needs");
return;
}
/* Odd for the duration, so a scan that overlapped this throws its counts
away rather than reporting a table half in one arrangement and half in
the other. */
__atomic_store_n(&flan_reg_epoch, flan_reg_epoch | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
memcpy(old, flan_reg, bytes);
/* Cleared slot by slot under each slot's own counter rather than by one
memset over the array: the memset would zero the counters themselves, and
a reader holding one would then validate a read of an entry that was
rewritten underneath it. */
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
flan_reg_begin(e);
e->type = NULL; e->typelen = 0; e->base = 0;
e->bytes = 0; e->elem = 0; e->seq = 0; e->died = 0;
flan_reg_end(e);
}
flan_reg_used = 0;
flan_reg_dead = 0; /* the dead are what this drops; none survive the sweep */
for (i = 0; i < FLAN_REG_CAP; i++) {
size_t s;
int64_t probe;
if (old[i].base == 0 || old[i].died != 0) continue;
s = flan_reg_slot(old[i].base);
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) {
flan_reg_entry *e = &flan_reg[j];
flan_reg_begin(e);
e->type = old[i].type; e->typelen = old[i].typelen;
e->base = old[i].base; e->bytes = old[i].bytes;
e->elem = old[i].elem; e->seq = old[i].seq; e->died = old[i].died;
flan_reg_end(e);
flan_reg_used++;
break;
}
}
}
free(old);
__atomic_store_n(&flan_reg_epoch, (flan_reg_epoch | 1) + 1, __ATOMIC_RELEASE);
}
/* One note per allocation. [base] replaces whatever was recorded there, live
* or dead: the allocator handing out an address is the event that makes any
* older answer about it wrong. */
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen) {
uintptr_t a = (uintptr_t)base;
size_t s;
int64_t probe;
if (!flan_reg_on || a == 0 || bytes <= 0) return;
/* Both halves, and the second is the one that matters: filling is what makes
a rearrangement urgent, but only the dead make it possible. */
if (flan_reg_used * 4 > (int64_t)FLAN_REG_CAP * 3
&& flan_reg_dead >= FLAN_REG_RECLAIM)
flan_reg_compact();
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 && flan_reg[j].base != a) continue;
if (flan_reg[j].base == 0) flan_reg_used++;
/* Reusing the slot of a block that died un-counts that death: the entry
about to be written is live, and the count the compaction trigger reads
is a count of what a sweep would actually reclaim. */
else if (flan_reg[j].died != 0) flan_reg_dead--;
/* The pair a torn read would get wrong is [type] and [typelen], which is
why the whole entry goes under the counter rather than the two of them
being ordered somehow. */
flan_reg_begin(&flan_reg[j]);
flan_reg[j].type = type;
flan_reg[j].typelen = typelen;
flan_reg[j].base = a;
flan_reg[j].bytes = bytes;
flan_reg[j].elem = elem;
flan_reg[j].seq = ++flan_reg_seq;
flan_reg[j].died = 0;
flan_reg_end(&flan_reg[j]);
return;
}
/* Every slot in use, and the compaction above declined to run because what
* a sweep would reclaim is not worth the sweep. The honest version of that
* quotes the number rather than claiming the table is all live: it usually
* is, and between one dead entry and FLAN_REG_RECLAIM of them it is not, and
* a reader deciding whether this is a leak wants to know which.
*
* The note is dropped. Killing the program because it ran out of diagnostic
* room would be the diagnostic shooting the patient — the watch table's rule
* and the same answer: a flag, readable by whoever asks, so that a missing
* entry is never mistaken for a freed one. What is new is that the drop is
* also said out loud, once, rather than only being discoverable by asking. */
{
char why[160];
snprintf(why, sizeof why,
"every slot is in use and only %lld of them have died, too few "
"to be worth rearranging the table for",
(long long)flan_reg_dead);
flan_reg_say_full(why);
}
}
int flan_dev_reg_overflowed(void) { return flan_reg_full; }
/* The block containing [a], live or dead, or NULL. A linear scan, because the
* reader is a person pressing a key and the writer is a game loop: the cost
* belongs on this side of the table. */
static flan_reg_entry *flan_reg_find(uintptr_t a) {
int64_t i;
flan_reg_entry *best = NULL;
if (a == 0) return NULL;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
if (e->base == 0) continue;
if (a < e->base || a >= e->base + (uintptr_t)e->bytes) continue;
/* A live block wins over a dead one covering the same address: the dead
entry is a stale answer the allocator has already contradicted. */
if (best == NULL || (best->died != 0 && e->died == 0)) best = e;
}
return best;
}
/* One block dies. The heap allocator's free calls this, and so does a resize,
* 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) {
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_begin(&flan_reg[j]);
flan_reg[j].died = ++flan_reg_seq;
flan_reg_end(&flan_reg[j]);
flan_reg_dead++;
}
return;
}
}
/* Every block inside [base, base+bytes) dies — which is an arena's free-all,
* and it is the release Valgrind cannot see. free-all is retain-capacity: the
* offset goes to zero and the pages stay mapped, so memcheck is never told
* anything died and a later read of stale bytes is a read of memory that is,
* as far as it knows, perfectly alive. The registry is told. That does not
* make memcheck report it; it makes the inspector able to. */
void flan_dev_reg_dead_range(void *base, int64_t bytes) {
uintptr_t lo = (uintptr_t)base, hi = lo + (uintptr_t)bytes;
int64_t i, now;
if (!flan_reg_on || bytes <= 0) return;
now = ++flan_reg_seq;
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry *e = &flan_reg[i];
if (e->base == 0 || e->died != 0) continue;
if (e->base >= lo && e->base < hi) {
flan_reg_begin(e);
e->died = now;
flan_reg_end(e);
flan_reg_dead++;
}
}
}
/* Is it safe to follow this pointer? The one question the renderer asks, and
* the reason the answer is worth having: the type at the other end is already
* static — (Ptr Enemy) says Enemy — so the registry is not supplying the type.
* It is supplying permission. */
int32_t flan_dev_reg_live(const void *p) {
flan_reg_entry *e;
if (!flan_reg_on) return 0;
e = flan_reg_find((uintptr_t)p);
return (int32_t)(e != NULL && e->died == 0 ? 1 : 0);
}
/* What was at this address, in words, for the branch that may not follow it.
* Emitted straight into the result buffer rather than returned: the caller is
* a render thunk, which has no allocator, and every other piece of a rendering
* arrives here the same way.
*
* There is no address in the text, and that is deliberate rather than an
* omission. An address is not stable across two runs of the same program, so
* printing one would make a rendering — and therefore a test that reads one —
* depend on where the heap happened to land. It is the rule [Render] already
* follows for an allocator. What a reader wants from a dangling pointer is
* *what died*, and the registry has that.
*
* Returns 1 if anything was written, so that a caller can tell "the registry
* has never heard of this address" — a stack local, which is by design not in
* here — from "this is dead", which is the sentence worth printing. */
int32_t flan_dev_reg_emit(const void *p) {
static char desc[192];
uintptr_t a = (uintptr_t)p;
flan_reg_entry *e = flan_reg_on ? flan_reg_find(a) : NULL;
int64_t off;
char where[64];
int n;
if (e == NULL || e->died == 0) return 0;
off = (int64_t)(a - e->base);
where[0] = '\0';
if (e->elem > 0 && off % e->elem == 0 && off / e->elem > 0)
snprintf(where, sizeof where, "[%lld] of ", (long long)(off / e->elem));
else if (off != 0)
snprintf(where, sizeof where, "+%lld into ", (long long)off);
n = snprintf(desc, sizeof desc, " dead: was %s%.*s, freed at step %lld",
where, (int)e->typelen, e->type, (long long)e->died);
if (n < 0) return 0;
if (n > (int)sizeof desc - 1) n = (int)sizeof desc - 1;
flan_dev_emit((const uint8_t *)desc, n);
return 1;
}
/* How many blocks the table holds — everything, or only the live ones. For a
* 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;
n++;
}
return n;
}
/* ── Reading the table back ───────────────────────────────────────────
*
* Three accessors and no formatter. Everything above this point is on the
* writer's side — a game loop — and everything below is read by a person
* pressing a key, so the shape that matters here is "hand back what is
* recorded" rather than "hand back a sentence". The agent turns these into
* protocol lines and the daemon turns those into an editor reply; the one
* piece of text this file still writes is the exit report at the bottom,
* which has nowhere else to go.
*/
/* What the table records for the address [p], live or dead. The containment
* lookup, exposed: [flan_dev_reg_live] answers the renderer's yes/no and
* [flan_dev_reg_emit] writes the epitaph, and neither hands back the *name*,
* which is what a reader that wants to point at a bare address needs — it has
* no (Ptr T) to read the type off, so the table's own answer is the only
* answer there is.
*
* [off] is how far into the block [p] lands, and it is not decoration: with
* [elem] it is what says whether the address is an element boundary or the
* middle of one. A caller that renders a T at an offset that is not a
* multiple of [elem] would be reading one element's tail as another's head,
* so it is given the two numbers rather than a flag it cannot check. */
int32_t flan_dev_reg_at(const void *p, const char **type, int64_t *typelen,
int64_t *off, int64_t *bytes, int64_t *elem,
int64_t *seq, int64_t *died) {
/* The one reader of the containment lookup that is not on the game thread —
* [flan_dev_reg_live] and [flan_dev_reg_emit] above run inside a render
* thunk, which is the writer's own thread — so this one copies each slot
* under its counter instead of pointing into the table. See the seqlock
* note above the entry type. */
uintptr_t a = (uintptr_t)p;
flan_reg_entry best, cur;
int have = 0, attempt;
if (!flan_reg_on || a == 0) return 0;
for (attempt = 0; attempt < 8; attempt++) {
uint64_t at;
int64_t i;
have = 0;
if (!flan_reg_scan_open(&at)) continue;
for (i = 0; i < FLAN_REG_CAP; i++) {
if (!flan_reg_snap(&flan_reg[i], &cur)) continue;
if (cur.base == 0) continue;
if (a < cur.base || a >= cur.base + (uintptr_t)cur.bytes) continue;
/* A live block wins over a dead one covering the same address: the dead
entry is a stale answer the allocator has already contradicted. */
if (!have || (best.died != 0 && cur.died == 0)) { best = cur; have = 1; }
}
if (flan_reg_scan_ok(at)) break;
have = 0;
}
if (!have) return 0;
if (type) *type = best.type;
if (typelen) *typelen = best.typelen;
if (off) *off = (int64_t)(a - best.base);
if (bytes) *bytes = best.bytes;
if (elem) *elem = best.elem;
if (seq) *seq = best.seq;
if (died) *died = best.died;
return 1;
}
/* An address, as a number, handed back as a pointer. The one thing an
* address-rooted render thunk cannot do for itself: Flan has no integer-to-
* pointer cast, deliberately — a program that could make a pointer out of
* arithmetic is a program the type system stops describing — and the
* inspector is not a program. It is the same arrangement [flan_agent_frame_
* slot] already has for a frame's slot, and for the same reason: the compiler
* knows the type, and something outside the language supplies the address. */
void *flan_dev_reg_addr(int64_t a) { return (void *)(uintptr_t)a; }
/* And back the other way, which is the half a *program* needs rather than the
* inspector. The address root above takes a number, and the things that hand
* out addresses as numbers all live outside the language — gdb, valgrind, a C
* library's callback, a printf("%p") in somebody's shim. A Flan program that
* wants to say one out loud has no cast for it, deliberately: pointer
* arithmetic out of an integer is the thing the type system stops describing.
* So the conversion is a C function, named and visible, and the language
* still has no operator for it. */
int64_t flan_dev_reg_number(const void *p) { return (int64_t)(uintptr_t)p; }
/* The table, by type spelling: one row per distinct name, with how many
* blocks carry it and how many bytes they hold. [live_only] is the whole
* difference between "what is this program made of" and "what is still held",
* which is why there is one walk here and not two — a leak report is a
* breakdown with the dead left out, and writing it twice would let the two
* drift.
*
* Caller-owned buffers, and the return is how many distinct types there were
* rather than how many were written: a caller whose buffers were too small is
* told so by the number coming back larger than [cap], which is the same
* contract the watch table's count has.
*
* And a walk that could not be taken returns -1 rather than a row count,
* because the two are not the same answer and this verb is the one place in
* the dev loop where confusing them costs the most. "No rows" is what a
* program that has freed everything looks like. "I could not read it" is what
* a program whose game thread is allocating through the whole read looks like,
* and the person asking is asking precisely because they suspect the second
* program of holding something. A zero handed back for a failed read is this
* file answering "nothing is held" about a table it never managed to see —
* the silent wrong answer everything else in here is written to refuse.
*
* [unread], on a -1, says which failure it was: a positive count is slots that
* were being written every time this looked at them, which is [flan_reg_snap]'s
* own contract being kept — its 0 means "a slot I could not read", and it is
* reported as that and never folded into the rows. A zero means no walk ever
* got a stable epoch at all: the table was being rearranged from end to end of
* every attempt. The caller turns either into a sentence.
*
* The grouping is O(rows x types) on string compare. The table is 4096 slots
* and the reader is a person, so this is the side the cost belongs on — the
* same judgement [flan_reg_find] is written down for. Compared by *content*
* and not by pointer: the name is a literal the compiler emitted beside a
* call site, and two modules that both allocate an Enemy emit two of them. */
int64_t flan_dev_reg_by_type(int32_t live_only, int64_t *counts,
int64_t *bytes, const char **types,
int64_t *typelens, int64_t cap, int64_t *unread) {
int64_t i, n = 0, missed = 0, fewest = -1;
int attempt;
if (unread) *unread = 0;
if (!flan_reg_on) return 0;
/* Read off a running program, which is what makes the counters below
necessary: a row is a (pointer, length) pair that is only meaningful
together, and the memcmp two lines down is where a torn one would read off
the end of a string literal. The whole walk is retried when a compaction
ran through the middle of it, since entries moved and the counts would
hold some blocks twice and some not at all. */
for (attempt = 0; attempt < 8; attempt++) {
uint64_t at;
n = 0;
missed = 0;
if (!flan_reg_scan_open(&at)) { flan_reg_scan_wait(); continue; }
for (i = 0; i < FLAN_REG_CAP; i++) {
flan_reg_entry e;
int64_t j;
int found = 0;
/* Counted, not stepped over. A slot the writer kept winning may hold a
block, and a walk that skipped one and still called itself whole would
be a leak report quietly missing the leak. */
if (!flan_reg_snap(&flan_reg[i], &e)) { missed++; continue; }
if (e.base == 0) continue;
if (live_only && e.died != 0) continue;
for (j = 0; j < n && j < cap; j++) {
if (typelens[j] != e.typelen) continue;
if (memcmp(types[j], e.type, (size_t)e.typelen) != 0) continue;
counts[j]++;
bytes[j] += e.bytes;
found = 1;
break;
}
if (found) continue;
if (n < cap) {
types[n] = e.type;
typelens[n] = e.typelen;
counts[n] = 1;
bytes[n] = e.bytes;
}
n++;
}
if (!flan_reg_scan_ok(at)) { flan_reg_scan_wait(); continue; }
/* A stable epoch and every slot copied: this is a table that existed. */
if (missed == 0) return n;
/* A stable epoch but slots that would not hold still. Worth another walk —
the writer moves on — and worth remembering the closest one, because it
is the number the refusal quotes. */
if (fewest < 0 || missed < fewest) fewest = missed;
flan_reg_scan_wait();
}
/* Eight walks, and not one of them saw the whole table. Answering with the
last walk's rows would be answering with a table that never existed, and
answering with zero rows would be answering "nothing is held" — so this
answers with neither, and the caller says so in a sentence. */
if (unread) *unread = fewest > 0 ? fewest : 0;
return -1;
}
/* ── What is still held when the program returns ──────────────────────
*
* Registered by [flan_dev_reg_enable] and therefore only in a dev build,
* which is the point: a file-scope destructor would run in *every* build,
* because this file is compiled into every build, and that would be a third
* place a release build is not free. docs/BUILT.md names two and only two.
*
* Off unless FLAN_DEV_LEAKS is set, and that is not timidity. The acceptance
* table reads programs/registry.flan's output with stderr folded in, so a
* report nobody asked for is a report that changes what a dev build prints.
*
* And it says "at exit" honestly. This runs when main returns or something
* calls exit(). A program killed with a signal — which is how a game under
* the editor usually ends — runs no handler at all, and no hook written here
* could change that. The answer for that program is the daemon's own verb,
* which reads the same table over the agent socket and can be asked at any
* moment, including the one before the kill. This hook is for the program
* that finishes on its own. */
static void flan_reg_report(void) {
enum { ROWS = 128 };
int64_t counts[ROWS], bytes[ROWS], typelens[ROWS];
const char *types[ROWS];
int64_t n, i, unread = 0, blocks = 0, held = 0;
n = flan_dev_reg_by_type(1, counts, bytes, types, typelens, ROWS, &unread);
/* At exit, with the program's own thread standing right here, a walk that
cannot settle means another thread is still allocating — and the report is
the one about what is still held, so saying nothing would be the loudest
possible version of the wrong answer. */
if (n < 0) {
fprintf(stderr,
"flan: the allocation registry could not be read at exit (%s), so "
"there is no report of what was still held\n",
unread > 0 ? "slots were being written throughout"
: "the table was being rearranged throughout");
return;
}
if (n == 0) return;
for (i = 0; i < n && i < ROWS; i++) { blocks += counts[i]; held += bytes[i]; }
fprintf(stderr, "flan: %lld block%s still held at exit, %lld bytes\n",
(long long)blocks, blocks == 1 ? "" : "s", (long long)held);
for (i = 0; i < n && i < ROWS; i++)
fprintf(stderr, "flan: %6lld %10lld %.*s\n", (long long)counts[i],
(long long)bytes[i], (int)typelens[i], types[i]);
if (n > ROWS)
fprintf(stderr, "flan: and %lld more type%s than this report holds\n",
(long long)(n - ROWS), n - ROWS == 1 ? "" : "s");
if (flan_reg_full)
fprintf(stderr,
"flan: the table overflowed, so this is a floor and not a "
"count\n");
}
/* ── A segfault in a dev session is a stop, not a silent death ─────────
*
* The dogfooding session this exists for: an in-place sort over
* (bytes "INSERTIONSORT") — the old zero-cost reinterpret — wrote into a
* string constant, and the session died with no message at all. The daemon
* runs the program's code in its own process, so the SIGSEGV took the
* compiler, the socket and the editor's session down together, and the
* program was not even told which address it touched.
*
* In a dev build the fault parks instead. SIGSEGV and SIGBUS are synchronous:
* the handler runs on the faulting thread, at the faulting instruction, with
* the shadow-stack chain intact — which is exactly the state an unhandled
* condition stops in. So after one line naming the address and the innermost
* Flan frame, the handler enters the same trap hook the runtime's six
* no-channel refusals use (flan_rt.c's rt_trap): the program stands still,
* the backtrace, locals and globals can all be read, a resume is refused
* with a reason, and the daemon stays alive serving evaluations. With no
* agent listening — flan_trap_hook NULL — the disposition is restored and
* the signal re-raised, so a standalone dev binary still dies with the exit
* code a segfault always had.
*
* The honest fine print, all of it deliberate for a dev-only path:
*
* - The break loop is not async-signal-safe (fprintf, nanosleep, the
* install queue). For a *synchronous* fault in program code this is the
* accepted trade every Lisp that maps SIGSEGV to a condition makes: the
* alternative is dying silently, which is the bug. A fault that lands
* inside malloc's own bookkeeping can deadlock the parked thread; the
* session it would have killed outright is still alive either way.
* - The handler runs on an alternate stack, sized well past SIGSTKSZ,
* because the commonest dev segfault is a stack overflow and a handler
* on the overflowed stack never runs. Thunks evaluated while parked run
* on that stack too, so it is a real stack, not a landing pad.
* - A fault inside the *reporting* restores the default disposition and
* re-raises: one loud death, never a loop. A fault raised by something
* evaluated while parked is a different case and gets its own line and
* its own break — see the clear of [flan_crash_entered] below, and
* SA_NODEFER, without which neither could happen at all.
* - A disposition is per *process*, and in a merged `flan dev' the daemon
* is that same process: the compiler thread and the agent's listener run
* alongside the program, and OCaml installs a SIGSEGV handler of its own
* to turn a daemon-side stack overflow into [Stack_overflow] (lib/dev.ml
* deliberately lets that propagate). So this handler is scoped to the
* ONE thread it was armed on — the thread the constructor ran on, which
* is the thread that runs the program, since .init_array runs before any
* other is spawned and [flan_program_main] wants the main thread for
* raylib's sake. A fault on any other thread chains to whatever was
* installed before, which is OCaml's handler, so the daemon keeps its
* own behaviour unchanged.
*
* Scoping by thread rather than by run is deliberate. The obvious
* alternative — arm at the start of a run and restore when it ends —
* is wrong here, because a finished program does not stop running Flan:
* [flan_merged_park] polls from the parked process and every C-x C-e
* typed at that prompt executes program code on this same thread.
* Restoring at the end of the run would leave exactly those evaluations
* unprotected, which is the crash this whole section exists to stop.
* The thread test holds for the whole life of the process instead, and
* needs nothing to remember where a run began or ended.
*
* It is also what keeps the alternate stack honest: [sigaltstack] is
* per-thread, so only the armed thread has one, and a thread without one
* would run this handler on the stack that just overflowed. Those are
* now the same set of threads by construction.
* - Under ASan the sanitizer's handler is the better report and arrives
* armed before any constructor here; detected (the weak __asan_init)
* and left alone. That skip is the one path here no test drives — it
* needs the @sanitize sweep, not `dune test'.
* - The report goes to fd 2 by write(2), where the break loop's own
* listing already goes. What nobody has checked is whether a merged
* build that routes fd 1 into a pipe leaves fd 2 somewhere an editor
* actually shows; if a session ever reports a park with no line above
* it, that is the first thing to look at, and the park itself is
* visible over the socket regardless (describe answers "SegFault").
*
* Installed by a global constructor the compiler emits ONLY into dev builds,
* next to the one that arms the allocation registry — a release build never
* calls this, links no constructor naming it, and dies the way it always
* did. */
/* wasm32 has no signals at all — its <signal.h> is an #error unless a build
* asks for emulation — and it has no daemon to keep alive either: there is
* no merged `flan dev' in a browser, so the crash this section exists to
* survive cannot happen there. The symbol still has to resolve, because the
* constructor the emitter writes for a dev build does not know the target,
* so the whole section reduces to a no-op. Same guard shape flan_rt.c uses
* for the two things it cannot have there. */
#if defined(__wasm__)
void flan_dev_crash_enable(void) {}
#else
#include <pthread.h>
#include <signal.h>
#include <unistd.h>
extern void (*flan_trap_hook)(const uint8_t *name, int64_t namelen);
extern void __asan_init(void) __attribute__((weak));
static volatile sig_atomic_t flan_crash_entered;
/* The thread this was armed on, and what was installed before it — the two
* halves of the scoping the header describes. [crash_prev] is kept per
* signal so that a chained SIGBUS is not handed SIGSEGV's old handler. */
static pthread_t crash_thread;
static struct sigaction crash_prev_segv, crash_prev_bus;
/* Hand the fault to whoever had the signal before this did. Three
* dispositions to honour and they are not interchangeable: a handler is
* called (SA_SIGINFO decides with which signature), SIG_DFL means restore
* and re-raise so the process dies the way it would have, and SIG_IGN on a
* hardware fault is not ignorable at all — the kernel forces the default —
* so it takes the same path as SIG_DFL rather than returning into an
* instruction that would fault again forever. */
static void crash_chain(int sig, siginfo_t *si, void *uc) {
const struct sigaction *p = sig == SIGBUS ? &crash_prev_bus : &crash_prev_segv;
if ((p->sa_flags & SA_SIGINFO) != 0 && p->sa_sigaction != NULL) {
p->sa_sigaction(sig, si, uc);
return;
}
if (p->sa_handler != SIG_DFL && p->sa_handler != SIG_IGN
&& p->sa_handler != NULL) {
p->sa_handler(sig);
return;
}
signal(sig, SIG_DFL);
raise(sig);
}
/* write(2) and byte-spelling only: the fault may have landed anywhere,
* including inside stdio. */
static void crash_puts(const char *s, size_t n) {
ssize_t r = write(2, s, n);
(void)r;
}
static void crash_hex(uintptr_t x) {
char b[2 + sizeof(uintptr_t) * 2];
size_t i = sizeof b;
do { b[--i] = "0123456789abcdef"[x & 0xf]; x >>= 4; } while (x != 0);
b[--i] = 'x';
b[--i] = '0';
crash_puts(b + i, sizeof b - i);
}
static void crash_handler(int sig, siginfo_t *si, void *uc) {
/* Not the program's thread: this is the daemon's own fault to deal with,
* and OCaml's handler is the one that knows how. See the header. */
if (!pthread_equal(pthread_self(), crash_thread)) {
crash_chain(sig, si, uc);
return;
}
if (flan_crash_entered++) goto die;
crash_puts("\nflan: ", 7);
if (sig == SIGBUS) crash_puts("SIGBUS", 6); else crash_puts("SIGSEGV", 7);
{
static const char touched[] = " \xe2\x80\x94 the program touched ";
crash_puts(touched, sizeof touched - 1);
}
crash_hex((uintptr_t)si->si_addr);
if (flan_frame_head != NULL && flan_frame_head->info != NULL) {
const flan_fninfo *fi = flan_frame_head->info;
crash_puts(" in ", 4);
crash_puts(fi->name, (size_t)fi->namelen);
crash_puts(" (", 2);
crash_puts(fi->loc, (size_t)fi->loclen);
crash_puts(")", 1);
}
{
static const char why[] =
"\nflan: a write through a read-only slice (bytes-view of a literal), "
"a null, or a stack overflow\n";
crash_puts(why, sizeof why - 1);
}
if (flan_trap_hook != NULL) {
/* Cleared before the park, not after it, and this is the whole reason
* the guard is armed so narrowly. The park below runs arbitrary Flan —
* every C-x C-e typed at the break loop — so a *second* fault down there
* is a new fault in new code and deserves its own line and its own
* break, not the guard's silent death. What the guard still covers is a
* fault in the reporting above, where a second attempt would only fault
* again. The break loop's own BREAK_MAX is what stops a loop of these
* from nesting forever. */
flan_crash_entered = 0;
/* Parks for good, exactly like NullAllocator and the other no-channel
* traps: there is no address to resume *at* — the faulting instruction
* would fault again — so this is a place to stand and read. */
if (sig == SIGBUS)
flan_trap_hook((const uint8_t *)"BusError", 8);
else
flan_trap_hook((const uint8_t *)"SegFault", 8);
}
die:
signal(sig, SIG_DFL);
raise(sig);
}
void flan_dev_crash_enable(void) {
static int done;
struct sigaction sa;
stack_t ss;
if (done) return;
done = 1;
/* ASan's own SIGSEGV report is strictly better and already installed. */
if (&__asan_init != NULL) return;
/* A real stack, not a landing pad: the park loop evaluates thunks here. */
ss.ss_size = 1 << 20;
ss.ss_sp = malloc(ss.ss_size);
ss.ss_flags = 0;
if (ss.ss_sp == NULL || sigaltstack(&ss, NULL) != 0) return;
memset(&sa, 0, sizeof sa);
sa.sa_sigaction = crash_handler;
/* SA_NODEFER is load-bearing and was the original bug relocated. Without
* it the kernel blocks this signal for the whole handler — which here is
* the whole *park*, since the loop never returns — and a hardware SIGSEGV
* delivered while SIGSEGV is blocked is not queued or handled: the kernel
* forces the default action and the process dies on the spot, with no
* message. That is exactly the author's vanished session, one level in:
* fault, park, evaluate something at the break loop that faults, daemon
* gone. With SA_NODEFER the second fault re-enters this handler, which is
* what makes [flan_crash_entered] a guard that can actually run. */
sa.sa_flags = SA_SIGINFO | SA_ONSTACK | SA_NODEFER;
sigemptyset(&sa.sa_mask);
/* Recorded before the install, not after: once [sigaction] returns, a
* fault can arrive, and a handler that has not yet learned which thread it
* belongs to would take the daemon's faults as the program's. */
crash_thread = pthread_self();
sigaction(SIGSEGV, &sa, &crash_prev_segv);
sigaction(SIGBUS, &sa, &crash_prev_bus);
}
#endif /* !__wasm__ */