The dev runtime rendered a value twice over: [flan_dev_emit_{u64,i64,f64,str}]
into the result buffer an evaluation is read back from, and
[flan_dev_watch_emit_*] into the current watch slot, with the same four bodies
either side and the sink as the only difference. [flan_dev_result_end] and
[flan_dev_watch_end] were the same ellipsis-and-generation close, comment for
comment, over two buffers.
So the rendering takes the sink as a parameter and the eight entry points are
eight one-line calls into four statics. The exports stay eight: the compiler
emits four of them by name (Session.externs) and a program reaches the watch
four through declare-c. ABI does not collapse because the bodies did.
The escape table is now [flan_escape_char] in flan_rt.c, once: what one byte
reads as inside a quoted string, into a caller's four bytes. A table and not a
printer, because the framings are genuinely different — [flan_escape_bytes]
builds a capped slice to hand back and the dev pair streams into a buffer it
does not own the end of — and the framing is the part that is each caller's.
The dyn printer keeps its own copy, which is docs/SPIKE-DUPLICITY.md §9's one
defended repeat: it is inside the runtime that owns the storage it walks. Its
comment, and flan_rt.c's, no longer tell a reader to change the other two.
Same for the NaN rule, which was spelled four times: [flan_f64_format] is
flan_rt.c's [flan_f64_to_bytes] without the slice, and the REPL emitter and the
watch table call it rather than restating "%g, and nan unsigned".
Byte-identical, checked two ways. A session driven over the daemon's socket
before and after — every arm of the emit family, the escapes, and a string long
enough to reach the truncating close — diffs empty. And a harness linking both
trees' flan_rt.c + flan_dev.c compares 8173 renderings: every byte 0..255
through both string emitters and through flan_escape_bytes, every length across
both caps and the ellipsis either side of them, both NaN signs, both infinities,
i64 and u64 at their extremes. Identical.
Dead code, each verified by its own grep before removal. These are exported C
symbols, so a program could reach one through declare-c; the evidence is that
nothing in the tree does, including the docs that write the surface down.
flan_dev_watch_u64 (flan_dev.c) — one occurrence repo-wide, its own
definition. The i64/f64/str siblings are declare-c'd in
test/programs/dev-watch.flan and written down in emacs/MANUAL.md; this one
appears in neither, and in no other file.
flan_break_resume (flan_rt.c) — the only non-prose reference was a stale
extern in vendor/agent/flan_agent.c with no call under it. Both gone.
[flan_name_id] stays: the bounds and arithmetic conditions still hash through
it. [flan_restart_take]'s comment no longer points at a function that is not
there.
flan_dev_watch_enabled (flan_dev.c) — prototyped in flan_agent.c, never
called. [watch_on] is still read directly by the three sites that gate on it.
clang_stamp (lib/build.ml) — a [lazy] never forced; one occurrence.
marshal (lib/expand.ml) — no reference anywhere. [write], which it wrapped,
is called twice in [call], so the [let rec] group is demoted to keep it.
is_bytes (lib/js.ml) — dead within js.ml. Nothing else in that file is
touched: the JS backend is parked, not dead.
Kept on purpose: [Loc.forget_sources], documented in docs/BUILT.md as
deliberately retained, and [flan_dev_watch_num_f64], which emacs/MANUAL.md
declares as public surface.
Two comments in lib/dev.ml argued the orphan grace in terms of elisp symbols
from before the rename — [flan-dev--open], [flan-dev--connection],
[flan-dev-poll-interval], and a file called emacs/flan-dev.el. None of those
exist. Re-spelled as [flan--open], [flan--connection], [flan-poll-interval] and
emacs/flan.el, which is where they are; the reasoning is load-bearing and is
unchanged.
dune test: exit 0. 59 lines of code out, 24 lines net of the prose that says
why.
1723 lines
71 KiB
C
1723 lines
71 KiB
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 <stddef.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);
|
|
|
|
/* Growing a Vec through a dyn view borrows flan_rt.c's own growth: doubling,
|
|
* allocator adoption and the epoch check all live in [flan_vec_push], and
|
|
* re-implementing any of that here would be a second copy of logic the
|
|
* duplicity doctrine (docs/SPIKE-DUPLICITY.md) says belongs on one side only.
|
|
* [v] is declared [void *] rather than [flan_vec *] so this file need not
|
|
* name flan_rt.c's type; the two structs' layouts must agree, which is
|
|
* [flan_dyn_vec_hdr] below, restated for the same reason [flan_desc] is. */
|
|
int8_t flan_vec_push(void *v, const void *elem, int64_t size, int64_t align,
|
|
const uint8_t *loc, int64_t loclen);
|
|
|
|
/* ── 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 5, 6 and 7 are unspoken for — keywords and maps took 4 and BOX_OBJ's
|
|
* [kind] field, not new top-level tags — 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;
|
|
|
|
/* A type's dyn map: where the dyn words are inside one instance of it. The
|
|
* compiler emits one of these per type that has any, as static data, and hands
|
|
* a pointer to it to [flan_dyn_root_push_desc]. Nothing here ever writes one.
|
|
* [size] is not read by the collector; it is the stride an array of the type
|
|
* has, which is what the typed-container view will need. */
|
|
typedef struct flan_desc {
|
|
int64_t size;
|
|
int64_t n;
|
|
const int64_t *offs;
|
|
} flan_desc;
|
|
|
|
#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
|
|
/* A keyword. The payload is a pointer to an interned entry that is not a GC
|
|
* object at all: keywords are immortal by construction — the intern table
|
|
* below holds the only copy of each name, nothing ever removes one, and the
|
|
* collector never sees the tag ([mark_value] walks BOX_OBJ and nothing else).
|
|
* Interning is what buys the Lisp symbol model: two keywords with the same
|
|
* name are the same word, so equality is the identity compare [dyn_equal]
|
|
* already opens with, never a memcmp. */
|
|
#define BOX_KW 4u
|
|
|
|
/* Restated from flan_dyn.h — a view's element kind. */
|
|
#define FLAN_VIEW_I64 0
|
|
#define FLAN_VIEW_F64 1
|
|
#define FLAN_VIEW_BOOL 2
|
|
|
|
/* 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 */
|
|
#define OBJ_MAP 3 /* keys and values interleaved: k0 v0 k1 v1 ... */
|
|
#define OBJ_VIEW 4 /* a typed container crossing into dyn as a view */
|
|
|
|
/* flan_vec, restated. This file must not name flan_rt.c's [flan_vec] — see
|
|
* the "if either table changes, change both" note above [flan_vec_push] —
|
|
* so a view over a [(Vec T)] is built from an address whose first five words
|
|
* this mirrors exactly. Only [ptr], [len] and [epoch]/[alloc] are ever read
|
|
* through it; nothing here writes one. */
|
|
typedef struct flan_dyn_vec_hdr {
|
|
void *ptr;
|
|
int64_t len;
|
|
int64_t cap;
|
|
void *alloc;
|
|
int64_t epoch;
|
|
} flan_dyn_vec_hdr;
|
|
|
|
/* This mirror's own layout, reported the same way flan_rt.c's
|
|
* [flan_vec_layout] reports the original's — see that function's comment
|
|
* for what ties the two together and why nothing at compile time otherwise
|
|
* does. */
|
|
void flan_dyn_vec_hdr_layout(int64_t out[6]) {
|
|
out[0] = (int64_t)sizeof(flan_dyn_vec_hdr);
|
|
out[1] = (int64_t)offsetof(flan_dyn_vec_hdr, ptr);
|
|
out[2] = (int64_t)offsetof(flan_dyn_vec_hdr, len);
|
|
out[3] = (int64_t)offsetof(flan_dyn_vec_hdr, cap);
|
|
out[4] = (int64_t)offsetof(flan_dyn_vec_hdr, alloc);
|
|
out[5] = (int64_t)offsetof(flan_dyn_vec_hdr, epoch);
|
|
}
|
|
|
|
/* flan_allocator's prefix, far enough to read the one word a stale-container
|
|
* check needs. The struct has more fields after [epoch]; this file never
|
|
* touches them; and the alignment of a leading same-typed prefix is the same
|
|
* in any translation unit that agrees on the field order, which is the
|
|
* "change both" this comment is the other half of. */
|
|
typedef struct flan_dyn_alloc_hdr {
|
|
void *proc;
|
|
void *data;
|
|
uint32_t caps;
|
|
uint64_t epoch;
|
|
} flan_dyn_alloc_hdr;
|
|
|
|
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 or entries
|
|
of a map */
|
|
union {
|
|
int64_t i; /* OBJ_INT */
|
|
struct { flan_dyn *items; int64_t cap; } v; /* OBJ_VEC and OBJ_MAP —
|
|
a map shares the vec's arm on purpose: its entries are the same malloc
|
|
block of dyn words, interleaved key then value, with [len] counting
|
|
entries and [cap] counting entries too. Sharing the arm is what lets the
|
|
marker and the sweep treat the two kinds with one load and a doubled
|
|
count rather than a second field to keep in step. */
|
|
/* OBJ_VIEW: a typed container's elements, native words this file did not
|
|
allocate and does not own. [is_vec] set means [base] is a
|
|
[flan_dyn_vec_hdr *] and [len] here is unused — the live length is
|
|
read from the header on every operation, which is the whole of why a
|
|
Vec growing through the view cannot go stale. [is_vec] clear means
|
|
[base] is the first element's address and [len] is the snapshot taken
|
|
at the crossing, for a slice or a fixed array, neither of which moves.
|
|
[elem] is one of FLAN_VIEW_I64/F64/BOOL. */
|
|
struct { void *base; int64_t len; int32_t elem; int32_t is_vec; } view;
|
|
/* OBJ_TEXT's bytes trail the header; see [obj_text_bytes]. */
|
|
} u;
|
|
} flan_obj;
|
|
|
|
/* How many dyn words hang off an object's items block — the count the marker
|
|
* walks and the sweep charges. A map holds two per entry.
|
|
*
|
|
* OBJ_VIEW answers 0 explicitly rather than falling into the [o->len] arm.
|
|
* [mark_push] never puts a view on the mark stack — it traces only
|
|
* OBJ_VEC/OBJ_MAP — so this is not reachable today, but [o->u.view.base]
|
|
* aliases [o->u.v.items] in the union, and a native array of i64 or f64
|
|
* reinterpreted as dyn words is exactly the kind of thing this file's
|
|
* roots contract exists to prevent happening by accident. Answering 0 here
|
|
* is what keeps a future change to the marking gate from silently trusting
|
|
* this function's default arm instead of failing loudly. */
|
|
static inline int64_t obj_words(flan_obj *o) {
|
|
if (o->kind == OBJ_VIEW) return 0;
|
|
return o->kind == OBJ_MAP ? o->len * 2 : o->len;
|
|
}
|
|
|
|
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 the
|
|
* addresses, so growing it moves the array and not the slots.
|
|
*
|
|
* A root is an address and a shape. The shape is NULL for the common case —
|
|
* the address is a dyn word and marking it is one call — and a [flan_desc] for
|
|
* an aggregate, which is a struct or an array of them with dyn fields
|
|
* somewhere inside. The descriptor is static data the compiler emitted for
|
|
* that type, and the pairing of address with descriptor is made at the *push*,
|
|
* by the code that knows what is at that address, which is why nothing in the
|
|
* heap or on the stack needs a header word for the collector to read. See
|
|
* flan_dyn.h's [flan_dyn_root_push_desc] for the whole of that argument. */
|
|
|
|
typedef struct {
|
|
void *base;
|
|
const flan_desc *desc; /* NULL: [base] is one flan_dyn */
|
|
} flan_root;
|
|
|
|
static flan_root *roots;
|
|
static int64_t roots_n, roots_cap;
|
|
|
|
/* How much of the bottom of that stack belongs to the globals rather than to
|
|
* any frame. The globals are pushed once, before the first frame runs, and
|
|
* never popped — so they are exactly the entries below this line, and every
|
|
* frame's roots are exactly the entries above it. Zero until a [main] says
|
|
* otherwise, which is also the right answer for a program that has no dyn
|
|
* globals to push. See [flan_dyn_root_globals_begin]. */
|
|
static int64_t roots_base;
|
|
|
|
/* ── 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", "keyword", "map" };
|
|
|
|
#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
|
|
#define FLAN_DYN_TAG_KEYWORD 6
|
|
#define FLAN_DYN_TAG_MAP 7
|
|
|
|
static inline flan_obj *dyn_obj(flan_dyn v) {
|
|
return (flan_obj *)(uintptr_t)dyn_payload(v);
|
|
}
|
|
|
|
/* An interned keyword's entry: the name's bytes trail the length, one malloc
|
|
* per distinct name, never freed. Not a flan_obj — the collector has no
|
|
* business with something immortal — and the tag alone says which it is. */
|
|
typedef struct kw_entry {
|
|
int64_t len;
|
|
/* bytes trail */
|
|
} kw_entry;
|
|
|
|
static inline kw_entry *dyn_kw(flan_dyn v) {
|
|
return (kw_entry *)(uintptr_t)dyn_payload(v);
|
|
}
|
|
|
|
static inline uint8_t *kw_bytes(kw_entry *k) { return (uint8_t *)(k + 1); }
|
|
|
|
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;
|
|
case BOX_KW: return FLAN_DYN_TAG_KEYWORD;
|
|
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;
|
|
/* A view answers the same tag a heap vec does: from a dyn program's
|
|
side there is nothing to tell them apart by, which is the point of a
|
|
view being indistinguishable rather than a fourth kind of vec. */
|
|
case OBJ_VEC: return FLAN_DYN_TAG_VEC;
|
|
case OBJ_VIEW: return FLAN_DYN_TAG_VEC;
|
|
case OBJ_MAP: return FLAN_DYN_TAG_MAP;
|
|
default: return FLAN_DYN_TAG_INT;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
const char *flan_dyn_tag_name(int32_t tag) {
|
|
if (tag < 0 || tag > FLAN_DYN_TAG_MAP) 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_char], which is where the typed side's printers —
|
|
* [flan_escape_bytes] and flan_dev.c's emitters — now share their one copy of
|
|
* it: printers that disagree about what a string looks like are that many
|
|
* wire formats.
|
|
*
|
|
* This copy is deliberate, and the argument for it is docs/SPIKE-DUPLICITY.md
|
|
* §9's: the dyn printer lives inside the runtime that owns the storage it
|
|
* walks, which is why it prints a dyn vec structurally where the typed
|
|
* printer answers <vec>. The whole printer is this side's; the table it
|
|
* shares with the other side is the part that must not drift. 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);
|
|
|
|
/* forward: the view helpers, needed by [render] and [say_render] above where
|
|
* they are defined, alongside the container operations below */
|
|
static int64_t view_len(const char *op, flan_obj *o);
|
|
static void *view_base(flan_obj *o);
|
|
static flan_dyn view_box(int32_t elem, const uint8_t *p);
|
|
static int64_t view_elem_size(int32_t elem);
|
|
|
|
/* forward: needed by [dyn_equal] below, defined alongside the view helpers
|
|
* further down — a length and an element reader that answer correctly
|
|
* whether [o] is an ordinary heap vec or a view over a typed container. */
|
|
static int64_t vecish_len(flan_obj *o);
|
|
static flan_dyn vecish_at(flan_obj *o, int64_t i);
|
|
|
|
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;
|
|
}
|
|
/* A keyword prints with its colon, bare, at every depth: :a is its own
|
|
* spelling the way true is, and quoting it would make it a text. */
|
|
case FLAN_DYN_TAG_KEYWORD: {
|
|
kw_entry *k = dyn_kw(v);
|
|
emit(":");
|
|
emit_n(kw_bytes(k), k->len);
|
|
return;
|
|
}
|
|
/* The map prints in edn's shape with the vec's spacing: a space before
|
|
* every element, key and value alike, so { :a 1 :b 2} sits beside the vec's
|
|
* [ 1 2 3] rather than inventing a fourth convention. Entries come out in
|
|
* insertion order, which is the only order the representation has. */
|
|
case FLAN_DYN_TAG_MAP: {
|
|
flan_obj *o = dyn_obj(v);
|
|
int64_t i;
|
|
emit("{");
|
|
for (i = 0; i < o->len; i++) {
|
|
emit(" ");
|
|
render(o->u.v.items[i * 2], depth + 1, 1);
|
|
emit(" ");
|
|
render(o->u.v.items[i * 2 + 1], depth + 1, 1);
|
|
}
|
|
emit("}");
|
|
return;
|
|
}
|
|
default: {
|
|
flan_obj *o = dyn_obj(v);
|
|
int64_t i, n = o->kind == OBJ_VIEW ? view_len("print", o) : o->len;
|
|
emit("[");
|
|
for (i = 0; i < n; i++) {
|
|
emit(" ");
|
|
if (o->kind == OBJ_VIEW)
|
|
render(view_box(o->u.view.elem,
|
|
(const uint8_t *)view_base(o)
|
|
+ i * view_elem_size(o->u.view.elem)),
|
|
depth + 1, 1);
|
|
else
|
|
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;
|
|
}
|
|
case FLAN_DYN_TAG_KEYWORD: {
|
|
kw_entry *k = dyn_kw(v);
|
|
int64_t i;
|
|
say_puts(s, ":");
|
|
for (i = 0; i < k->len && s->n < s->cap - 6; i++) {
|
|
char c[2];
|
|
c[0] = (char)kw_bytes(k)[i];
|
|
c[1] = '\0';
|
|
say_puts(s, c);
|
|
}
|
|
if (i < k->len) say_puts(s, "...");
|
|
return;
|
|
}
|
|
case FLAN_DYN_TAG_MAP: {
|
|
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 * 2], depth + 1);
|
|
say_puts(s, " ");
|
|
say_render(s, o->u.v.items[i * 2 + 1], depth + 1);
|
|
}
|
|
say_puts(s, i < o->len ? " ...}" : "}");
|
|
return;
|
|
}
|
|
default: {
|
|
flan_obj *o = dyn_obj(v);
|
|
int64_t i, n = o->kind == OBJ_VIEW ? view_len("print", o) : o->len;
|
|
if (depth >= 2) { say_puts(s, "[...]"); return; }
|
|
say_puts(s, "[");
|
|
for (i = 0; i < n && s->n < s->cap - 8; i++) {
|
|
say_puts(s, " ");
|
|
if (o->kind == OBJ_VIEW)
|
|
say_render(s,
|
|
view_box(o->u.view.elem,
|
|
(const uint8_t *)view_base(o)
|
|
+ i * view_elem_size(o->u.view.elem)),
|
|
depth + 1);
|
|
else
|
|
say_render(s, o->u.v.items[i], depth + 1);
|
|
}
|
|
say_puts(s, i < n ? " ...]" : "]");
|
|
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 and a map have 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 && o->kind != OBJ_MAP) 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++) {
|
|
const flan_desc *d = roots[i].desc;
|
|
if (d == NULL) mark_value(*(flan_dyn *)roots[i].base);
|
|
else {
|
|
int64_t j;
|
|
for (j = 0; j < d->n; j++)
|
|
mark_value(*(flan_dyn *)((char *)roots[i].base + d->offs[j]));
|
|
}
|
|
}
|
|
for (k = 0; k < RING; k++) mark_push(ring[k]);
|
|
while (mstack_n > 0) {
|
|
flan_obj *o = mstack[--mstack_n];
|
|
int64_t n = obj_words(o);
|
|
for (i = 0; i < n; 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 || o->kind == OBJ_MAP) {
|
|
int64_t per = o->kind == OBJ_MAP ? 2 : 1;
|
|
held += o->u.v.cap * per * (int64_t)sizeof(flan_dyn);
|
|
free(o->u.v.items);
|
|
}
|
|
gc_bytes -= held;
|
|
gc_count--;
|
|
*link = next;
|
|
free(o);
|
|
}
|
|
o = next;
|
|
}
|
|
}
|
|
|
|
static void root_add(void *base, const flan_desc *d) {
|
|
if (roots_n == roots_cap) {
|
|
int64_t cap = roots_cap ? roots_cap * 2 : 64;
|
|
flan_root *r = (flan_root *)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].base = base;
|
|
roots[roots_n].desc = d;
|
|
roots_n++;
|
|
}
|
|
|
|
void flan_dyn_root_push(flan_dyn *slot) { root_add(slot, NULL); }
|
|
|
|
/* The aggregate form. One entry on the same stack, so one [flan_dyn_root_pop]
|
|
* takes off a mixture of the two and a function's pop count stays the number
|
|
* of pushes it made. A NULL descriptor is not an error — it is a type the
|
|
* compiler found no dyn in — but it still occupies an entry, because the count
|
|
* is what the epilogue knows, and it is turned into an empty descriptor rather
|
|
* than stored as NULL, which on this stack means something else. */
|
|
static const flan_desc desc_empty = { 0, 0, NULL };
|
|
|
|
void flan_dyn_root_push_desc(void *base, const flan_desc *d) {
|
|
root_add(base, d == NULL ? &desc_empty : d);
|
|
}
|
|
|
|
/* Clamped at the globals 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. The floor is [roots_base] and not
|
|
* zero because the globals under it were never any frame's to pop: an
|
|
* over-popping frame taking them with it is the one way this clamp could turn
|
|
* a miscount into a use-after-free. */
|
|
void flan_dyn_root_pop(int64_t n) {
|
|
if (n <= 0) return;
|
|
roots_n = roots_n - n > roots_base ? roots_n - n : roots_base;
|
|
}
|
|
|
|
/* The two halves of "the globals are the bottom of this stack".
|
|
*
|
|
* [begin] empties it outright, because a re-entered [main] is about to push
|
|
* the same globals again and the entries the previous run left are the ones
|
|
* that would be duplicated. [end] records how many of them there are.
|
|
*
|
|
* Nothing between the two may allocate: between them the globals hold whatever
|
|
* the previous run left in them and are not rooted, so a collection there
|
|
* would sweep values the slots still point at. The emitted [main] calls
|
|
* [begin] immediately before the pushes and [end] immediately after, with only
|
|
* the pushes in between, which is what makes that hold. */
|
|
void flan_dyn_root_globals_begin(void) { roots_n = 0; roots_base = 0; }
|
|
void flan_dyn_root_globals_end(void) { roots_base = roots_n; }
|
|
|
|
void flan_dyn_root_reset(void) { roots_n = roots_base; }
|
|
|
|
/* ── 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);
|
|
}
|
|
|
|
flan_dyn flan_dyn_map_new(void) {
|
|
flan_obj *o = gc_alloc(OBJ_MAP, 0);
|
|
o->len = 0;
|
|
o->u.v.items = NULL;
|
|
o->u.v.cap = 0;
|
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
|
}
|
|
|
|
/* ── Keywords ──────────────────────────────────────────────────────────
|
|
*
|
|
* One global table, append-only, never freed: a keyword is a *name*, the set
|
|
* of names a program uses is written in its source (plus whatever an edn file
|
|
* contributes), and a name is not something the collector should be asked to
|
|
* prove liveness of. Interning here rather than at each site is what makes
|
|
* two spellings of :a one word — the constructor scans for the bytes and
|
|
* answers the entry that already holds them, so keyword equality upstream is
|
|
* the identity compare and never touches the bytes again.
|
|
*
|
|
* The scan is linear. A structural hash would repay itself on a program with
|
|
* thousands of distinct keywords; a config file has dozens, every literal in
|
|
* compiled code could be hoisted to one construction the day it matters, and
|
|
* a table this simple has nothing in it to get wrong. */
|
|
|
|
static kw_entry **kws;
|
|
static int64_t kws_n, kws_cap;
|
|
|
|
flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n) {
|
|
int64_t i;
|
|
kw_entry *k;
|
|
if (n < 0) n = 0;
|
|
for (i = 0; i < kws_n; i++) {
|
|
k = kws[i];
|
|
if (k->len == n && (n == 0 || memcmp(kw_bytes(k), p, (size_t)n) == 0))
|
|
return dyn_make(BOX_KW, (uint64_t)(uintptr_t)k);
|
|
}
|
|
if (kws_n == kws_cap) {
|
|
int64_t cap = kws_cap ? kws_cap * 2 : 32;
|
|
kw_entry **t = (kw_entry **)realloc(kws, (size_t)cap * sizeof *t);
|
|
if (t == NULL) trap_oom(cap * (int64_t)sizeof *t);
|
|
kws = t;
|
|
kws_cap = cap;
|
|
}
|
|
k = (kw_entry *)malloc(sizeof(kw_entry) + (size_t)n);
|
|
if (k == NULL) trap_oom((int64_t)sizeof(kw_entry) + n);
|
|
k->len = n;
|
|
if (n > 0) memcpy(kw_bytes(k), p, (size_t)n);
|
|
kws[kws_n++] = k;
|
|
return dyn_make(BOX_KW, (uint64_t)(uintptr_t)k);
|
|
}
|
|
|
|
/* ── 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);
|
|
}
|
|
|
|
/* nil <-> None at an (Option T) boundary. Cannot trap — every dyn value
|
|
* answers this one way or the other. */
|
|
int32_t flan_dyn_is_nil(flan_dyn v) {
|
|
return flan_dyn_tag(v) == FLAN_DYN_TAG_NIL ? 1 : 0;
|
|
}
|
|
|
|
/* (Some nil)'s run-time half: a dyn value the checker could not see was nil
|
|
* at compile time, reaching Some anyway. [op] is "some" rather than a Flan
|
|
* spelling of the call, matching how every other dyn trap here names the
|
|
* operation that refused. */
|
|
flan_dyn flan_dyn_need_not_nil(flan_dyn v) {
|
|
if (flan_dyn_tag(v) == FLAN_DYN_TAG_NIL)
|
|
trap1(TYPE_TRAP, "some",
|
|
"Some cannot hold nil -- nil and None would become the same case "
|
|
"of an (Option dyn)", v);
|
|
return v;
|
|
}
|
|
|
|
/* Clojure's truthiness, not C's or Python's: nil and false are the only
|
|
* falsey values, and everything else — 0, 0.0, "", an empty vec, an empty
|
|
* map, any keyword — is truthy. Never traps; every tag answers. */
|
|
uint8_t flan_dyn_truthy(flan_dyn v) {
|
|
int32_t t = flan_dyn_tag(v);
|
|
if (t == FLAN_DYN_TAG_NIL) return 0;
|
|
if (t == FLAN_DYN_TAG_BOOL) return (uint8_t)(dyn_payload(v) ? 1 : 0);
|
|
return 1;
|
|
}
|
|
|
|
/* ── 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, xn, yn;
|
|
if (x == y) return 1;
|
|
if (depth >= EQ_DEPTH) return 0;
|
|
/* [x]/[y] may each be an ordinary heap vec or a view (M2 item 3) — the
|
|
tag does not say which, so [vecish_len]/[vecish_at] below read either
|
|
shape correctly. Reading raw through [x->u.v.items] the way this arm
|
|
used to is wrong for a view: nothing sets [len] for OBJ_VIEW, so it
|
|
reads back 0, and the elements alias [u.view.base] reinterpreted as
|
|
dyn words — two views with different contents would compare equal, a
|
|
view and an equal heap vec would compare unequal, and a map keyed by
|
|
any view would collide with every other view, silently, with nothing
|
|
to crash. */
|
|
xn = vecish_len(x);
|
|
yn = vecish_len(y);
|
|
if (xn != yn) return 0;
|
|
for (i = 0; i < xn; i++)
|
|
if (!dyn_equal(vecish_at(x, i), vecish_at(y, i), depth + 1)) return 0;
|
|
return 1;
|
|
}
|
|
/* Two maps are equal when they hold the same keys and each key answers an
|
|
* equal value — by lookup and never by position, because two maps built by
|
|
* inserting the same pairs in different orders are the same map. Sizes are
|
|
* compared first, so one lookup per entry of x is the whole walk: every key
|
|
* of x found in y at equal size means every key of y was found. Quadratic,
|
|
* like everything else about this map, and wrong to be clever about before
|
|
* the linear scan itself is. */
|
|
if (ta == FLAN_DYN_TAG_MAP) {
|
|
flan_obj *x = dyn_obj(a), *y = dyn_obj(b);
|
|
int64_t i, j;
|
|
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++) {
|
|
flan_dyn k = x->u.v.items[i * 2];
|
|
int found = 0;
|
|
for (j = 0; j < y->len; j++) {
|
|
if (dyn_equal(k, y->u.v.items[j * 2], depth + 1)) {
|
|
if (!dyn_equal(x->u.v.items[i * 2 + 1], y->u.v.items[j * 2 + 1],
|
|
depth + 1))
|
|
return 0;
|
|
found = 1;
|
|
break;
|
|
}
|
|
}
|
|
if (!found) return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
/* nil, bool and keyword, whose whole content the identity test above
|
|
* already compared — a keyword's bytes were interned into exactly one
|
|
* entry, so two keywords are equal iff they are the same word. 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 ────────────────────────────────────────────────────────*/
|
|
|
|
static inline int is_map(flan_dyn v) {
|
|
return flan_dyn_tag(v) == FLAN_DYN_TAG_MAP;
|
|
}
|
|
|
|
/* ── Typed containers as views ─────────────────────────────────────────
|
|
*
|
|
* Every entry point below already dispatches on [flan_dyn_tag], which does
|
|
* not distinguish a view from a heap vec — see [flan_dyn_tag]'s switch — so
|
|
* [flan_dyn_len], [flan_dyn_at], [flan_dyn_set_at], [flan_dyn_push] and the
|
|
* printer each add one branch for [OBJ_VIEW] beside the existing [OBJ_VEC]
|
|
* one. What follows is that branch's machinery. */
|
|
|
|
static int64_t view_elem_size(int32_t elem) {
|
|
return elem == FLAN_VIEW_BOOL ? 1 : 8;
|
|
}
|
|
|
|
/* The stale-container check flan_rt.c's [flan_vec_check] runs for a typed
|
|
* Vec, restated for a view's own trap rather than reused: the duplicity
|
|
* doctrine's dyn side gets its own spelling (docs/SPIKE-DUPLICITY.md), and a
|
|
* dyn program that hits this wants the same park-and-inspect [flan_trap]
|
|
* gives every other dyn mistake, not the typed side's [rt_die]. A Vec with
|
|
* no allocator yet — one nobody has pushed to — has nothing to check.
|
|
*
|
|
* The message never renders the view it just declared unsafe to read —
|
|
* review's second finding, and it was not a decoration this dropped for
|
|
* safety's sake, it was a real infinite recursion: [say] on a view calls
|
|
* [say_render]'s view branch, which calls [view_len], which calls back in
|
|
* here, unconditionally, because the epoch is still stale. Every render of
|
|
* this same view would hit the same check and take the same branch, so
|
|
* nothing about depth or a visited set closes it — the fix is that a
|
|
* stale-container check must never read the container it has just refused
|
|
* to trust, not even to describe it in the sentence explaining why. */
|
|
static void view_vec_check(const char *op, flan_dyn_vec_hdr *h) {
|
|
if (h->alloc) {
|
|
flan_dyn_alloc_hdr *a = (flan_dyn_alloc_hdr *)h->alloc;
|
|
if ((int64_t)a->epoch != h->epoch) {
|
|
fflush(stdout);
|
|
fprintf(stderr,
|
|
"dyn %s: this view's container's allocator was released — the "
|
|
"Vec was made at epoch %lld and the allocator is at %lld now\n",
|
|
op, (long long)h->epoch, (long long)(int64_t)a->epoch);
|
|
flan_trap((const uint8_t *)"DynRange", 8);
|
|
}
|
|
}
|
|
}
|
|
|
|
/* [len] and [base], read live for a Vec view (so a push that grows and
|
|
* moves the underlying Vec is seen the very next operation) and read from
|
|
* the snapshot for a flat one. */
|
|
static int64_t view_len(const char *op, flan_obj *o) {
|
|
if (o->u.view.is_vec) {
|
|
flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)o->u.view.base;
|
|
view_vec_check(op, h);
|
|
return h->len;
|
|
}
|
|
return o->u.view.len;
|
|
}
|
|
|
|
static void *view_base(flan_obj *o) {
|
|
if (o->u.view.is_vec) return ((flan_dyn_vec_hdr *)o->u.view.base)->ptr;
|
|
return o->u.view.base;
|
|
}
|
|
|
|
/* Reads box the element on the way out — the runtime already knows how to
|
|
* box an i64, an f64 or a bool, so this is that, from raw bytes rather than
|
|
* from a C value already in hand. */
|
|
static flan_dyn view_box(int32_t elem, const uint8_t *p) {
|
|
switch (elem) {
|
|
case FLAN_VIEW_I64: { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); }
|
|
case FLAN_VIEW_F64: { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); }
|
|
default: { uint8_t b = *p; return flan_dyn_from_bool(b); }
|
|
}
|
|
}
|
|
|
|
/* A length and an element reader that answer correctly whether [o] is an
|
|
* ordinary heap vec (OBJ_VEC, elements are dyn words) or a view over a
|
|
* typed container (OBJ_VIEW, elements are native bytes boxed on the way
|
|
* out) — the pair [dyn_equal]'s VEC arm needs so that a view compares
|
|
* correctly against another view and against an ordinary vec alike. Reading
|
|
* [o->len]/[o->u.v.items] directly, the way that arm used to, answers 0 and
|
|
* garbage for a view: nothing sets [len] for OBJ_VIEW, and its elements
|
|
* alias [u.view.base] reinterpreted as dyn words rather than the native
|
|
* bytes they are. */
|
|
static int64_t vecish_len(flan_obj *o) {
|
|
return o->kind == OBJ_VIEW ? view_len("=", o) : o->len;
|
|
}
|
|
|
|
static flan_dyn vecish_at(flan_obj *o, int64_t i) {
|
|
if (o->kind == OBJ_VIEW)
|
|
return view_box(o->u.view.elem,
|
|
(const uint8_t *)view_base(o)
|
|
+ i * view_elem_size(o->u.view.elem));
|
|
return o->u.v.items[i];
|
|
}
|
|
|
|
/* Writes tag-check on the way in: the dyn value's tag must be the one this
|
|
* view's element type wants, or this traps by name and never coerces or
|
|
* truncates a mismatched value into the slot. [v] is the view, for the
|
|
* sentence's container half; [x] is the value that was refused. */
|
|
static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x,
|
|
uint8_t *p) {
|
|
switch (elem) {
|
|
case FLAN_VIEW_I64: {
|
|
int64_t n;
|
|
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT)
|
|
trap2(TYPE_TRAP, op, "this view's elements are int", v, x);
|
|
n = dyn_int_value(x);
|
|
memcpy(p, &n, 8);
|
|
return;
|
|
}
|
|
case FLAN_VIEW_F64: {
|
|
double d;
|
|
if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT)
|
|
trap2(TYPE_TRAP, op, "this view's elements are float", v, x);
|
|
d = dyn_num_value(x);
|
|
memcpy(p, &d, 8);
|
|
return;
|
|
}
|
|
default: {
|
|
uint8_t b;
|
|
if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL)
|
|
trap2(TYPE_TRAP, op, "this view's elements are bool", v, x);
|
|
b = dyn_payload(x) ? 1 : 0;
|
|
*p = b;
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
flan_dyn flan_dyn_view_vec(void *hdr, int32_t elem) {
|
|
flan_obj *o = gc_alloc(OBJ_VIEW, 0);
|
|
o->u.view.base = hdr;
|
|
o->u.view.len = 0;
|
|
o->u.view.elem = elem;
|
|
o->u.view.is_vec = 1;
|
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
|
}
|
|
|
|
flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) {
|
|
flan_obj *o = gc_alloc(OBJ_VIEW, 0);
|
|
o->u.view.base = data;
|
|
o->u.view.len = len;
|
|
o->u.view.elem = elem;
|
|
o->u.view.is_vec = 0;
|
|
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
|
}
|
|
|
|
flan_dyn flan_dyn_len(flan_dyn v) {
|
|
if (is_text(v) || is_map(v)) return flan_dyn_from_i64(dyn_obj(v)->len);
|
|
if (is_vec(v)) {
|
|
flan_obj *o = dyn_obj(v);
|
|
if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len("len", o));
|
|
return flan_dyn_from_i64(o->len);
|
|
}
|
|
trap1(TYPE_TRAP, "len", "only a text, a vec or a map 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 (o->kind == OBJ_VIEW) {
|
|
int64_t len = view_len("at", o);
|
|
if (k < 0 || k >= len) trap_range("at", v, k, len);
|
|
return view_box(o->u.view.elem,
|
|
(const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem));
|
|
}
|
|
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;
|
|
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 (o->kind == OBJ_VIEW) {
|
|
int64_t len = view_len("set-at", o);
|
|
uint8_t *p;
|
|
if (k < 0 || k >= len) trap_range("set-at", v, k, len);
|
|
p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem);
|
|
view_unbox("set-at", v, o->u.view.elem, x, p);
|
|
return;
|
|
}
|
|
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->kind == OBJ_VIEW) {
|
|
uint8_t buf[8];
|
|
static const uint8_t push_loc[] = "(dyn push)";
|
|
int64_t size;
|
|
if (!o->u.view.is_vec)
|
|
trap2(TYPE_TRAP, "push",
|
|
"this view is a slice or an array and cannot grow", v, x);
|
|
size = view_elem_size(o->u.view.elem);
|
|
view_unbox("push", v, o->u.view.elem, x, buf);
|
|
if (!flan_vec_push(o->u.view.base, buf, size, size, push_loc,
|
|
(int64_t)sizeof(push_loc) - 1))
|
|
trap_oom(size);
|
|
return;
|
|
}
|
|
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;
|
|
}
|
|
|
|
/* ── Maps ──────────────────────────────────────────────────────────────
|
|
*
|
|
* Association pairs in one block, scanned linearly with the structural
|
|
* equality above. Not a hash table, and that is a decision rather than a
|
|
* shortcut deferred: hashing dyn values structurally means a hash function
|
|
* over every tag kept in step with [dyn_equal] forever — the exact same-side
|
|
* duplication the duplicity audit warns the typed side's printers into — and
|
|
* the maps this exists for are documents read from files, tens of entries.
|
|
* "The answer to 'I need more performance' will never be a faster GC"; nor
|
|
* will it be a faster dyn map. Type the program.
|
|
*
|
|
* A key occurs once: [set] replaces the value of an equal key in place, which
|
|
* is what makes a map keyed by anything — including another map — a set with
|
|
* dedup for free. Insertion order is preserved and is the print order.
|
|
*
|
|
* Absence answers nil rather than trapping. A key that is not in a map is an
|
|
* answer to a question the caller was allowed to ask — the same line [eq]
|
|
* takes about unrelated tags — and nil is the value FIX.org's queue says
|
|
* arrives with maps. [contains] is the question to ask when nil might also be
|
|
* *stored*, and both are here so neither has to be guessed from the other. */
|
|
|
|
static int64_t map_find(flan_obj *o, flan_dyn k) {
|
|
int64_t i;
|
|
for (i = 0; i < o->len; i++)
|
|
if (dyn_equal(o->u.v.items[i * 2], k, 0)) return i;
|
|
return -1;
|
|
}
|
|
|
|
static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) {
|
|
if (!is_map(m)) trap2(TYPE_TRAP, op, "only a map answers it", m, k);
|
|
return dyn_obj(m);
|
|
}
|
|
|
|
flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) {
|
|
flan_obj *o = want_map("get", m, k);
|
|
int64_t i = map_find(o, k);
|
|
return i < 0 ? flan_dyn_nil() : o->u.v.items[i * 2 + 1];
|
|
}
|
|
|
|
flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) {
|
|
flan_obj *o = want_map("has-key?", m, k);
|
|
return flan_dyn_from_bool(map_find(o, k) >= 0);
|
|
}
|
|
|
|
void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) {
|
|
flan_obj *o = want_map("put", m, k);
|
|
int64_t i = map_find(o, k);
|
|
if (i >= 0) {
|
|
o->u.v.items[i * 2 + 1] = v;
|
|
return;
|
|
}
|
|
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 * 2 * sizeof *items);
|
|
if (items == NULL) trap_oom(cap * 2 * (int64_t)sizeof *items);
|
|
/* Charged now for the reason push's growth is: the trigger has to see
|
|
* the block while it is growing, not after. */
|
|
gc_bytes += (cap - o->u.v.cap) * 2 * (int64_t)sizeof *items;
|
|
o->u.v.items = items;
|
|
o->u.v.cap = cap;
|
|
}
|
|
o->u.v.items[o->len * 2] = k;
|
|
o->u.v.items[o->len * 2 + 1] = v;
|
|
o->len++;
|
|
}
|