flan/runtime/flan_dev.c

/* flan_dev — the part of the host ABI that only a dev build has.
 *
 * A redefinition module reaches the host's functions and globals through
 * symbols the host already exports: a cell for each function, the storage for
 * each global. That covers everything the program was *built* with. It does
 * not cover a name the module introduces — a defn or a defvar 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>

#define FLAN_DEV_MAX 4096

typedef struct {
  const char *name;   /* strdup'd: the module that passed it may go away */
  void       *cell;   /* a function's cell, or a global's storage */
  size_t      size;   /* a global's size; 0 for a function */
} entry;

static entry  table[FLAN_DEV_MAX];
static size_t used;

static void die(const char *what, const char *name) {
  fprintf(stderr, "flan_dev: %s: %s\n", what, name);
  fflush(stderr);
  abort();
}

static entry *find(const char *name) {
  for (size_t i = 0; i < used; i++)
    if (strcmp(table[i].name, name) == 0) return &table[i];
  return NULL;
}

static entry *intern(const char *name) {
  if (used == FLAN_DEV_MAX) die("out of dev name slots", name);
  entry *e = &table[used++];
  e->name = strdup(name);
  if (e->name == NULL) die("out of memory", name);
  e->cell = NULL;
  e->size = 0;
  return e;
}

/* The cell a run-time-introduced function is called through. One indirection
 * more than a function the host was built with, whose cell is a symbol the
 * module can name directly — the compiler picks per name, so the common case
 * stays a single load. */
void **flan_dev_cell(const char *name) {
  entry *e = find(name);
  if (e == NULL) e = intern(name);
  return &e->cell;
}

/* Storage for a run-time-introduced global, allocated once.
 *
 * [init] is its declared initial value, or NULL for all-zero. It is copied on
 * the allocation and ignored on every call after it, which is where "a reload
 * must not reset the program's state" lives: the second module to mention this
 * name is a redefinition, and re-running an initialiser would throw away
 * exactly what the reload exists to preserve. Doing it here rather than by a
 * branch in the caller means the rule cannot be got wrong at one call site.
 *
 * A size mismatch is the layout-drift failure, caught at its first chance: the
 * running process has already laid this memory out, and handing back the old
 * allocation for a differently shaped type means the new body reads fields at
 * the wrong offsets and nothing ever says so. Retyping a var needs a restart. */
void *flan_dev_global(const char *name, uint64_t size, const void *init) {
  entry *e = find(name);
  if (e == NULL) {
    e = intern(name);
    e->cell = calloc(1, size ? (size_t)size : 1);
    if (e->cell == NULL) die("out of memory", name);
    e->size = (size_t)size;
    if (init != NULL && size > 0) memcpy(e->cell, init, (size_t)size);
    return e->cell;
  }
  if (e->size != (size_t)size) die("size changed; restart to retype", name);
  return e->cell;
}

/* ── The value of an evaluated expression ──────────────────────────── */

/* C-x C-e compiles a thunk that renders one expression and emits it here, a
 * piece at a time. It is not written to stdout: stdout belongs to the program,
 * it is in the hot path for anything that prints, and a dev-only feature must
 * not put a branch in it. The daemon reads this back over the agent's socket.
 *
 * Emitting piece by piece rather than returning one string is what makes a
 * composite renderer possible at all — a struct is its fields with punctuation
 * between them, and concatenating that in the generated IR would mean an
 * allocator the language does not have.
 *
 * The output bound lives here and nowhere else. A slice of a million elements
 * renders with a loop the compiler cannot bound, so [emit] truncates and
 * [end] says so with an ellipsis. One place enforcing it means no renderer has
 * to carry a budget.
 *
 * [generation] is what makes the read safe without a handshake. The thunk runs
 * on the game thread at a frame boundary, whenever that happens to be; the
 * daemon waits for the counter to move rather than guessing it has.
 *
 * It is a *seqlock*, and it has to be a real one, because the reader is the
 * agent's listener thread and the writer is the game thread and neither waits
 * for the other. The counter is odd for exactly as long as a value is being
 * written, so a reader that sees an odd count, or a different count either
 * side of its copy, has read a value that was being overwritten underneath it
 * and reads again. A count of 2k means k complete values; the count the
 * outside world is given is that k, so that the daemon's "has it moved" keeps
 * meaning "is there a new value".
 *
 * The copy is what makes it safe, and the API is shaped around that: a reader
 * gets *bytes of its own*, not a pointer into [result]. The pointer version of
 * this was the bug — it read the generation, then a length, then handed back
 * the buffer itself, and the caller sent it down a socket some time later
 * while the game thread was free to be a hundred bytes into the next value.
 * A seqlock cannot validate a read that happens after it returns. */

/* Fixed, and it stays fixed. This was expected to go with the socket — a 4K
 * cap reads like a transport buffer — and it is not one. This is the buffer
 * the *game thread* writes into, from a render thunk at a frame boundary, and
 * a growable one would mean the frame thread calling realloc: an allocation in
 * the one place this whole design exists to keep allocation out of. It would
 * also break the seqlock above, which is a protocol about torn *contents* and
 * assumes the address it memcpys from does not move or go away underneath it;
 * growing on the writer's side is a use-after-free the counter cannot see.
 *
 * So the cap is a render budget, not a wire size, and what did go is the
 * agent's second copy of the number. Removing the bound itself is a redesign
 * of the read — probe, allocate, re-read, validate, retry — and belongs with
 * moving the read to a frame boundary, which is the seqlock's own decision. */
#define RESULT_MAX 4096
static char     result[RESULT_MAX];
static size_t   result_len;
static int      result_full;
static uint64_t generation;

void flan_dev_result_begin(void) {
  /* Odd first, and only then the reset: the counter has to say "in progress"
   * before the buffer stops being the value it used to be.
   *
   * The fence is the half of that a release *store* cannot do. A release store
   * orders what comes before it, not what comes after, so the writes below —
   * and every memcpy in [emit] — would be free to become visible ahead of the
   * odd count, and a reader could see an even count either side of a copy it
   * made while the buffer was being overwritten. Which is the bug this
   * replaced, with more ceremony. So: mark it relaxed, fence, then write.
   *
   * Setting the low bit rather than incrementing, because a [begin] with no
   * [end] is reachable and must not poison the counter for the life of the
   * process. A render thunk that signals is stopped inside this window, and a
   * restart taken from that break transfers past the thunk — [end] never runs.
   * Repairing it here costs nothing in the ordinary case (2k, 2k+1, 2k+2) and
   * means an abandoned write is over as soon as the next evaluation starts,
   * rather than leaving every later read reporting "in progress" forever.
   *
   * What it does not fix, because the buffer cannot: an evaluation that runs
   * while another is stopped mid-render shares this one buffer, so the inner
   * value is the one that survives and the outer thunk, if it is ever resumed,
   * appends to it. That was true before the counter was a seqlock. */
  __atomic_store_n(&generation, generation | 1, __ATOMIC_RELAXED);
  __atomic_thread_fence(__ATOMIC_RELEASE);
  result_len = 0;
  result_full = 0;
}

void flan_dev_emit(const uint8_t *bytes, int64_t len) {
  size_t n = len < 0 ? 0 : (size_t)len;
  if (result_len + n > RESULT_MAX) {
    n = RESULT_MAX - result_len;
    result_full = 1;
  }
  memcpy(result + result_len, bytes, n);
  result_len += n;
}

