flan/runtime/flan_dyn.c

/* flan_dyn — tagged values, a mark-sweep heap, and the operations over them.
 *
 * Milestone 1 of dynamic-by-default: code nobody annotated computes with
 * values that carry their type at run time, code that is fully annotated
 * compiles to exactly what it compiled to before, and a build that asks for
 * neither a collector nor a tag can be told that it has one.
 *
 * The argument for every decision in here — why NaN-boxing rather than low-bit
 * tagging, why mark-sweep rather than anything cleverer, why the roots are
 * pushed rather than found — is docs/SPIKE-DYNAMIC.md. This file carries the
 * parts of it a reader needs *while reading the code*, and points at the doc
 * for the rest.
 *
 * ── What this file may depend on ──────────────────────────────────────
 *
 * flan_rt.c, and nothing else in the tree. The dependency does not run the
 * other way: no line of flan_rt.c or flan_dev.c names anything defined here.
 * That is the whole of what makes a `--no-gc` build possible — not because the
 * linker drops this object (it does not; a named object is linked whole, and
 * `nm` on any corpus program finds flan_dyn_add in it), but because nothing
 * else needs it, so *not compiling it* is a change at the three sites that
 * name it and nowhere else. A single back-reference from the release runtime
 * would make the collector unconditional and the refusal a lie. See the doc's
 * "Dropping the collector".
 *
 * ── Threads ───────────────────────────────────────────────────────────
 *
 * There are none, and the globals below are plain globals for the reason the
 * handler stack, the restart stack and the frame chain in the other two files
 * are: one thread runs Flan. The dev agent's listener thread runs C and the
 * loader and never enters a Flan body, so it never allocates and never marks.
 * If the language grows threads, the heap needs a lock and the roots need to
 * be thread-local, and that is one change in two places rather than a rewrite.
 */

#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* ── What we borrow from flan_rt.c ─────────────────────────────────────
 *
 * Declared rather than included: the build hands clang each runtime .c on its
 * own with no include path (see [Build.compile_c]), so a #include of
 * flan_dyn.h would not resolve. runtime/flan_dyn.h says the same things a
 * second time and test/dyn_ops.c includes it, which is what keeps the two
 * copies honest. */

void flan_write_stdout(const uint8_t *p, int64_t n);

/* The one non-local exit a dyn operation can take. flan_rt.c's [rt_trap] is
 * static, and re-implementing what it does — the break-loop hook, the flush,
 * the socket, [_exit(134)] — would be a second answer to "how does a Flan
 * program die where it stands", which that file went to some trouble to have
 * only one of. So flan_rt.c exports a thin wrapper and this calls it. */
_Noreturn void flan_trap(const uint8_t *name, int64_t namelen);

/* ── The representation ────────────────────────────────────────────────
 *
 * NaN-boxed, in a word. A double is *itself*: the 2^64 minus a NaN's worth of
 * bit patterns that are not quiet NaNs are read straight back as f64, at no
 * cost, which is what a language where f64 is first class and where sand.flan
 * runs a physics loop wants. Everything else hides inside the quiet-NaN space.
 *
 * The box is sign bit + all-ones exponent + quiet bit, which is
 * 0xFFF8000000000000. Bits 50..48 are three tag bits; bits 47..0 are the
 * payload, which is exactly the width of an x86-64 user-space pointer.
 *
 *   63  62..52   51   50..48   47..0
 *    1   1...1    1    tag     payload
 *
 * The collision this scheme always has to answer for is a real f64 that is
 * already a *negative* quiet NaN: those bits are indistinguishable from a box.
 * [flan_dyn_from_f64] answers it by canonicalising every NaN to the positive
 * quiet NaN on the way in. That is not a new rule invented here — flan_rt.c's
 * [flan_f64_to_bytes] already renders every NaN as "nan" with no sign, and
 * carries three paragraphs on why the sign bit of a NaN is not a fact about
 * the arithmetic and should not be shown. A dyn value takes the same line one
 * step further and does not *store* it. Nothing observable changes: NaN is not
 * equal to itself, so no comparison can see which NaN it is, and the printer
 * was already refusing to say.
 *
 * Integers. i64 is first class here and 48 bits is not 64, so an int that fits
 * the payload is inline and one that does not is a heap box. The inline range
 * is ±2^47, which is every array index, every counter and every timestamp in
 * milliseconds until the year 6429; the box is what keeps the other end of the
 * type honest rather than quietly wrapping. See the doc.
 *
 * Tags 6 and 7 are unspoken for, and that is where a typed handle goes when
 * interop arrives — a (Vec i64) crossing into dyn without being copied. Again,
 * the doc. */

typedef uint64_t flan_dyn;

#define DYN_QNAN    0xFFF8000000000000ULL
#define DYN_TAGMASK 0x0007000000000000ULL
#define DYN_PAYMASK 0x0000FFFFFFFFFFFFULL
#define DYN_TAGSHIFT 48

/* The four box tags. Not the same numbers as FLAN_DYN_TAG_* in the header:
 * those are what a *reader* is told (float and int are two answers), these are
 * how the word is laid out (a float is not boxed at all, and a big int is a
 * pointer). [flan_dyn_tag] is the translation. */
#define BOX_NIL  0u
#define BOX_BOOL 1u
#define BOX_INT  2u
#define BOX_OBJ  3u

/* Spelled as a negated positive rather than as a shift of -1: shifting a
 * negative value left is undefined, and this file is swept by UBSan. */
#define DYN_INT_MAX (((int64_t)1 << 47) - 1)
#define DYN_INT_MIN (-DYN_INT_MAX - 1)

