JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
flan/runtime/flan_dev.c

2967 lines
136 KiB
C
Raw Blame History

/* 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 a listing takes between its
* attempts at reading the table, whether it is waiting out a rearrangement or
* a single slot mid-write. See flan_reg_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 global's storage */
size_t size; /* a global's size; 0 for a function */
/* A function's cell: the body, the signature word it was installed with,
* and that signature as a C string — the same three words a host's own
* cell has (Emit.sig_text). All zero until a module publishes into it, and
* a zero word matches no signature, so a call that somehow ran first would
* stop on StaleCall rather than jump to null. */
void *fn[3];
} 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;
e->fn[0] = e->fn[1] = e->fn[2] = NULL;
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->fn;
}
/* 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;
}
/* A global's storage by its symbol, for the daemon's inspector, or NULL for a
* name this table never interned — a global the host was built with, which the
* agent finds by symbol instead. It never interns: a lookup that allocated
* would hand back zeroed storage the program has never seen. */
void *flan_dev_global_find(const char *name) {
entry *e = find(name);
return e == NULL ? NULL : 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; }
/* ── An expression thunk's string literals ──────────────────────────── */
/* A literal in an evaluated expression is a copy made here and kept for the
* life of the process, one per distinct text, NUL after the bytes as the
* module's own constants have. The expression may store it anywhere, so
* pointing it into the thunk's module would keep that module mapped for ever
* (Emit's [pool]); pointing it here lets the agent unload the module once the
* thunk returns. Game thread only: thunks run there. */
typedef struct lit { struct lit *next; int64_t len; uint8_t bytes[]; } lit;
static lit **lits;
static size_t lits_cap, lits_n;
static uint64_t lit_hash(const uint8_t *p, int64_t n) {
uint64_t h = 1469598103934665603ULL; /* FNV-1a */
for (int64_t i = 0; i < n; i++) { h ^= p[i]; h *= 1099511628211ULL; }
return h;
}
const uint8_t *flan_dev_literal(const uint8_t *p, int64_t n) {
if (n < 0) n = 0;
if (lits_n >= lits_cap / 2) {
size_t cap = lits_cap ? lits_cap * 2 : 64;
lit **t = calloc(cap, sizeof *t);
if (t == NULL) die("out of memory", "a string literal");
for (size_t i = 0; i < lits_cap; i++)
for (lit *e = lits[i], *nx; e != NULL; e = nx) {
nx = e->next;
size_t b = lit_hash(e->bytes, e->len) & (cap - 1);
e->next = t[b];
t[b] = e;
}
free(lits);
lits = t;
lits_cap = cap;
}
size_t b = lit_hash(p, n) & (lits_cap - 1);
for (lit *e = lits[b]; e != NULL; e = e->next)
if (e->len == n && memcmp(e->bytes, p, (size_t)n) == 0) return e->bytes;
lit *e = malloc(sizeof *e + (size_t)n + 1);
if (e == NULL) die("out of memory", "a string literal");
e->len = n;
if (n > 0) memcpy(e->bytes, p, (size_t)n);
e->bytes[n] = 0;
e->next = lits[b];
lits[b] = e;
lits_n++;
return e->bytes;
}
/* Called between the copy and the second read of the counter, when set. It
* exists for test/dev_limits.c and nothing else sets it: the losing side of
* the race is a write landing inside that window, and a second thread cannot
* be made to land there on demand. A hook that writes a value from inside the
* window is the same interleaving, every time. */
void (*flan_dev_result_read_hook)(void);
int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
uint64_t *len) {
for (int attempt = 0; attempt < 64; attempt++) {
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);
if (flan_dev_result_read_hook != NULL) flan_dev_result_read_hook();
/* The copy must be ordered before the second read of the counter, or the
* check is of a copy the compiler was free to make afterwards. */
__atomic_thread_fence(__ATOMIC_ACQUIRE);
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. A scalar entry point called through [declare-c]
* costs a load and a branch per watched value per frame, in both builds. The
* [(watch ...)] form costs that in a dev build only: outside one the backend
* drops its call, and what is left is the value's own evaluation. */
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;
}
/* [flan_dev_watch_begin] for a name that arrives as bytes and a length, which
* is how a Flan string crosses to the runtime: (watch "name" v) calls this.
* The name is copied to a NUL-terminated buffer on the stack, cut to what a
* slot holds, so nothing here allocates. */
int flan_dev_watch_begin_n(const uint8_t *name, int64_t len) {
/* The same first test [flan_dev_watch_begin] makes, ahead of the copy, so an
* unarmed table costs a load and a branch here too. */
if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) { watch_cur = NULL; return 0; }
char buf[WATCH_NAME];
size_t n = len < 0 ? 0 : (size_t)len;
if (n > WATCH_NAME - 1) n = WATCH_NAME - 1;
memcpy(buf, name, n);
buf[n] = '\0';
return flan_dev_watch_begin(buf);
}
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 str 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: 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*. That is the
* [(watch "hp" hp)] form in check.ml, which points [Render.render] at
* [flan_dev_watch_begin_n], the [flan_dev_watch_emit_*] above and
* [flan_dev_watch_end]. */
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 str 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;
/* The call this frame is in: the site of the last Flan call it made,
* NUL-terminated, stored after the arguments and before the call. NULL
* until its first. Stale in the innermost frame, which may have returned
* from that call since — which is why [flan_dev_frame_at_loc] is read for
* the outer frames only. */
const char *at;
/* Zero at the push, and given a number from [flan_dev_frame_claim] the
* first time a dyn view is taken of this frame's storage. It is what tells
* this activation from the next call to land at the same address, which a
* view kept past the return would otherwise take for its own. */
uint64_t serial;
/* The function's frame address (its rbp), stored at the push. Every local
* of the function lies below it and above everything its callees push, so
* a stack address belongs to the innermost frame whose [fp] is above it
* ([flan_dev_frame_owner]). */
const void *fp;
} flan_frame;
/* The compiler names this symbol directly. A redefinition module reaches it
* 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; }
/* Where the chain stood, and putting it back there: the agent's way out of a
* trapped evaluation jumps past the frames the evaluation pushed. */
void *flan_dev_frames_mark(void) { return flan_frame_head; }
void flan_dev_frames_restore(void *head) { flan_frame_head = (flan_frame *)head; }
/* A dyn view of a local (flan_dyn.c, [view_make]): the frame's serial, made
* on first use, and the function's name for the sentence a stale view prints
* — copied out now, because by then the frame is dead stack. */
static uint64_t flan_frame_serials;
uint64_t flan_dev_frame_claim(void *frame, const char **name,
int64_t *namelen) {
flan_frame *f = frame;
*name = "?";
*namelen = 1;
if (f == NULL) return 0;
if (f->info != NULL) {
*name = f->info->name;
*namelen = f->info->namelen;
}
if (f->serial == 0) f->serial = ++flan_frame_serials;
return f->serial;
}
/* Still on the chain, and still the same activation. The walk is from the
* innermost frame out and is the depth of the stack at worst; dead stack
* keeps its old bytes, so the serial alone cannot say the frame is gone. */
int32_t flan_dev_frame_alive(const void *frame, uint64_t serial) {
const flan_frame *f;
for (f = flan_frame_head; f != NULL; f = f->prev)
if (f == frame) return f->serial == serial;
return 0;
}
/* The frame whose storage holds the stack address [p], for a view the
* compiler could not tie to its own frame: a slice of a local, or a slice
* parameter over a caller's. The stack grows down, so [p] is on it only when
* it is above this function's own frame, and it is the innermost Flan frame
* whose frame address is above it that owns it. NULL for anything else — the
* heap, a global, or stack above every Flan frame. */
void *flan_dev_frame_owner(const void *p) {
uintptr_t a = (uintptr_t)p;
flan_frame *f;
if (flan_frame_head == NULL
|| a <= (uintptr_t)__builtin_frame_address(0))
return NULL;
for (f = flan_frame_head; f != NULL; f = f->prev)
if (f->fp != NULL && (uintptr_t)f->fp > a) return f;
return NULL;
}
/* [i] counts from the innermost. NULL past the end, which is how a caller
* learns the depth without a second walk. */
void *flan_dev_frame_at(int32_t i) {
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;
}
/* Where the frame is: the call it is in, or NULL when it has made none. */
const char *flan_dev_frame_at_loc(const void *frame, int64_t *len) {
const flan_frame *f = frame;
if (f == NULL || f->at == NULL) { *len = 0; return NULL; }
*len = (int64_t)strlen(f->at);
return f->at;
}
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, which is a base address only at
* i = 0. 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. The table starts here and
* doubles when three quarters of it is live ([flan_reg_grow]): a dyn view's
* dev check asks it whether a block is still alive, and a table that dropped
* notes would answer "never heard of it" for a block that has since been
* freed, which is the check silently stopping. Read as [FLAN_REG_CAP]: the
* capacity is loaded before the table's address, and [flan_reg_grow] stores
* them the other way round, so a reader never pairs the larger capacity with
* the smaller table. */
#define FLAN_REG_CAP0 4096
static int64_t flan_reg_capv = FLAN_REG_CAP0;
#define FLAN_REG_CAP (__atomic_load_n(&flan_reg_capv, __ATOMIC_ACQUIRE))
/* 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 */
/* The allocator the block came from, where the note knew it — a Vec's, or
* the temp arena's — and NULL where it did not. (free s) on a slice asks
* it, so a block is never handed to an allocator it did not come from. */
const void *owner;
/* Set for a block handed out as a slice — (bytes s), (clone xs), a
* formatted number — and clear for a Vec's or a Map's storage, which only
* their own free releases. */
int32_t sliced;
} 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);
}
/* A reader's pause between attempts, and the one wait anywhere in this file.
*
* Retrying immediately looks like several chances and is not. Every retry on
* the reading side costs a handful of loads, so a whole run of them fits
* inside the one write they are all losing to, and the reader gives up having
* waited for nothing. Measured, with a writer allocating and freeing on top of
* three thousand live blocks: without this pause 8 listings in 200 were
* answered and 192 were refused; with it, 200 of 200.
*
* A quarter of a millisecond is well over one compaction, and — the reason it
* is a sleep and not a spin — well over the handover a descheduled writer
* needs. The writer is a game loop and never reaches this; the reader is the
* agent's listener thread, or the exiting program's own, and both of them are
* answering a person. It is [flan_agent.c]'s break-loop idiom, nanosleep a
* step and look again, for its reason too: a spin would take a core from the
* thread being waited on, which on a machine with more threads than cores is
* exactly the thread that has to run before the wait can end. */
static void flan_reg_wait(void) {
struct timespec step;
step.tv_sec = 0;
step.tv_nsec = 250000; /* 250us */
nanosleep(&step, NULL);
}
/* How many times a reader re-reads a slot's counter before it starts waiting
* between the tries instead of going straight round again.
*
* Two different things leave a counter odd, and they are minutes apart in
* scale. A writer that is running holds it odd for seven stores, so a reader
* that simply looks again wins almost at once and a sleep would be pure
* latency. A writer that was descheduled in the middle of those stores holds
* it odd for however long the scheduler takes to run it again — a millisecond
* or more on a loaded machine — and no amount of looking again will end that,
* because the looking is what is keeping the core busy.
*
* That second case is what this constant is for. It was the whole of a
* reproducible wrong answer: with sixty-four bare retries and nothing else,
* the reader burned its entire budget inside a fraction of one scheduler
* quantum, called the slot unreadable, and the listing above it refused a
* table that was perfectly readable and never moved. It showed up only under
* load, which is exactly when a writer gets descheduled — no refusals at all
* on an idle machine, and one run in five when the cores were oversubscribed.
* The sixty-four were not a short budget, which is the part worth being exact
* about: sixty-four bare re-reads of one word finish in about two microseconds,
* so against a writer that will not run again for a millisecond the budget was
* not small, it was zero wall-clock. There was no timeout to widen.
* See TODO.org, "A spin is not patience: the registry's slot read". */
#define FLAN_REG_SPINS 8
#define FLAN_REG_TRIES 40 /* 8 spins, then 32 waits: ~8ms of patience */
/* 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 < FLAN_REG_TRIES; attempt++) {
uint64_t g1;
/* The wait is only on the path that found a write in flight, so a table
nobody is writing pays nothing for it. There is one writer, so only one
slot is odd at any instant and it is almost always readable on the first
look after the first sleep — which is what a walk typically costs, and
is not a bound. A compaction writes every slot under its own counter, so
a writer the scheduler keeps taking the core from can charge the full
8ms against several slots of one walk; the arithmetic worst case is
4096 of them. Nothing observed comes near that, and a walk that is
paying it is a walk that is about to refuse anyway. */
if (attempt >= FLAN_REG_SPINS) flan_reg_wait();
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 uint64_t flan_reg_grows; /* how many times the table has grown */
static void flan_reg_wait(void);
static int flan_reg_scan_open(uint64_t *at) {
uint64_t g = __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE);
/* A growth copies the whole table and takes longer than a compaction, long
enough to use up a listing's attempts one wait at a time. So a listing
that meets one waits it out, up to a tenth of a second, rather than
counting each look as a lost attempt. */
for (int w = 0; (g & 1) && w < 400; w++) {
flan_reg_wait();
g = __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE);
}
if (g & 1) return 0;
*at = g;
return 1;
}
/* Did the table grow since [grows0]? A walk that a growth overlapped is
retried without counting against its attempts: a growth ends. */
static int flan_reg_grew(uint64_t grows0) {
return __atomic_load_n(&flan_reg_grows, __ATOMIC_ACQUIRE) != grows0;
}
static int flan_reg_scan_ok(uint64_t at) {
__atomic_thread_fence(__ATOMIC_ACQUIRE);
return __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE) == at;
}
/* The pause a walk takes between its own attempts is [flan_reg_wait] above,
* the same one a slot takes: a compaction is what a walk loses to, and it is
* over in well under the step. 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. */
/* 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 (%lld blocks) — %s. Blocks "
"noted from here on are dropped, so every listing is a floor and "
"not a count.\n",
(long long)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 */
extern int flan_dev_views_checked; /* defined below */
void flan_dev_reg_enable(void) {
if (flan_reg_on) return;
flan_reg = (flan_reg_entry *)calloc((size_t)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;
flan_dev_views_checked = 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; }
/* The same flag as a word flan_dyn.c reads on every view's crossing: a dyn
* view carries its dev record only when this is set. */
int flan_dev_views_checked;
/* A block a resize moved away from, filled with 0xDEADBEEF words in a dev
* build. A slice is a pointer and a length and carries nothing that could say
* the Vec under it grew, so a slice taken before a push that moved the storage
* still reads the old block — which, unpoisoned, holds exactly the values it
* held, and the stale read looks right. Filled, it reads a value nobody
* wrote. A release build keeps the load and the branch and nothing else.
* Byte-wise at the tail so that an element size that is not a multiple of
* four is still filled to its end. */
void flan_dev_poison(void *p, int64_t bytes) {
static const uint8_t pat[4] = { 0xEF, 0xBE, 0xAD, 0xDE };
uint8_t *b = (uint8_t *)p;
int64_t i;
if (!flan_reg_on || p == NULL || bytes <= 0) return;
for (i = 0; i < bytes; i++) b[i] = pat[i & 3];
}
/* 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);
}
/* ── The registry by address ──────────────────────────────────────────
*
* The table above answers "which block starts here"; a dyn view crossing
* asks "which live block holds this address", once per crossing, and a scan
* of every slot for that cost microseconds a crossing. So each live block's
* base is also filed under every 64 KiB chunk it overlaps, and the question
* reads one chunk's short list. A block wider than FLAN_IX_WIDE chunks goes
* on one list of its own, read every time; there are few such blocks. Only
* the game thread reads or writes it.
*
* A base is filed when its note is written and taken out when the block dies.
* An entry here is a hint, not a fact: the list names bases, and the answer
* is always the table's entry for that base, checked live and containing. */
#define FLAN_IX_SHIFT 16
#define FLAN_IX_WIDE 64
typedef struct {
uintptr_t key; /* chunk + 1; 0 for an empty bucket */
int32_t n, cap;
uintptr_t *bases;
} flan_ix_bucket;
static flan_ix_bucket *flan_ix;
static size_t flan_ix_cap, flan_ix_used;
static uintptr_t *flan_ix_wide;
static int32_t flan_ix_widen, flan_ix_widecap;
static size_t flan_ix_hash(uintptr_t key) {
return (size_t)((key * 11400714819323198485ULL) >> 20);
}
static flan_ix_bucket *flan_ix_find(uintptr_t chunk, int make) {
uintptr_t key = chunk + 1;
size_t i, mask;
if (flan_ix_cap == 0) {
if (!make) return NULL;
flan_ix = (flan_ix_bucket *)calloc(1024, sizeof *flan_ix);
if (flan_ix == NULL) return NULL;
flan_ix_cap = 1024;
}
if (make && (flan_ix_used + 1) * 2 > flan_ix_cap) {
size_t ncap = flan_ix_cap * 2, j;
flan_ix_bucket *n = (flan_ix_bucket *)calloc(ncap, sizeof *n);
if (n == NULL) return NULL;
for (j = 0; j < flan_ix_cap; j++) {
size_t k;
if (flan_ix[j].key == 0) continue;
for (k = flan_ix_hash(flan_ix[j].key) & (ncap - 1); n[k].key != 0;
k = (k + 1) & (ncap - 1)) {}
n[k] = flan_ix[j];
}
free(flan_ix);
flan_ix = n;
flan_ix_cap = ncap;
}
mask = flan_ix_cap - 1;
for (i = flan_ix_hash(key) & mask;; i = (i + 1) & mask) {
if (flan_ix[i].key == key) return &flan_ix[i];
if (flan_ix[i].key == 0) {
if (!make) return NULL;
flan_ix[i].key = key;
flan_ix_used++;
return &flan_ix[i];
}
}
}
static void flan_ix_list_add(uintptr_t **v, int32_t *n, int32_t *cap,
uintptr_t base) {
int32_t i;
for (i = 0; i < *n; i++) if ((*v)[i] == base) return;
if (*n == *cap) {
int32_t ncap = *cap ? *cap * 2 : 4;
uintptr_t *nv = (uintptr_t *)realloc(*v, (size_t)ncap * sizeof **v);
if (nv == NULL) return;
*v = nv;
*cap = ncap;
}
(*v)[(*n)++] = base;
}
static void flan_ix_list_del(uintptr_t *v, int32_t *n, uintptr_t base) {
int32_t i;
for (i = 0; i < *n; i++)
if (v[i] == base) { v[i] = v[--*n]; return; }
}
static void flan_ix_file(uintptr_t base, int64_t bytes, int add) {
uintptr_t c, lo = base >> FLAN_IX_SHIFT,
hi = (base + (uintptr_t)bytes - 1) >> FLAN_IX_SHIFT;
if (bytes <= 0) return;
if (hi - lo >= FLAN_IX_WIDE) {
if (add) flan_ix_list_add(&flan_ix_wide, &flan_ix_widen, &flan_ix_widecap, base);
else flan_ix_list_del(flan_ix_wide, &flan_ix_widen, base);
return;
}
for (c = lo; c <= hi; c++) {
flan_ix_bucket *b = flan_ix_find(c, add);
if (b == NULL) continue;
if (add) flan_ix_list_add(&b->bases, &b->n, &b->cap, base);
else flan_ix_list_del(b->bases, &b->n, base);
}
}
/* The live entry for [base], by the probe a free takes. */
static flan_reg_entry *flan_reg_live_at(uintptr_t base) {
size_t s = flan_reg_slot(base);
int64_t probe;
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
if (flan_reg[j].base == 0) return NULL;
if (flan_reg[j].base == base && flan_reg[j].died == 0) return &flan_reg[j];
}
return NULL;
}
/* Drop every dead entry and re-insert the live ones. Called when the table is
* filling *and* there is a worthwhile number of dead in it: in a long-running
* program the dead are the bulk of it, and losing them is much cheaper than
* 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. */
/* Twice the room, every entry carried over, live and dead alike (a dead one
* still names what died). Under the table-wide counter, as a compaction is,
* so a listing that overlapped it starts again. The old table is not freed:
* a listing on the listener thread may still be reading it, and a dev build
* can afford the half it keeps. 0 when the memory could not be had, and the
* table stays as it was. */
static int flan_reg_grow(void) {
int64_t cap = FLAN_REG_CAP, ncap = cap * 2, i;
flan_reg_entry *n = (flan_reg_entry *)calloc((size_t)ncap, sizeof *n);
if (n == NULL) return 0;
__atomic_store_n(&flan_reg_epoch, flan_reg_epoch | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
for (i = 0; i < cap; i++) {
size_t j;
if (flan_reg[i].base == 0) continue;
j = (size_t)(((flan_reg[i].base >> 3) * 11400714819323198485ULL) >> 40)
& (size_t)(ncap - 1);
while (n[j].base != 0) j = (j + 1) & (size_t)(ncap - 1);
n[j] = flan_reg[i];
n[j].gen = 0;
}
__atomic_store_n(&flan_reg, n, __ATOMIC_RELEASE);
__atomic_store_n(&flan_reg_capv, ncap, __ATOMIC_RELEASE);
__atomic_store_n(&flan_reg_grows, flan_reg_grows + 1, __ATOMIC_RELEASE);
__atomic_store_n(&flan_reg_epoch, (flan_reg_epoch | 1) + 1, __ATOMIC_RELEASE);
return 1;
}
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;
e->owner = old[i].owner;
e->sliced = old[i].sliced;
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. */
static void flan_reg_note_full(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner, int32_t sliced);
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen) {
flan_reg_note_full(base, bytes, elem, type, typelen, NULL, 0);
}
void flan_dev_reg_note_owned(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner) {
flan_reg_note_full(base, bytes, elem, type, typelen, owner, 0);
}
/* A block handed out as a slice, which (free s) may release. */
void flan_dev_reg_note_sliced(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner) {
flan_reg_note_full(base, bytes, elem, type, typelen, owner, 1);
}
static void flan_reg_note_full(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner, int32_t sliced) {
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();
/* Still three quarters full once the dead are gone: the live set outgrew
the table, so the table grows rather than drop what comes next. */
if (flan_reg_used * 4 > (int64_t)FLAN_REG_CAP * 3) flan_reg_grow();
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[j].owner = owner;
flan_reg[j].sliced = sliced;
flan_reg_end(&flan_reg[j]);
flan_ix_file(a, bytes, 1);
return;
}
/* Every slot in use, and the compaction above declined to run because what
* 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; }
/* (free s) on a slice, asked before the block is handed back: 0 when it may
* go to [owner] — or when the registry cannot say, because this is not a dev
* build, the table is full, or the note did not know the allocator — 1 when
* [p] is not the start of a block any allocator handed out, 2 when the block
* came from another allocator (whose record goes to [*found]), 3 when it was
* already released, 4 when it is a Vec's or a Map's storage rather than a
* block handed out as a slice. */
static flan_reg_entry *flan_reg_find(uintptr_t a);
/* The entry for a block that starts at [base], live before dead, by the
* probe a free takes: (free s) always hands over a block's start, so the
* question is equality and a scan of the whole table — which grows — would
* make every free cost the table's size. NULL when no block starts there. */
static flan_reg_entry *flan_reg_at_base(uintptr_t base) {
flan_reg_entry *dead = NULL;
int64_t cap = FLAN_REG_CAP, probe;
size_t s0 = flan_reg_slot(base);
for (probe = 0; probe < cap; probe++) {
size_t j = (s0 + (size_t)probe) & (size_t)(cap - 1);
if (flan_reg[j].base == 0) break;
if (flan_reg[j].base != base) continue;
if (flan_reg[j].died == 0) return &flan_reg[j];
if (dead == NULL) dead = &flan_reg[j];
}
return dead;
}
int32_t flan_dev_reg_owner_check(const void *p, const void *owner,
const void **found) {
flan_reg_entry *e;
if (!flan_reg_on) return 0;
e = flan_reg_at_base((uintptr_t)p);
if (e == NULL) return flan_reg_full ? 0 : 1;
if (e->base != (uintptr_t)p) return 1;
if (e->died != 0) return 3;
if (!e->sliced) return 4;
if (e->owner != NULL && e->owner != owner) {
if (found) *found = e->owner;
return 2;
}
return 0;
}
/* 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++;
flan_ix_file(a, flan_reg[j].bytes, 0);
}
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++;
flan_ix_file(e->base, e->bytes, 0);
}
}
}
/* 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);
}
/* A dyn view's storage (flan_dyn.c, [view_make]): the smallest live block
* holding [p], by base and sequence, so the view can ask later whether that
* same note is still alive. The smallest, because an arena's own region can
* be a block too, and it outlives the allocation inside it that a free-all
* ends. 0 when no live block holds [p] — a global, a frame, C memory — and
* always in a release build. Read through the address index above. */
int32_t flan_dev_reg_claim(const void *p, uintptr_t *base, int64_t *seq,
const char **type, int64_t *typelen) {
uintptr_t a = (uintptr_t)p;
flan_reg_entry *best = NULL;
flan_ix_bucket *b;
int32_t i, pass;
if (!flan_reg_on || a == 0) return 0;
b = flan_ix_find(a >> FLAN_IX_SHIFT, 0);
for (pass = 0; pass < 2; pass++) {
uintptr_t *v = pass == 0 ? (b ? b->bases : NULL) : flan_ix_wide;
int32_t n = pass == 0 ? (b ? b->n : 0) : flan_ix_widen;
for (i = 0; i < n; i++) {
flan_reg_entry *e;
if (a < v[i]) continue;
e = flan_reg_live_at(v[i]);
if (e == NULL || a >= e->base + (uintptr_t)e->bytes) continue;
if (best == NULL || e->bytes < best->bytes) best = e;
}
}
if (best == NULL) return 0;
*base = best->base;
*seq = best->seq;
*type = best->type;
*typelen = best->typelen;
return 1;
}
/* Is the note [flan_dev_reg_claim] found still there and alive? The probe a
* free takes, keyed on the base: an entry is dropped only when its address is
* handed out again, and the new note has a new sequence. A compaction moves
* entries but keeps both. */
int32_t flan_dev_reg_alive(uintptr_t base, int64_t seq) {
size_t s;
int64_t probe;
if (!flan_reg_on || base == 0) return 1;
s = flan_reg_slot(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) return 0;
if (flan_reg[j].base != base || flan_reg[j].seq != seq) continue;
return flan_reg[j].died == 0;
}
return 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_epitaph(const void *p, char *buf, int64_t cap);
int32_t flan_dev_reg_emit(const void *p) {
static char desc[192];
int32_t n = flan_dev_reg_epitaph(p, desc, (int64_t)sizeof desc);
if (n <= 0) return 0;
flan_dev_emit((const uint8_t *)desc, n);
return 1;
}
/* The epitaph's text, into [buf], and its length — 0 for an address that is
* live or that the table never saw. [flan_dev_reg_emit] above is this aimed at
* the result buffer; the agent's [ptr] verb is this aimed at a reply, for the
* daemon's inspector, which reads a stopped program's memory itself rather
* than building a thunk to render it. One sentence, so the two cannot word a
* dead pointer differently. */
int32_t flan_dev_reg_epitaph(const void *p, char *buf, int64_t cap) {
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 || cap <= 1) 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(buf, (size_t)cap, " 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)cap - 1) n = (int)cap - 1;
return n;
}
/* 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;
/* The walk-level retries wait between themselves, for [flan_reg_wait]'s
reason and not for this verb's own risk: the agent gates this one behind a
stopped program, so the writer is parked and there is usually nothing to
lose to. Going straight round again would still be the same mistake the
slot read was making — eight walks that all fit inside the one
rearrangement they are all losing to — and leaving one bare retry in the
file next to the note explaining why they are wrong is how the next
person learns the rule has exceptions it does not have. */
int regrown = 0;
for (attempt = 0; attempt < 8; attempt++) {
uint64_t at, grows0 = __atomic_load_n(&flan_reg_grows, __ATOMIC_ACQUIRE);
int64_t i;
have = 0;
if (!flan_reg_scan_open(&at)) { flan_reg_wait(); 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 (flan_reg_grew(grows0) && regrown++ < 64) attempt--;
flan_reg_wait();
}
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, which is the half a *program* needs rather than
* the inspector. The address root 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. */
int regrown = 0;
for (attempt = 0; attempt < 8; attempt++) {
uint64_t at, grows0 = __atomic_load_n(&flan_reg_grows, __ATOMIC_ACQUIRE);
n = 0;
missed = 0;
if (!flan_reg_scan_open(&at)) { flan_reg_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)) {
if (flan_reg_grew(grows0) && regrown++ < 64) attempt--;
flan_reg_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_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 library's resources, counted at the boundary ────────────────────
*
* TODO.org, "A debug tracking allocator over the raylib boundary". A texture
* or an image's pixels is memory raylib allocated, which neither ASan nor the
* registry above can see: nothing instrumented made it. What does see it is
* the call that made it. lib/shim.ml says which declare-c bindings acquire and
* release a resource and writes notes into their wrappers; lib/check.ml opens
* each call to one with where it is. This is the table they keep.
*
* An entry is one acquisition not yet released: the resource's key — a hash of
* its identifying field, computed by the compiler — its type and the source
* location of the call that made it. A release removes one entry with the same
* key and type. A release that finds none is a release of something this run
* never loaded — an unload twice over, or of a value raylib keeps for itself —
* and is counted separately, by type and site, because it is a bug of its own.
*
* Only a dev build calls in here: the notes are [flan_dev_reg_note_] calls,
* which a release build drops. The report at exit is off unless
* FLAN_DEV_LEAKS is set, the same switch as the block report above, and like
* that one it cannot run for a program ended by a signal.
*
* One thread, the game's, calls these; nothing reads the table while the
* program runs. The strings are literals the compiler emitted beside the call,
* and a module is never unloaded, so they outlive the table. */
typedef struct {
uint64_t key;
const char *type;
int64_t typelen;
const char *site;
int64_t sitelen;
int64_t count; /* 1 for a held resource; the total for a stray release */
} flan_res_entry;
static flan_res_entry *flan_res_held;
static int64_t flan_res_nheld, flan_res_capheld;
static flan_res_entry *flan_res_stray;
static int64_t flan_res_nstray, flan_res_capstray;
static int flan_res_lost; /* an entry was dropped because malloc failed */
static int flan_res_armed;
static void flan_res_report(void);
static void flan_res_arm(void) {
if (flan_res_armed) return;
flan_res_armed = 1;
if (getenv("FLAN_DEV_LEAKS") != NULL) atexit(flan_res_report);
}
static int flan_res_same(const char *a, int64_t an, const char *b, int64_t bn) {
return an == bn && memcmp(a, b, (size_t)an) == 0;
}
/* ── Where the call is ──
*
* The call site opens a note with the binding's name and its location, and
* the wrapper's notes read it and close it. A stack, because a tracked call
* can sit in the arguments of another — (load-texture-from-image
* (gen-image-color ...)) opens the outer site, then the inner one, and the
* inner wrapper runs and closes first. The wrapper names itself, so a site is
* only used by the call it was opened for; a wrapper reached through a
* function value opened none, finds a different name on top, and says it does
* not know where it was called from. A transfer out of a wrapper leaves its
* entry behind, under whatever is pushed next, which is why the depth is
* bounded and the oldest entry is the one dropped. */
#define FLAN_RES_SITES 64
static struct { const char *name; int64_t namelen; const char *site;
int64_t sitelen; } flan_res_sites[FLAN_RES_SITES];
static int flan_res_nsites;
void flan_dev_reg_note_res_site(const char *name, int64_t namelen,
const char *site, int64_t sitelen) {
if (flan_res_nsites == FLAN_RES_SITES) {
memmove(&flan_res_sites[0], &flan_res_sites[1],
(FLAN_RES_SITES - 1) * sizeof flan_res_sites[0]);
flan_res_nsites--;
}
flan_res_sites[flan_res_nsites].name = name;
flan_res_sites[flan_res_nsites].namelen = namelen;
flan_res_sites[flan_res_nsites].site = site;
flan_res_sites[flan_res_nsites].sitelen = sitelen;
flan_res_nsites++;
}
static int flan_res_top_is(const char *name, int64_t namelen) {
return flan_res_nsites > 0
&& flan_res_same(flan_res_sites[flan_res_nsites - 1].name,
flan_res_sites[flan_res_nsites - 1].namelen, name,
namelen);
}
static const char flan_res_unknown[] = "a call through a function value";
static void flan_res_site_of(const char *name, int64_t namelen,
const char **site, int64_t *sitelen) {
if (flan_res_top_is(name, namelen)) {
*site = flan_res_sites[flan_res_nsites - 1].site;
*sitelen = flan_res_sites[flan_res_nsites - 1].sitelen;
} else {
*site = flan_res_unknown;
*sitelen = (int64_t)(sizeof flan_res_unknown - 1);
}
}
void flan_dev_reg_note_res_done(const char *name, int64_t namelen) {
if (flan_res_top_is(name, namelen)) flan_res_nsites--;
}
static flan_res_entry *flan_res_push(flan_res_entry **v, int64_t *n,
int64_t *cap) {
if (*n == *cap) {
int64_t nc = *cap ? *cap * 2 : 64;
flan_res_entry *nv =
(flan_res_entry *)realloc(*v, (size_t)nc * sizeof **v);
/* A diagnostic that runs out of memory says so and keeps the program
going: the report then calls itself a floor rather than a count. */
if (nv == NULL) { flan_res_lost = 1; return NULL; }
*v = nv;
*cap = nc;
}
return &(*v)[(*n)++];
}
void flan_dev_reg_note_res_acquire(uint64_t key, const char *type,
int64_t typelen, const char *name,
int64_t namelen) {
flan_res_entry *e;
flan_res_arm();
e = flan_res_push(&flan_res_held, &flan_res_nheld, &flan_res_capheld);
if (e == NULL) return;
e->key = key; e->type = type; e->typelen = typelen; e->count = 1;
flan_res_site_of(name, namelen, &e->site, &e->sitelen);
}
void flan_dev_reg_note_res_release(uint64_t key, const char *type,
int64_t typelen, const char *name,
int64_t namelen) {
int64_t i;
flan_res_entry *e;
const char *site;
int64_t sitelen;
flan_res_arm();
/* Newest first: a resource loaded and unloaded in one frame is the common
case, and it is at the end. */
for (i = flan_res_nheld - 1; i >= 0; i--) {
flan_res_entry *h = &flan_res_held[i];
if (h->key == key && flan_res_same(h->type, h->typelen, type, typelen)) {
/* Shifted down rather than swapped with the last, so the report lists
what is left in the order it was loaded. */
memmove(&flan_res_held[i], &flan_res_held[i + 1],
(size_t)(flan_res_nheld - i - 1) * sizeof *flan_res_held);
flan_res_nheld--;
return;
}
}
flan_res_site_of(name, namelen, &site, &sitelen);
for (i = 0; i < flan_res_nstray; i++) {
e = &flan_res_stray[i];
if (flan_res_same(e->type, e->typelen, type, typelen)
&& flan_res_same(e->site, e->sitelen, site, sitelen)) {
e->count++;
return;
}
}
e = flan_res_push(&flan_res_stray, &flan_res_nstray, &flan_res_capstray);
if (e == NULL) return;
e->key = key; e->type = type; e->typelen = typelen;
e->site = site; e->sitelen = sitelen; e->count = 1;
}
/* A call that changes a resource in place — ImageFormat reallocates an
* image's pixels — gives it a new key. The old keys arrive before the call
* and the new ones after it, in reverse order, so they pair on a stack. More
* than eight at once would be a binding with nine pointer parameters to one
* resource type; past that the pairing is dropped rather than guessed. */
#define FLAN_RES_REKEY_MAX 8
static uint64_t flan_res_rekey[FLAN_RES_REKEY_MAX];
static int flan_res_nrekey, flan_res_rekey_over;
void flan_dev_reg_note_res_rekey_from(uint64_t old) {
if (flan_res_nrekey < FLAN_RES_REKEY_MAX)
flan_res_rekey[flan_res_nrekey++] = old;
else
flan_res_rekey_over++;
}
void flan_dev_reg_note_res_rekey_to(uint64_t now, const char *type,
int64_t typelen) {
uint64_t old;
int64_t i;
if (flan_res_rekey_over > 0) { flan_res_rekey_over--; return; }
if (flan_res_nrekey == 0) return;
old = flan_res_rekey[--flan_res_nrekey];
if (old == now) return;
for (i = flan_res_nheld - 1; i >= 0; i--) {
flan_res_entry *h = &flan_res_held[i];
if (h->key == old && flan_res_same(h->type, h->typelen, type, typelen)) {
h->key = now;
return;
}
}
}
/* The held entries, grouped by type and site, in the order they were first
* loaded. Quadratic in the number of groups, which is the number of distinct
* load sites and not the number of resources. */
static void flan_res_report(void) {
int64_t i, j;
if (flan_res_nheld > 0) {
fprintf(stderr, "flan: %lld resource%s still held at exit, loaded and "
"never unloaded:\n",
(long long)flan_res_nheld, flan_res_nheld == 1 ? "" : "s");
for (i = 0; i < flan_res_nheld; i++) {
flan_res_entry *e = &flan_res_held[i];
int64_t n = 0;
int seen = 0;
for (j = 0; j < i && !seen; j++)
seen = flan_res_same(flan_res_held[j].type, flan_res_held[j].typelen,
e->type, e->typelen)
&& flan_res_same(flan_res_held[j].site, flan_res_held[j].sitelen,
e->site, e->sitelen);
if (seen) continue;
for (j = i; j < flan_res_nheld; j++)
if (flan_res_same(flan_res_held[j].type, flan_res_held[j].typelen,
e->type, e->typelen)
&& flan_res_same(flan_res_held[j].site, flan_res_held[j].sitelen,
e->site, e->sitelen))
n++;
fprintf(stderr, "flan: %lld %.*s, loaded at %.*s\n", (long long)n,
(int)e->typelen, e->type, (int)e->sitelen, e->site);
}
}
for (i = 0; i < flan_res_nstray; i++) {
flan_res_entry *e = &flan_res_stray[i];
fprintf(stderr, "flan: %.*s released %lld time%s at %.*s with nothing "
"loaded to match\n",
(int)e->typelen, e->type, (long long)e->count,
e->count == 1 ? "" : "s", (int)e->sitelen, e->site);
}
if (flan_res_lost)
fprintf(stderr, "flan: the resource table ran out of memory, 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>
#if defined(__linux__) && (defined(__x86_64__) || defined(__aarch64__))
#include <sys/mman.h>
#include <ucontext.h>
#define FLAN_PARK_STACKS 1
#endif
extern void (*flan_trap_hook)(const uint8_t *name, int64_t namelen);
#ifdef FLAN_PARK_STACKS
/* Where a fault's break loop runs. Not the signal stack: the loop evaluates
* whatever is typed at it, and a runaway recursion there ran off the end of a
* 1 MiB malloc'd block with nothing below it, into the heap. And a fault taken
* while already on the signal stack has no stack to be delivered on, so the
* kernel kills the process.
*
* So the handler moves to one of these before calling the hook: 8 MiB each,
* mapped on first use, with a guard page at the low end. An overflow on one
* faults on its guard, the fault is delivered on the signal stack (the
* interrupted code was not on it), and its break loop gets the next stack up.
* Which stack is next is read off the interrupted stack pointer: a fault in
* code running on stack k parks on k + 1, and every stack above k is free,
* because a break loop is only ever left by a jump down to its caller. */
#define PARK_COUNT 10
#define PARK_SIZE ((size_t)8 << 20)
static char *park_lo[PARK_COUNT];
static ucontext_t park_uc[PARK_COUNT];
static const uint8_t *park_name;
static int64_t park_namelen;
/* The guard page counts as the stack's: an overflow's stack pointer is in it
* when the fault is taken, and reading it as some other stack's would park the
* overflow's break loop on the very stack it overflowed. */
static int park_index_of(uintptr_t sp) {
uintptr_t pg = (uintptr_t)sysconf(_SC_PAGESIZE);
for (int i = 0; i < PARK_COUNT; i++)
if (park_lo[i] != NULL && sp >= (uintptr_t)park_lo[i] - pg
&& sp <= (uintptr_t)park_lo[i] + PARK_SIZE)
return i;
return -1;
}
static char *park_stack(int i) {
if (park_lo[i] == NULL) {
size_t pg = (size_t)sysconf(_SC_PAGESIZE);
char *m = mmap(NULL, PARK_SIZE + pg, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE, -1, 0);
if (m == MAP_FAILED) return NULL;
if (mprotect(m, pg, PROT_NONE) != 0) {
munmap(m, PARK_SIZE + pg);
return NULL;
}
park_lo[i] = m + pg;
}
return park_lo[i];
}
static uintptr_t park_interrupted_sp(void *uc) {
const ucontext_t *u = (const ucontext_t *)uc;
#if defined(__x86_64__)
return (uintptr_t)u->uc_mcontext.gregs[15]; /* REG_RSP */
#else
return (uintptr_t)u->uc_mcontext.sp;
#endif
}
static void park_run(void) {
flan_trap_hook(park_name, park_namelen);
/* The hook parks and is left only by a jump; reaching here is dying. */
signal(SIGSEGV, SIG_DFL);
raise(SIGSEGV);
}
/* Calls the hook on the next park stack, or returns 0 when there is none to
* be had and the caller should call it where it stands. */
static int park_elsewhere(void *uc, const uint8_t *name, int64_t namelen) {
int k = park_index_of(park_interrupted_sp(uc)) + 1;
char *st = k < PARK_COUNT ? park_stack(k) : NULL;
if (st == NULL) return 0;
park_name = name;
park_namelen = namelen;
if (getcontext(&park_uc[k]) != 0) return 0;
park_uc[k].uc_stack.ss_sp = st;
park_uc[k].uc_stack.ss_size = PARK_SIZE;
park_uc[k].uc_link = NULL;
makecontext(&park_uc[k], park_run, 0);
setcontext(&park_uc[k]);
return 0;
}
#endif
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);
}
/* Non-NULL while the agent renders a value for the inspector, naming it. A
* fault then is the reader's, and the report says so instead of blaming the
* frame that happens to be on top — the program was stopped, not running. */
const char *volatile flan_dev_crash_reading;
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);
if (flan_dev_crash_reading != NULL) {
static const char reading[] = " \xe2\x80\x94 reading ";
static const char tail[] = " for the inspector touched ";
crash_puts(reading, sizeof reading - 1);
crash_puts(flan_dev_crash_reading, strlen(flan_dev_crash_reading));
crash_puts(tail, sizeof tail - 1);
} else {
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_dev_crash_reading == NULL
&& 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 into read-only memory, "
"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. */
#ifdef FLAN_PARK_STACKS
if (sig == SIGBUS)
park_elsewhere(uc, (const uint8_t *)"BusError", 8);
else
park_elsewhere(uc, (const uint8_t *)"SegFault", 8);
#endif
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__ */
Reference in New Issue View Git Blame Copy Permalink