static void emit_cstr(const char *s) {
  flan_dev_emit((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. */
void flan_dev_emit_u64(uint64_t x) {
  char buf[32];
  snprintf(buf, sizeof buf, "%llu", (unsigned long long)x);
  emit_cstr(buf);
}

void flan_dev_emit_i64(int64_t x) {
  char buf[32];
  snprintf(buf, sizeof buf, "%lld", (long long)x);
  emit_cstr(buf);
}

void flan_dev_emit_f64(double x) {
  char buf[64];
  snprintf(buf, sizeof buf, "%g", x);
  emit_cstr(buf);
}

/* 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. */
void flan_dev_emit_str(const uint8_t *bytes, int64_t len) {
  size_t n = len < 0 ? 0 : (size_t)len;
  emit_cstr("\"");
  for (size_t i = 0; i < n; i++) {
    unsigned char c = bytes[i];
    switch (c) {
      case '"':  emit_cstr("\\\""); break;
      case '\\': emit_cstr("\\\\"); break;
      case '\n': emit_cstr("\\n"); break;
      case '\t': emit_cstr("\\t"); break;
      case '\r': emit_cstr("\\r"); break;
      default:
        if (c < 0x20) {
          char buf[8];
          snprintf(buf, sizeof buf, "\\x%02x", c);
          emit_cstr(buf);
        } else {
          flan_dev_emit(&c, 1);
        }
    }
  }
  emit_cstr("\"");
}

void flan_dev_result_end(void) {
  if (result_full) {
    /* Room is made for it rather than assumed: the buffer is full by
     * definition when this fires. */
    const char *ell = "...";
    size_t k = strlen(ell);
    if (result_len > RESULT_MAX - k) result_len = RESULT_MAX - k;
    memcpy(result + result_len, ell, k);
    result_len += k;
  }
  /* 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. */
  __atomic_store_n(&generation, (generation | 1) + 1, __ATOMIC_RELEASE);
}

/* Copy the current value out, with the counter that says which one it is.
 *
 * Returns 1 having copied a value that was complete for the whole of the copy,
 * 0 if the game thread was in the middle of writing one — in which case [gen]
 * is the last *complete* value's number and [len] is 0, so a caller polling
 * for a new one keeps polling instead of being handed half of it. Spinning
 * here is bounded: the writer is a render thunk between frames, not a loop,
 * and the reader is the listener thread, which has nothing better to do.
 *
 * [cap] is the caller's buffer. A value longer than it is truncated, which is
 * the only failure this can have and is a clamp rather than an overrun; every
 * caller sizes its buffer from [flan_dev_result_cap] so it does not arise. */
/* What a caller's buffer has to be for the copy never to be truncated. One
 * declaration, asked for rather than written down twice — the agent carried
 * its own copy of the number and a check that the two had not drifted, back
 * when it was sizing something to send through a socket. */
uint64_t flan_dev_result_cap(void) { return RESULT_MAX; }

int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
                         uint64_t *len) {
  for (int attempt = 0; attempt < 64; attempt++) {
    uint64_t g1 = __atomic_load_n(&generation, __ATOMIC_ACQUIRE);
    if (g1 & 1) continue;                  /* a write is in progress */
    size_t n = __atomic_load_n(&result_len, __ATOMIC_RELAXED);
    if (n > RESULT_MAX) n = RESULT_MAX;    /* a torn read cannot overrun */
    if ((uint64_t)n > cap) n = (size_t)cap;
    memcpy(dst, result, n);
    /* The copy must be ordered before the second read of the counter, or the
     * check is of a copy the compiler was free to make afterwards. */
    __atomic_thread_fence(__ATOMIC_ACQUIRE);
    if (__atomic_load_n(&generation, __ATOMIC_ACQUIRE) == g1) {
      *gen = g1 / 2;
      *len = (uint64_t)n;
      return 1;
    }
  }
  /* Integer division is the same answer either side of a write in progress:
   * during value k the counter is 2k-1 and k-1 are complete. */
  *gen = __atomic_load_n(&generation, __ATOMIC_ACQUIRE) / 2;
  *len = 0;
  return 0;
}

/* ── The watch table ────────────────────────────────────────────────── */

/* A HUD, pushed rather than polled, and the push is why it exists at all.
 *
 * The watch buffer's obvious shape is the one the author's Clojure version
 * has: Emacs polls a render function on a timer and paints what it returns.
 * That does not port. Here an evaluation *compiles a module and dlopens it* —
 * tens of milliseconds and a new .so each time, in a directory nothing sweeps
 * — so a 5Hz poll is hundreds of shared objects a minute for a value that was
 * already sitting in a register.
 *
 * So the direction is inverted. The program writes: it calls
 * [flan_dev_watch_*] from inside its own loop, which renders the value to text
 * and stores it under a name. Emacs reads the *table*, which is memory. Both
 * halves are cheap for opposite reasons, the values update at frame rate
 * rather than at timer rate, and — the part a poll cannot do at all — the last
 * frame's values are still here while the program is stopped in a break loop,
 * because nothing has to run to produce them.
 *
 * Everything below is written for one caller: the game thread, mid-frame.
 * That is the same constraint the rest of this file is under and it is
 * stricter here, because this runs every frame rather than once per
 * evaluation:
 *
 *   - No allocation. Names are fixed char arrays inside the table, not
 *     strdup'd the way [intern] above does it. [intern] runs at module load
 *     and may malloc; this runs at 60fps and may not.
 *   - No lock. The reader is the agent's listener thread and the writer is the
 *     game thread; neither waits for the other.
 *   - No call into OCaml, which is the rule that keeps the collector off the
 *     frame thread. Nothing here is OCaml.
 *
 * Deliberately NOT sharing [result] and [generation] above. It was tempting —
 * the renderers are the same shape — and it is wrong: [result] is written once
 * per C-x C-e and this is written every frame, so watch traffic would overwrite
 * the value of every expression anyone evaluated. The two are separate storage
 * with separate counters and that is not an accident.
 */

/* The three bounds, and what happens past each one.
 *
 * [WATCH_MAX] slots. Past it, a name is **dropped**, not fatal. The house
 * style elsewhere in this file is [die], and this is the one place it would be
 * wrong: a watch is a diagnostic, and killing the program because somebody
 * watched a 65th value is the diagnostic shooting the patient. It is not
 * silent either — [flan_dev_watch_overflowed] is read back with the table and
 * the buffer says so, so an overflow is visible rather than a value that
 * mysteriously never appears.
 *
 * A flag and **not a count**, which is the correction worth recording. A
 * counter here would be incremented from the write path, and the write path
 * runs once per watched value per *frame* — so one name too many at 60fps
 * reads back as "3847 names found no slot" within a minute, which is a false
 * sentence about a true problem. What a reader needs is "the table is full and
 * something is not being shown", which is one bit, and one bit cannot drift
 * into a wrong number. Counting *distinct* names that missed would mean
 * remembering which ones had, which is exactly the bookkeeping the frame
 * thread has no room for.
 *
 * [WATCH_NAME] bytes of name, [WATCH_VAL] bytes of rendered value. Both
 * truncate; the value's truncation shows as an ellipsis, the same as
 * [result_end] does, so a clipped value does not read as a complete one. */
#define WATCH_MAX  64
#define WATCH_NAME 32
#define WATCH_VAL  192

typedef struct {
  char     name[WATCH_NAME];  /* NUL-terminated, truncated to fit */
  char     val[WATCH_VAL];
  uint32_t len;
  int      full;              /* the value did not fit */
  /* An accumulator slot. [val]/[len] are unused; the five doubles below are
   * the value, and the *reader* turns them into text. See "A number sampled
   * thousands of times a frame" below. */
  int      num;
  uint64_t epoch;             /* the window [n]/[lo]/[hi]/[sum] belong to */
  double   n, lo, hi, last, sum;
  uint64_t gen;               /* this slot's own seqlock */
} watch_slot;

static watch_slot watch_table[WATCH_MAX];
static uint32_t   watch_used;      /* claimed slots; only ever grows */
static int        watch_overflowed; /* some name found no slot; see above */

/* The current accumulation window. Bumped by [flan_dev_watch_reset], which is
 * the editor saying "start again from here"; a slot notices on its next
 * sample. The counter is the reader's to move and the slots are the writer's
 * to clear, so no thread ever writes the other's memory. */
static uint64_t watch_epoch;

/* One counter per slot rather than one for the table.
 *
 * A table-wide counter would make a read all-or-nothing: the reader would have
 * to copy every slot inside a single even generation, which means catching the
 * gap *between* two frames' worth of writes — a window that at 60fps is
 * whatever the game does after its last watch call, and may be nothing.
 * Per-slot, the reader retries one slot at a time and always gets somewhere,
 * and the worst it can produce is a snapshot whose entries come from adjacent
 * frames. For a HUD that is not a defect: a frame counter one ahead of a
 * position read a millisecond earlier is what a HUD looks like anyway. It
 * would be a defect for anything where two values have to agree, and if that
 * is ever wanted it is a different op, not a bigger counter. */

/* Is anyone looking?
 *
 * Set when a watch buffer opens and cleared when it closes, so the cost of a
 * watch call in a program nobody is debugging is one relaxed load and a
 * not-taken branch. That is what "watching costs nothing when nobody is
 * watching" means here, and it is the same number in a dev build and a release
 * build — [flan_dev.c] is linked into both (see [Build], which says why) so the
 * symbols resolve either way and there is no second version of this file.
 *
 * What it is *not*: free. Eliding the call entirely needs the compiler to know
 * the form, which is a [check.ml] arm this does not have. A load and a branch
 * per watched value per frame is the honest number, and it is the same number
 * in both builds rather than a dev-only tax. */
static int watch_on;

void flan_dev_watch_enable(int on) {
  __atomic_store_n(&watch_on, on ? 1 : 0, __ATOMIC_RELAXED);
}

int flan_dev_watch_enabled(void) {
  return __atomic_load_n(&watch_on, __ATOMIC_RELAXED);
}

/* The slot a name owns, or NULL if the table is full.
 *
 * Linear, because the table is 64 long and a hash would need a policy for
 * collisions that a scan does not. A HUD with twenty values does twenty
 * strcmps of a handful of bytes per frame; if that ever shows up in a profile
 * the answer is to watch fewer things.
 *
 * [watch_used] only ever grows and a slot's name never changes once set, so a
 * reader can walk [0, watch_used) without synchronising against this: the
 * worst it sees is a slot whose name is written and whose value is not yet,
 * which that slot's own seqlock catches. */
static watch_slot *watch_find(const char *name) {
  uint32_t used = __atomic_load_n(&watch_used, __ATOMIC_RELAXED);
  for (uint32_t i = 0; i < used; i++)
    if (strncmp(watch_table[i].name, name, WATCH_NAME - 1) == 0)
      return &watch_table[i];
  if (used == WATCH_MAX) {
    __atomic_store_n(&watch_overflowed, 1, __ATOMIC_RELAXED);
    return NULL;
  }
  watch_slot *s = &watch_table[used];
  size_t n = strlen(name);
  if (n > WATCH_NAME - 1) n = WATCH_NAME - 1;
  memcpy(s->name, name, n);
  s->name[n] = '\0';
  s->len = 0;
  s->full = 0;
  /* Published last, so a reader that sees this index sees a finished name. */
  __atomic_store_n(&watch_used, used + 1, __ATOMIC_RELEASE);
  return s;
}

/* The slot the emitters below are writing into. A plain static and not an
 * atomic, because begin/emit/end is one uninterrupted run on the one thread
 * that writes — the same assumption [result_len] above is written under. */
static watch_slot *watch_cur;

/* Open a slot for writing; 0 if nobody is watching or the table is full, in
 * which case the emitters below are no-ops and the caller need not branch.
 *
 * Odd first, then the reset, for [flan_dev_result_begin]'s reason: the counter
 * has to say "in progress" before the buffer stops being the value it used to
 * be, and a release *store* orders only what precedes it, so the fence is the
 * half it cannot do. Setting the low bit rather than incrementing means a
 * begin whose end never runs — a break taken inside a render — is repaired by
 * the next write rather than poisoning the slot for the life of the process. */
int flan_dev_watch_begin(const char *name) {
  if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) { watch_cur = NULL; return 0; }
  watch_slot *s = watch_find(name);
  watch_cur = s;
  if (s == NULL) return 0;
  __atomic_store_n(&s->gen, s->gen | 1, __ATOMIC_RELAXED);
  __atomic_thread_fence(__ATOMIC_RELEASE);
  s->len = 0;
  s->full = 0;
  /* A name written as text is a text slot from now on. The table's rule
   * everywhere else is that the last writer wins and this is the same rule;
   * a program that watches one name both ways gets whichever ran last, and
   * that is not worth a guard on the frame thread. */
  s->num = 0;
  return 1;
}

void flan_dev_watch_emit(const uint8_t *bytes, int64_t len) {
  watch_slot *s = watch_cur;
  if (s == NULL) return;
  size_t n = len < 0 ? 0 : (size_t)len;
  if (s->len + n > WATCH_VAL) {
    n = WATCH_VAL - s->len;
    s->full = 1;
  }
  memcpy(s->val + s->len, bytes, n);
  s->len += (uint32_t)n;
}

static void watch_cstr(const char *str) {
  flan_dev_watch_emit((const uint8_t *)str, (int64_t)strlen(str));
}

void flan_dev_watch_emit_i64(int64_t x) {
  char buf[32];
  snprintf(buf, sizeof buf, "%lld", (long long)x);
  watch_cstr(buf);
}

void flan_dev_watch_emit_u64(uint64_t x) {
  char buf[32];
  snprintf(buf, sizeof buf, "%llu", (unsigned long long)x);
  watch_cstr(buf);
}

void flan_dev_watch_emit_f64(double x) {
  char buf[64];
  snprintf(buf, sizeof buf, "%g", x);
  watch_cstr(buf);
}

/* Quoted and escaped, for [flan_dev_emit_str]'s reason and one more: a string
 * whose content is not escaped does not round-trip, and a newline in one would
 * become a second row of the table on the wire rather than part of a value. */
void flan_dev_watch_emit_str(const uint8_t *bytes, int64_t len) {
  size_t n = len < 0 ? 0 : (size_t)len;
  watch_cstr("\"");
  for (size_t i = 0; i < n; i++) {
    unsigned char c = bytes[i];
    switch (c) {
      case '"':  watch_cstr("\\\""); break;
      case '\\': watch_cstr("\\\\"); break;
      case '\n': watch_cstr("\\n"); break;
      case '\t': watch_cstr("\\t"); break;
      case '\r': watch_cstr("\\r"); break;
      default:
        if (c < 0x20) {
          char buf[8];
          snprintf(buf, sizeof buf, "\\x%02x", c);
          watch_cstr(buf);
        } else {
          flan_dev_watch_emit(&c, 1);
        }
    }
  }
  watch_cstr("\"");
}

void flan_dev_watch_end(void) {
  watch_slot *s = watch_cur;
  watch_cur = NULL;
  if (s == NULL) return;
  if (s->full) {
    /* Room is made for it rather than assumed: the value is full by
     * definition when this fires. */
    const char *ell = "...";
    size_t k = strlen(ell);
    if (s->len > WATCH_VAL - k) s->len = (uint32_t)(WATCH_VAL - k);
    memcpy(s->val + s->len, ell, k);
    s->len += (uint32_t)k;
  }
  /* 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 an abandoned write
   * left behind. */
  __atomic_store_n(&s->gen, (s->gen | 1) + 1, __ATOMIC_RELEASE);
}

/* ── Watching one scalar, with no compiler change ───────────────────── */

/* These are the whole feature for a scalar, and they are what a program can
 * use today:
 *
 *   (declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
 *   ...
 *   (watch-i64 "ticks" ticks)
 *
 * No arm in the checker, no new special form, nothing the compiler has to
 * learn — which is the point, because the checker is not a file this change
 * owns.
 *
 * They return i32 rather than nothing for a blunt reason: [declare-c] refuses
 * a void return outright — "which is not a value C can carry", shim.ml — so a
 * function a program can declare has to return something. Since it must, it
 * returns the useful thing: 1 if the value was written, 0 if it was not,
 * which is either nobody watching or a full table. A caller is free to ignore
 * it and normally does.
 *
 * A composite — a struct, a slice, a union — cannot be done this way, and that
 * is not a shortcoming of these four: a Flan value carries no header, so
 * nothing at run time can say what it is, and rendering one is a compile-time
 * walk over its *type*. The walk already exists — [Render.render] — and the
 * four [flan_dev_watch_emit_*] above are the emitter it would be pointed at,
 * shaped exactly like the [print] arm's. What is missing is the
 * [(watch "hp" hp)] arm in check.ml that joins the two, which is a file this
 * change does not own. docs/BUILT.md says what that arm is. */
int32_t flan_dev_watch_i64(const char *name, int64_t x) {
  if (!flan_dev_watch_begin(name)) return 0;
  flan_dev_watch_emit_i64(x);
  flan_dev_watch_end();
  return 1;
}

int32_t flan_dev_watch_u64(const char *name, uint64_t x) {
  if (!flan_dev_watch_begin(name)) return 0;
  flan_dev_watch_emit_u64(x);
  flan_dev_watch_end();
  return 1;
}

int32_t flan_dev_watch_f64(const char *name, double x) {
  if (!flan_dev_watch_begin(name)) return 0;
  flan_dev_watch_emit_f64(x);
  flan_dev_watch_end();
  return 1;
}

int32_t flan_dev_watch_str(const char *name, const char *s) {
  if (!flan_dev_watch_begin(name)) return 0;
  flan_dev_watch_emit_str((const uint8_t *)s, (int64_t)strlen(s));
  flan_dev_watch_end();
  return 1;
}

/* ── A number sampled thousands of times a frame ─────────────────────── */

/* The scalar watch above keeps one value per name, and from a hot inner loop
 * that is nearly useless: you see whichever of the 91,200 cells happened to
 * run last. This is the other half — the port of [spy-num] from the author's
 * watch.clj, which exists for exactly that reason and is the piece docs/PORTING.md
 * calls the least obvious and the most valuable.
 *
 * **What a slot keeps: count, min, max, last, mean.** Five numbers, and the
 * argument for them is that they are the ones you can ask for without building
 * a query. [n] says how many times the expression ran, which is the first
 * thing that is wrong when a loop is wrong. [min] and [max] are the range,
 * which is what you are looking for when you suspect an index or a velocity is
 * leaving the region it should stay in — and a range is the thing a single
 * sample can never show you. [last] is the one sample, kept because it is what
 * the scalar watch would have given you and losing it would be a regression.
 * [mean] is carried as a running [sum] and divided at read time, because a
 * mean accumulated as a mean drifts and a sum does not.
 *
 * **What it deliberately does not keep: a ring, or a history.** A small ring
 * of the last N samples was the other candidate. It loses on the only ground
 * that matters here: N samples out of 91,200 is a sample of the *tail* of the
 * loop, not of the loop, so it answers "what did the last few cells do" when
 * the question is "what did the cells do". Every richer answer than five
 * numbers is a UI for building a query, and a query builder is the one thing
 * this design exists not to be.
 *
 * **The write path does no formatting.** That is the entire point and is where
 * the naive version dies: an [snprintf] per sample at thousands of samples per
 * frame is a HUD that costs more than the game. A sample here is a load, five
 * compares and stores, and the slot's seqlock. The *reader* — the agent's
 * listener thread, once per editor tick — turns the five numbers into text.
 * watch.clj reaches the same place with a double-array per label and a render
 * function Emacs calls; the reasoning is the author's, not ours.
 *
 * **The window is since the last reset, not since the program started.** This
 * is the one place this deliberately *diverges* from watch.clj, whose stats
 * are cumulative until [reset-spies!] is called by hand. Cumulative is the
 * wrong default for a frame loop: a min and a max over a whole session reach
 * the session's extremes within a few seconds of play and then never move
 * again, so the two most useful of the five go dead exactly when you start
 * interacting with the thing you are debugging. This tool exists to show you a
 * number while you drag the mouse. So the editor bumps
 * [flan_dev_watch_reset] on its tick and each slot clears itself on its next
 * sample, which makes the displayed range "since you last looked" — a fifth of
 * a second, a dozen frames — and keeps it tracking the present. A caller that
 * wants cumulative numbers gets them by not resetting; that is the setting,
 * and it lives in the editor rather than here.
 *
 * **i64 accumulates as a double**, so a magnitude past 2^53 loses precision in
 * the sum and in the ends of the range. Said rather than designed around: a
 * count, a coordinate and a tile index are what this is pointed at, and a
 * second integer accumulator to cover the case nobody has would be two code
 * paths for one tool. */
static void watch_record(watch_slot *s, double v) {
  uint64_t e = __atomic_load_n(&watch_epoch, __ATOMIC_RELAXED);
  /* Odd first, then the change, then even — [flan_dev_watch_begin]'s protocol
   * exactly, and the epoch check is *inside* the odd window so a reader can
   * never catch a half-cleared slot. */
  __atomic_store_n(&s->gen, s->gen | 1, __ATOMIC_RELAXED);
  __atomic_thread_fence(__ATOMIC_RELEASE);
  s->num = 1;
  if (s->epoch != e) { s->epoch = e; s->n = 0; s->sum = 0; }
  if (s->n == 0) { s->lo = v; s->hi = v; }
  else { if (v < s->lo) s->lo = v; if (v > s->hi) s->hi = v; }
  s->n   += 1;
  s->sum += v;
  s->last = v;
  __atomic_store_n(&s->gen, (s->gen | 1) + 1, __ATOMIC_RELEASE);
}

/* Start a new window. Called by the editor beside its table read, never by the
 * program. It moves one counter and touches no slot, which is what keeps the
 * game thread the only writer of the table. */
void flan_dev_watch_reset(void) {
  __atomic_add_fetch(&watch_epoch, 1, __ATOMIC_RELEASE);
}

/* Reachable from a program by [declare-c], the same as the four scalars and
 * for the same reason — no arm in the checker, nothing the compiler learns:
 *
 *   (declare-c watch-num-i64 [name string x i64] i32 "flan_dev_watch_num_i64")
 *   ...
 *   (watch-num-i64 "cell" (at grid i))
 *
 * Two entry points rather than one so a program need not cast an i64 to an f64
 * at the call site, which is noise in the one place this is meant to be
 * droppable into. */
int32_t flan_dev_watch_num_i64(const char *name, int64_t x) {
  if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) return 0;
  watch_slot *s = watch_find(name);
  if (s == NULL) return 0;
  watch_record(s, (double)x);
  return 1;
}