static inline int dyn_boxed(flan_dyn v) { return (v & DYN_QNAN) == DYN_QNAN; }
static inline unsigned dyn_box(flan_dyn v) {
  return (unsigned)((v & DYN_TAGMASK) >> DYN_TAGSHIFT);
}
static inline uint64_t dyn_payload(flan_dyn v) { return v & DYN_PAYMASK; }

static inline flan_dyn dyn_make(unsigned tag, uint64_t payload) {
  return DYN_QNAN | ((uint64_t)tag << DYN_TAGSHIFT) | (payload & DYN_PAYMASK);
}

/* ── The heap ──────────────────────────────────────────────────────────
 *
 * One header, three kinds, and a singly-linked list of everything ever
 * allocated. The list is the sweep's; there is no other index, no free list
 * and no size class, because the collector's stated job is to be small enough
 * to read in one sitting. A heap that wants to be faster than this wants the
 * program to be typed instead.
 *
 * [mark] is a byte and not a bit in a side table for the same reason. A side
 * table is the right answer when the sweep is the cost, and the sweep is never
 * going to be the cost here.
 *
 * A vec's elements live in a plain malloc block hanging off the header rather
 * than in a GC object of their own. Two reasons: a growth is then a [realloc]
 * and not a copy this file writes, and the elements are never reachable except
 * through their vec, so giving them an identity would buy nothing and cost a
 * header. Their bytes are counted in [gc_bytes] and freed when the vec is
 * swept, which is the whole of their lifetime. */

#define OBJ_TEXT 0
#define OBJ_VEC  1
#define OBJ_INT  2   /* an i64 too wide for the payload */

typedef struct flan_obj {
  struct flan_obj *next;   /* every object ever allocated, newest first */
  uint8_t          kind;
  uint8_t          mark;
  int64_t          len;    /* bytes of a text, elements of a vec */
  union {
    int64_t   i;                             /* OBJ_INT */
    struct { flan_dyn *items; int64_t cap; } v;  /* OBJ_VEC */
    /* OBJ_TEXT's bytes trail the header; see [obj_text_bytes]. */
  } u;
} flan_obj;

static inline uint8_t *obj_text_bytes(flan_obj *o) { return (uint8_t *)(o + 1); }

static flan_obj *gc_all;      /* the sweep list */
static int64_t   gc_bytes;    /* what the live objects hold, headers included */
static int64_t   gc_count;
static int64_t   gc_next;     /* collect when an allocation would pass this */
static int64_t   gc_floor = 1 << 20;
static int       gc_ready;

/* ── Roots ─────────────────────────────────────────────────────────────
 *
 * Addresses of slots, pushed by the code that owns them. Not a conservative
 * scan of the C stack, and the reason is worth stating once here rather than
 * only in the doc: a conservative scan has to decide whether an arbitrary word
 * is a pointer, and NaN-boxing makes that decision *wrong* in both directions
 * — a live double is bit-identical to a boxed pointer often enough to retain
 * garbage, and a payload with the box stripped is not the pointer the scanner
 * would look for. Precision here is cheaper than the arguments about it.
 *
 * Growable, because a deep recursion over dyn locals is an ordinary program
 * and a fixed table would be a limit nobody could predict. The array holds
 * [flan_dyn *], so growing it moves the array and not the slots. */

static flan_dyn **roots;
static int64_t    roots_n, roots_cap;

/* ── The temporaries ring ──────────────────────────────────────────────
 *
 * The hazard this exists for, plainly: mark-sweep frees what is unreachable,
 * and a freshly allocated object is unreachable until somebody roots it. So
 *
 *     flan_dyn_push(v, flan_dyn_add(flan_dyn_from_bytes(p, n), ...));
 *
 * — or any expression with two allocating calls in it — can have the second
 * allocation collect the result of the first, in the window before the
 * compiler has stored either into a rooted slot. C's argument evaluation order
 * is unspecified, so this is not even a window a careful emitter could close
 * by ordering its calls.
 *
 * The answer is the smallest one that does not need the other lane to have
 * read a document: every object this file allocates is written into a fixed
 * ring, and the marker roots the whole ring unconditionally. Any expression
 * making at most RING allocations before rooting its result is then safe, with
 * no ABI change and no contract for anybody to get wrong. The cost is a store
 * and a masked increment per allocation, and up to RING objects' worth of
 * float in the heap — which the trigger absorbs, because the trigger is a
 * fraction of live bytes and not a count.
 *
 * 64 slots. An expression with 65 allocating calls in it and no intervening
 * root would be a single Flan form with 65 constructors in it, which is not a
 * form anybody writes; if it ever is, the compiler roots its intermediates and
 * this ring is belt on top of braces. */

#define RING 64
static flan_obj *ring[RING];
static unsigned  ring_at;

/* ── Tag words ─────────────────────────────────────────────────────────
 *
 * One table. The trap messages below and [flan_dyn_tag_name] read it, so a
 * sentence a program dies with and a name an inspector shows cannot drift
 * apart. Words and never numbers: "cannot add int and text" is a sentence
 * somebody can act on and "tag 2 and tag 4" is a puzzle. */

static const char *const tag_words[] = { "nil", "bool", "int", "float",
                                         "text", "vec" };

#define FLAN_DYN_TAG_NIL   0
#define FLAN_DYN_TAG_BOOL  1
#define FLAN_DYN_TAG_INT   2
#define FLAN_DYN_TAG_FLOAT 3
#define FLAN_DYN_TAG_TEXT  4
#define FLAN_DYN_TAG_VEC   5

static inline flan_obj *dyn_obj(flan_dyn v) {
  return (flan_obj *)(uintptr_t)dyn_payload(v);
}