int32_t flan_dev_watch_num_f64(const char *name, double x) {
  if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) return 0;
  watch_slot *s = watch_find(name);
  if (s == NULL) return 0;
  watch_record(s, x);
  return 1;
}

/* A whole number prints as one. watch.clj's [fmt-num] does this and the reason
 * is worth keeping: a spy on an array index that reads 66.0000 makes you look
 * for a rounding bug that is not there. */
static void watch_num_str(char *out, size_t cap, double d) {
  if (d >= -9.0e15 && d <= 9.0e15 && d == (double)(long long)d)
    snprintf(out, cap, "%lld", (long long)d);
  else
    snprintf(out, cap, "%.4f", d);
}

/* Rendered on the listener thread, from numbers already copied out of the
 * slot, so nothing here races and nothing here runs per sample. Comfortably
 * inside [WATCH_VAL]: five numbers at %.4f and their labels is well under 192
 * bytes, and [snprintf] truncates rather than overruns if a caller's buffer is
 * smaller than [flan_dev_watch_val_cap].
 *
 * **[n] is at least 1 whenever this runs**, so there is no empty-window arm
 * and [sum / n] cannot divide by zero. A slot only becomes a num slot inside
 * [watch_record], which always falls through to [s->n += 1], and the clear on
 * an epoch change sits in the same odd-generation window as that increment, so
 * no reader can catch a num slot at zero.
 *
 * There used to be an "n=0  last=..." arm here, for the window a reset opens
 * before the program's next sample. It is deleted rather than kept, because
 * the only way to reach it is to compare [s->epoch] with [watch_epoch] in
 * [flan_dev_watch_read] — and that is the one thing the reader must not do. A
 * stopped program does not sample. An epoch-aware reader would blank the watch
 * for as long as the program stayed stopped, and looking at the numbers from
 * the moment you stopped is the whole point of stopping. The lazy clear is
 * right there; its cost is one stale tick in a *running* program, and the
 * editor keeps even that honest by not sending [:reset] while the program is
 * stopped. See [flan-watch--tick]. */