int32_t flan_dyn_tag(flan_dyn v) {
  if (!dyn_boxed(v)) return FLAN_DYN_TAG_FLOAT;
  switch (dyn_box(v)) {
  case BOX_NIL:  return FLAN_DYN_TAG_NIL;
  case BOX_BOOL: return FLAN_DYN_TAG_BOOL;
  case BOX_INT:  return FLAN_DYN_TAG_INT;
  default: {
    flan_obj *o = dyn_obj(v);
    if (o == NULL) return FLAN_DYN_TAG_NIL;
    switch (o->kind) {
    case OBJ_TEXT: return FLAN_DYN_TAG_TEXT;
    case OBJ_VEC:  return FLAN_DYN_TAG_VEC;
    default:       return FLAN_DYN_TAG_INT;
    }
  }
  }
}

const char *flan_dyn_tag_name(int32_t tag) {
  if (tag < 0 || tag > FLAN_DYN_TAG_VEC) return "?";
  return tag_words[tag];
}

static inline const char *tag_of(flan_dyn v) {
  return flan_dyn_tag_name(flan_dyn_tag(v));
}

/* ── Rendering, for messages and for print ─────────────────────────────
 *
 * One walk, two callers. [flan_dyn_print] writes to stdout through
 * [flan_write_stdout], so a dyn print and a typed print interleave correctly
 * in the one buffer; a trap message renders into a small buffer and puts the
 * values in the sentence.
 *
 * What it renders, per tag, is what typed [print] renders for the
 * corresponding type — captured from a running program rather than read off
 * lib/render.ml, because that file is the REPL's inspector and not necessarily
 * println's expansion:
 *
 *     int      %lld                        42
 *     float    %g, and "nan" unsigned      3.5, 1, nan
 *     bool     the word                    true / false
 *     text     bare at the top level,      hi   /   "a b"
 *              quoted and escaped inside
 *     vec      a slice's spelling          [ 1 2 3]
 *
 * The leading space before every element is not a slip: it is what
 * lib/render.ml's slice loop emits and what a Flan program prints today, and
 * an acceptance test comparing the two would notice a tidier answer.
 *
 * nil is the one tag with no typed counterpart, and it renders as `nil`.
 *
 * A typed Vec prints as `<vec>` rather than structurally, and a dyn vec does
 * not: it prints the way a *slice* does. That is deliberate and is argued in
 * the doc — the typed refusal is about borrowing storage the printer does not
 * own, and a dyn vec's storage is the collector's, so there is nothing to
 * borrow and nobody to ask.
 *
 * DEPTH is a cycle stop and nothing else. A typed value cannot contain itself,
 * so the typed printer needs no run-time cap; [flan_dyn_set_at] makes a dyn
 * vec that can, so this one does. Past the cap it prints render.ml's "...",
 * which is the same mark that file uses for the same idea. */

#define PRINT_DEPTH 16

static void emit(const char *s) {
  flan_write_stdout((const uint8_t *)s, (int64_t)strlen(s));
}

static void emit_n(const uint8_t *p, int64_t n) { flan_write_stdout(p, n); }

/* A text inside a structure, quoted and escaped. The same table as
 * flan_rt.c's [flan_escape_bytes] and flan_dev.c's [flan_dev_emit_str], and
 * for the same reason those two are the same as each other: three printers
 * that disagree about what a string looks like is three wire formats. If that
 * table changes, change this one. Streamed rather than built, so there is no
 * buffer to overrun and no length to cap. */
static void emit_escaped(const uint8_t *p, int64_t n) {
  int64_t i;
  emit("\"");
  for (i = 0; i < n; i++) {
    unsigned char c = p[i];
    switch (c) {
    case '"':  emit("\\\""); break;
    case '\\': emit("\\\\"); break;
    case '\n': emit("\\n");  break;
    case '\t': emit("\\t");  break;
    case '\r': emit("\\r");  break;
    default:
      if (c < 0x20) {
        char b[5];
        snprintf(b, sizeof b, "\\x%02x", c);
        emit(b);
      } else {
        emit_n(&c, 1);
      }
    }
  }
  emit("\"");
}

static int64_t dyn_int_value(flan_dyn v);   /* forward: both int shapes */
static double  dyn_num_value(flan_dyn v);

static void render(flan_dyn v, int depth, int nested) {
  char buf[64];
  int32_t t = flan_dyn_tag(v);
  if (depth > PRINT_DEPTH) { emit("..."); return; }
  switch (t) {
  case FLAN_DYN_TAG_NIL:
    emit("nil");
    return;
  case FLAN_DYN_TAG_BOOL:
    emit(dyn_payload(v) ? "true" : "false");
    return;
  case FLAN_DYN_TAG_INT:
    snprintf(buf, sizeof buf, "%lld", (long long)dyn_int_value(v));
    emit(buf);
    return;
  case FLAN_DYN_TAG_FLOAT: {
    double d;
    memcpy(&d, &v, sizeof d);
    /* x != x rather than isnan, which keeps math.h out of this file and is
     * the comparison flan_rt.c and the prelude both use. */
    if (d != d) snprintf(buf, sizeof buf, "nan");
    else snprintf(buf, sizeof buf, "%g", d);
    emit(buf);
    return;
  }
  case FLAN_DYN_TAG_TEXT: {
    flan_obj *o = dyn_obj(v);
    if (nested) emit_escaped(obj_text_bytes(o), o->len);
    else emit_n(obj_text_bytes(o), o->len);
    return;
  }
  default: {
    flan_obj *o = dyn_obj(v);
    int64_t i;
    emit("[");
    for (i = 0; i < o->len; i++) {
      emit(" ");
      render(o->u.v.items[i], depth + 1, 1);
    }
    emit("]");
    return;
  }
  }
}

void flan_dyn_print(flan_dyn v) { render(v, 0, 0); }