static uint64_t watch_render_num(double n, double lo, double hi, double last,
                                 double sum, char *vd, uint64_t vcap) {
  if (vcap == 0) return 0;
  char b[4][40];
  int k;
  watch_num_str(b[0], sizeof b[0], lo);
  watch_num_str(b[1], sizeof b[1], hi);
  watch_num_str(b[2], sizeof b[2], last);
  watch_num_str(b[3], sizeof b[3], sum / n);
  k = snprintf(vd, (size_t)vcap, "n=%lld  min=%s  max=%s  last=%s  mean=%s",
               (long long)n, b[0], b[1], b[2], b[3]);
  if (k < 0) return 0;
  if ((uint64_t)k > vcap - 1) return vcap - 1;
  return (uint64_t)k;
}

/* ── Reading the table back ─────────────────────────────────────────── */

/* How many slots have ever been claimed. Only grows, so a reader walking
 * [0, n) is walking names that are all finished. */
uint32_t flan_dev_watch_count(void) {
  return __atomic_load_n(&watch_used, __ATOMIC_ACQUIRE);
}

/* Whether any name ever found no slot. Never cleared: a table that overflowed
 * once is a table whose contents are incomplete, and a name that was refused a
 * slot does not get one later. */
int flan_dev_watch_overflowed(void) {
  return __atomic_load_n(&watch_overflowed, __ATOMIC_RELAXED);
}