/* The same walk into a buffer, for a trap's sentence. Bounded and truncated
 * rather than allocating: a trap is the one moment when allocating would be a
 * second thing to go wrong, and the message's job is to name the value, not to
 * reproduce it. The depth is 2 rather than PRINT_DEPTH for the same reason. */

#define SAY_MAX 96

typedef struct { char *p; int64_t n, cap; } sayer;

static void say_puts(sayer *s, const char *t) {
  while (*t && s->n < s->cap - 1) s->p[s->n++] = *t++;
  s->p[s->n] = '\0';
}

static void say_render(sayer *s, flan_dyn v, int depth) {
  char buf[64];
  int32_t t = flan_dyn_tag(v);
  if (s->n >= s->cap - 4) return;
  switch (t) {
  case FLAN_DYN_TAG_NIL:  say_puts(s, "nil"); return;
  case FLAN_DYN_TAG_BOOL: say_puts(s, dyn_payload(v) ? "true" : "false"); return;
  case FLAN_DYN_TAG_INT:
    snprintf(buf, sizeof buf, "%lld", (long long)dyn_int_value(v));
    say_puts(s, buf);
    return;
  case FLAN_DYN_TAG_FLOAT: {
    double d;
    memcpy(&d, &v, sizeof d);
    if (d != d) snprintf(buf, sizeof buf, "nan");
    else snprintf(buf, sizeof buf, "%g", d);
    say_puts(s, buf);
    return;
  }
  case FLAN_DYN_TAG_TEXT: {
    flan_obj *o = dyn_obj(v);
    int64_t i;
    say_puts(s, "\"");
    for (i = 0; i < o->len && s->n < s->cap - 6; i++) {
      char c[2];
      uint8_t b = obj_text_bytes(o)[i];
      c[0] = b >= 0x20 ? (char)b : '.';
      c[1] = '\0';
      say_puts(s, c);
    }
    say_puts(s, i < o->len ? "...\"" : "\"");
    return;
  }
  default: {
    flan_obj *o = dyn_obj(v);
    int64_t i;
    if (depth >= 2) { say_puts(s, "[...]"); return; }
    say_puts(s, "[");
    for (i = 0; i < o->len && s->n < s->cap - 8; i++) {
      say_puts(s, " ");
      say_render(s, o->u.v.items[i], depth + 1);
    }
    say_puts(s, i < o->len ? " ...]" : "]");
    return;
  }
  }
}

static void say(char *buf, int64_t cap, flan_dyn v) {
  sayer s;
  s.p = buf;
  s.n = 0;
  s.cap = cap;
  buf[0] = '\0';
  say_render(&s, v, 0);
}

/* ── Traps ─────────────────────────────────────────────────────────────
 *
 * The shape of every message: the operation, then what was wrong in words,
 * then the call as it would have been written. So a program that adds a number
 * to a string stops with
 *
 *     dyn +: int and text, and + wants two numbers — (+ 3 "hi")
 *
 * which names the operation, both tags, and both values, in that order,
 * because that is the order somebody reads it in. [flan_trap] then parks the
 * program in a dev session and ends it standing up in a standalone build; the
 * sentence is the same either way, which is the point of routing through the
 * hook rather than calling abort here.
 *
 * The trap *name* — what the break loop shows and what a `layout` op will say
 * it cannot place — is "DynType" for a tag that was not what the operation
 * wanted, "DynRange" for an index outside a vec or a text, "DynArith" for a
 * division by zero or the one quotient that overflows, and "DynHeap" for an
 * allocation the host refused. Four names rather than one because they are
 * four different mistakes and a person stopped in one of them wants to know
 * which without reading the sentence twice — and because the break loop lists
 * them by name. */

static _Noreturn void trap2(const char *name, int64_t namelen, const char *op,
                            const char *why, flan_dyn a, flan_dyn b) {
  char sa[SAY_MAX], sb[SAY_MAX];
  say(sa, SAY_MAX, a);
  say(sb, SAY_MAX, b);
  fflush(stdout);
  fprintf(stderr, "dyn %s: %s and %s, and %s — (%s %s %s)\n", op, tag_of(a),
          tag_of(b), why, op, sa, sb);
  flan_trap((const uint8_t *)name, namelen);
}

static _Noreturn void trap1(const char *name, int64_t namelen, const char *op,
                            const char *why, flan_dyn a) {
  char sa[SAY_MAX];
  say(sa, SAY_MAX, a);
  fflush(stdout);
  fprintf(stderr, "dyn %s: %s, and %s — (%s %s)\n", op, tag_of(a), why, op, sa);
  flan_trap((const uint8_t *)name, namelen);
}

#define TYPE_TRAP  "DynType", 7
#define ARITH_TRAP "DynArith", 8

static _Noreturn void trap_range(const char *op, flan_dyn v, int64_t i,
                                 int64_t len) {
  char sv[SAY_MAX];
  say(sv, SAY_MAX, v);
  fflush(stdout);
  fprintf(stderr,
          "dyn %s: index %lld is out of bounds for %s of length %lld — %s\n",
          op, (long long)i, tag_of(v), (long long)len, sv);
  flan_trap((const uint8_t *)"DynRange", 8);
}

/* ── Allocation and collection ─────────────────────────────────────────
 *
 * Collection happens here and nowhere else, which is the fact the roots
 * contract rests on: between two allocations nothing is swept, so a
 * temporary living only in a C local survives the operation it was made in.
 * A growing vec's element array is a [realloc] and not an allocation in this
 * sense — it cannot collect, because the value being pushed may not be rooted
 * yet. That means a program that only ever pushes can hold more than the
 * trigger says before the next real allocation catches up, which is fine: what
 * it is holding is the vec, and the vec is live.
 *
 * The trigger is the plainest one that works: collect when this allocation
 * would carry the heap past a limit, then set the limit to twice what survived
 * — with a floor, so a program with a tiny live set does not collect on every
 * other allocation. That gives amortised O(1) collections per byte allocated
 * and a heap bounded at twice the live set plus the floor, which is the
 * property the million-allocation test asserts.
 *
 * "The answer to 'I need more performance' will never be a faster GC, it will
 * be to type the whole program" — so there is no generation, no card table, no
 * incremental phase, and no free list. */