/* Copy slot [i] out: its name into [nd], its value into [vd].
 *
 * Returns 1 having copied a value that was complete for the whole of the copy,
 * 0 if the game thread was in the middle of writing one — in which case [vlen]
 * is 0 and the caller keeps whatever it showed last, which for a HUD is the
 * right failure: a value that flickers to blank for one tick is worse than one
 * that is a frame stale.
 *
 * The name needs no seqlock. It is written once, before [watch_used] is
 * published with a release store, and never again.
 *
 * The copy is what makes this safe, and the API is shaped around it: the
 * caller gets bytes of its own, never a pointer into the table. A seqlock
 * cannot validate a read that happens after it returns — the bug
 * [flan_dev_result_read] was rewritten for. */
int flan_dev_watch_read(uint32_t i, char *nd, uint64_t ncap,
                        char *vd, uint64_t vcap, uint64_t *vlen) {
  *vlen = 0;
  if (i >= __atomic_load_n(&watch_used, __ATOMIC_ACQUIRE)) return 0;
  watch_slot *s = &watch_table[i];
  if (ncap > 0) {
    size_t n = strlen(s->name);
    if (n > ncap - 1) n = (size_t)ncap - 1;
    memcpy(nd, s->name, n);
    nd[n] = '\0';
  }
  for (int attempt = 0; attempt < 64; attempt++) {
    uint64_t g1 = __atomic_load_n(&s->gen, __ATOMIC_ACQUIRE);
    if (g1 & 1) continue;                    /* a write is in progress */
    /* An accumulator slot carries five doubles rather than rendered text, so
     * what is copied under the seqlock is the numbers; the formatting happens
     * *after* the counter check, out of locals, which is why it is safe to do
     * it here at all. See "A number sampled thousands of times a frame". */
    int    isnum = __atomic_load_n(&s->num, __ATOMIC_RELAXED);
    double an = s->n, alo = s->lo, ahi = s->hi, alast = s->last, asum = s->sum;
    size_t n = __atomic_load_n(&s->len, __ATOMIC_RELAXED);
    if (n > WATCH_VAL) n = WATCH_VAL;        /* a torn read cannot overrun */
    if ((uint64_t)n > vcap) n = (size_t)vcap;
    if (!isnum) memcpy(vd, s->val, n);
    /* Ordered before the second read of the counter, or the check is of a copy
     * the compiler was free to make afterwards. */
    __atomic_thread_fence(__ATOMIC_ACQUIRE);
    if (__atomic_load_n(&s->gen, __ATOMIC_ACQUIRE) == g1) {
      *vlen = isnum ? watch_render_num(an, alo, ahi, alast, asum, vd, vcap)
                    : (uint64_t)n;
      return 1;
    }
  }
  return 0;
}

/* What a caller's buffers have to be for a copy never to be truncated. Asked
 * for rather than written down twice, the same as [flan_dev_result_cap]. The
 * value's is [WATCH_VAL] plus the ellipsis [end] may append. */
uint64_t flan_dev_watch_name_cap(void) { return WATCH_NAME; }
uint64_t flan_dev_watch_val_cap(void)  { return WATCH_VAL + 4; }

/* ── The shadow stack ───────────────────────────────────────────────── */

/* plan.org's "Dev vs release builds" has had *Frames: shadow stack* in the dev
 * column since the beginning. This is it, and it exists for one reason: the
 * more a break loop can show, the less often a real debugger is needed. A
 * stopped program that cannot say where it is sends someone to lldb.
 *
 * Native unwinding would be the other route and is deliberately not taken:
 * plan.org lowers every non-local exit explicitly rather than through platform
 * unwinding, so there is no .eh_frame walk to borrow, and a frame pointer walk
 * gives addresses that only DWARF can turn back into names. A pushed record
 * carries the name itself, is the same on wasm32 as it is here, and needs no
 * agreement with the optimiser about what a frame looks like.
 *
 * The compiler emits the push and the pop inline (emit.ml, [emit_fn]) rather
 * than calling in here: this is on every call in a dev build, and a call to
 * record a call would double the thing being measured.
 *
 * A plain global, not a _Thread_local. It matches what the handler stack and
 * the restart stack in flan_rt.c already assume — one thread runs Flan; the
 * listener thread runs C and the loader and never enters a Flan body. If the
 * language ever grows threads this becomes thread-local and the compiler's
 * two stores become TLS-relative, which is the only change.
 *
 * Nothing in here walks the chain while the game thread is running. The break
 * loop snapshots it on the stopped thread, exactly as it snapshots the restart
 * list and for exactly the same reason: a chain read by another thread is a
 * chain that can be popped underneath the reader. The accessors below are the
 * snapshot's, and take the frame they were given rather than re-reading the
 * head. */

typedef struct {
  const char *name;     /* the Flan name, qualified; not NUL-terminated */
  int64_t     namelen;
  const char *loc;      /* file:line:col, as Loc spells it */
  int64_t     loclen;
  int32_t     nslots;
  /* What the two ends compare about a frame's slots, from
     [Emit.slot_fingerprint]: a hash over every slot's name and the spelling of
     its type. The frame carries the one belonging to the body it was compiled
     from; the daemon recomputes it from the body it now holds, and a
     difference means the frame is running a superseded body. A count alone
     cannot see a rename, which is the case this exists for. */
  int32_t     slotsig;
  /* And the globals half, from [Reach.ref_fingerprint]: a hash over the set of
     globals the body names. Separate from [slotsig] on purpose — a body can
     name different globals while binding identical locals, so a frame's locals
     can be trustworthy while its contribution to the globals section is not,
     and one number over both would refuse a frame that reads perfectly. */
  int32_t     refsig;
} flan_fninfo;

typedef struct flan_frame {
  struct flan_frame *prev;
  const flan_fninfo *info;
  /* One entry per slot, each null until the binding that fills that slot has
   * run — so "not bound yet at the point this frame stopped" is a null and
   * needs no liveness analysis to work out. Null altogether for a function
   * with no named slot, and in a release build there is no frame at all.
   * Read through [flan_dev_frame_slot], which is where the bound is checked. */
  void     **slots;
} flan_frame;