static void gc_mark_all(void);
static void gc_sweep(void);

void flan_gc_init(void) {
  if (gc_ready) return;
  gc_ready = 1;
  gc_all = NULL;
  gc_bytes = 0;
  gc_count = 0;
  gc_next = gc_floor;
}

/* The trigger is recomputed from the new floor by the same formula the sweep
 * uses, rather than only being raised to meet it. Raising alone left a heap
 * that had been given a *lower* floor still running to the old one — the first
 * collection then happened a megabyte in, and a test that had asked for 64K
 * measured a megabyte. */
void flan_gc_set_floor(int64_t bytes) {
  gc_floor = bytes > 0 ? bytes : (1 << 20);
  gc_next = gc_bytes * 2;
  if (gc_next < gc_floor) gc_next = gc_floor;
}

int64_t flan_gc_live_bytes(void) { return gc_bytes; }
int64_t flan_gc_count(void) { return gc_count; }

void flan_gc_collect(void) {
  gc_mark_all();
  gc_sweep();
  gc_next = gc_bytes * 2;
  if (gc_next < gc_floor) gc_next = gc_floor;
}

/* Out of memory is the one failure in here that is not the program's fault and
 * not recoverable by anything this file can do. It takes the trap path like
 * everything else, so a dev session parks on it and can be read, rather than
 * the allocation quietly answering NULL and every caller below growing a null
 * check for a case none of them can handle. */
static _Noreturn void trap_oom(int64_t want) {
  fflush(stdout);
  fprintf(stderr,
          "dyn heap: %lld bytes could not be allocated, with %lld live\n",
          (long long)want, (long long)gc_bytes);
  flan_trap((const uint8_t *)"DynHeap", 7);
}

static flan_obj *gc_alloc(uint8_t kind, int64_t extra) {
  int64_t need = (int64_t)sizeof(flan_obj) + extra;
  flan_obj *o;
  if (!gc_ready) flan_gc_init();
  if (gc_bytes + need > gc_next) flan_gc_collect();
  o = (flan_obj *)malloc((size_t)need);
  if (o == NULL) trap_oom(need);
  o->next = gc_all;
  o->kind = kind;
  o->mark = 0;
  o->len = 0;
  memset(&o->u, 0, sizeof o->u);
  gc_all = o;
  gc_bytes += need;
  gc_count++;
  /* Into the ring before anything else can allocate. See the ring's comment:
   * this is the one line that makes an expression with two constructors in it
   * safe without the other lane having agreed to anything. */
  ring[ring_at] = o;
  ring_at = (ring_at + 1) % RING;
  return o;
}

/* The mark stack. Explicit rather than recursive, because a vec of a vec of a
 * vec is an ordinary dyn value and its depth is the program's, not this
 * file's: a recursive marker would put the heap's depth on the C stack and a
 * long enough chain would overflow it during a collection, which is the worst
 * possible moment. Grown on demand and kept between collections, so a steady
 * program stops paying for it after the first one. */
static flan_obj **mstack;
static int64_t    mstack_n, mstack_cap;

static void mark_push(flan_obj *o) {
  if (o == NULL || o->mark) return;
  o->mark = 1;
  /* Only a vec has anything to trace. A text and a boxed int are leaves, and
   * marking them is the whole of their visit. */
  if (o->kind != OBJ_VEC) return;
  if (mstack_n == mstack_cap) {
    int64_t cap = mstack_cap ? mstack_cap * 2 : 64;
    flan_obj **m = (flan_obj **)realloc(mstack, (size_t)cap * sizeof *m);
    if (m == NULL) trap_oom(cap * (int64_t)sizeof *m);
    mstack = m;
    mstack_cap = cap;
  }
  mstack[mstack_n++] = o;
}

static void mark_value(flan_dyn v) {
  if (dyn_boxed(v) && dyn_box(v) == BOX_OBJ) mark_push(dyn_obj(v));
}

static void gc_mark_all(void) {
  int64_t i;
  unsigned k;
  for (i = 0; i < roots_n; i++) mark_value(*roots[i]);
  for (k = 0; k < RING; k++) mark_push(ring[k]);
  while (mstack_n > 0) {
    flan_obj *o = mstack[--mstack_n];
    for (i = 0; i < o->len; i++) mark_value(o->u.v.items[i]);
  }
}

static void gc_sweep(void) {
  flan_obj **link = &gc_all;
  flan_obj *o = gc_all;
  while (o != NULL) {
    flan_obj *next = o->next;
    if (o->mark) {
      o->mark = 0;
      link = &o->next;
    } else {
      int64_t held = (int64_t)sizeof(flan_obj);
      if (o->kind == OBJ_TEXT) held += o->len;
      if (o->kind == OBJ_VEC) {
        held += o->u.v.cap * (int64_t)sizeof(flan_dyn);
        free(o->u.v.items);
      }
      gc_bytes -= held;
      gc_count--;
      *link = next;
      free(o);
    }
    o = next;
  }
}

void flan_dyn_root_push(flan_dyn *slot) {
  if (roots_n == roots_cap) {
    int64_t cap = roots_cap ? roots_cap * 2 : 64;
    flan_dyn **r = (flan_dyn **)realloc(roots, (size_t)cap * sizeof *r);
    if (r == NULL) trap_oom(cap * (int64_t)sizeof *r);
    roots = r;
    roots_cap = cap;
  }
  roots[roots_n++] = slot;
}