/* The compiler names this symbol directly. A redefinition module reaches it
 * the same way it reaches any other host global — through the dynamic symbol
 * table, which [--dev] links with -rdynamic. */
flan_frame *flan_frame_head;

/* The chain, dropped. The counterpart of flan_rt.c's
 * [flan_condition_stacks_reset] and there for the same one caller: the merged
 * dev build's [main] can be entered a second time, and it gets back there by
 * longjmp rather than by returning, so every frame the finished run pushed is
 * still on this chain and every one of them is an alloca in stack that the
 * next run is about to reuse. A backtrace taken after that would walk records
 * whose [name] and [loc] pointers are whatever the new run happens to have
 * written there — a listing that looks like a listing and names nothing real,
 * which is the failure this whole file exists to avoid. */
void flan_dev_frames_reset(void) { flan_frame_head = NULL; }

/* [i] counts from the innermost. NULL past the end, which is how a caller
 * learns the depth without a second walk. */
void *flan_dev_frame_at(int32_t i) {
  flan_frame *f = flan_frame_head;
  while (f != NULL && i > 0) { f = f->prev; i--; }
  return f;
}

int32_t flan_dev_frame_count(void) {
  int32_t n = 0;
  for (flan_frame *f = flan_frame_head; f != NULL; f = f->prev) {
    n++;
    if (n > 100000) break;   /* a corrupt chain says so rather than hanging */
  }
  return n;
}

const char *flan_dev_frame_name(const void *frame, int64_t *len) {
  const flan_frame *f = frame;
  if (f == NULL || f->info == NULL) { *len = 0; return NULL; }
  *len = f->info->namelen;
  return f->info->name;
}

const char *flan_dev_frame_loc(const void *frame, int64_t *len) {
  const flan_frame *f = frame;
  if (f == NULL || f->info == NULL) { *len = 0; return NULL; }
  *len = f->info->loclen;
  return f->info->loc;
}

int32_t flan_dev_frame_nslots(const void *frame) {
  const flan_frame *f = frame;
  return (f == NULL || f->info == NULL) ? 0 : f->info->nslots;
}

/* The fingerprint of the body this frame was compiled from. Zero for a frame
 * with no description, which is the same "nothing to compare" a zero slot
 * count already means. */
int32_t flan_dev_frame_slotsig(const void *frame) {
  const flan_frame *f = frame;
  return (f == NULL || f->info == NULL) ? 0 : f->info->slotsig;
}

/* The fingerprint of the globals that body names. Zero for a frame with no
 * description, the same "nothing to compare" the slot count and the slot
 * fingerprint already mean. */
int32_t flan_dev_frame_refsig(const void *frame) {
  const flan_frame *f = frame;
  return (f == NULL || f->info == NULL) ? 0 : f->info->refsig;
}

/* Where slot [i] of this frame lives, or NULL — which means one of three
 * things, all of which are "there is nothing to read here": this build records
 * no slots, the index is not one of them, or the binding that fills it had not
 * run when the frame stopped. A caller renders what it is given and refuses
 * what it is not; nothing here guesses. */
void *flan_dev_frame_slot(const void *frame, int32_t i) {
  const flan_frame *f = frame;
  if (f == NULL || f->info == NULL || f->slots == NULL) return NULL;
  if (i < 0 || i >= f->info->nslots) return NULL;
  return f->slots[i];
}

/* ── The allocation registry: an address answers with a type ───────────
 *
 * A Flan struct is exactly its C layout: no header, no tag word. That is
 * deliberate — it is what makes a struct free and the FFI work — and it is
 * also why "what is at this address" has no run-time answer. A tag cannot be
 * added without breaking raylib.
 *
 * The registry sidesteps the question rather than answering it. The
 * allocator's *caller* knows the type at the moment it asks for memory, and
 * the compiler is standing right there: a dev build emits one note after every
 * allocating call, naming the type the memory was asked for. Nothing about a
 * value's layout changes. A release build emits no note and this table stays
 * empty for the life of the process.
 *
 * What a note records is a *block*, not a value: base, extent, and the size of
 * one element. So a lookup is containment rather than equality, and that is
 * not an optimisation — every pointer a program can hold into heap storage is
 * interior. (at v i) is v->ptr + i*size and (resolve p h) is an item in the
 * middle of a pool's array; neither is ever a base address. A table that
 * answered only exact hits would answer nothing anybody can ask it.
 *
 * Dead entries are kept, which is the second thing this buys: an address that
 * was freed still names what died. An entry is dropped only when the allocator
 * hands the same address out again, which is exactly when the old answer stops
 * being true.
 *
 * The type name is a pointer into read-only data, not a copy. The strings are
 * the ones the compiler already emits beside the call site, and this file's
 * header says a module is never dlclose'd, so they outlive the table.
 */

/* A power of two: the probe wraps with a mask. Fixed, and full is not fatal —
 * see flan_dev_reg_note. */
#define FLAN_REG_CAP 4096

typedef struct {
  const char *type;     /* the Flan spelling, e.g. "Enemy" or "(Vec i32)" */
  int64_t     typelen;
  uintptr_t   base;     /* 0 for an empty slot */
  int64_t     bytes;    /* the extent of the block */
  int64_t     elem;     /* one element's size, or 0 if it is not an array */
  int64_t     seq;      /* when it was made */
  int64_t     died;     /* when it was released, or 0 while it is live */
  uint64_t    gen;      /* this slot's own seqlock; odd while it is written */
} flan_reg_entry;

/* ── Why this table has a seqlock and the watch table's is the model ───
 *
 * The writer is the game thread, inside every allocation and every free. The
 * reader is the agent's listener thread, on a program that is *running* — the
 * two listing verbs answer "where did the memory go" and "what is still held",
 * and the second of those is asked in the last moment before a game is killed,
 * which is a moment the program is not stopped in. So the frame chain's answer
 * — snapshot it while the thread is parked — is not available to this table,
 * and a plain read of it is a read of eight words another thread is in the
 * middle of writing.
 *
 * The consequence is not a slightly wrong number. [type] and [typelen] are a
 * pointer and a length that are only meaningful together, and a reader that
 * takes the new pointer with the old length reads off the end of a string
 * literal. That is the failure this closes.
 *
 * Per slot, exactly as [watch_slot] does it: odd while a write is in flight,
 * even when it is whole, and a reader copies the slot and re-reads the counter
 * to find out whether what it copied ever existed. The compaction is the one
 * thing a per-slot counter cannot describe, because it moves entries between
 * slots — so it bumps a table-wide counter around itself and a scan that sees
 * that counter move starts again. Nothing here blocks the writer: a reader
 * that cannot get a clean read gives up after a bounded number of attempts,
 * which is the rule everywhere else in this file. */
static uint64_t flan_reg_epoch;   /* odd while the table is being compacted */

static void flan_reg_begin(flan_reg_entry *e) {
  __atomic_store_n(&e->gen, e->gen | 1, __ATOMIC_RELAXED);
  __atomic_thread_fence(__ATOMIC_RELEASE);
}

/* Back to even, so a reader that sees the new count sees the whole entry. The
 * [| 1] is [watch]'s: a write abandoned by a break taken inside it must still
 * land on an even count. */
static void flan_reg_end(flan_reg_entry *e) {
  __atomic_store_n(&e->gen, (e->gen | 1) + 1, __ATOMIC_RELEASE);
}

/* One slot, copied whole or not at all. 0 means the writer kept winning, which
 * a caller reports as a slot it could not read rather than as an empty one. */
static int flan_reg_snap(flan_reg_entry *e, flan_reg_entry *out) {
  int attempt;
  for (attempt = 0; attempt < 64; attempt++) {
    uint64_t g1 = __atomic_load_n(&e->gen, __ATOMIC_ACQUIRE);
    if (g1 & 1) continue;                    /* a write is in progress */
    *out = *e;
    /* Ordered before the second read of the counter, or the check is of a copy
     * the compiler was free to make afterwards. */
    __atomic_thread_fence(__ATOMIC_ACQUIRE);
    if (__atomic_load_n(&e->gen, __ATOMIC_ACQUIRE) == g1) return 1;
  }
  return 0;
}