/* Clamped at empty rather than refused. A pop that outruns its pushes means
 * the frame machinery is already out of step, and the useful thing at that
 * point is a heap that still collects, not a second failure on top of the
 * first. flan_rt.c's [flan_handler_pop] takes the same line for the same
 * reason, by frame rather than by count. */
void flan_dyn_root_pop(int64_t n) {
  if (n <= 0) return;
  roots_n = n < roots_n ? roots_n - n : 0;
}

void flan_dyn_root_reset(void) { roots_n = 0; }

/* ── Constructors ──────────────────────────────────────────────────────*/

flan_dyn flan_dyn_nil(void) { return dyn_make(BOX_NIL, 0); }

flan_dyn flan_dyn_from_bool(uint8_t b) {
  return dyn_make(BOX_BOOL, b ? 1u : 0u);
}

flan_dyn flan_dyn_from_i64(int64_t x) {
  flan_obj *o;
  if (x >= DYN_INT_MIN && x <= DYN_INT_MAX)
    return dyn_make(BOX_INT, (uint64_t)x);
  /* Wider than the payload, so it goes on the heap. Rare by construction —
   * see the representation note — and it is the case that keeps i64 an i64
   * rather than a 48-bit integer with a different name. */
  o = gc_alloc(OBJ_INT, 0);
  o->u.i = x;
  return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
}

flan_dyn flan_dyn_from_f64(double x) {
  flan_dyn v;
  /* Every NaN becomes the one positive quiet NaN, which is what keeps a
   * negative quiet NaN from being read back as a box. The argument that this
   * loses nothing is in the representation note above and in flan_rt.c's
   * [flan_f64_to_bytes]. */
  if (x != x) return 0x7FF8000000000000ULL;
  memcpy(&v, &x, sizeof v);
  return v;
}

flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n) {
  flan_obj *o;
  if (n < 0) n = 0;
  o = gc_alloc(OBJ_TEXT, n);
  o->len = n;
  if (n > 0) memcpy(obj_text_bytes(o), p, (size_t)n);
  return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
}

flan_dyn flan_dyn_vec_new(void) {
  flan_obj *o = gc_alloc(OBJ_VEC, 0);
  o->len = 0;
  o->u.v.items = NULL;
  o->u.v.cap = 0;
  return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
}

/* ── Reading a value back ──────────────────────────────────────────────*/

static int64_t dyn_int_value(flan_dyn v) {
  if (dyn_box(v) == BOX_INT) {
    /* Sign-extend from 48 bits. The shift pair is the portable spelling; a
     * bitfield would be one line shorter and implementation-defined. */
    uint64_t p = dyn_payload(v);
    return (int64_t)(p << 16) >> 16;
  }
  return dyn_obj(v)->u.i;
}

static double dyn_num_value(flan_dyn v) {
  double d;
  if (flan_dyn_tag(v) == FLAN_DYN_TAG_INT) return (double)dyn_int_value(v);
  memcpy(&d, &v, sizeof d);
  return d;
}

static inline int is_num(flan_dyn v) {
  int32_t t = flan_dyn_tag(v);
  return t == FLAN_DYN_TAG_INT || t == FLAN_DYN_TAG_FLOAT;
}

static inline int is_text(flan_dyn v) {
  return flan_dyn_tag(v) == FLAN_DYN_TAG_TEXT;
}

static inline int is_vec(flan_dyn v) {
  return flan_dyn_tag(v) == FLAN_DYN_TAG_VEC;
}

int64_t flan_dyn_need_i64(flan_dyn v) {
  if (flan_dyn_tag(v) != FLAN_DYN_TAG_INT)
    trap1(TYPE_TRAP, "i64", "an int was wanted", v);
  return dyn_int_value(v);
}

/* A float, and an int is not one. Refusing the widening is the decision, not
 * an omission: typed Flan has no implicit widening anywhere — [(print-i64 x)]
 * used to force an explicit [(i64 x)] at every site — and a boundary that
 * quietly turned an int into a float would be the one place in the language
 * where a *value* changed type without anybody writing it down. The dyn
 * *operators* promote, because arithmetic between a 2 and a 2.5 has an obvious
 * answer and refusing it makes dynamic code worse; the boundary into a typed
 * f64 parameter does not, because there the annotation is somebody's stated
 * expectation and a mismatch is worth hearing about.
 *
 * Where this is sharper than the typed language is a *literal*. `(g 1)`
 * against `(defn g [x f64] ...)` compiles, because the checker gives the
 * literal the type the parameter asks for; a dyn value written as `1` has
 * already been through flan_dyn_from_i64 and cannot remember that it was a
 * literal. So the same source read as dyn traps where read as typed it does
 * not. That is a real divergence, it is the compiler's to close — by tagging
 * such a literal as a float where it can see the context — and it is written
 * down in the doc's boundary section so that closing it is a decision somebody
 * makes rather than a surprise somebody meets. Softening the check here is the
 * option not to take: this function sees a tag and nothing else, so it could
 * not tell (g 1) from (g (len xs)). */
double flan_dyn_need_f64(flan_dyn v) {
  if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT)
    trap1(TYPE_TRAP, "f64", "a float was wanted", v);
  return dyn_num_value(v);
}

uint8_t flan_dyn_need_bool(flan_dyn v) {
  if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL)
    trap1(TYPE_TRAP, "bool", "a bool was wanted", v);
  return (uint8_t)(dyn_payload(v) ? 1 : 0);
}