/* The table-wide counter, read on the way into a scan and again on the way
 * out: a compaction between the two moved entries, so the scan saw some of
 * them twice and some not at all. */
static int flan_reg_scan_open(uint64_t *at) {
  uint64_t g = __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE);
  if (g & 1) return 0;
  *at = g;
  return 1;
}

static int flan_reg_scan_ok(uint64_t at) {
  __atomic_thread_fence(__ATOMIC_ACQUIRE);
  return __atomic_load_n(&flan_reg_epoch, __ATOMIC_ACQUIRE) == at;
}

/* Allocated by flan_dev_reg_enable and null until then, which is the whole of
 * what a release build carries: a null pointer, a zero flag, and the load and
 * not-taken branch each of the hooks below begins with. A fixed array here
 * instead would be a quarter of a megabyte of BSS in a shipped game, for a
 * table nothing in that build ever writes. */
static flan_reg_entry *flan_reg;
static int64_t        flan_reg_used;   /* live + dead slots in use */
static int64_t        flan_reg_seq;    /* a monotonic clock, in events */
static int            flan_reg_on;     /* only a dev build turns this on */
static int            flan_reg_full;   /* something found no slot */

/* Armed by the program's entry in a dev build. The free-side hooks in
 * flan_rt.c are called unconditionally and begin with this load and a
 * not-taken branch, because flan_dev.c is linked into every build and a
 * second version of the allocator gated on a build flag is worse than a
 * branch. That is a real cost and not zero; docs/BUILT.md says so rather than
 * repeating the claim that a release build carries nothing. */
static void flan_reg_report(void);   /* the exit report, at the bottom */

void flan_dev_reg_enable(void) {
  if (flan_reg_on) return;
  flan_reg = (flan_reg_entry *)calloc(FLAN_REG_CAP, sizeof *flan_reg);
  /* A registry that could not be made is not worth dying over; the flag stays
     off and every question about an address answers "never heard of it",
     which is what a release build answers too. */
  if (flan_reg == NULL) return;
  flan_reg_on = 1;
  /* Here and not at file scope: a destructor attribute would run in every
     build, since this file is linked into every build, and that would be a
     third place a release build is not free. Registered from inside the one
     function only a dev build's constructor calls, a release binary still
     carries a null pointer, a zero flag and the declarations. */
  if (getenv("FLAN_DEV_LEAKS") != NULL) atexit(flan_reg_report);
}

int flan_dev_reg_enabled(void) { return flan_reg_on; }

/* Knuth's multiplicative hash over the address, which is what an allocator
 * hands out: aligned, and therefore dense in its low bits. */
static size_t flan_reg_slot(uintptr_t a) {
  return (size_t)(((a >> 3) * 11400714819323198485ULL) >> 40)
         & (FLAN_REG_CAP - 1);
}

/* Drop every dead entry and re-insert the live ones. Called when the table
 * fills: in a long-running program the dead are the bulk of it, and losing
 * them is much cheaper than losing the live half. */
static void flan_reg_compact(void) {
  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_full = 1; 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;
  for (i = 0; i < FLAN_REG_CAP; i++) {
    size_t s;
    int64_t probe;
    if (old[i].base == 0 || old[i].died != 0) continue;
    s = flan_reg_slot(old[i].base);
    for (probe = 0; probe < FLAN_REG_CAP; probe++) {
      size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
      if (flan_reg[j].base == 0) {
        flan_reg_entry *e = &flan_reg[j];
        flan_reg_begin(e);
        e->type = old[i].type; e->typelen = old[i].typelen;
        e->base = old[i].base; e->bytes = old[i].bytes;
        e->elem = old[i].elem; e->seq = old[i].seq; e->died = old[i].died;
        flan_reg_end(e);
        flan_reg_used++;
        break;
      }
    }
  }
  free(old);
  __atomic_store_n(&flan_reg_epoch, (flan_reg_epoch | 1) + 1, __ATOMIC_RELEASE);
}

/* One note per allocation. [base] replaces whatever was recorded there, live
 * or dead: the allocator handing out an address is the event that makes any
 * older answer about it wrong. */
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
                       const char *type, int64_t typelen) {
  uintptr_t a = (uintptr_t)base;
  size_t s;
  int64_t probe;
  if (!flan_reg_on || a == 0 || bytes <= 0) return;
  if (flan_reg_used * 4 > (int64_t)FLAN_REG_CAP * 3) flan_reg_compact();
  s = flan_reg_slot(a);
  for (probe = 0; probe < FLAN_REG_CAP; probe++) {
    size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
    if (flan_reg[j].base != 0 && flan_reg[j].base != a) continue;
    if (flan_reg[j].base == 0) flan_reg_used++;
    /* The pair a torn read would get wrong is [type] and [typelen], which is
       why the whole entry goes under the counter rather than the two of them
       being ordered somehow. */
    flan_reg_begin(&flan_reg[j]);
    flan_reg[j].type = type;
    flan_reg[j].typelen = typelen;
    flan_reg[j].base = a;
    flan_reg[j].bytes = bytes;
    flan_reg[j].elem = elem;
    flan_reg[j].seq = ++flan_reg_seq;
    flan_reg[j].died = 0;
    flan_reg_end(&flan_reg[j]);
    return;
  }
  /* Full of live blocks. 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. */
  flan_reg_full = 1;
}

int flan_dev_reg_overflowed(void) { return flan_reg_full; }

/* The block containing [a], live or dead, or NULL. A linear scan, because the
 * reader is a person pressing a key and the writer is a game loop: the cost
 * belongs on this side of the table. */
static flan_reg_entry *flan_reg_find(uintptr_t a) {
  int64_t i;
  flan_reg_entry *best = NULL;
  if (a == 0) return NULL;
  for (i = 0; i < FLAN_REG_CAP; i++) {
    flan_reg_entry *e = &flan_reg[i];
    if (e->base == 0) continue;
    if (a < e->base || a >= e->base + (uintptr_t)e->bytes) continue;
    /* A live block wins over a dead one covering the same address: the dead
       entry is a stale answer the allocator has already contradicted. */
    if (best == NULL || (best->died != 0 && e->died == 0)) best = e;
  }
  return best;
}

/* One block dies. The heap allocator's free calls this, and so does a resize,
 * for the block it moved away from.
 *
 * The probe, not the scan — and the difference matters because this is on the
 * *writer's* side. A free hands back the base address the allocator gave out,
 * which is what the slot is keyed on, so the question here is equality and
 * never containment. Reaching for flan_reg_find would put a 4096-entry sweep
 * on every free in a dev build, which is the cost the note was careful not to
 * have. */
void flan_dev_reg_dead(void *base) {
  uintptr_t a = (uintptr_t)base;
  size_t s;
  int64_t probe;
  if (!flan_reg_on || a == 0) return;
  s = flan_reg_slot(a);
  for (probe = 0; probe < FLAN_REG_CAP; probe++) {
    size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
    if (flan_reg[j].base == 0) return;      /* never noted; nothing to mark */
    if (flan_reg[j].base != a) continue;
    if (flan_reg[j].died == 0) {
      flan_reg_begin(&flan_reg[j]);
      flan_reg[j].died = ++flan_reg_seq;
      flan_reg_end(&flan_reg[j]);
    }
    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);
    }
  }
}

/* Is it safe to follow this pointer? The one question the renderer asks, and
 * the reason the answer is worth having: the type at the other end is already
 * static — (Ptr Enemy) says Enemy — so the registry is not supplying the type.
 * It is supplying permission. */
int32_t flan_dev_reg_live(const void *p) {
  flan_reg_entry *e;
  if (!flan_reg_on) return 0;
  e = flan_reg_find((uintptr_t)p);
  return (int32_t)(e != NULL && e->died == 0 ? 1 : 0);
}

/* What was at this address, in words, for the branch that may not follow it.
 * Emitted straight into the result buffer rather than returned: the caller is
 * a render thunk, which has no allocator, and every other piece of a rendering
 * arrives here the same way.
 *
 * There is no address in the text, and that is deliberate rather than an
 * omission. An address is not stable across two runs of the same program, so
 * printing one would make a rendering — and therefore a test that reads one —
 * depend on where the heap happened to land. It is the rule [Render] already
 * follows for an allocator. What a reader wants from a dangling pointer is
 * *what died*, and the registry has that.
 *
 * Returns 1 if anything was written, so that a caller can tell "the registry
 * has never heard of this address" — a stack local, which is by design not in
 * here — from "this is dead", which is the sentence worth printing. */
int32_t flan_dev_reg_emit(const void *p) {
  static char desc[192];
  uintptr_t a = (uintptr_t)p;
  flan_reg_entry *e = flan_reg_on ? flan_reg_find(a) : NULL;
  int64_t off;
  char where[64];
  int n;
  if (e == NULL || e->died == 0) return 0;
  off = (int64_t)(a - e->base);
  where[0] = '\0';
  if (e->elem > 0 && off % e->elem == 0 && off / e->elem > 0)
    snprintf(where, sizeof where, "[%lld] of ", (long long)(off / e->elem));
  else if (off != 0)
    snprintf(where, sizeof where, "+%lld into ", (long long)off);
  n = snprintf(desc, sizeof desc, " dead: was %s%.*s, freed at step %lld",
               where, (int)e->typelen, e->type, (long long)e->died);
  if (n < 0) return 0;
  if (n > (int)sizeof desc - 1) n = (int)sizeof desc - 1;
  flan_dev_emit((const uint8_t *)desc, n);
  return 1;
}

/* How many blocks the table holds — everything, or only the live ones. For a
 * test, and for the breakdown-by-type listing that is not built yet. */
int64_t flan_dev_reg_count(int32_t live_only) {
  int64_t i, n = 0;
  if (!flan_reg_on) return 0;
  for (i = 0; i < FLAN_REG_CAP; i++) {
    if (flan_reg[i].base == 0) continue;
    if (live_only && flan_reg[i].died != 0) continue;
    n++;
  }
  return n;
}


/* ── Reading the table back ───────────────────────────────────────────
 *
 * Three accessors and no formatter. Everything above this point is on the
 * writer's side — a game loop — and everything below is read by a person
 * pressing a key, so the shape that matters here is "hand back what is
 * recorded" rather than "hand back a sentence". The agent turns these into
 * protocol lines and the daemon turns those into an editor reply; the one
 * piece of text this file still writes is the exit report at the bottom,
 * which has nowhere else to go.
 */

/* What the table records for the address [p], live or dead. The containment
 * lookup, exposed: [flan_dev_reg_live] answers the renderer's yes/no and
 * [flan_dev_reg_emit] writes the epitaph, and neither hands back the *name*,
 * which is what a reader that wants to point at a bare address needs — it has
 * no (Ptr T) to read the type off, so the table's own answer is the only
 * answer there is.
 *
 * [off] is how far into the block [p] lands, and it is not decoration: with
 * [elem] it is what says whether the address is an element boundary or the
 * middle of one. A caller that renders a T at an offset that is not a
 * multiple of [elem] would be reading one element's tail as another's head,
 * so it is given the two numbers rather than a flag it cannot check. */
int32_t flan_dev_reg_at(const void *p, const char **type, int64_t *typelen,
                        int64_t *off, int64_t *bytes, int64_t *elem,
                        int64_t *seq, int64_t *died) {
  /* The one reader of the containment lookup that is not on the game thread —
   * [flan_dev_reg_live] and [flan_dev_reg_emit] above run inside a render
   * thunk, which is the writer's own thread — so this one copies each slot
   * under its counter instead of pointing into the table. See the seqlock
   * note above the entry type. */
  uintptr_t a = (uintptr_t)p;
  flan_reg_entry best, cur;
  int have = 0, attempt;
  if (!flan_reg_on || a == 0) return 0;
  for (attempt = 0; attempt < 8; attempt++) {
    uint64_t at;
    int64_t i;
    have = 0;
    if (!flan_reg_scan_open(&at)) continue;
    for (i = 0; i < FLAN_REG_CAP; i++) {
      if (!flan_reg_snap(&flan_reg[i], &cur)) continue;
      if (cur.base == 0) continue;
      if (a < cur.base || a >= cur.base + (uintptr_t)cur.bytes) continue;
      /* A live block wins over a dead one covering the same address: the dead
         entry is a stale answer the allocator has already contradicted. */
      if (!have || (best.died != 0 && cur.died == 0)) { best = cur; have = 1; }
    }
    if (flan_reg_scan_ok(at)) break;
    have = 0;
  }
  if (!have) return 0;
  if (type)    *type    = best.type;
  if (typelen) *typelen = best.typelen;
  if (off)     *off     = (int64_t)(a - best.base);
  if (bytes)   *bytes   = best.bytes;
  if (elem)    *elem    = best.elem;
  if (seq)     *seq     = best.seq;
  if (died)    *died    = best.died;
  return 1;
}

/* An address, as a number, handed back as a pointer. The one thing an
 * address-rooted render thunk cannot do for itself: Flan has no integer-to-
 * pointer cast, deliberately — a program that could make a pointer out of
 * arithmetic is a program the type system stops describing — and the
 * inspector is not a program. It is the same arrangement [flan_agent_frame_
 * slot] already has for a frame's slot, and for the same reason: the compiler
 * knows the type, and something outside the language supplies the address. */
void *flan_dev_reg_addr(int64_t a) { return (void *)(uintptr_t)a; }

/* And back the other way, which is the half a *program* needs rather than the
 * inspector. The address root above takes a number, and the things that hand
 * out addresses as numbers all live outside the language — gdb, valgrind, a C
 * library's callback, a printf("%p") in somebody's shim. A Flan program that
 * wants to say one out loud has no cast for it, deliberately: pointer
 * arithmetic out of an integer is the thing the type system stops describing.
 * So the conversion is a C function, named and visible, and the language
 * still has no operator for it. */
int64_t flan_dev_reg_number(const void *p) { return (int64_t)(uintptr_t)p; }

/* The table, by type spelling: one row per distinct name, with how many
 * blocks carry it and how many bytes they hold. [live_only] is the whole
 * difference between "what is this program made of" and "what is still held",
 * which is why there is one walk here and not two — a leak report is a
 * breakdown with the dead left out, and writing it twice would let the two
 * drift.
 *
 * Caller-owned buffers, and the return is how many distinct types there were
 * rather than how many were written: a caller whose buffers were too small is
 * told so by the number coming back larger than [cap], which is the same
 * contract the watch table's count has.
 *
 * 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 i, n = 0;
  int attempt;
  if (!flan_reg_on) return 0;
  /* Read off a running program, which is what makes the counters below
     necessary: a row is a (pointer, length) pair that is only meaningful
     together, and the memcmp two lines down is where a torn one would read off
     the end of a string literal. The whole walk is retried when a compaction
     ran through the middle of it, since entries moved and the counts would
     hold some blocks twice and some not at all. */
  for (attempt = 0; attempt < 8; attempt++) {
    uint64_t at;
    n = 0;
    if (!flan_reg_scan_open(&at)) continue;
    for (i = 0; i < FLAN_REG_CAP; i++) {
      flan_reg_entry e;
      int64_t j;
      int found = 0;
      if (!flan_reg_snap(&flan_reg[i], &e)) 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)) return n;
  }
  /* Eight walks and a compaction through every one of them. Answering with the
     last walk's rows would be answering with a table that never existed, so
     this answers with none — the caller prints a header saying how many rows
     follow, and zero is a number it can print. */
  return 0;
}

/* ── 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, blocks = 0, held = 0;
  n = flan_dev_reg_by_type(1, counts, bytes, types, typelens, ROWS);
  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");
}