/* ── Arithmetic ────────────────────────────────────────────────────────
 *
 * Two ints answer an int; anything else numeric answers a float. The promotion
 * is the one place dyn is more permissive than the typed language, and the
 * case for it is that (+ 1 2.5) has exactly one sensible answer and a language
 * that refuses it is not dynamic in any useful sense. A program that wants the
 * refusal annotates, which is the whole bargain.
 *
 * Integer division and remainder by zero trap rather than answering. That
 * matches typed Flan, which signals ArithError and dies with "divide by zero"
 * if nothing handles it; the condition is not signalled here because a dyn
 * operation has no [loc] to report and no transfer channel in its hands, which
 * is the same reason the six traps in flan_rt.c park rather than signal. The
 * float case is left to IEEE — 1.0/0.0 is inf and that is an answer, not a
 * failure.
 *
 * The INT64_MIN / -1 pair overflows, and is the only pair that does. It gets
 * its own sentence for the reason flan_rt.c's gives it one: somebody meeting
 * it has probably never had to think about it. */

static void want_nums(const char *op, const char *why, flan_dyn a, flan_dyn b) {
  if (!is_num(a) || !is_num(b)) trap2(TYPE_TRAP, op, why, a, b);
}

#define ARITH_NUM "it takes two numbers"

static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) {
  int64_t x, y;
  want_nums(op, ARITH_NUM, a, b);
  if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT &&
      flan_dyn_tag(b) == FLAN_DYN_TAG_INT) {
    x = dyn_int_value(a);
    y = dyn_int_value(b);
    switch (op[0]) {
    case '+': return flan_dyn_from_i64((int64_t)((uint64_t)x + (uint64_t)y));
    case '-': return flan_dyn_from_i64((int64_t)((uint64_t)x - (uint64_t)y));
    case '*': return flan_dyn_from_i64((int64_t)((uint64_t)x * (uint64_t)y));
    case '/':
      if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b);
      if (x == INT64_MIN && y == -1)
        trap2(ARITH_TRAP, op,
              "the quotient is one past the largest i64, which is true of "
              "this pair of operands and no other", a, b);
      return flan_dyn_from_i64(x / y);
    default:
      if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b);
      if (x == INT64_MIN && y == -1) return flan_dyn_from_i64(0);
      return flan_dyn_from_i64(x % y);
    }
  }
  {
    double p = dyn_num_value(a), q = dyn_num_value(b);
    switch (op[0]) {
    case '+': return flan_dyn_from_f64(p + q);
    case '-': return flan_dyn_from_f64(p - q);
    case '*': return flan_dyn_from_f64(p * q);
    case '/': return flan_dyn_from_f64(p / q);
    default:
      /* No fmod, which would drag math.h in for one operator. The identity is
       * the definition of the remainder, and the trunc is what C's [%] does
       * for integers, so the two operators agree about sign. */
      if (q == 0.0) return flan_dyn_from_f64(p - p); /* nan, by 0/0 */
      {
        double t = p / q;
        double k;
        /* A quotient past 2^63 has no integer part this can name, and the
         * cast would be undefined rather than merely wrong. Every such
         * remainder is zero to the precision a double has left, so that is
         * what it answers — which is also fmod's answer. */
        if (!(t > -9.2233720368547758e18 && t < 9.2233720368547758e18))
          return flan_dyn_from_f64(t == t ? 0.0 : t);
        k = (t < 0) ? -(double)(int64_t)(-t) : (double)(int64_t)t;
        return flan_dyn_from_f64(p - k * q);
      }
    }
  }
}

flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith("+", a, b); }
flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith("-", a, b); }
flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith("*", a, b); }
flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith("/", a, b); }
flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", a, b); }

/* ── Ordering ──────────────────────────────────────────────────────────
 *
 * Numbers against numbers, text against text, and nothing else. Text orders
 * bytewise, which is [memcmp] with the shorter one first on a tie — the same
 * order a sort of a [(Vec string)] would want and the only order that needs no
 * locale, no collation table and no argument.
 *
 * A number against a text traps rather than answering. The temptation is to
 * order by tag so that every value is comparable and sorting never fails; the
 * reason not to is that the resulting order is an artefact of this file's tag
 * numbering, and a program that sorted a mixed vec would get a stable answer
 * that means nothing. */

static int order(const char *op, flan_dyn a, flan_dyn b) {
  if (is_num(a) && is_num(b)) {
    if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT &&
        flan_dyn_tag(b) == FLAN_DYN_TAG_INT) {
      int64_t x = dyn_int_value(a), y = dyn_int_value(b);
      return x < y ? -1 : (x > y ? 1 : 0);
    }
    {
      double p = dyn_num_value(a), q = dyn_num_value(b);
      /* NaN is unordered, and the honest answer is that it is neither less
       * than nor greater than anything. Reported as "greater" would make a
       * sort loop; reported as 2 lets each operator below answer false, which
       * is what IEEE says every one of them answers. */
      if (p != p || q != q) return 2;
      return p < q ? -1 : (p > q ? 1 : 0);
    }
  }
  if (is_text(a) && is_text(b)) {
    flan_obj *x = dyn_obj(a), *y = dyn_obj(b);
    int64_t n = x->len < y->len ? x->len : y->len;
    int c = n > 0 ? memcmp(obj_text_bytes(x), obj_text_bytes(y), (size_t)n) : 0;
    if (c != 0) return c < 0 ? -1 : 1;
    return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0);
  }
  trap2(TYPE_TRAP, op,
        "it compares two numbers or two texts, and these are neither", a, b);
}

flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) {
  return flan_dyn_from_bool(order("<", a, b) == -1);
}
flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) {
  int c = order("<=", a, b);
  return flan_dyn_from_bool(c == -1 || c == 0);
}
flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) {
  return flan_dyn_from_bool(order(">", a, b) == 1);
}
flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) {
  int c = order(">=", a, b);
  return flan_dyn_from_bool(c == 1 || c == 0);
}

/* ── Equality ──────────────────────────────────────────────────────────
 *
 * Structural, and the only operation here that never traps: two values of
 * unrelated tags are unequal, which is an answer, and making it an error would
 * mean a dyn program could not ask "is this the string I expected" without
 * first checking that it is a string at all.
 *
 * A number equals a number by value across the two tags — (= 1 1.0) is true —
 * which is the same promotion the operators do and for the same reason. Text
 * is bytewise and not by identity: two separately built texts with the same
 * bytes are equal, and the doc's "string identity" section says why that is
 * the only defensible choice when a text is immutable.
 *
 * A vec is equal element by element, with an identity shortcut first. The
 * depth cap is the cycle stop: [set_at] lets a vec contain itself, and past
 * the cap two vecs are equal only if they are the same vec, which terminates
 * and answers correctly for the case that actually arises (a cycle compared
 * against itself). Two *distinct* cyclic vecs with the same shape answer
 * false, which is a wrong answer to a question nobody has asked yet; the
 * honest fix is a visited set and it can be added the day somebody needs it. */

#define EQ_DEPTH 64

static int dyn_equal(flan_dyn a, flan_dyn b, int depth) {
  int32_t ta = flan_dyn_tag(a), tb = flan_dyn_tag(b);
  if (a == b && ta != FLAN_DYN_TAG_FLOAT) return 1;
  if (is_num(a) && is_num(b)) {
    if (ta == FLAN_DYN_TAG_INT && tb == FLAN_DYN_TAG_INT)
      return dyn_int_value(a) == dyn_int_value(b);
    return dyn_num_value(a) == dyn_num_value(b);
  }
  if (ta != tb) return 0;
  if (ta == FLAN_DYN_TAG_TEXT) {
    flan_obj *x = dyn_obj(a), *y = dyn_obj(b);
    if (x->len != y->len) return 0;
    return x->len == 0 ||
           memcmp(obj_text_bytes(x), obj_text_bytes(y), (size_t)x->len) == 0;
  }
  if (ta == FLAN_DYN_TAG_VEC) {
    flan_obj *x = dyn_obj(a), *y = dyn_obj(b);
    int64_t i;
    if (x == y) return 1;
    if (depth >= EQ_DEPTH) return 0;
    if (x->len != y->len) return 0;
    for (i = 0; i < x->len; i++)
      if (!dyn_equal(x->u.v.items[i], y->u.v.items[i], depth + 1)) return 0;
    return 1;
  }
  /* nil and bool, whose whole content is the payload the identity test above
   * already compared. Reached only when that test said no. */
  return 0;
}

flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) {
  return flan_dyn_from_bool((uint8_t)dyn_equal(a, b, 0));
}

/* ── Containers ────────────────────────────────────────────────────────*/

flan_dyn flan_dyn_len(flan_dyn v) {
  if (is_text(v) || is_vec(v)) return flan_dyn_from_i64(dyn_obj(v)->len);
  trap1(TYPE_TRAP, "len", "only a text or a vec has one", v);
}

/* The index has to be an int, and that is a separate sentence from the
 * container being wrong: (at v "1") and (at 3 1) are two different mistakes
 * and telling somebody "these are the wrong types" names neither. */
static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) {
  if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT)
    trap2(TYPE_TRAP, op, "an index must be an int", v, i);
  return dyn_int_value(i);
}

/* A text answers a byte, as an int. That is what [(at s i)] on a
 * [(Slice u8)] does in the typed language, and a text is a run of bytes in
 * both. Codepoints are utf8's job and stay there. */
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) {
  int64_t k;
  flan_obj *o;
  if (!is_text(v) && !is_vec(v))
    trap2(TYPE_TRAP, "at", "only a text or a vec is indexed", v, i);
  k = need_index("at", v, i);
  o = dyn_obj(v);
  if (k < 0 || k >= o->len) trap_range("at", v, k, o->len);
  if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]);
  return o->u.v.items[k];
}

void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) {
  int64_t k;
  flan_obj *o;
  (void)x;
  if (is_text(v))
    trap2(TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i);
  if (!is_vec(v))
    trap2(TYPE_TRAP, "set-at", "only a vec is assigned into", v, i);
  k = need_index("set-at", v, i);
  o = dyn_obj(v);
  if (k < 0 || k >= o->len) trap_range("set-at", v, k, o->len);
  o->u.v.items[k] = x;
}

void flan_dyn_push(flan_dyn v, flan_dyn x) {
  flan_obj *o;
  if (!is_vec(v)) {
    /* The value is in the sentence rather than the vec, because the vec is the
     * thing that is wrong and the value is what says which push it was. */
    trap2(TYPE_TRAP, "push", "only a vec is pushed to", v, x);
  }
  o = dyn_obj(v);
  if (o->len == o->u.v.cap) {
    int64_t cap = o->u.v.cap ? o->u.v.cap * 2 : 8;
    flan_dyn *items =
      (flan_dyn *)realloc(o->u.v.items, (size_t)cap * sizeof *items);
    if (items == NULL) trap_oom(cap * (int64_t)sizeof *items);
    /* The growth is charged to the heap so the trigger sees it, and it is
     * charged *here* rather than at the next collection because a vec that
     * doubles a dozen times between allocations would otherwise be invisible
     * to the trigger until it was already large. */
    gc_bytes += (cap - o->u.v.cap) * (int64_t)sizeof *items;
    o->u.v.items = items;
    o->u.v.cap = cap;
  }
  o->u.v.items[o->len++] = x;
}