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

3224 lines
142 KiB
C
Raw Blame History

/* flan_rt — the milestone-2 host ABI.
*
* This is the whole of it: argv, stdout, exit, and four text conversions
* (plan.org, Milestone-2 primitives). Keeping the list this short is what
* makes the wasm32 target cheap, because a primitive is the only thing
* implemented twice.
*
* Every function here takes and returns scalars or an out-pointer. Nothing
* returns a struct by value: the emitted .ll would then have to agree with the
* platform's struct-return ABI, which is exactly the kind of thing that works
* on x86-64 and silently does not on wasm32.
*/
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
/* ── Conditions, spec-conditions.md ────────────────────────────────── */
/* A handler stack, and nothing more. signal walks it, calls every frame whose
* type matches, and returns; a handler that returns normally leaves the
* signalling function to carry on, and with an empty stack signal is a null
* check. Nothing here transfers control — restart-case is what will, and it
* needs a calling convention this does not.
*
* Frames are allocated by the caller, on its own stack: establishing a handler
* is two stores and a push. The condition crosses as a pointer because a
* condition is a struct and the handler runs while the signalling frame is
* still alive, so there is nothing to copy.
*
* A type is a number rather than a pointer to anything, so that a module
* compiled later against a running program agrees with it: see Check.type_id. */
typedef struct flan_handler {
struct flan_handler *prev;
uint32_t type_id;
void (*fn)(void *condition, void *xfer);
} flan_handler;
static flan_handler *handlers;
void flan_handler_push(flan_handler *h) {
h->prev = handlers;
handlers = h;
}
void flan_handler_pop(flan_handler *h) {
/* By frame, not by count: restoring what this frame displaced is correct
* even if something below it got the stack out of step. */
handlers = h->prev;
}
/* [xfer] is the signalling function's own end of the transfer channel
* (spec-conditions.md §6), threaded through so that a handler invoking a
* restart can write its target into it. That makes this C frame transparent to
* a transfer, which it has to be: a handler is always reached through here, so
* the rule that a transfer cannot cross a foreign frame would otherwise make
* restart-case useless.
*
* A handler that transfers stops the walk. The remaining handlers are for a
* signal that is still looking for someone; this one has been answered. */
void flan_signal(uint32_t type_id, void *condition, void *xfer) {
for (flan_handler *h = handlers; h != NULL; h = h->prev)
if (h->type_id == type_id) {
h->fn(condition, xfer);
if (*(void **)xfer != NULL) return;
}
}
/* A restart stack, the same shape and for the same reasons. What a transfer
* carries is the *address* of one of these frames, not a number: the frame is
* allocated by the restart-case that offers it, on its own stack, so the
* address is unique against every module a running program may later load and
* against every re-entry of the same restart-case. §4's "innermost frame
* offering the name" is then just the order of the walk. */
typedef struct flan_restart {
struct flan_restart *prev;
uint32_t name_id;
/* The name as written, beside the hash that matching uses. Matching never
* needs it; a break loop does, because it has to show someone their choices
* and nothing at run time can turn a hash back into a name. */
const uint8_t *name;
int64_t namelen;
} flan_restart;
static flan_restart *restarts;
void flan_restart_push(flan_restart *r) {
r->prev = restarts;
restarts = r;
}
void flan_restart_pop(flan_restart *r) { restarts = r->prev; }
/* What is on offer, innermost first — spec-conditions.md §4's walk, without
* committing to anything. This is [compute-restarts]' data; today its only
* caller is the break loop. */
int32_t flan_restart_count(void) {
int32_t n = 0;
for (flan_restart *r = restarts; r != NULL; r = r->prev) n++;
return n;
}
const uint8_t *flan_restart_name(int32_t i, int64_t *len) {
for (flan_restart *r = restarts; r != NULL; r = r->prev)
if (i-- == 0) { *len = r->namelen; return r->name; }
*len = 0;
return NULL;
}
void *flan_find_restart(uint32_t name_id) {
for (flan_restart *r = restarts; r != NULL; r = r->prev)
if (r->name_id == name_id) return r;
return NULL;
}
/* The i'th frame itself, innermost first — the same walk as
* [flan_restart_name] and the other half of it. A break loop that offers
* someone a *list* has to be able to take the entry they picked, and §4's
* by-name lookup cannot express "the second retry": it takes the first frame
* offering the name, by definition, so a shadowed restart is on every list
* and reachable from none of them. Identifying a restart positionally is the
* only thing that fixes that, and it is why SBCL does the same.
*
* The address is the currency: a transfer carries the frame's address, so a
* caller that holds one from before is holding the same frame the walk found,
* whatever the walk finds today. */
void *flan_restart_frame(int32_t i) {
for (flan_restart *r = restarts; r != NULL; r = r->prev)
if (i-- == 0) return r;
return NULL;
}
/* Aim the transfer channel at a frame obtained earlier. The same store
* [flan_break_resume] makes and the same one an invoke-restart makes — this
* only spells it without a lookup, for a caller that did its looking up when
* the stack was worth reading. */
void flan_restart_take(void *frame, void *xfer) { *(void **)xfer = frame; }
/* [T] and string are both ptr+len — see Emit.ll. */
typedef struct { const uint8_t *ptr; int64_t len; } flan_slice;
static int rt_argc;
static char **rt_argv;
static flan_slice *rt_args; /* argv as [string], built once, never freed */
void flan_rt_init(int32_t argc, char **argv) {
rt_argc = (int)argc;
rt_argv = argv;
/* Line buffered even when stdout is a file or a pipe, where the C default is
* a 4K block. A Flan program can run for minutes with a REPL attached to it,
* and output that only appears when it exits is output nobody can use. It is
* also what makes a program's progress observable to a test that is driving
* it. The cost is one write per line instead of per 4K. */
setvbuf(stdout, NULL, _IOLBF, 0);
}
/* Defined below with the rest of the non-local exits, and forward-declared
* here because the argument vector is built long before them. */
static _Noreturn void rt_die(void);
/* The one malloc in this file that is not an allocator's, because the argument
* vector belongs to the process rather than to any region a Flan program named.
* A failure here cannot be a condition: [argv] has no allocation site for the
* compiler to wrap in a restart, and answering with a shorter vector — or with
* a null pointer and a length — is the silently-wrong answer every other entry
* point in this file refuses to give. It cannot fire in practice: this is a
* handful of words asked for before the program has allocated anything. */
void flan_argv(flan_slice *out) {
if (rt_args == NULL && rt_argc > 0) {
rt_args = (flan_slice *)malloc(sizeof(flan_slice) * (size_t)rt_argc);
if (rt_args == NULL) {
fflush(stdout);
fprintf(stderr,
"flan: out of memory building the argument vector for %d "
"arguments\n",
rt_argc);
rt_die();
}
for (int i = 0; i < rt_argc; i++) {
rt_args[i].ptr = (const uint8_t *)rt_argv[i];
rt_args[i].len = (int64_t)strlen(rt_argv[i]);
}
}
out->ptr = (const uint8_t *)rt_args;
out->len = (int64_t)rt_argc;
}
void flan_write_stdout(const uint8_t *p, int64_t n) {
if (n > 0) fwrite(p, 1, (size_t)n, stdout);
}
/* The merged dev build's way out, and null everywhere else.
*
* A Flan [main] does not return: [Emit] ends it with a call to this and an
* [unreachable], because stdout is a FILE* and the acceptance tests read it.
* That is fine when the program is its own process and wrong when the compiler
* is in the same one — [exit] would take the session down with the program.
* The merged entry point installs a hook that flushes, tells the compiler the
* program is done, and parks instead. See lib/dev.ml. */
void (*flan_exit_hook)(int32_t status) = 0;
void flan_exit(int32_t status) {
fflush(stdout);
if (flan_exit_hook) flan_exit_hook(status); /* does not return */
exit((int)status);
}
/* Both stacks above, emptied — for the one caller that can reach this point
* with either of them non-empty.
*
* A handler frame and a restart frame are each an alloca in the function that
* establishes one, pushed on entry and popped on the way out, so in a program
* that runs to its end and stops there both chains are empty or point at
* storage that is about to stop existing, and neither case needs anybody's
* help. The merged dev build is the exception: its hook does not let [main]
* return, it longjmps back to the C [main] so that the program can be run
* again, and a longjmp pops no frame. Without this the second run starts with
* the first run's chains still threaded through stack that has been handed
* back — a [signal] would call a handler in a frame that is gone, which is a
* jump into whatever the new run wrote over it.
*
* Called only from between two runs, on the thread that runs them, which is
* why it needs no lock: there is no Flan code executing anywhere when it
* happens. */
void flan_condition_stacks_reset(void) {
handlers = NULL;
restarts = NULL;
}
/* The conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it.
* calc-me's tokenizer needs the first, the prelude's printers the second. */
/* Where the rendered text goes, and who owns it.
*
* The buffer belongs to the *caller*: the compiler gives every one of these
* call sites a frame slot of its own and passes its address, so two
* conversions in one expression are two buffers and the text of the first is
* still there while the second is made. It used to be one file-static, shared
* by every call in the process — (print a) (print b) over two conversions
* printed the second number twice, with no crash and nothing for a sanitizer
* to see, because the read was inside a buffer that was perfectly alive.
*
* What this does *not* buy is storage: the slice points into the caller's
* frame, so holding one past the function that made it, or pushing it into a
* container that outlives the frame, is still the caller's problem. Copy the
* bytes for that. The size is agreed with check.ml, which allocates the slot —
* grep FLAN_NUM_BYTES there before changing it here. */
#define FLAN_NUM_BYTES 64
/* snprintf returns what it *would* have written, not what it did. The three
* shims below hand the result back as a slice, so taking that number at face
* value would publish a length past the end of the caller's buffer and every
* reader of that slice would run off it. No format here can reach 64 — %g is
* at most 13 characters and %lld at most 20 — so this clamp cannot fire today;
* it is here because the distance between "cannot fire" and "reads off the end
* of the frame" is one format string, and nothing else in the file says so.
* Found by reading, under a sanitizer sweep that could not have found it:
* nothing in the corpus prints a number long enough. */
static int64_t fit(int n) {
if (n < 0) return 0;
return n < FLAN_NUM_BYTES ? (int64_t)n : (int64_t)(FLAN_NUM_BYTES - 1);
}
/* The length is clamped below *and* above. Above is obvious and was always
* here. Below was not, and it was the real one: a slice's length is a signed
* 64-bit count, (slice s 2 1) computes 2 - 1 - 2 = -1, and `(size_t)n` on a
* negative n is 18446744073709551615, which is not less than 511, so k became
* 511 and the memcpy read 511 bytes from wherever the slice pointed. A checked
* build traps on the reversed slice before it gets here; an unchecked one does
* not, and every other (ptr, len) entry point in this file — flan_write_stdout,
* flan_escape_bytes, flan_dev_emit — already guards the negative case. These
* two were the exceptions. */
static size_t clamp_len(int64_t n, size_t cap) {
if (n <= 0) return 0;
return (uint64_t)n < (uint64_t)cap ? (size_t)n : cap;
}
double flan_bytes_to_f64(const uint8_t *p, int64_t n) {
char buf[512];
size_t k = clamp_len(n, sizeof buf - 1);
memcpy(buf, p, k);
buf[k] = '\0';
return strtod(buf, NULL);
}
int64_t flan_bytes_to_i64(const uint8_t *p, int64_t n) {
char buf[64];
size_t k = clamp_len(n, sizeof buf - 1);
memcpy(buf, p, k);
buf[k] = '\0';
return (int64_t)strtoll(buf, NULL, 10);
}
/* %g so that 3.5 prints as "3.5" and not "3.500000" — calc-me's expected
* output is a table of exact strings. */
void flan_f64_to_bytes(double x, uint8_t *buf, flan_slice *out) {
int n = snprintf((char *)buf, FLAN_NUM_BYTES, "%g", x);
out->ptr = buf;
out->len = fit(n);
}
void flan_i64_to_bytes(int64_t x, uint8_t *buf, flan_slice *out) {
int n = snprintf((char *)buf, FLAN_NUM_BYTES, "%lld", (long long)x);
out->ptr = buf;
out->len = fit(n);
}
/* u64 is not i64 with a flag: 0xFFFFFFFFFFFFFFFF is 18446744073709551615 and
* not -1, and routing it through the signed printer is the only way println
* could disagree with the REPL about a value both can hold. Hence a second
* shim rather than a cast at the call site. */
void flan_u64_to_bytes(uint64_t x, uint8_t *buf, flan_slice *out) {
int n = snprintf((char *)buf, FLAN_NUM_BYTES, "%llu", (unsigned long long)x);
out->ptr = buf;
out->len = fit(n);
}
/* A string *inside* a printed structure, quoted and escaped, so that the run
* of bytes can be told from the punctuation around it — (S {:name "a b"}) has
* two fields if the quotes are missing and one if they are there.
*
* This is the same escape table as flan_dev_emit_str in flan_dev.c, and
* deliberately so: the REPL and println must not disagree about what a struct
* looks like. It cannot be the *same function* because the dev one streams
* into the result buffer and this one has to hand back a slice; if either
* table changes, change both.
*
* Its own buffer, not `scratch`: escaping is the one conversion whose output
* is not a bounded handful of characters. Over-long input is truncated with an
* ellipsis rather than silently cut, because a value that prints as a shorter
* value is the failure nobody notices. */
#define ESCAPE_MAX 1024
static char escaped[ESCAPE_MAX];
void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) {
size_t len = n < 0 ? 0 : (size_t)n;
size_t w = 0;
int cut = 0;
/* The guard reserves 9 bytes, and all 9 are spoken for: 4 for the longest
* single escape (\xNN), 3 for the ellipsis, 1 for the closing quote, 1
* spare. So the loop never writes a partial escape and the three writes
* after it never need a bound of their own. Swept over every length to 1300
* against \x01, '"', '\\' and 'a': the worst output is 1021 of 1024. If the
* escape table ever grows a longer form, this 9 grows with it. */
escaped[w++] = '"';
for (size_t i = 0; i < len; i++) {
if (w + 5 + 4 >= ESCAPE_MAX) { cut = 1; break; }
unsigned char c = p[i];
switch (c) {
case '"': escaped[w++] = '\\'; escaped[w++] = '"'; break;
case '\\': escaped[w++] = '\\'; escaped[w++] = '\\'; break;
case '\n': escaped[w++] = '\\'; escaped[w++] = 'n'; break;
case '\t': escaped[w++] = '\\'; escaped[w++] = 't'; break;
case '\r': escaped[w++] = '\\'; escaped[w++] = 'r'; break;
default:
if (c < 0x20) {
w += (size_t)snprintf(escaped + w, 5, "\\x%02x", c);
} else {
escaped[w++] = (char)c;
}
}
}
if (cut) { escaped[w++] = '.'; escaped[w++] = '.'; escaped[w++] = '.'; }
escaped[w++] = '"';
out->ptr = (const uint8_t *)escaped;
out->len = (int64_t)w;
}
/* Bounds failures. The emitted code branches here and then falls off the end
* with `unreachable`, so these must not return — the same explicit shape as
* every other non-local exit, which is what keeps wasm32 free of unwinding.
*
* The location is passed as ptr+len because that is what a Flan string already
* is; nothing here allocates. Exit 134 is abort()'s status without abort()'s
* signal, so the same assertion should hold once wasm32 builds.
*
* stdout is flushed *before* the message: stderr is unbuffered and a
* redirected stdout is not, so without this the error appears above the output
* that led to it. */
static _Noreturn void rt_die(void) {
fflush(stdout);
fflush(stderr);
exit(134);
}
_Noreturn void flan_bounds_fail(const uint8_t *loc, int64_t loclen,
int64_t idx, int64_t len) {
fflush(stdout);
fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n",
(int)loclen, (const char *)loc, (long long)idx, (long long)len);
rt_die();
}
/* §2's diverging variant: the same walk, but a handler that returns normally
* has not answered it. Only a transfer gets past here — the caller's guard
* sees the channel and forwards it — so with nothing transferring the program
* stops. In a dev build this is where the break loop will go; until it exists,
* stopping is all there is, and it says which condition it was.
*
* [flan_signal] is not reused with a flag because the two differ in what they
* do when the walk ends, which is the whole of §1 against §2. */
/* The dev-build break loop, spec-conditions.md §2. A hook rather than a direct
* call because the loop lives in the *agent*, which is an optional package, and
* this file is the release runtime — it must not depend on something a program
* may not have imported. A program with no agent leaves this NULL and dies the
* way it always did.
*
* The hook may resume by writing a restart into the transfer channel, which is
* the same channel an invoke-restart writes and reaches the same guard. So
* choosing a restart from the break loop and choosing one from a handler are
* the same act, lowered the same way. */
void (*flan_break_hook)(const uint8_t *name, int64_t namelen, void *condition,
void *xfer);
/* Must agree with Check.type_id, byte for byte, or a name typed at the break
* loop matches nothing. FNV-1a over the name, 32 bits. */
static uint32_t flan_name_id(const uint8_t *s, int64_t n) {
uint32_t h = 0x811c9dc5u;
for (int64_t i = 0; i < n; i++) {
h ^= (uint32_t)s[i];
h *= 0x01000193u;
}
return h;
}
/* What the break loop calls to resume: look a restart up by the name someone
* typed and aim the channel at it. 0 if no frame offers it, and then the loop
* says so rather than resuming into nothing. */
int32_t flan_break_resume(const uint8_t *name, int64_t namelen, void *xfer) {
void *r = flan_find_restart(flan_name_id(name, namelen));
if (r == NULL) return 0;
*(void **)xfer = r;
return 1;
}
void flan_error(uint32_t type_id, void *condition, void *xfer,
const uint8_t *name, int64_t namelen) {
flan_signal(type_id, condition, xfer);
if (*(void **)xfer != NULL) return;
/* Nothing handled it. In a dev build that is a place to stand, not the end
* of the program — which is the whole of §2 and the reason it is worth
* having. */
if (flan_break_hook != NULL) {
flan_break_hook(name, namelen, condition, xfer);
if (*(void **)xfer != NULL) return;
}
fflush(stdout);
fprintf(stderr, "unhandled %.*s\n", (int)namelen, (const char *)name);
rt_die();
}
/* Nothing on the restart stack offers the name. It is reported where the
* invoke was, because that is the only place that knows what was asked for;
* there is nowhere to resume, so there is nothing else to do. */
_Noreturn void flan_restart_fail(const uint8_t *loc, int64_t loclen,
const uint8_t *name, int64_t namelen) {
fflush(stdout);
fprintf(stderr, "%.*s: no restart named %.*s is active\n",
(int)loclen, (const char *)loc, (int)namelen, (const char *)name);
rt_die();
}
/* The frame the name found does not take these arguments — spec-conditions.md
* §3's run-time check. It has to be at run time: a restart is resolved on a
* dynamic stack, so the invoke site cannot see what it will find, and the
* frame cannot see who will find it. What each end knows is its own parameter
* list, so the message is both of them side by side. */
_Noreturn void flan_restart_args_fail(const uint8_t *loc, int64_t loclen,
const uint8_t *name, int64_t namelen,
const uint8_t *want, int64_t wantlen,
const uint8_t *got, int64_t gotlen) {
fflush(stdout);
fprintf(stderr, "%.*s: restart %.*s takes %.*s, given %.*s\n",
(int)loclen, (const char *)loc, (int)namelen, (const char *)name,
(int)wantlen, (const char *)want, (int)gotlen, (const char *)got);
rt_die();
}
/* A clause with parameters was reached by a transfer that filled none of them
* in. No [invoke-restart] can do that — it writes the arguments before it aims
* the channel — so this is the other way a transfer starts: the break loop,
* which today takes a restart by position and has no way to supply a value.
* Refused at the clause rather than run on a buffer nobody wrote. */
_Noreturn void flan_restart_unarmed(const uint8_t *loc, int64_t loclen,
const uint8_t *name, int64_t namelen,
const uint8_t *want, int64_t wantlen) {
fflush(stdout);
fprintf(stderr,
"%.*s: restart %.*s takes %.*s, and whatever took it supplied no "
"arguments — a restart with parameters cannot be taken from the "
"break loop yet\n",
(int)loclen, (const char *)loc, (int)namelen, (const char *)name,
(int)wantlen, (const char *)want);
rt_die();
}
/* Something a defer called invoked a restart. A defer is the cleanup a
* transfer runs on its way out (§5), so a transfer starting there would leave
* this frame's defers half run with two targets and no way to choose. The
* lexical case is refused by the checker; this is the one that reaches a
* function through a call, where nothing static could see it. */
_Noreturn void flan_transfer_fail(const uint8_t *loc, int64_t loclen) {
fflush(stdout);
fprintf(stderr,
"%.*s: a defer invoked a restart, which a defer may not do — it is "
"the cleanup a transfer runs on its way out\n",
(int)loclen, (const char *)loc);
rt_die();
}
_Noreturn void flan_slice_fail(const uint8_t *loc, int64_t loclen,
int64_t lo, int64_t hi, int64_t len) {
fflush(stdout);
fprintf(stderr, "%.*s: slice [%lld %lld) is out of bounds for length %lld\n",
(int)loclen, (const char *)loc, (long long)lo, (long long)hi,
(long long)len);
rt_die();
}
/* ── An index out of range is a condition ──────────────────────────────
*
* The two functions above are still here and still die; what changed is that
* they are no longer the *first* thing a bad index reaches. A bounds failure
* now signals BoundsError with `error`, exactly as a failed allocation signals
* StorageExhausted, and only reaches the message above if nothing answered.
*
* Why it had to change. `flan dev` runs the compiler inside the program, in
* one process. exit(134) therefore took the session with it, and the session
* is the thing the project is built around never having to restart. The
* ordinary route into it is not exotic: a grid indexed from a mouse position
* is out of bounds the first time the pointer leaves the window.
*
* **No restart is established here**, and that is a decision rather than an
* omission. flan_alloc_* and the file guards offer `retry` because their
* attempt is repeatable — a handler frees something, or supplies another
* path, and the same operation then succeeds. Nothing a handler can do makes
* index 51 valid for a length-50 array, so there is no attempt to re-run and
* nothing for a site restart to resume into. `use-value` for the index is the
* near miss: it would cost every indexing operation an alloca and a restart
* frame, and what it buys is a *different element*, silently, which is the
* class of answer this codebase refuses everywhere else. The restarts that
* matter are the ones the program already established — a frame loop's
* `continue` — and those are on the restart stack and reachable from the break
* loop without anything being pushed here.
*
* With no break hook — a release build, or any program that did not import the
* agent — flan_break_hook is NULL, nothing transfers, and this falls through
* to the same message and the same status it always had. That is still the
* right answer: there is nowhere to stand.
*
* The condition is three int64s on this frame and it must agree field for
* field with the prelude's (defstruct BoundsError [low i64 high i64 length
* i64]) — the same hand-kept agreement flan_name_id has with Check.type_id,
* and for the same reason: a struct is a layout and a type is a number, and
* neither side can see the other. `low` and `high` are the same index for an
* `at`, and the two ends of the range for a `slice`, so one condition type
* covers both and a handler writes one clause rather than two. */
typedef struct { int64_t low, high, length; } flan_bounds_cond;
static const uint8_t flan_bounds_name[] = "BoundsError";
#define FLAN_BOUNDS_NAMELEN 11
/* Returns nonzero if something transferred, in which case the caller returns
* and its caller's guard carries the transfer out. */
static int flan_bounds_signal(void *xfer, int64_t low, int64_t high,
int64_t len) {
flan_bounds_cond c;
uint32_t id = flan_name_id(flan_bounds_name, FLAN_BOUNDS_NAMELEN);
c.low = low;
c.high = high;
c.length = len;
flan_signal(id, &c, xfer);
if (*(void **)xfer != NULL) return 1;
if (flan_break_hook != NULL) {
flan_break_hook(flan_bounds_name, FLAN_BOUNDS_NAMELEN, &c, xfer);
if (*(void **)xfer != NULL) return 1;
}
return 0;
}
void flan_bounds_error(const uint8_t *loc, int64_t loclen, int64_t idx,
int64_t len, void *xfer) {
if (flan_bounds_signal(xfer, idx, idx, len)) return;
flan_bounds_fail(loc, loclen, idx, len);
}
void flan_slice_error(const uint8_t *loc, int64_t loclen, int64_t lo,
int64_t hi, int64_t len, void *xfer) {
if (flan_bounds_signal(xfer, lo, hi, len)) return;
flan_slice_fail(loc, loclen, lo, hi, len);
}
/* ── (slice-from-ptr p n), which has its own refusal ───────────────────
*
* It used to borrow flan_slice_error, and what came out named a range and a
* length the caller never wrote: "slice [0 -2) is out of bounds for length 0".
* The arithmetic behind that was defensible — the condition violated is
* 0 <= n, which is a reversed range spelled the other way — but the sentence
* was about a container, and there is no container here.
*
* This is the one form in the language where the compiler cannot check the
* thing that matters. Everywhere else the length is the compiler's: an array
* has one, a slice carries one, a Vec stores one. Here the caller is the only
* thing that knows how many elements live behind that pointer, and writing n
* *is* the promise. So this refusal is where that promise has to be spelled
* out, because it is the only context the reader has.
*
* What is checked is the one half that can be: that the promise is not absurd.
* A count of elements is not negative. The message says what is not checked
* too, so that a caller does not read a trap here as proof that the pointer
* was looked at.
*
* It signals BoundsError like the other two, with the same three int64s, so a
* handler writes one clause and not three. The triple is (0, n, 0): the
* violated condition written as a range, which is what those fields can carry.
* Deliberately not (0, n, n) — that reads as a range in bounds, and a handler
* testing high <= length would wave the failure through. */
_Noreturn void flan_slice_promise_fail(const uint8_t *loc, int64_t loclen,
int64_t n) {
fflush(stdout);
fprintf(stderr,
"%.*s: slice-from-ptr was promised %lld elements behind the pointer, "
"and a count of elements is never negative\n",
(int)loclen, (const char *)loc, (long long)n);
fprintf(stderr,
" the caller promises the pointer addresses n elements and nothing "
"else can know it, so the sign of n is the whole of what this check "
"can see\n");
rt_die();
}
void flan_slice_promise_error(const uint8_t *loc, int64_t loclen, int64_t n,
void *xfer) {
if (flan_bounds_signal(xfer, 0, n, 0)) return;
flan_slice_promise_fail(loc, loclen, n);
}
/* ── Arithmetic with no answer is a condition ──────────────────
*
* Three situations, and until now none of them had a defined behaviour.
* A divide or remainder by zero was a raw SIGFPE: the process died with no
* message, no location, and nothing to handle. (/ INT64_MIN -1) is the one
* division that overflows — its true quotient is one past the top of the
* type -- and `idiv` makes that a SIGFPE too, where LLVM calls it undefined.
* And a float to integer cast whose value does not fit produces x86's fixed
* "integer indefinite" under one backend and whatever the optimiser feels
* like under the other.
*
* They now signal ArithError, and the argument is the one made for
* BoundsError above with one addition that is specific to these: a SIGFPE
* cannot be caught and resumed, so the only way to get a message naming the
* file and the line at all is a test *before* the instruction. The emitted
* branch is therefore not the price of making this a condition — it is the
* price of it having any defined behaviour at all — and once it is being
* paid, signalling rather than dying costs nothing further.
*
* **No restart is established here**, which is BoundsError's decision rather
* than StorageExhausted's, and here it is forced rather than chosen. A
* restart frame is allocated by the restart-case that offers it, on its own
* stack, and a transfer carries that frame's address — see the restart stack
* at the top of this file. Nothing in C can push one on a program's behalf,
* so a `use-value` at the failing division would have to be an alloca and a
* push/pop emitted at every division in every checked build. That is the same
* cost refused for indexing, buying a silently different answer, and division
* is the weaker case of the two: an `at` at least has an element to hand
* back. What answers this is the restart the program already established.
*
* The condition is three fields on this frame and must agree field for field
* with the prelude's (defstruct ArithError [op i32 lhs i64 rhs i64]) — the
* same hand-kept agreement flan_bounds_cond has with BoundsError. `op` is one
* of the codes below; `lhs` and `rhs` are the two operands for a division and
* the destination type's representable range for a cast, which is the
* violated condition written as a range, exactly as flan_slice_promise_error
* writes one into BoundsError's fields. */
enum {
FLAN_ARITH_DIV_ZERO = 0,
FLAN_ARITH_REM_ZERO = 1,
FLAN_ARITH_DIV_OVERFLOW = 2,
FLAN_ARITH_REM_OVERFLOW = 3,
FLAN_ARITH_CAST_RANGE = 4
};
typedef struct { int32_t op; int64_t lhs, rhs; } flan_arith_cond;
static const uint8_t flan_arith_name[] = "ArithError";
#define FLAN_ARITH_NAMELEN 10
/* The sentence each code gets when nothing answered. It is separate from the
* struct because the condition deliberately carries no rendered message:
* formatting is the unhandled path's job, and this is the unhandled path. */
static void flan_arith_fail(const uint8_t *loc, int64_t loclen, int32_t op,
int64_t lhs, int64_t rhs) {
fflush(stdout);
switch (op) {
case FLAN_ARITH_DIV_ZERO:
fprintf(stderr, "%.*s: divide by zero: (/ %lld 0)\n", (int)loclen,
(const char *)loc, (long long)lhs);
break;
case FLAN_ARITH_REM_ZERO:
fprintf(stderr, "%.*s: remainder by zero: (%% %lld 0)\n", (int)loclen,
(const char *)loc, (long long)lhs);
break;
/* Worth its own sentence rather than sharing the word "overflow", because
* the reader who hits it has probably never had to think about this case:
* it is the single pair of operands in the whole type for which a division
* overflows, and it overshoots by exactly one. */
case FLAN_ARITH_DIV_OVERFLOW:
case FLAN_ARITH_REM_OVERFLOW:
fprintf(stderr,
"%.*s: (%s %lld %lld) overflows: the quotient is one past the "
"largest value the type holds, and this is the only pair of "
"operands for which that is true\n",
(int)loclen, (const char *)loc,
op == FLAN_ARITH_DIV_OVERFLOW ? "/" : "%", (long long)lhs,
(long long)rhs);
break;
default:
fprintf(stderr,
"%.*s: this value does not fit the integer type it is cast to, "
"which holds [%lld %lld]\n",
(int)loclen, (const char *)loc, (long long)lhs, (long long)rhs);
break;
}
rt_die();
}
void flan_arith_error(const uint8_t *loc, int64_t loclen, int32_t op,
int64_t lhs, int64_t rhs, void *xfer) {
flan_arith_cond c;
uint32_t id = flan_name_id(flan_arith_name, FLAN_ARITH_NAMELEN);
c.op = op;
c.lhs = lhs;
c.rhs = rhs;
flan_signal(id, &c, xfer);
if (*(void **)xfer != NULL) return;
if (flan_break_hook != NULL) {
flan_break_hook(flan_arith_name, FLAN_ARITH_NAMELEN, &c, xfer);
if (*(void **)xfer != NULL) return;
}
flan_arith_fail(loc, loclen, op, lhs, rhs);
}
/* ── Allocators, spec-memory.md ────────────────────────────────────────
*
* One type-erased procedure plus an opaque data pointer, which is Odin's
* shape (base/runtime/core.odin, Allocator_Proc), and every operation takes
* size and align as parameters because the only place the concrete type is
* known is the call site.
*
* A Flan `Allocator` value is a *pointer* to one of these, not a copy of it.
* That is forced by two things in the spec and is not a convenience: the
* capability set has to be readable at run time from wherever a container
* landed, and `free-all` bumps an epoch that every container made from the
* allocator has to observe. A copied-by-value allocator would give each copy
* its own epoch and the dev trap would never fire.
*
* Nothing here returns a struct by value, per the file header.
*/
enum {
FLAN_ALLOC_ALLOC = 0,
FLAN_ALLOC_RESIZE = 1,
FLAN_ALLOC_FREE = 2,
FLAN_ALLOC_FREE_ALL = 3
};
/* The capability set. Odin reads its own back through the procedure
* (Query_Features returning an Allocator_Mode_Set); a field is the same
* information without the round trip, and `can-free` is the one that is
* load-bearing — spec-memory.md refuses a drop-carrying container against an
* allocator that lacks it. */
enum {
FLAN_CAN_ALLOC = 1u << 0,
FLAN_CAN_RESIZE = 1u << 1,
FLAN_CAN_FREE = 1u << 2,
FLAN_CAN_FREE_ALL = 1u << 3
};
typedef struct flan_allocator flan_allocator;
/* Returns NULL on failure and never reports failure any other way. The
* condition, the restart and the message are all the compiler's job; this
* layer says yes or no. */
typedef void *(*flan_alloc_proc)(flan_allocator *a, int32_t mode, void *p,
int64_t old_size, int64_t size, int64_t align);
struct flan_allocator {
flan_alloc_proc proc;
void *data;
uint32_t caps;
/* Bumped on every free-all. A container records it and traps if it moved:
* spec-memory.md, "Dev builds detect a released region". Separate from the
* per-Vec generation word, which answers a different question. */
uint64_t epoch;
/* Dev accounting for the general-purpose tier: "did you forget to free" is
* an allocator-tier question and this is the allocator's answer. */
int64_t live_blocks;
int64_t live_bytes;
/* A cap on live bytes, or 0 for none. It is here because
* spec-memory.md's retry restart is only answerable by a handler that can
* make the *same* request succeed, and for a fixed backing buffer the only
* such handler is one that raises the ceiling: releasing the region a
* container lives in invalidates the container, which is what the epoch
* check exists to catch. So "grow the arena and then invoke retry", which
* the spec names as the handler that works, needs a ceiling to raise. It
* doubles as the knob a test exhausts an allocator with on purpose. */
int64_t budget;
};
/* ── Byte counts that cannot wrap ──────────────────────────────────────
*
* Every size this file computes is a signed 64-bit count of bytes, and every
* one of them is a product or a sum of numbers a Flan program chose: a
* capacity from (vec-reserve!), an element size from the checker. Signed
* overflow is undefined, and the defined-in-practice outcome is worse than
* the undefined one — a product that wraps to a small positive allocates a
* block that fits while the container records the unwrapped capacity, and the
* next push memcpys past the end of it. Nothing traps, nothing is reported,
* and a sanitizer sees a write inside a block it was told to expect.
*
* So the arithmetic goes through these two, which answer "did it fit" the way
* every allocating entry point in this file does. A count that does not fit
* is *not* a new condition: the request is one no allocator could satisfy, so
* it reports as StorageExhausted along the path an out-of-memory takes, and
* the caller's [flan_fail_bytes] carries FLAN_BYTES_UNREPRESENTABLE — the
* largest number the field can hold, which is honest in the only way it can
* be, since the true size has no representation to report. */
#define FLAN_BYTES_UNREPRESENTABLE INT64_MAX
static int flan_mul_bytes(int64_t a, int64_t b, int64_t *out) {
if (a < 0 || b < 0) return 0;
return !__builtin_mul_overflow(a, b, out);
}
static int flan_add_bytes(int64_t a, int64_t b, int64_t *out) {
if (a < 0 || b < 0) return 0;
return !__builtin_add_overflow(a, b, out);
}
/* Would this request put the allocator over its budget?
*
* The sum is checked for the same reason the products are: a size that makes
* [live_bytes + size] wrap negative would compare below any ceiling and pass,
* which is the one answer this function must never give. A request that
* cannot even be added to what is already live is over every budget there is. */
static int flan_over_budget(flan_allocator *a, int64_t size) {
int64_t total;
if (a->budget <= 0) return 0;
if (!flan_add_bytes(a->live_bytes, size, &total)) return 1;
return total > a->budget;
}
/* ── The allocation registry's two halves, and why they are split ──────
*
* Recording *what type* a block was made for happens where the type is known,
* which is the compiler: a dev build emits a note after every allocating call.
* Nothing in this file has to learn a type name and no signature here grows
* one. See flan_dev.c, which holds the table.
*
* Recording that a block *died* happens here, and needs no type at all — it is
* an address, or a range of them. So this half is unconditional and calls into
* flan_dev.c, which is linked into every build and begins each of these with a
* load of a flag that only a dev build ever sets. A release build pays a load
* and a not-taken branch per free, which is not nothing, and docs/BUILT.md says so.
*/
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen);
void flan_dev_reg_dead(void *base);
void flan_dev_reg_dead_range(void *base, int64_t bytes);
/* -- The heap allocator: malloc, realloc, free. ---------------------- */
static void *flan_heap_proc(flan_allocator *a, int32_t mode, void *p,
int64_t old_size, int64_t size, int64_t align) {
switch (mode) {
case FLAN_ALLOC_ALLOC: {
void *q = NULL;
size_t al, sz;
if (size <= 0) return NULL;
if (flan_over_budget(a, size)) return NULL;
al = (size_t)(align < (int64_t)sizeof(void *) ? (int64_t)sizeof(void *) : align);
sz = (size_t)size;
/* aligned_alloc requires a size that is a multiple of the alignment. */
if (sz % al) sz += al - (sz % al);
q = aligned_alloc(al, sz);
if (q) { a->live_blocks++; a->live_bytes += size; }
return q;
}
case FLAN_ALLOC_RESIZE: {
/* aligned_alloc has no realloc, so growth is a new block and a copy. The
* caller passes old_size for exactly this reason, and it is the one
* number a wrong answer here would read off the end of. */
void *q;
if (flan_over_budget(a, size - old_size)) return NULL;
q = flan_heap_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align);
if (!q) return NULL;
if (p && old_size > 0)
memcpy(q, p, (size_t)(old_size < size ? old_size : size));
/* The block moved, so the old address stops meaning what it meant. The
new one is named again by the note the compiler emits after the call
that got here — which is also why a resize needs no note of its own. */
if (p) {
flan_dev_reg_dead(p);
free(p);
a->live_blocks--;
a->live_bytes -= old_size;
}
return q;
}
case FLAN_ALLOC_FREE:
if (p) {
flan_dev_reg_dead(p);
free(p);
a->live_blocks--;
a->live_bytes -= old_size;
}
return NULL;
case FLAN_ALLOC_FREE_ALL:
default:
return NULL;
}
}
static flan_allocator flan_heap = {
flan_heap_proc, NULL,
FLAN_CAN_ALLOC | FLAN_CAN_RESIZE | FLAN_CAN_FREE,
0, 0, 0, 0
};
/* -- Telling memcheck an arena reset happened. -----------------------
*
* One valgrind client request, vendored rather than included. The macro in
* <valgrind/memcheck.h> is two dozen lines of inline asm and two integer
* constants; what an #include buys is those lines, and what it costs is a
* dependency this project has already refused twice over — it shells out to
* clang rather than linking libLLVM, and plan.org rejected libclang.
*
* The decisive argument is not taste, it is measurement: the machine that runs
* `dune build --root . @valgrind` has /usr/bin/valgrind and no
* /usr/include/valgrind. valgrind-devel is a separate package almost nobody
* installs. A guarded #include would therefore compile to nothing on the one
* box where the sweep runs, and the control in test_valgrind.ml that proves
* this works would go quiet with no diagnostic. There is also nowhere to put
* an -I: this file is cat'd into an OCaml string literal (lib/dune,
* runtime_src.ml) and handed to clang in a scratch directory, so the include
* path a build system would supply does not exist here.
*
* The sequence is four rotates of a register whose value they leave unchanged,
* followed by `xchg %rbx,%rbx`. Outside valgrind that is five no-op
* instructions; under it the JIT recognises the preamble and reads the request
* block out of %rax. Nothing is linked, nothing is probed, and a binary built
* this way runs identically with no valgrind on the machine at all.
*
* 0x4d43 is 'M','C' — memcheck's tool base, VG_USERREQ_TOOL_BASE('M','C') —
* and +1 is MAKE_MEM_UNDEFINED, +0 being NOACCESS and +2 DEFINED. Being wrong
* about either number is a silent no-op rather than an error, which is exactly
* why test_valgrind.ml asserts the effect instead of trusting the constant.
*
* The asm is amd64-only and the guard is load-bearing rather than defensive:
* this runtime is also compiled for wasm32-wasi and for emscripten, where the
* block would not assemble. Everywhere but x86-64 the request is a cast to
* void, and memcheck does not run there anyway. */
#if defined(__x86_64__) && !defined(__wasm__)
#define FLAN_VG_PREAMBLE \
"rolq $3, %%rdi ; rolq $13, %%rdi\n\t" \
"rolq $61, %%rdi ; rolq $51, %%rdi\n\t"
#define FLAN_VG_REQUEST(dflt, req, a1, a2, a3, a4, a5) \
__extension__({ \
volatile unsigned long long int _vg_args[6]; \
volatile unsigned long long int _vg_result; \
_vg_args[0] = (unsigned long long int)(req); \
_vg_args[1] = (unsigned long long int)(a1); \
_vg_args[2] = (unsigned long long int)(a2); \
_vg_args[3] = (unsigned long long int)(a3); \
_vg_args[4] = (unsigned long long int)(a4); \
_vg_args[5] = (unsigned long long int)(a5); \
__asm__ volatile(FLAN_VG_PREAMBLE \
/* %rdx = client_request ( %rax ) */ \
"xchgq %%rbx,%%rbx" \
: "=d"(_vg_result) \
: "a"(&_vg_args[0]), "0"(dflt) \
: "cc", "memory"); \
_vg_result; \
})
#define FLAN_VG_MAKE_MEM_UNDEFINED(p, n) \
((void)FLAN_VG_REQUEST(0, 0x4d430000u + 1, (p), (n), 0, 0, 0))
#else
#define FLAN_VG_MAKE_MEM_UNDEFINED(p, n) ((void)(p), (void)(n))
#endif
/* -- The arena: one fixed backing buffer and a bump offset. ----------
*
* `free-all` is retain-capacity: offset = 0, the pages stay. That is an
* announced amendment to spec-memory.md's operation table (see docs/BUILT.md) and
* it is what Odin's arena_free_all already does in effect. Handing the pages
* back is `arena-destroy`, a separate operation, because a frame arena reset
* every frame must not return memory only to ask for it again.
*
* The epoch is bumped either way: the pages are the same but every container
* made before the reset is invalid, which is the whole point of the trap. */
typedef struct flan_arena {
uint8_t *base;
int64_t cap;
int64_t offset;
int64_t peak;
} flan_arena;
static int64_t flan_align_up(int64_t x, int64_t a) {
if (a <= 1) return x;
return (x + a - 1) / a * a;
}
static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
int64_t old_size, int64_t size, int64_t align) {
flan_arena *ar = (flan_arena *)a->data;
switch (mode) {
case FLAN_ALLOC_ALLOC: {
int64_t start, end;
if (size <= 0) return NULL;
if (flan_over_budget(a, size)) return NULL;
if (align < 1) align = 1;
start = flan_align_up(ar->offset, align);
end = start + size;
if (end > ar->cap || end < start) return NULL; /* exhausted, or overflow */
ar->offset = end;
if (end > ar->peak) ar->peak = end;
a->live_blocks++;
a->live_bytes += size;
return ar->base + start;
}
case FLAN_ALLOC_RESIZE: {
void *q;
/* Growing the most recent block in place is the one case worth special
* casing: a Vec that is the only thing pushing into a frame arena grows
* without copying, which is the common shape. */
if (p && (uint8_t *)p + old_size == ar->base + ar->offset) {
int64_t end = (int64_t)((uint8_t *)p - ar->base) + size;
if (end > ar->cap || end < 0) return NULL;
ar->offset = end;
if (end > ar->peak) ar->peak = end;
a->live_bytes += size - old_size;
return p;
}
q = flan_arena_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align);
if (!q) return NULL;
if (p && old_size > 0)
memcpy(q, p, (size_t)(old_size < size ? old_size : size));
return q; /* the old block is not reclaimable */
}
case FLAN_ALLOC_FREE:
return NULL; /* refused by the capability set above */
case FLAN_ALLOC_FREE_ALL:
/* Two tools told the same fact, and they are not interchangeable. The
registry is the answer for a person at an editor: it makes the *names*
agree that everything in the region died, so a later read through a
pointer into it is answerable rather than silent.
The client request is the answer for memcheck, and it closes the hole
test_valgrind.ml used to only measure. The pages stay mapped and the
bytes stay readable — free-all is retain-capacity and an arena is one
malloc — so nothing about the *addresses* changes and memcheck would
otherwise never learn the storage died. Marking the region undefined
resets its definedness bits, and round two reading a byte it never
wrote now reports instead of quietly printing round one's value.
The whole capacity rather than [0, offset): everything past the offset
is equally reusable and equally stale, and two calls would only be
cheaper if the second could be skipped. */
flan_dev_reg_dead_range(ar->base, ar->cap);
FLAN_VG_MAKE_MEM_UNDEFINED(ar->base, ar->cap);
ar->offset = 0;
a->live_blocks = 0;
a->live_bytes = 0;
return NULL;
default:
return NULL;
}
}
/* -- The context, spec-memory.md's context/allocator and context/temp ----
*
* A dynamic variable with save and restore, not an extra parameter on every
* signature. The spec calls it part of the calling convention; taking that
* literally would touch every function signature, the FFI shim, the dev
* trampolines and the reload ABI, for the same observable behaviour. The
* literal reading is deferred and docs/BUILT.md says so.
*
* There are no threads in Flan, so a plain global is the whole of it. */
static flan_allocator *flan_ctx_alloc = &flan_heap;
static flan_allocator *flan_ctx_tmp = NULL;
flan_allocator *flan_arena_new(int64_t cap);
flan_allocator *flan_context_allocator(void) { return flan_ctx_alloc; }
/* The default temp arena, made on first use. 1 MiB: big enough that the
* per-frame tier does not fail on a toy program, small enough that a program
* which never touches it has not paid for a heap. */
#define FLAN_TEMP_DEFAULT (1 << 20)
flan_allocator *flan_context_temp(void) {
if (!flan_ctx_tmp) flan_ctx_tmp = flan_arena_new(FLAN_TEMP_DEFAULT);
return flan_ctx_tmp;
}
/* Returns the previous one, which is what with-allocator restores — on the
* normal path and on the transfer path both. */
flan_allocator *flan_context_set(flan_allocator *a) {
flan_allocator *prev = flan_ctx_alloc;
if (a) flan_ctx_alloc = a;
return prev;
}
void flan_context_restore(flan_allocator *a) {
if (a) flan_ctx_alloc = a;
}
flan_allocator *flan_arena_new(int64_t cap) {
flan_allocator *a;
flan_arena *ar;
if (cap <= 0) cap = FLAN_TEMP_DEFAULT;
a = (flan_allocator *)calloc(1, sizeof *a);
ar = (flan_arena *)calloc(1, sizeof *ar);
if (!a || !ar) { free(a); free(ar); return NULL; }
ar->base = (uint8_t *)malloc((size_t)cap);
if (!ar->base) { free(a); free(ar); return NULL; }
ar->cap = cap;
a->proc = flan_arena_proc;
a->data = ar;
/* No FLAN_CAN_FREE: an arena cannot release one block, which is Odin's
* answer too (allocators.odin returns Mode_Not_Implemented for .Free). */
a->caps = FLAN_CAN_ALLOC | FLAN_CAN_RESIZE | FLAN_CAN_FREE_ALL;
return a;
}
void flan_arena_destroy(flan_allocator *a) {
flan_arena *ar;
if (!a || a->proc != flan_arena_proc) return;
ar = (flan_arena *)a->data;
if (a == flan_ctx_alloc) flan_ctx_alloc = &flan_heap;
if (a == flan_ctx_tmp) flan_ctx_tmp = NULL;
a->epoch++;
flan_dev_reg_dead_range(ar->base, ar->cap);
free(ar->base);
free(ar);
free(a);
}
flan_allocator *flan_heap_allocator(void) { return &flan_heap; }
int8_t flan_alloc_can_free(flan_allocator *a) {
return (int8_t)(a && (a->caps & FLAN_CAN_FREE) ? 1 : 0);
}
int8_t flan_alloc_can_free_all(flan_allocator *a) {
return (int8_t)(a && (a->caps & FLAN_CAN_FREE_ALL) ? 1 : 0);
}
int64_t flan_alloc_epoch(flan_allocator *a) {
return a ? (int64_t)a->epoch : 0;
}
int64_t flan_alloc_live_blocks(flan_allocator *a) {
return a ? a->live_blocks : 0;
}
int64_t flan_alloc_budget(flan_allocator *a) { return a ? a->budget : 0; }
void flan_alloc_set_budget(flan_allocator *a, int64_t n) {
if (a) a->budget = n < 0 ? 0 : n;
}
_Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen);
_Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen);
/* free-all on an allocator that does not offer it is a trap, not a silent
* no-op: "I released the region" and "I leaked the region" must not be the
* same program text. */
void flan_alloc_free_all(flan_allocator *a, const uint8_t *loc, int64_t loclen) {
/* A null allocator is a zeroed [defvar] nobody assigned yet. Silently doing
* nothing would make "I released the region" and "I never made one" the same
* program text, which is the thing this trap exists to prevent. */
if (!a) flan_null_alloc_fail(loc, loclen);
if (!(a->caps & FLAN_CAN_FREE_ALL)) flan_free_all_fail(loc, loclen);
a->proc(a, FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0);
a->epoch++;
}
_Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen) {
fflush(stdout);
fprintf(stderr,
"%.*s: this allocator is null — a zeroed Allocator was never given "
"one\n",
(int)loclen, (const char *)loc);
rt_die();
}
_Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) {
fflush(stdout);
fprintf(stderr,
"%.*s: this allocator does not offer free-all — it has no region to "
"release, and releasing nothing is not the same as releasing "
"everything\n",
(int)loclen, (const char *)loc);
rt_die();
}
/* ── The region requirement, spec-memory.md's arena rule ───────────────
*
* A container whose elements themselves own storage — a `(Vec Value)` where a
* `Value` may hold a `(Vec Value)` — may allocate only from an allocator that
* cannot release one block. The reason is the one the checker's refusal used
* to give and is worth restating where the branch actually is: this runtime is
* type-erased, so `flan_vec_free` memcpys and releases slots bytewise and has
* no way to reach inside a slot. Against the heap that is a leak of everything
* the elements own. Against a region it is not a question at all, because no
* individual slot is ever released: `free-all` takes the whole arena, inner
* blocks included, and there is nothing left for a bytewise release to get
* wrong.
*
* So the capability set is what decides it, and `can-free` is the bit: an
* allocator that can free one block is one on which the leak is expressible,
* and an allocator that cannot is one on which it is not. The question is
* asked of the capability rather than of "is this an arena" because a fixed
* backing buffer someone writes later is the same answer for the same reason.
*
* ONE BRANCH PER CONTAINER, not per element. spec-memory.md fixes that and it
* is a performance decision before it is a safety one: the alternative is
* letting such a container into the general tier and having something walk it
* at release, which is the registry of destructors the frame tier's reset
* exists to not have.
*
* It is a run-time branch and not a compile-time refusal because there is
* nothing static to refuse against. `with-allocator` rebinds a dynamic
* variable, so which tier a `(vec-new)` meets is not knowable where it is
* written, and `context/allocator` is a value read at run time. The checker
* decides *whether to ask* — that part is a property of the element type and
* is settled at compile time — and this decides the answer.
*
* Nothing the compiler emits calls this one directly. The three container
* wrappers below it do, and they are what the emitted code names, because a
* container answers for the allocator it recorded — or, having recorded none,
* for the one it is about to adopt. Asking through the container is also what
* keeps the allocator expression at a construction site from being named
* twice; see [Check.region_check]. */
_Noreturn void flan_region_only_fail(const uint8_t *loc, int64_t loclen);
void flan_alloc_region_only(flan_allocator *a, const uint8_t *loc,
int64_t loclen) {
if (!a) flan_null_alloc_fail(loc, loclen);
if (a->caps & FLAN_CAN_FREE) flan_region_only_fail(loc, loclen);
}
_Noreturn void flan_region_only_fail(const uint8_t *loc, int64_t loclen) {
fflush(stdout);
fprintf(stderr,
"%.*s: this container's elements own storage, and this allocator can "
"free one block — so a free here would release the slots and leak "
"everything inside them, and nothing type-erased can walk them. "
"Build it against a region allocator, whose free-all takes the "
"inner blocks too: (with-allocator context/temp ...) or an "
"(arena-new n)\n",
(int)loclen, (const char *)loc);
rt_die();
}
/* ── (Vec T), spec-memory.md ────────────────────────────────────────────
*
* One type-erased runtime over (size, align), which is Odin's arrangement
* (base/runtime/dynamic_array_internal.odin): the monomorphised wrapper is the
* only place the concrete type is known, so it is the only place that can
* produce the numbers, and it passes them in. There are no generics here and
* none are needed.
*
* Header, and it is six words rather than the spec's four:
*
* ptr len cap allocator the release layout spec-memory.md fixes
* gen bumped on every reallocation — the stale-slice
* word spec-memory.md asks for. It has no reader
* and cannot have one as things stand, which is
* the part "not yet" used to hide: a slice is
* ptr+len, so it carries neither the Vec it came
* from nor the generation it was taken at, and
* the check has nothing to compare. Giving it a
* reader is a third word on every slice in the
* language, not a change to this file. Nothing
* here or anywhere else reads it; do not write
* code that trusts it. See docs/BUILT.md.
* epoch the allocator's epoch when this Vec last
* touched it. Any operation on a container whose
* recorded epoch has moved traps.
*
* The two dev words are present in every build, not only a dev one, and that
* is not laziness: a redefinition module is built by llc and ld against a host
* that was built separately, and nothing makes the two agree on a struct size.
* A layout that changes with a build flag is a layout that can disagree across
* that boundary silently. Dropping them in release is deferred and docs/BUILT.md
* says what it is blocked on.
*
* Every entry point returns int8_t 1/0 for "did it fit", and never reports
* failure any other way: the condition, the restart and the message are the
* compiler's job (see Check's alloc_guard). */
typedef struct flan_vec {
void *ptr;
int64_t len;
int64_t cap;
flan_allocator *alloc;
int64_t gen;
int64_t epoch;
} flan_vec;
/* The request that did not fit, for the condition the compiler builds at the
* failing site. A pair of globals rather than out-parameters because the
* condition is a value struct on the signalling frame's stack with fixed
* numeric fields and no rendered message — spec-memory.md is explicit that
* this is the one path that must not allocate, and reading two words is the
* cheapest way to carry the numbers out. */
static int64_t flan_fail_bytes = 0;
static int64_t flan_fail_align = 0;
static int64_t flan_fail_id = 0;
int64_t flan_alloc_fail_bytes(void) { return flan_fail_bytes; }
int64_t flan_alloc_fail_align(void) { return flan_fail_align; }
int64_t flan_alloc_fail_id(void) { return flan_fail_id; }
/* The allocator's identity, for the condition's :allocator field. The pointer
* is the identity — the same thing the epoch hangs off. */
int64_t flan_alloc_id(flan_allocator *a) { return (int64_t)(intptr_t)a; }
_Noreturn void flan_vec_stale_fail(const uint8_t *loc, int64_t loclen,
int64_t was, int64_t now) {
fflush(stdout);
fprintf(stderr,
"%.*s: this container's allocator was released — it was made at "
"epoch %lld and the allocator is at %lld now\n",
(int)loclen, (const char *)loc, (long long)was, (long long)now);
rt_die();
}
_Noreturn void flan_vec_bounds_fail(const uint8_t *loc, int64_t loclen,
int64_t i, int64_t len) {
fflush(stdout);
fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n",
(int)loclen, (const char *)loc, (long long)i, (long long)len);
rt_die();
}
/* spec-memory.md, "Dev builds detect a released region". This is the check
* that makes the epoch word worth carrying, and it runs on every operation,
* not only in a dev build — see the header on why the words are unconditional.
* A Vec that never allocated has no allocator and nothing to check. */
static void flan_vec_check(flan_vec *v, const uint8_t *loc, int64_t loclen) {
if (v->alloc) {
int64_t now = (int64_t)v->alloc->epoch;
if (now != v->epoch) flan_vec_stale_fail(loc, loclen, v->epoch, now);
}
}
/* A zeroed Vec — a struct field nobody assigned, or a (defvar xs (Vec i32)) —
* has a null allocator, and the first operation that needs storage adopts the
* context allocator. That is Odin's behaviour, and the alternative was to
* refuse a Vec-typed struct field outright until step 5. Shipping the null
* silently was not an option: it is a null deref on the first push. */
static flan_allocator *flan_vec_adopt(flan_vec *v) {
if (!v->alloc) {
v->alloc = flan_context_allocator();
v->epoch = (int64_t)v->alloc->epoch;
}
return v->alloc;
}
/* The region requirement asked of a container rather than of a named
* allocator, which is the form every *growth* site needs. A Vec that was built
* by (vec-new) has its allocator already and answers from it; one that was
* zeroed — a data type case's field left out of a literal, a (defvar xs (Vec
* Value)) that a global starts as — has none yet, and the allocator it is
* about to adopt is the context. Asking the context in that case is not a
* guess: [flan_vec_adopt], three lines up, is the code that will take it, and
* it runs on this same call.
*
* Without this the construction guard would have a hole exactly the width of
* ZII: every zeroed container skips (vec-new) entirely and reaches storage
* through its first push. */
void flan_alloc_region_only(flan_allocator *a, const uint8_t *loc,
int64_t loclen);
void flan_vec_region_only(flan_vec *v, const uint8_t *loc, int64_t loclen) {
flan_alloc_region_only(v->alloc ? v->alloc : flan_context_allocator(),
loc, loclen);
}
static int8_t flan_vec_grow(flan_vec *v, int64_t want, int64_t size,
int64_t align) {
flan_allocator *a = flan_vec_adopt(v);
int64_t cap = v->cap, bytes;
void *p;
if (want <= cap) return 1;
/* Doubling, from four. Four rather than one because the three reallocations
* a growing-from-one Vec does before it holds anything are pure cost, and
* doubling because it is what makes n pushes amortised O(n). */
if (cap < 4) cap = 4;
while (cap < want) {
if (cap > (int64_t)1 << 40) { cap = want; break; }
cap *= 2;
}
/* [want] arrives from (vec-reserve!) unfiltered, and the doubling loop above
* hands a want past 1<<40 straight through as the capacity, so this product
* is the one the program picked times the one the checker did. See the note
* on flan_mul_bytes. */
if (!flan_mul_bytes(cap, size, &bytes)) {
flan_fail_bytes = FLAN_BYTES_UNREPRESENTABLE;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
return 0;
}
flan_fail_bytes = bytes;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
if (v->ptr)
p = a->proc(a, FLAN_ALLOC_RESIZE, v->ptr, v->cap * size, bytes, align);
else
p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, align);
if (!p) return 0;
v->ptr = p;
v->cap = cap;
/* Any slice taken before this points at storage that may have moved. The
* word is bumped here and read nowhere yet; see docs/BUILT.md. */
v->gen++;
return 1;
}
int8_t flan_vec_init(flan_vec *v, flan_allocator *a, int64_t cap, int64_t size,
int64_t align, const uint8_t *loc, int64_t loclen) {
/* [a] is NULL only when no allocator was named at the site and the context
* is being used. An allocator *named* at the site and null is a zeroed
* Allocator nobody assigned, and substituting the heap for it would be the
* same "released the region / never made one" collapse flan_alloc_free_all
* traps for — except silent, and discovered as a leak. The checker cannot
* see it, because a null is a run-time value.
*
* The no-allocator-named case never arrives here as NULL: the checker passes
* flan_context_allocator(), which always answers one. */
if (!a) flan_null_alloc_fail(loc, loclen);
v->ptr = NULL;
v->len = 0;
v->cap = 0;
v->gen = 0;
v->alloc = a;
v->epoch = (int64_t)v->alloc->epoch;
if (cap <= 0) return 1;
return flan_vec_grow(v, cap, size, align);
}
int8_t flan_vec_reserve(flan_vec *v, int64_t n, int64_t size, int64_t align,
const uint8_t *loc, int64_t loclen) {
flan_vec_check(v, loc, loclen);
if (n <= v->cap) return 1;
return flan_vec_grow(v, n, size, align);
}
int8_t flan_vec_push(flan_vec *v, const void *elem, int64_t size,
int64_t align, const uint8_t *loc, int64_t loclen) {
flan_vec_check(v, loc, loclen);
if (v->len + 1 > v->cap && !flan_vec_grow(v, v->len + 1, size, align))
return 0;
memcpy((uint8_t *)v->ptr + v->len * size, elem, (size_t)size);
v->len++;
return 1;
}
int64_t flan_vec_len(flan_vec *v, const uint8_t *loc, int64_t loclen) {
flan_vec_check(v, loc, loclen);
return v->len;
}
/* [xfer] is this operation's end of the transfer channel, so that an index out
* of range signals BoundsError instead of ending the process — see the note
* above flan_bounds_error. (at v i) and (at arr i) are the same form in the
* source and shipping one of them signalling and the other exiting would read
* as a bug, so the two are plumbed together. The channel is the last
* parameter, as it is on every Flan signature; Emit appends it and guards the
* call, and a transfer therefore leaves through the caller's pad with NULL
* here never dereferenced. */
void *flan_vec_at(flan_vec *v, int32_t i, int64_t size, const uint8_t *loc,
int64_t loclen, void *xfer) {
flan_vec_check(v, loc, loclen);
/* The same unsigned comparison the fixed-array bounds check uses: a negative
* index sign-extends to a huge unsigned and is caught by the one test. */
if ((uint64_t)(int64_t)i >= (uint64_t)v->len) {
if (flan_bounds_signal(xfer, (int64_t)i, (int64_t)i, v->len)) return NULL;
flan_vec_bounds_fail(loc, loclen, (int64_t)i, v->len);
}
return (uint8_t *)v->ptr + (int64_t)i * size;
}
/* [hi] of -1 means "to the end": (as-slice v) has no static length to write. */
void flan_vec_as_slice(flan_vec *v, void *out, int32_t lo, int32_t hi,
int64_t size, const uint8_t *loc, int64_t loclen,
void *xfer) {
struct { void *p; int64_t n; } s;
int64_t l = lo, h = (hi < 0) ? v->len : hi;
flan_vec_check(v, loc, loclen);
if (l < 0 || h > v->len || l > h) {
/* Both ends, because both are what went wrong — the fixed-array slice
* check reports the same pair. [out] is left untouched on the transfer
* path; the caller's guard branches before it reads the slice. */
if (flan_bounds_signal(xfer, l, h, v->len)) return;
flan_vec_bounds_fail(loc, loclen, l, v->len);
}
s.p = (uint8_t *)v->ptr + l * size;
s.n = h - l;
memcpy(out, &s, sizeof s);
}
/* spec-memory.md's first release point. The Vec is left zeroed rather than
* dangling — the checker has already made using it afterwards a compile error,
* and zeroing costs nothing and makes a bug that slips past the checker a null
* deref rather than a use-after-free. An allocator without can-free keeps the
* block: releasing it is free-all's job, and pretending otherwise here is the
* silent-no-op this file refuses elsewhere. */
void flan_vec_free(flan_vec *v, int64_t size, int64_t align,
const uint8_t *loc, int64_t loclen) {
flan_vec_check(v, loc, loclen);
if (v->ptr && v->alloc && (v->alloc->caps & FLAN_CAN_FREE))
v->alloc->proc(v->alloc, FLAN_ALLOC_FREE, v->ptr, v->cap * size, 0, align);
(void)align;
v->ptr = NULL;
v->len = 0;
v->cap = 0;
v->alloc = NULL;
v->gen++;
v->epoch = 0;
}
int8_t flan_vec_clone(flan_vec *dst, flan_vec *src, flan_allocator *a,
int64_t size, int64_t align, const uint8_t *loc,
int64_t loclen) {
flan_vec_check(src, loc, loclen);
if (!flan_vec_init(dst, a, src->len, size, align, loc, loclen)) return 0;
if (src->len > 0) memcpy(dst->ptr, src->ptr, (size_t)(src->len * size));
dst->len = src->len;
return 1;
}
/* ── (Pool T) and (Handle T), spec-memory.md ─────────────────────────
*
* A handle is a reference to something that can die, which reports that it
* died rather than silently resolving to whatever reused its slot. That is
* the whole design, and every decision below follows from it.
*
* THE PACKING. A handle is one int64_t: the slot index in the low 32 bits and
* that slot's generation counter in the high 32. One word, so it copies,
* zeroes and compares like the integer it is, and owns nothing — the pool is
* the single owner. 32 bits of index because a Vec's index is an i32 here and
* widening indices is one change across every container, not a pool question.
*
* LIVE IS ODD. A slot's generation starts at 0 and is bumped on every
* allocation and on every release, so an odd generation means live and an
* even one means dead. Two things fall out of that and both are load-bearing:
* a zeroed handle is generation 0, which is even, so it resolves to nothing
* rather than to slot 0 — ZII gives a handle field the right meaning for
* free; and iteration can ask a slot whether it is live without a second
* array or a spare bit.
*
* WRAPPING RETIRES THE SLOT. 32 bits is 2^31 allocate/release pairs on one
* slot — every frame at 60fps for a year and a bit — but "rare" is not an
* answer when the failure is the silent wrong one this type exists to
* prevent. So a release from generation 0xFFFFFFFF bumps to 0 and does *not*
* put the slot back on the free list. The slot is retired: dead forever, its
* payload leaked, and no future handle can ever collide with an old one.
* Leaking is defined behaviour here (spec-memory.md, "Leaking is defined
* behaviour") and one slot is a bounded price for making the collision
* unrepresentable rather than unlikely.
*
* TWO FAILURES, KEPT APART. A stale handle answers "gone" — it is an answer,
* not an error. A pool whose allocator was released traps, through the same
* epoch check a Vec gets. They answer different questions and must not be
* conflated, exactly as the Vec's generation and epoch words must not be.
*
* GROWTH IS TRANSACTIONAL, and that is not tidiness. spec-memory.md's
* StorageExhausted restart re-attempts *the same call*, so a failed grow has
* to leave the pool byte for byte as it was — including a cap that still
* agrees with the real block sizes, since the next attempt passes cap as the
* allocator's old_size. Two blocks grow together, so a resize-in-place of the
* first followed by a failure on the second would leave cap describing
* neither. Allocate both, copy, then release the old pair: the only state
* mutated after the last thing that can fail.
*/
typedef struct flan_pool_slot {
uint32_t gen; /* odd: live. even: dead. 0: never allocated, or retired. */
int32_t next; /* free-list link, -1 for the end. Meaningless while live. */
} flan_pool_slot;
typedef struct flan_pool {
void *items; /* cap payloads, size bytes each */
flan_pool_slot *slots; /* cap slot headers, index-parallel with items */
int64_t len; /* slot high-water: 0..len have ever been handed out */
int64_t cap;
int64_t live; /* how many of those are live now */
int64_t free; /* head of the free list, -1 when empty */
flan_allocator *alloc;
int64_t epoch;
} flan_pool;
static int64_t flan_handle_pack(int64_t i, uint32_t gen) {
return (int64_t)(((uint64_t)gen << 32) | (uint64_t)(uint32_t)i);
}
static int64_t flan_handle_index(int64_t h) {
return (int64_t)(uint32_t)(uint64_t)h;
}
static uint32_t flan_handle_gen(int64_t h) {
return (uint32_t)((uint64_t)h >> 32);
}
/* The same epoch check a Vec gets, and for the same reason. A pool that never
* allocated has no allocator and nothing to check. */
static void flan_pool_check(flan_pool *p, const uint8_t *loc, int64_t loclen) {
if (p->alloc) {
int64_t now = (int64_t)p->alloc->epoch;
if (now != p->epoch) flan_vec_stale_fail(loc, loclen, p->epoch, now);
}
}
/* The same guard a Vec gets, at the same place and for the same reason — see
* the note above [flan_vec_region_only]. */
void flan_pool_region_only(flan_pool *p, const uint8_t *loc, int64_t loclen) {
flan_alloc_region_only(p->alloc ? p->alloc : flan_context_allocator(),
loc, loclen);
}
static flan_allocator *flan_pool_adopt(flan_pool *p) {
if (!p->alloc) {
p->alloc = flan_context_allocator();
p->epoch = (int64_t)p->alloc->epoch;
}
return p->alloc;
}
static int8_t flan_pool_grow(flan_pool *p, int64_t want, int64_t size,
int64_t align) {
flan_allocator *a = flan_pool_adopt(p);
int64_t cap = p->cap, sslot = (int64_t)sizeof(flan_pool_slot);
int64_t ibytes, sbytes, total;
void *ni, *ns;
if (want <= cap) return 1;
/* Doubling from four, exactly as the Vec grows. */
if (cap < 4) cap = 4;
while (cap < want) {
if (cap > (int64_t)1 << 40) { cap = want; break; }
cap *= 2;
}
/* Two products and their sum, all three checked: the pool asks for the items
* and the slots as separate blocks but reports them as one number, and a
* wrap in either half is the same memcpy past the end the Vec's is. */
if (!flan_mul_bytes(cap, size, &ibytes)
|| !flan_mul_bytes(cap, sslot, &sbytes)
|| !flan_add_bytes(ibytes, sbytes, &total)) {
flan_fail_bytes = FLAN_BYTES_UNREPRESENTABLE;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
return 0;
}
flan_fail_bytes = total;
flan_fail_align = align;
flan_fail_id = (int64_t)(intptr_t)a;
ni = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, ibytes, align);
if (!ni) return 0;
ns = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, sbytes, 8);
if (!ns) {
/* An allocator without can-free leaks the first block here. That is the
* defined outcome and not a new one: the request failed because the
* region is exhausted, and the region is about to be released whole or
* the ceiling raised and the call re-attempted. */
if (a->caps & FLAN_CAN_FREE)
a->proc(a, FLAN_ALLOC_FREE, ni, ibytes, 0, align);
return 0;
}
if (p->len > 0) {
memcpy(ni, p->items, (size_t)(p->len * size));
memcpy(ns, p->slots, (size_t)(p->len * sslot));
}
if (p->items && (a->caps & FLAN_CAN_FREE)) {
a->proc(a, FLAN_ALLOC_FREE, p->items, p->cap * size, 0, align);
a->proc(a, FLAN_ALLOC_FREE, p->slots, p->cap * sslot, 0, 8);
}
p->items = ni;
p->slots = ns;
p->cap = cap;
return 1;
}
int8_t flan_pool_init(flan_pool *p, flan_allocator *a, int64_t size,
int64_t align, const uint8_t *loc, int64_t loclen) {
(void)size; (void)align;
/* Null for the same reason and with the same answer flan_vec_init gives:
* the no-allocator-named case never arrives here as NULL. */
if (!a) flan_null_alloc_fail(loc, loclen);
p->items = NULL;
p->slots = NULL;
p->len = 0;
p->cap = 0;
p->live = 0;
p->free = -1;
p->alloc = a;
p->epoch = (int64_t)a->epoch;
return 1;
}
/* 1/0 for "did it fit", like every other allocating entry point. The handle
* goes out through [out] rather than being returned, so that the compiler's
* alloc_guard reads the answer and the handle separately. */
int8_t flan_pool_insert(flan_pool *p, const void *elem, int64_t *out,
int64_t size, int64_t align, const uint8_t *loc,
int64_t loclen) {
int64_t i;
flan_pool_check(p, loc, loclen);
if (p->free >= 0) {
i = p->free;
p->free = p->slots[i].next;
} else {
if (p->len + 1 > p->cap && !flan_pool_grow(p, p->len + 1, size, align))
return 0;
i = p->len++;
p->slots[i].gen = 0;
p->slots[i].next = -1;
}
p->slots[i].gen++; /* even -> odd: this slot is live */
p->live++;
memcpy((uint8_t *)p->items + i * size, elem, (size_t)size);
*out = flan_handle_pack(i, p->slots[i].gen);
return 1;
}
/* NULL when the handle names nothing, which the compiler turns into None. The
* index is bounded with the unsigned comparison flan_vec_at uses, because the
* low half of a handle can be any 32 bits at all. */
void *flan_pool_resolve(flan_pool *p, int64_t h, int64_t size,
const uint8_t *loc, int64_t loclen) {
int64_t i = flan_handle_index(h);
uint32_t g = flan_handle_gen(h);
flan_pool_check(p, loc, loclen);
if (!(g & 1u)) return NULL; /* a zeroed or dead handle */
if ((uint64_t)i >= (uint64_t)p->len) return NULL;
if (p->slots[i].gen != g) return NULL; /* the slot was reused */
return (uint8_t *)p->items + i * size;
}
/* 1 if this call released it, 0 if the handle was already gone. Releasing
* twice is therefore an answer rather than undefined behaviour — which is the
* generational scheme paying for itself a second time, since a pool is the
* one place a double free is *detectable* rather than merely refused. */
int8_t flan_pool_release(flan_pool *p, int64_t h, const uint8_t *loc,
int64_t loclen) {
int64_t i = flan_handle_index(h);
uint32_t g = flan_handle_gen(h), was;
flan_pool_check(p, loc, loclen);
if (!(g & 1u)) return 0;
if ((uint64_t)i >= (uint64_t)p->len) return 0;
if (p->slots[i].gen != g) return 0;
was = p->slots[i].gen;
p->slots[i].gen = was + 1; /* odd -> even: dead, and every old handle with it */
p->live--;
/* The wrap. See the header: the slot is retired rather than reissued. */
if (was != 0xFFFFFFFFu) {
p->slots[i].next = (int32_t)p->free;
p->free = i;
}
return 1;
}
int64_t flan_pool_len(flan_pool *p, const uint8_t *loc, int64_t loclen) {
flan_pool_check(p, loc, loclen);
return p->len;
}
int64_t flan_pool_live(flan_pool *p, const uint8_t *loc, int64_t loclen) {
flan_pool_check(p, loc, loclen);
return p->live;
}
/* The handle of slot [i], or 0 — the never-valid handle — if that slot is
* dead. This plus (len p) is the whole of enumeration, which is what
* migrate-instances needs and what a Vec behind an index cannot give: a Vec's
* indices shift under a removal and a pool's never do. Out of range traps
* rather than answering 0, because an index is an index here and 0..len are
* the valid ones. */
int64_t flan_pool_handle(flan_pool *p, int32_t i, const uint8_t *loc,
int64_t loclen) {
uint32_t g;
flan_pool_check(p, loc, loclen);
if ((uint64_t)(int64_t)i >= (uint64_t)p->len)
flan_vec_bounds_fail(loc, loclen, (int64_t)i, p->len);
g = p->slots[i].gen;
if (!(g & 1u)) return 0;
return flan_handle_pack((int64_t)i, g);
}
/* spec-memory.md's first release point, applied to the owner. Zeroed rather
* than left dangling, for the reason flan_vec_free zeroes. Every handle into
* it is stale afterwards and says so: len goes to 0, so the bound check
* answers "gone" for all of them. */
void flan_pool_free(flan_pool *p, int64_t size, int64_t align,
const uint8_t *loc, int64_t loclen) {
flan_pool_check(p, loc, loclen);
if (p->items && p->alloc && (p->alloc->caps & FLAN_CAN_FREE)) {
p->alloc->proc(p->alloc, FLAN_ALLOC_FREE, p->items, p->cap * size, 0, align);
p->alloc->proc(p->alloc, FLAN_ALLOC_FREE, p->slots,
p->cap * (int64_t)sizeof(flan_pool_slot), 0, 8);
}
p->items = NULL;
p->slots = NULL;
p->len = 0;
p->cap = 0;
p->live = 0;
p->free = -1;
p->alloc = NULL;
p->epoch = 0;
}
/* ── (Map K V), spec-memory.md ──────────────────────────────────────────
*
* Odin's map, followed deliberately: open-addressed Robin Hood hashing at a
* 75% load factor, cache-line cell packing, and pointer-width integers through
* the probe loop (base/runtime/dynamic_map_internal.odin, whose header states
* the same three). One type-erased runtime over (key size, value size) and a
* compiler-emitted hash and equality pair, exactly as the Vec runtime is one
* over (size, align).
*
* Why the shape matters, since the obvious question is whether this is another
* Python dict. Python's algorithm is fine. What makes it slow is that every
* key and every value is a separately allocated, reference-counted object, and
* hashing goes through __hash__ and __eq__ calls that cannot be inlined. Here
* a key is raw bytes inside the block and the hash and comparison are compiled
* concretely per key type. That is most of the gap before any cleverness.
*
* Robin Hood, in one paragraph. Every occupied slot has a probe distance: how
* far it sits from the slot its hash wanted. On insert, if the element already
* in a slot is closer to its desired slot than the element being placed, the
* two swap and the poorer one carries on down the run. Distances even out, the
* worst case collapses towards the average, and a lookup may stop the moment
* it is further from home than the occupant it is looking at — which is the
* early exit in flan_map_find and is why a miss costs about what a hit does.
*
* Cache-line cells, in one more. A flat [capacity]K array lets one key straddle
* two cache lines, so a probe that walks four slots can touch five lines. A
* Map_Cell packs as many Ks as fit in 64 bytes and pads the remainder, so no
* key ever straddles a line and a linear probe walks memory in the order the
* prefetcher expects. Keys, values and hashes are three separate blocks, so a
* probe — which reads hashes and only then one key — touches hash lines and
* nothing else until it has a candidate.
*
* Header, six words, the same as flan_vec's and for the same reason (a layout
* that changes with a build flag can disagree across the reload boundary):
*
* data one allocation: keys | values | hashes | scratch
* len live entries
* log2cap 0 until something is allocated; never 1 or 2 after
* allocator gen epoch as on a Vec, and checked the same way
*
* Odin stuffs log2cap into the low six bits of the data pointer because its
* Raw_Map must be three words. This header already carries an allocator, a
* generation and an epoch, so the bit-stuffing would buy nothing and cost a
* mask on every access — and, more usefully, not tagging means correctness
* never depends on the block being 64-byte aligned. It is requested as 64, and
* cell packing pays off when the request is honoured, but an arena whose base
* is not cache-aligned gives a slower map rather than a wrong one.
*
* Every entry point returns int8_t 1/0 for "did it fit", never reporting
* failure any other way — the condition, the restart and the message are the
* compiler's job (Check's alloc_guard). */
#define FLAN_MAP_CACHE_LINE 64
#define FLAN_MAP_LOAD_FACTOR 75
#define FLAN_MAP_MIN_LOG2 3 /* 8 slots */
/* The hash word. Zero means the slot is empty, which is what makes a
* zeroed hash block an empty map. There is still no tombstone now that
* removal exists: the only two states a slot has are empty and occupied, and
* flan_map_remove restores that by shifting the run back rather than by
* marking the hole. Odin marks it and repairs on the next insert, which is
* why its insert has a second loop and its every lookup tests for a
* tombstone; neither is here. What spec-memory.md still defers is the rest of
* that sentence — move-aware lookup and owned entries — so a removed value is
* copied out and nothing is dropped.
*
* The top bit is set on every stored hash so that a hasher answering 0 does
* not read as an empty slot. It is the highest bit, so the desired slot and
* the probe distance — which use only the low log2cap bits — are unchanged by
* it, and no hash needs rewriting when the capacity changes. */
typedef uint64_t flan_map_hash;
#define FLAN_MAP_OCCUPIED ((uint64_t)1 << 63)
/* The pair the compiler emits per key type. [size] is the key's size, passed
* so that the flat hasher and comparator below can serve every key whose
* equality is bytewise and need no per-type function at all.
*
* The trailing pointer is the transfer channel. Every Flan function's emitted
* signature ends with one (Emit's xfer_param), and a hash function emitted for
* a struct key is an ordinary Flan function — so the typedef spells it out
* rather than hoping nothing ever writes through it. Nothing does: neither a
* hasher nor a comparator can signal, because the only things either can call
* are the leaf C entry points below. It is passed as a real address, never
* NULL, so that a store through it would be a store and not a crash. */
typedef uint64_t (*flan_hash_fn)(const void *key, uint64_t seed, int64_t size,
void *xfer);
typedef int8_t (*flan_eq_fn)(const void *a, const void *b, int64_t size,
void *xfer);
typedef struct flan_map {
void *data;
int64_t len;
int64_t log2cap;
flan_allocator *alloc;
int64_t gen;
int64_t epoch;
} flan_map;
/* ── Hashing ──────────────────────────────────────────────────────────
*
* FNV-1a over the bytes, then a final avalanche. FNV alone leaves the low bits
* poorly mixed and the low bits are exactly what selects the slot, so the
* splitmix64 finaliser is not decoration: without it consecutive small integer
* keys collide in long runs. The seed is mixed in first so that two maps do not
* agree on the same pathological ordering. */
static uint64_t flan_mix64(uint64_t x) {
x ^= x >> 30;
x *= 0xbf58476d1ce4e5b9ULL;
x ^= x >> 27;
x *= 0x94d049bb133111ebULL;
x ^= x >> 31;
return x;
}
static uint64_t flan_hash_mem(const uint8_t *p, int64_t n, uint64_t seed) {
uint64_t h = 0xcbf29ce484222325ULL ^ seed;
int64_t i = 0;
/* Eight bytes at a time. Byte-at-a-time FNV is a serial chain of one
* multiply per byte, and the multiply's latency is the whole cost — it was
* a quarter of a lookup before this. The tail is the byte loop, which is
* the original and is what any size not a multiple of eight still gets. */
for (; i + 8 <= n; i += 8) {
uint64_t w;
memcpy(&w, p + i, 8);
h = (h ^ w) * 0x100000001b3ULL;
}
for (; i < n; i++) h = (h ^ (uint64_t)p[i]) * 0x100000001b3ULL;
return flan_mix64(h);
}
/* The key is [size] bytes and its equality is bytewise. Every integer, enum,
* bool, float and fixed array of those is served by this one pair, so the
* compiler emits a function only for a key type that needs one. */
/* Each of the four comes in two spellings, and the split is not decoration.
*
* flan_key_hash_flat(k, seed, size) called directly
* flan_hash_flat(k, seed, size, xfer) taken as a function pointer
*
* The pointer form has to match flan_hash_fn, whose last parameter exists
* because a hash function emitted for a struct key is an ordinary Flan
* function and every Flan function's signature ends with the transfer channel.
* The direct form has to match what such an emitted function *calls*, and an
* emitted function has no channel to hand on — it would be passing its own,
* which is not the same thing and not something a leaf hasher should see. So
* one is the implementation and the other is a thin wrapper, rather than one
* function called two ways with an argument that is a lie in one of them. */
uint64_t flan_key_hash_flat(const void *key, uint64_t seed, int64_t size) {
/* A key that is one machine word — which is every integer, every enum and
* every bool, so very nearly every key — is one load and one mix. This is
* where "the hash is compiled concretely per key type" stops being a
* description of the arrangement and starts being the reason it is quick:
* the general path is a loop over bytes with a multiply chain, and none of
* these takes it. */
switch (size) {
case 1: return flan_mix64((uint64_t)*(const uint8_t *)key + seed);
case 2: { uint16_t x; memcpy(&x, key, 2); return flan_mix64((uint64_t)x + seed); }
case 4: { uint32_t x; memcpy(&x, key, 4); return flan_mix64((uint64_t)x + seed); }
case 8: { uint64_t x; memcpy(&x, key, 8); return flan_mix64(x + seed); }
default: return flan_hash_mem((const uint8_t *)key, size, seed);
}
}
int8_t flan_key_eq_flat(const void *a, const void *b, int64_t size) {
/* Likewise, and for a sharper reason: memcmp on eight bytes is a *call* into
* libc's vectorised implementation, which was an eighth of a lookup. These
* four cases are a load and a compare. */
switch (size) {
case 1: return (int8_t)(*(const uint8_t *)a == *(const uint8_t *)b);
case 2: { uint16_t x, y; memcpy(&x, a, 2); memcpy(&y, b, 2); return (int8_t)(x == y); }
case 4: { uint32_t x, y; memcpy(&x, a, 4); memcpy(&y, b, 4); return (int8_t)(x == y); }
case 8: { uint64_t x, y; memcpy(&x, a, 8); memcpy(&y, b, 8); return (int8_t)(x == y); }
default: return (int8_t)(memcmp(a, b, (size_t)size) == 0);
}
}
/* Copying one entry's worth of bytes. Same reason again: memcpy of eight bytes
* became a call into libc's memmove, which is pure overhead for a size the
* switch resolves to a single load and store. */
static void flan_copy_small(void *dst, const void *src, int64_t n) {
switch (n) {
case 1: *(uint8_t *)dst = *(const uint8_t *)src; return;
case 2: memcpy(dst, src, 2); return;
case 4: memcpy(dst, src, 4); return;
case 8: memcpy(dst, src, 8); return;
case 16: memcpy(dst, src, 16); return;
default: memcpy(dst, src, (size_t)n); return;
}
}
uint64_t flan_hash_flat(const void *key, uint64_t seed, int64_t size,
void *xfer) {
(void)xfer;
return flan_key_hash_flat(key, seed, size);
}
int8_t flan_eq_flat(const void *a, const void *b, int64_t size, void *xfer) {
(void)xfer;
return flan_key_eq_flat(a, b, size);
}
/* A string is ptr+len and its bytes are elsewhere, so neither the flat hasher
* nor memcmp is correct for it: two equal strings at different addresses must
* hash the same. [size] is ignored; the shape is fixed. */
uint64_t flan_key_hash_str(const void *key, uint64_t seed, int64_t size) {
const flan_slice *s = (const flan_slice *)key;
(void)size;
return flan_hash_mem(s->ptr, s->len, seed);
}
int8_t flan_key_eq_str(const void *a, const void *b, int64_t size) {
const flan_slice *x = (const flan_slice *)a, *y = (const flan_slice *)b;
(void)size;
if (x->len != y->len) return 0;
if (x->len == 0) return 1;
return (int8_t)(memcmp(x->ptr, y->ptr, (size_t)x->len) == 0);
}
uint64_t flan_hash_str(const void *key, uint64_t seed, int64_t size,
void *xfer) {
(void)xfer;
return flan_key_hash_str(key, seed, size);
}
int8_t flan_eq_str(const void *a, const void *b, int64_t size, void *xfer) {
(void)xfer;
return flan_key_eq_str(a, b, size);
}
/* Combining, for a key type the compiler does emit a function for: a struct
* with padding (whose padding bytes are indeterminate and must not be hashed)
* or one with a string field (whose bytes are elsewhere). The emitted function
* hashes each field with the right pair and folds the results through here. */
uint64_t flan_hash_combine(uint64_t acc, uint64_t h) {
return flan_mix64(acc ^ (h + 0x9e3779b97f4a7c15ULL + (acc << 6) + (acc >> 2)));
}
/* ── Cell geometry ────────────────────────────────────────────────────
*
* Odin precomputes these into a Map_Cell_Info so the probe loop never divides.
* They are derived from the element size alone — alignment cannot matter,
* because a cell starts on a 64-byte boundary and no Flan type is aligned
* above that — so they are derived once on entry to each operation and kept in
* locals, which is the same trade with one less thing for the checker to pass
* and get wrong. */
/* 64/size for every size a cell can pack, as a table rather than a division.
*
* This is Odin's Map_Cell_Info by another route. Odin precomputes
* elements_per_cell and size_of_cell into a static per-type record because the
* probe loop must not divide; the same number is wanted here and the call site
* cannot hand it over, because the sizes reach this runtime as ordinary i64
* arguments rather than as a compile-time record. A 64-entry table is one load
* and needs nothing added to the calling convention.
*
* It is worth the lines: the geometry is recomputed on every lookup, three
* times over (keys, values, hashes), and three divisions there measured as a
* fifth of the whole operation. */
static const uint8_t flan_epc_table[64] = {
1, 64, 32, 21, 16, 12, 10, 9,
8, 7, 6, 5, 5, 4, 4, 4,
4, 3, 3, 3, 3, 3, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2,
2, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1,
};
static int64_t flan_cell_epc(int64_t size) {
if (size <= 0 || size >= FLAN_MAP_CACHE_LINE) return 1;
return (int64_t)flan_epc_table[size];
}
/* log2 of [epc] when it is a power of two, and -1 when it is not.
*
* epc is 64/size clamped to at least 1, so the only powers of two it can ever
* be are these seven. A switch over them is a handful of compares the branch
* predictor gets right every time; a loop looking for the bit measured *worse*
* than the division it was replacing, which is why this is written out. */
static int flan_log2_epc(int64_t epc) {
switch (epc) {
case 1: return 0;
case 2: return 1;
case 4: return 2;
case 8: return 3;
case 16: return 4;
case 32: return 5;
case 64: return 6;
default: return -1;
}
}
/* Rounding to a cache line is a mask, not a division: the generic
* flan_align_up divides, and this sits on the lookup path. */
static int64_t flan_map_round(int64_t x) {
return (x + (FLAN_MAP_CACHE_LINE - 1)) & ~(int64_t)(FLAN_MAP_CACHE_LINE - 1);
}
static int64_t flan_cell_size(int64_t size) {
return flan_map_round(flan_cell_epc(size) * size);
}
/* The bytes a [count]-element run of cells occupies, rounded to a cache line
* so the next block starts on one too.
*
* Division-free in the common case, and that matters more here than anywhere
* else in this file: flan_map_blocks calls this five times and is itself
* called once per lookup, so a division here is five divisions on the hot
* path — which measured as the difference between a 39ns lookup and a 12ns
* one, far outweighing the per-slot indexing the cell shift covers. */
static int64_t flan_run_bytes(int64_t epc, int64_t cell, int64_t shift,
int64_t count) {
int64_t cells, bytes;
if (count < 0 || count > FLAN_BYTES_UNREPRESENTABLE - epc)
return FLAN_BYTES_UNREPRESENTABLE;
cells = (shift >= 0) ? ((count + epc - 1) >> shift) : ((count + epc - 1) / epc);
/* One predictable branch on a path that is otherwise two shifts. The count
* is a capacity the program asked for, so the product is only bounded by
* what the checker knows the element to be — see flan_mul_bytes. */
if (!flan_mul_bytes(cells, cell, &bytes)) return FLAN_BYTES_UNREPRESENTABLE;
return bytes;
}
static int64_t flan_cells_bytes(int64_t size, int64_t count) {
int64_t epc = flan_cell_epc(size);
return flan_run_bytes(epc, flan_cell_size(size), flan_log2_epc(epc), count);
}
/* log2 of [epc] when it is a power of two, and -1 when it is not.
*
* This is the difference between a probe that costs a shift and one that costs
* two 64-bit integer divisions, and it is measurable: with the divisions in
* place a cache-resident i64 lookup took 39ns, and without them 12ns. Odin
* does not need it because its static path resolves elements_per_cell at
* compile time and its dynamic path special-cases 1 and 2; here the number is
* always a run-time value, so the compiler cannot turn the division into a
* shift and something has to.
*
* It is a power of two whenever the element size is, which is every primitive,
* every pointer, and a struct whose size rounds to one — so the fallback is
* the rare path rather than the common one. */
/* Slot [i] of a cell-packed run. [epc], [cell] and [shift] are hoisted by
* every caller that walks, which is why they are parameters rather than
* recomputed here — recomputing [shift] per slot would cost more than the
* division it removes. */
static uint8_t *flan_cell_at(uint8_t *base, int64_t size, int64_t epc,
int64_t cell, int64_t shift, int64_t i) {
if (epc == 1) return base + i * cell;
if (shift >= 0)
return base + (i >> shift) * cell + (i & (epc - 1)) * size;
return base + (i / epc) * cell + (i % epc) * size;
}
/* The four blocks. Keys, values and hashes get one run each; the scratch is
* two more keys and two more values, which is where the Robin Hood swap keeps
* the element in flight. Odin allocates the same two, for the same reason: the
* swap is a memcpy between type-erased buffers and there is no local of the
* right type to hold one. */
/* Saturating rather than refusing, because this is called for its number by
* the geometry as well as by the allocation, and the geometry has nowhere to
* put a failure. FLAN_BYTES_UNREPRESENTABLE out of here is the only value the
* allocation is allowed to see and not attempt: flan_map_alloc turns it into
* the StorageExhausted an impossible request deserves. */
static int64_t flan_map_block_size(int64_t ksize, int64_t vsize, int64_t cap) {
int64_t total = 0;
int64_t parts[5];
int i;
parts[0] = flan_cells_bytes(ksize, cap);
parts[1] = flan_cells_bytes(vsize, cap);
parts[2] = flan_cells_bytes((int64_t)sizeof(flan_map_hash), cap);
parts[3] = flan_cells_bytes(ksize, 2);
parts[4] = flan_cells_bytes(vsize, 2);
for (i = 0; i < 5; i++)
if (!flan_add_bytes(total, parts[i], &total))
return FLAN_BYTES_UNREPRESENTABLE;
return total;
}
/* Everything an operation needs to walk the block, computed once on entry.
*
* It used to be five calls to flan_cells_bytes, each recomputing the element
* geometry it had just been asked for, on a function called once per lookup.
* Gathering it into one struct is the single largest win in this file after
* the hash: the arithmetic is the same, it simply happens once. */
typedef struct flan_map_geom {
int64_t kepc, kcell, vepc, vcell;
int64_t kshift, vshift;
uint8_t *ks;
uint8_t *vs;
flan_map_hash *hs;
uint8_t *sk;
uint8_t *sv;
} flan_map_geom;
static void flan_map_geometry(const flan_map *m, int64_t ksize, int64_t vsize,
int64_t cap, flan_map_geom *g) {
uint8_t *p = (uint8_t *)m->data;
int64_t hsize = (int64_t)sizeof(flan_map_hash);
int64_t hepc = flan_cell_epc(hsize), hcell = flan_cell_size(hsize);
int hshift = flan_log2_epc(hepc);
g->kepc = flan_cell_epc(ksize); g->kcell = flan_cell_size(ksize);
g->vepc = flan_cell_epc(vsize); g->vcell = flan_cell_size(vsize);
g->kshift = flan_log2_epc(g->kepc);
g->vshift = flan_log2_epc(g->vepc);
g->ks = p;
p += flan_run_bytes(g->kepc, g->kcell, g->kshift, cap);
g->vs = p;
p += flan_run_bytes(g->vepc, g->vcell, g->vshift, cap);
g->hs = (flan_map_hash *)p;
p += flan_run_bytes(hepc, hcell, hshift, cap);
g->sk = p;
p += flan_run_bytes(g->kepc, g->kcell, g->kshift, 2);
g->sv = p;
}
/* The same epoch check a Vec does, and it runs in every build for the same
* reason. A map that never allocated has no allocator and nothing to check. */
static void flan_map_check(flan_map *m, const uint8_t *loc, int64_t loclen) {
if (m->alloc) {
int64_t now = (int64_t)m->alloc->epoch;
if (now != m->epoch) flan_vec_stale_fail(loc, loclen, m->epoch, now);
}
}
/* The same guard a Vec gets, at the same place and for the same reason — see
* the note above [flan_vec_region_only]. Only the *value* half of a map can
* own anything: a key that owned storage would hash its header rather than
* what it points at, and [map_type] has always refused one. */
void flan_map_region_only(flan_map *m, const uint8_t *loc, int64_t loclen) {
flan_alloc_region_only(m->alloc ? m->alloc : flan_context_allocator(),
loc, loclen);
}
static flan_allocator *flan_map_adopt(flan_map *m) {
if (!m->alloc) {
m->alloc = flan_context_allocator();
m->epoch = (int64_t)m->alloc->epoch;
}
return m->alloc;
}
/* The seed, derived from the block address exactly as Odin derives it: two
* maps with the same keys then disagree about which slot is which, so an
* adversarial insertion order against one is not an insertion order against
* the other. It changes on every grow, which is why hashes are recomputed
* there rather than carried over. */
static uint64_t flan_map_seed(const flan_map *m) {
/* One multiply, not a full avalanche. This is recomputed on every lookup and
* all it has to do is decorrelate two maps from each other: whatever it
* returns is fed to the hasher, which mixes properly. A splitmix here was
* five dependent multiplies on the critical path of every probe, for
* mixing that happens again immediately afterwards.
*
* The block is 64-byte aligned when the allocator honours the request, so
* the low six bits carry nothing and are shifted out before multiplying. */
return (((uint64_t)(uintptr_t)m->data >> 6) * 0x9e3779b97f4a7c15ULL);
}
static int64_t flan_map_cap(const flan_map *m) {
return m->data ? ((int64_t)1 << m->log2cap) : 0;
}
/* 75% of capacity, as fixed-point integer arithmetic. Robin Hood wants a
* maximum load factor under 100% and 75% is where Odin sets it. */
static int64_t flan_map_threshold(const flan_map *m) {
return (flan_map_cap(m) * FLAN_MAP_LOAD_FACTOR) / 100;
}
/* How far this element is from the slot its hash wanted. Odin's identity:
* (slot - hash) & mask is the same number as (slot + cap - desired) & mask,
* with fewer operations, because desired is hash & mask. */
static int64_t flan_map_distance(uint64_t hash, int64_t slot, int64_t mask) {
return (int64_t)(((uint64_t)slot - hash) & (uint64_t)mask);
}
/* Place one element, already hashed, into a map known to have room. This is
* Odin's swap_loop and nothing else: with no tombstones there is no second
* loop, and the load factor guarantees an empty slot is reached. */
static void flan_map_place(flan_map *m, uint64_t h, const void *ikey,
const void *ival, int64_t ksize, int64_t vsize) {
flan_map_geom g;
int64_t cap = flan_map_cap(m), mask = cap - 1;
int64_t pos = (int64_t)(h & (uint64_t)mask), dist = 0;
uint8_t *k, *v, *tk, *tv;
flan_map_geometry(m, ksize, vsize, cap, &g);
/* The element in flight lives in scratch slot 0; slot 1 is the swap
* temporary. Both are inside the block, so nothing here touches the stack
* with a size only known at run time. */
k = flan_cell_at(g.sk, ksize, g.kepc, g.kcell, g.kshift, 0);
v = flan_cell_at(g.sv, vsize, g.vepc, g.vcell, g.vshift, 0);
tk = flan_cell_at(g.sk, ksize, g.kepc, g.kcell, g.kshift, 1);
tv = flan_cell_at(g.sv, vsize, g.vepc, g.vcell, g.vshift, 1);
flan_copy_small(k, ikey, ksize);
if (vsize > 0) flan_copy_small(v, ival, vsize);
for (;;) {
uint64_t eh = g.hs[pos];
if (eh == 0) {
flan_copy_small(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos),
k, ksize);
if (vsize > 0)
flan_copy_small(flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, pos),
v, vsize);
g.hs[pos] = h;
return;
}
/* The Robin Hood swap: the occupant is richer — closer to home — than the
* element in flight, so the poorer one takes the slot and the richer one
* carries on. This is what keeps the variance down. */
if (dist > flan_map_distance(eh, pos, mask)) {
uint8_t *kp = flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos);
uint8_t *vp = flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, pos);
uint64_t th;
flan_copy_small(tk, k, ksize);
flan_copy_small(k, kp, ksize);
flan_copy_small(kp, tk, ksize);
if (vsize > 0) {
flan_copy_small(tv, v, vsize);
flan_copy_small(v, vp, vsize);
flan_copy_small(vp, tv, vsize);
}
th = h; h = g.hs[pos]; g.hs[pos] = th;
dist = flan_map_distance(h, pos, mask);
}
pos = (pos + 1) & mask;
dist++;
}
}
/* The slot holding [key], or -1. The middle test is the Robin Hood early exit:
* this probe is further from home than the occupant is, and Robin Hood
* maintains that no element is ever further from home than one it passed, so
* the key cannot be further along. A miss therefore costs about what a hit
* does, which is the property the ordering buys. */
static int64_t flan_map_find_g(flan_map *m, const void *key, int64_t ksize,
int64_t vsize, flan_hash_fn hash, flan_eq_fn eq,
flan_map_geom *gp) {
flan_map_geom g;
int64_t cap, mask, pos, dist = 0;
uint64_t h;
void *xfer = NULL;
if (!m->data || m->len == 0) return -1;
cap = flan_map_cap(m);
mask = cap - 1;
flan_map_geometry(m, ksize, vsize, cap, &g);
if (gp) *gp = g;
h = hash(key, flan_map_seed(m), ksize, &xfer) | FLAN_MAP_OCCUPIED;
pos = (int64_t)(h & (uint64_t)mask);
for (;;) {
uint64_t eh = g.hs[pos];
if (eh == 0) return -1;
if (dist > flan_map_distance(eh, pos, mask)) return -1;
if (eh == h
&& eq(key, flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos),
ksize, &xfer))
return pos;
pos = (pos + 1) & mask;
dist++;
}
}
/* Allocate a block for 2^log2cap slots and zero the hashes. Only the hash run
* needs zeroing — a key or value slot is never read without its hash saying it
* is live — so the keys and values are left as the allocator returned them. */
static int8_t flan_map_alloc(flan_map *m, flan_allocator *a, int64_t log2cap,
int64_t ksize, int64_t vsize) {
int64_t cap = (int64_t)1 << log2cap;
int64_t bytes = flan_map_block_size(ksize, vsize, cap);
void *p;
flan_fail_bytes = bytes;
flan_fail_align = FLAN_MAP_CACHE_LINE;
flan_fail_id = (int64_t)(intptr_t)a;
/* A block whose size does not fit in the count is a request no allocator can
* answer, and asking anyway would hand a wrapped number to a proc that might
* take it. The failure is the allocator's own. */
if (bytes == FLAN_BYTES_UNREPRESENTABLE) return 0;
p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, FLAN_MAP_CACHE_LINE);
if (!p) return 0;
m->data = p;
m->log2cap = log2cap;
m->len = 0;
{
flan_map_geom g;
flan_map_geometry(m, ksize, vsize, cap, &g);
memset(g.hs, 0,
(size_t)flan_cells_bytes((int64_t)sizeof(flan_map_hash), cap));
}
return 1;
}
/* Double the capacity and reinsert. The seed moves with the block, so every
* hash is recomputed rather than carried over — which is what a fresh seed per
* block is for. The old block is released only after the last read of it. */
static int8_t flan_map_grow(flan_map *m, int64_t want, int64_t ksize,
int64_t vsize, flan_hash_fn hash) {
flan_allocator *a = flan_map_adopt(m);
flan_map fresh;
int64_t log2cap = FLAN_MAP_MIN_LOG2, old_cap = flan_map_cap(m);
flan_map_geom g;
int64_t i, moved;
void *xfer = NULL;
/* Smallest power of two whose 75% threshold still holds [want]. */
while ((((int64_t)1 << log2cap) * FLAN_MAP_LOAD_FACTOR) / 100 < want) {
if (log2cap >= 40) return 0;
log2cap++;
}
if (log2cap <= m->log2cap && m->data) return 1;
fresh.data = NULL; fresh.len = 0; fresh.log2cap = 0;
fresh.alloc = a; fresh.gen = 0; fresh.epoch = (int64_t)a->epoch;
if (!flan_map_alloc(&fresh, a, log2cap, ksize, vsize)) return 0;
if (m->data) {
flan_map_geometry(m, ksize, vsize, old_cap, &g);
moved = m->len;
for (i = 0; i < old_cap && moved > 0; i++) {
uint64_t h;
if (g.hs[i] == 0) continue;
h = hash(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i),
flan_map_seed(&fresh), ksize, &xfer) | FLAN_MAP_OCCUPIED;
flan_map_place(&fresh, h,
flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i),
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, i),
ksize, vsize);
fresh.len++;
moved--;
}
if (a->caps & FLAN_CAN_FREE)
a->proc(a, FLAN_ALLOC_FREE, m->data,
flan_map_block_size(ksize, vsize, old_cap), 0,
FLAN_MAP_CACHE_LINE);
}
m->data = fresh.data;
m->log2cap = fresh.log2cap;
m->len = fresh.len;
/* Every key and value moved, so any pointer into the old block is stale —
* the same word, bumped for the same reason, as a Vec's reallocation. */
m->gen++;
return 1;
}
int8_t flan_map_init(flan_map *m, flan_allocator *a, int64_t ksize,
int64_t vsize, const uint8_t *loc, int64_t loclen) {
if (!a) flan_null_alloc_fail(loc, loclen);
(void)ksize; (void)vsize;
m->data = NULL;
m->len = 0;
m->log2cap = 0;
m->gen = 0;
m->alloc = a;
m->epoch = (int64_t)a->epoch;
/* No block until something is put in it: an empty map that is never written
* costs nothing, which is what makes a (defvar m (Map string i32)) free. */
return 1;
}
/* The upsert. spec-memory.md: it either inserts or replaces, and returns Unit
* — there is no Result and no ignorable error code, because a put that put
* nothing and said nothing is the outcome the StorageExhausted rule exists to
* make impossible. */
int8_t flan_map_put(flan_map *m, const void *key, const void *val,
int64_t ksize, int64_t vsize, flan_hash_fn hash,
flan_eq_fn eq, const uint8_t *loc, int64_t loclen) {
int64_t at;
flan_map_geom g;
uint64_t h;
flan_map_check(m, loc, loclen);
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g);
if (at >= 0) {
/* Replace. The key already in the block compares equal to the one handed
* in, so it is left alone: overwriting it would be a no-op for every
* bytewise key and a question nobody has asked for the others. */
if (vsize > 0)
flan_copy_small(
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, at), val, vsize);
return 1;
}
if (!m->data || m->len + 1 > flan_map_threshold(m))
if (!flan_map_grow(m, m->len + 1, ksize, vsize, hash)) return 0;
{
void *xfer = NULL;
h = hash(key, flan_map_seed(m), ksize, &xfer) | FLAN_MAP_OCCUPIED;
}
flan_map_place(m, h, key, val, ksize, vsize);
m->len++;
return 1;
}
/* Lookup. The value is copied out into [out] — the first Map implementation
* admits copyable keys and values only, so get returns a copy — and the answer
* is 1/0 for found, which the compiler turns into Some/None. */
int8_t flan_map_get(flan_map *m, const void *key, void *out, int64_t ksize,
int64_t vsize, flan_hash_fn hash, flan_eq_fn eq,
const uint8_t *loc, int64_t loclen) {
int64_t at;
flan_map_geom g;
flan_map_check(m, loc, loclen);
/* The geometry the probe already built, rather than a second helping of the
* same arithmetic: it was a fifth of the operation, computed twice. */
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g);
if (at < 0) return 0;
if (vsize > 0)
flan_copy_small(
out, flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, at), vsize);
return 1;
}
int8_t flan_map_has(flan_map *m, const void *key, int64_t ksize, int64_t vsize,
flan_hash_fn hash, flan_eq_fn eq, const uint8_t *loc,
int64_t loclen) {
flan_map_check(m, loc, loclen);
return (int8_t)(flan_map_find_g(m, key, ksize, vsize, hash, eq, NULL) >= 0);
}
/* Removal, by backward shift, which is what keeps this file tombstone-free.
*
* Odin's own erase (base/runtime/dynamic_map_internal.odin, map_erase_dynamic)
* marks a tombstone and leaves the repair to the next insert, which is why its
* insert carries a second loop this file has never had. Read rather than
* recalled: the note in this file that said Odin deletes by backward shift was
* describing its *insert*. The trade is the usual one — erase is O(1) there
* and the shift is here, and every lookup there pays a tombstone test this one
* does not.
*
* The invariant Robin Hood lookups depend on is that no live element is ever
* separated from its home slot by an empty one: the probe stops at the first
* empty slot, so a hole left in the middle of a run would hide everything
* after it. So the hole walks forward: each following element that is not
* already home moves back one slot, and the walk stops at the first slot that
* is empty or whose occupant is already home — neither can be moved back, and
* neither can be hiding anything.
*
* It releases nothing. A key and a value live inside the one block the map
* allocated, so there is no per-entry allocation to hand back and nothing here
* asks the allocator for anything — which is what makes removal from a map
* backed by an arena, or by any allocator that refuses can-free, mean exactly
* what it means for a heap-backed one. The block is released only by free and
* by the grow that replaces it.
*
* [out] takes a copy of the value that was there, or is NULL when the caller
* does not want one. A cursor held across this is invalidated the way a put
* that grows invalidates one: the shift moves entries to lower slots, and an
* iteration resuming at a higher index would step over them. */
int8_t flan_map_remove(flan_map *m, const void *key, void *out, int64_t ksize,
int64_t vsize, flan_hash_fn hash, flan_eq_fn eq,
const uint8_t *loc, int64_t loclen) {
flan_map_geom g;
int64_t at, mask, pos;
flan_map_check(m, loc, loclen);
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g);
if (at < 0) return 0;
if (vsize > 0 && out)
flan_copy_small(
out, flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, at), vsize);
mask = flan_map_cap(m) - 1;
pos = at;
for (;;) {
int64_t next = (pos + 1) & mask;
uint64_t eh = g.hs[next];
if (eh == 0 || flan_map_distance(eh, next, mask) == 0) {
g.hs[pos] = 0;
break;
}
flan_copy_small(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos),
flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, next),
ksize);
if (vsize > 0)
flan_copy_small(
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, pos),
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, next), vsize);
g.hs[pos] = eh;
pos = next;
}
m->len--;
return 1;
}
int64_t flan_map_len(flan_map *m, const uint8_t *loc, int64_t loclen) {
flan_map_check(m, loc, loclen);
return m->len;
}
/* The cursor step, and the whole of iteration.
*
* Everything else in this file addresses *one* entry: get, put and has each
* hash a key and probe. Nothing walked the block, so a map's keys and its
* values could not be read out at all, and this is the one function that
* changes it.
*
* The cursor is a slot index the caller owns, and the contract is the one a
* slot index gives for free: it starts at 0, it is written back one past the
* entry just answered, and a 0 answer leaves it at [cap] so calling again is
* still 0. There is no iterator struct because there is nothing for one to
* hold — a map has no tombstones, so no state beyond the position is needed to
* know where to resume.
*
* Invalidated by anything that moves the block, exactly as a Vec's slice is:
* a put that grows rehashes into a new block and every index before it means a
* different entry. A remove is the same hazard without the reallocation — its
* backward shift moves entries to lower slots, and a cursor already past them
* steps over entries it has not answered. The epoch check below catches a
* released arena and nothing catches either of these, which is the same
* bargain [as-slice] already makes.
*
* The layout is the one the geometry describes and is worth restating because
* it is the thing most likely to be got wrong here: [data] is *one* allocation
* laid out keys | values | hashes | scratch, each run cell-packed, so a key is
* reached through [flan_cell_at] and never by [ks + i * ksize]. The hashes are
* the exception the clone loop already relies on — an 8-byte element packs 8
* to a 64-byte cell with nothing left over, so a flat index is the right
* index. Order is block order, which is the hash's order and not the
* insertion's; two maps holding the same entries may walk them differently. */
int8_t flan_map_next(flan_map *m, int64_t *cursor, void *kout, void *vout,
int64_t ksize, int64_t vsize,
const uint8_t *loc, int64_t loclen) {
flan_map_geom g;
int64_t cap, i;
flan_map_check(m, loc, loclen);
if (!m->data || m->len == 0) return 0;
cap = flan_map_cap(m);
i = *cursor;
if (i < 0) i = 0;
if (i >= cap) { *cursor = cap; return 0; }
flan_map_geometry(m, ksize, vsize, cap, &g);
for (; i < cap; i++) {
if (g.hs[i] == 0) continue;
memcpy(kout, flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i),
(size_t)ksize);
memcpy(vout, flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, i),
(size_t)vsize);
*cursor = i + 1;
return 1;
}
*cursor = cap;
return 0;
}
/* Room for [n] entries without reallocating, which means a block whose 75%
* threshold is at least n. */
int8_t flan_map_reserve(flan_map *m, int64_t n, int64_t ksize, int64_t vsize,
flan_hash_fn hash, const uint8_t *loc, int64_t loclen) {
flan_map_check(m, loc, loclen);
if (n <= 0) return 1;
if (m->data && n <= flan_map_threshold(m)) return 1;
return flan_map_grow(m, n, ksize, vsize, hash);
}
/* spec-memory.md's first release point, and the same rules the Vec's free
* follows: left zeroed rather than dangling, and an allocator without can-free
* keeps the block because releasing it is free-all's job. */
void flan_map_free(flan_map *m, int64_t ksize, int64_t vsize,
const uint8_t *loc, int64_t loclen) {
flan_map_check(m, loc, loclen);
if (m->data && m->alloc && (m->alloc->caps & FLAN_CAN_FREE))
m->alloc->proc(m->alloc, FLAN_ALLOC_FREE, m->data,
flan_map_block_size(ksize, vsize, flan_map_cap(m)), 0,
FLAN_MAP_CACHE_LINE);
m->data = NULL;
m->len = 0;
m->log2cap = 0;
m->alloc = NULL;
m->gen++;
m->epoch = 0;
}
/* A deep, independent copy. It reinserts rather than copying the block: the
* seed is derived from the block address, so a bytewise copy would be a map
* whose stored hashes disagree with its own seed and whose every lookup
* missed. Reinserting is also what makes the copy's layout independent of the
* original's insertion history. */
int8_t flan_map_clone(flan_map *dst, flan_map *src, flan_allocator *a,
int64_t ksize, int64_t vsize, flan_hash_fn hash,
const uint8_t *loc, int64_t loclen) {
flan_map_geom g;
int64_t cap, i, moved;
void *xfer = NULL;
flan_map_check(src, loc, loclen);
if (!flan_map_init(dst, a, ksize, vsize, loc, loclen)) return 0;
if (!src->data || src->len == 0) return 1;
if (!flan_map_grow(dst, src->len, ksize, vsize, hash)) return 0;
cap = flan_map_cap(src);
flan_map_geometry(src, ksize, vsize, cap, &g);
moved = src->len;
for (i = 0; i < cap && moved > 0; i++) {
uint64_t h;
if (g.hs[i] == 0) continue;
h = hash(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i),
flan_map_seed(dst), ksize, &xfer) | FLAN_MAP_OCCUPIED;
flan_map_place(dst, h, flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i),
flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, i),
ksize, vsize);
dst->len++;
moved--;
}
return 1;
}
/* ── Noting a container's storage ─────────────────────────────────────
*
* The type name comes from the compiler; the *extent* comes from here, because
* the header is the only thing that knows where the storage landed and how
* much of it there is. Three entry points rather than one because three
* headers are three layouts, and a pool is two blocks that are allocated and
* released together but are not adjacent.
*
* Each is called immediately after the operation that may have allocated —
* every one of them, not only the first — because storage moves. A note is an
* upsert keyed on the base address, so re-noting an unmoved block costs a
* probe and overwrites the entry with the same numbers.
*
* A container with no storage yet notes nothing: flan_dev_reg_note ignores a
* null base, so an empty Vec needs no branch on this side. */
void flan_dev_reg_note_vec(flan_vec *v, int64_t size, const char *type,
int64_t typelen) {
if (v) flan_dev_reg_note(v->ptr, v->cap * size, size, type, typelen);
}
void flan_dev_reg_note_pool(flan_pool *p, int64_t size, const char *type,
int64_t typelen) {
if (!p) return;
flan_dev_reg_note(p->items, p->cap * size, size, type, typelen);
/* The slot headers are the pool's own bookkeeping and not the element type,
so they are named for what they are. Recording them matters for the same
reason the items do: after a free-all their bytes are still readable and
an address landing in them must not come back as an element. */
flan_dev_reg_note(p->slots, p->cap * (int64_t)sizeof(flan_pool_slot),
(int64_t)sizeof(flan_pool_slot), "pool slots", 11);
}
void flan_dev_reg_note_map(flan_map *m, int64_t ksize, int64_t vsize,
const char *type, int64_t typelen) {
if (!m || !m->data) return;
/* One block holding the hashes, the keys and the values, so the element
size is meaningless here and is passed as 0: an address inside it is
"+n into" rather than "[i] of". */
flan_dev_reg_note(m->data,
flan_map_block_size(ksize, vsize, flan_map_cap(m)), 0,
type, typelen);
}
/* ── The filesystem, and the whole of what it adds to the host ABI ───
*
* plan.org names the filesystem as the #1 portability risk — "pack assets, one
* abstraction, never touch paths" — so the widening here is deliberately three
* calls and one reader, and the reason each exists is written down:
*
* flan_file_size(path, n, &out) how many bytes are there
* flan_file_read(path, n, buf, cap, &got) fill a buffer the caller owns
* flan_file_write(path, n, buf, len) write a whole file
* flan_file_fail_reason() which of the four reasons it was
*
* They are POSIX-shaped and know nothing about a Vec: no file handle crosses
* the boundary, no descriptor is held between calls, and every one takes a
* path and returns 1/0 the way every allocator entry point already does. The
* Vec-aware part is flan_slurp below, which is *runtime glue* on this side of
* the ABI rather than a fourth host call — so a second target implements three
* functions and inherits the rest.
*
* These do touch paths, which is the widening plan.org warned about and which
* decision 2 took knowingly. `embed` is the answer that does not: an asset
* baked in at compile time needs none of this and works identically on both
* targets. Reach for slurp when the bytes genuinely are not known until the
* program runs.
*
* The reason is a global rather than an out-parameter for the same reason
* flan_alloc_fail_bytes is: the condition the compiler builds at the failing
* site is a value struct with fixed numeric fields and no rendered message,
* and reading one word is the cheapest way to carry the number out. */
#include <errno.h>
#define FLAN_FILE_OK 0
#define FLAN_FILE_MISSING 1
#define FLAN_FILE_DENIED 2
#define FLAN_FILE_IO 3
/* Decision 2: writing is desktop-only and *signals* on web. Not a build-time
* refusal, because Flan has no conditional compilation and "isolate this to
* desktop" is therefore not expressible in source; and not a silent no-op,
* because that is how a save file disappears with nothing said. The program
* gets a condition and decides. This is the language having something Odin
* does not — Odin's core/os/file_js.odin stubs the whole API to .Unsupported
* so that importing core:os "panics cleanly". */
#define FLAN_FILE_UNSUPPORTED 4
static int64_t flan_file_fail = FLAN_FILE_OK;
int64_t flan_file_fail_reason(void) { return flan_file_fail; }
/* A Flan string is ptr+len and never NUL-terminated, so every entry point here
* makes a terminated copy on its own stack. PATH_MAX is not consulted: a path
* too long for this buffer is reported as missing rather than truncated and
* silently opened, which is the failure this exists to avoid. */
#define FLAN_PATH_MAX 4096
/* The same policy at the other boundary, for the generated FFI shim.
*
* flan_path_cstr refuses an embedded NUL because the file opened would not be
* the file named; a string handed to any other C function is no different —
* the callee reads to the first NUL, so what crosses is a prefix of the value
* the program passed, and every C API that takes a name, a title or a query
* would act on the wrong one. The shim cannot signal: a foreign call has no
* allocation site for the compiler to wrap and no transfer channel of its own,
* so this traps naming the declare-c that was called, the way an out-of-bounds
* index traps naming its site. See lib/shim.ml, which emits the call. */
_Noreturn void flan_shim_nul_fail(const char *site) {
fflush(stdout);
fprintf(stderr,
"%s: a string passed to C contains a NUL byte — C reads to the "
"first one, so the value this function would act on is a prefix of "
"the one passed. Remove the NUL before the call.\n",
site);
rt_die();
}
static int flan_path_cstr(const uint8_t *p, int64_t n, char *out) {
if (n < 0 || n >= FLAN_PATH_MAX) return 0;
if (n > 0) memcpy(out, p, (size_t)n);
out[n] = '\0';
/* An embedded NUL would make the C string shorter than the Flan one, so the
* file opened would not be the file named. Refuse rather than guess. */
if ((int64_t)strlen(out) != n) return 0;
return 1;
}
static int64_t flan_errno_reason(void) {
switch (errno) {
case ENOENT: case ENOTDIR: return FLAN_FILE_MISSING;
case EACCES: case EPERM: return FLAN_FILE_DENIED;
default: return FLAN_FILE_IO;
}
}
int8_t flan_file_size(const uint8_t *path, int64_t n, int64_t *out) {
char buf[FLAN_PATH_MAX];
FILE *f;
long end;
*out = 0;
if (!flan_path_cstr(path, n, buf)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
f = fopen(buf, "rb");
if (!f) { flan_file_fail = flan_errno_reason(); return 0; }
if (fseek(f, 0, SEEK_END) != 0 || (end = ftell(f)) < 0) {
fclose(f);
flan_file_fail = FLAN_FILE_IO;
return 0;
}
fclose(f);
*out = (int64_t)end;
flan_file_fail = FLAN_FILE_OK;
return 1;
}
/* Reads at most cap bytes and reports how many it got. The file may have
* changed size since flan_file_size looked, so the count is an output and not
* an assertion: a short read is a successful read of a shorter file, and a
* longer file is truncated to the buffer the caller already allocated. */
int8_t flan_file_read(const uint8_t *path, int64_t n, void *dst, int64_t cap,
int64_t *got) {
char buf[FLAN_PATH_MAX];
FILE *f;
size_t r;
*got = 0;
if (!flan_path_cstr(path, n, buf)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
f = fopen(buf, "rb");
if (!f) { flan_file_fail = flan_errno_reason(); return 0; }
r = cap > 0 ? fread(dst, 1, (size_t)cap, f) : 0;
if (ferror(f)) { fclose(f); flan_file_fail = FLAN_FILE_IO; return 0; }
fclose(f);
*got = (int64_t)r;
flan_file_fail = FLAN_FILE_OK;
return 1;
}
int8_t flan_file_write(const uint8_t *path, int64_t n, const void *src,
int64_t len) {
#if defined(__EMSCRIPTEN__)
/* The browser has no filesystem to write to that outlives the page, and
* MEMFS would be the silent no-op decision 2 rules out by name. So the
* answer is the condition, every time, with the path still in it so a
* handler can say which write was refused. */
(void)path; (void)n; (void)src; (void)len;
flan_file_fail = FLAN_FILE_UNSUPPORTED;
return 0;
#else
char buf[FLAN_PATH_MAX];
FILE *f;
size_t w;
if (!flan_path_cstr(path, n, buf)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
f = fopen(buf, "wb");
if (!f) { flan_file_fail = flan_errno_reason(); return 0; }
w = len > 0 ? fwrite(src, 1, (size_t)len, f) : 0;
if (w != (size_t)(len > 0 ? len : 0) || fclose(f) != 0) {
flan_file_fail = FLAN_FILE_IO;
return 0;
}
flan_file_fail = FLAN_FILE_OK;
return 1;
#endif
}
/* Runtime glue, not host ABI: the Vec-aware half of slurp, kept on this side
* of the boundary so the three calls above stay POSIX-shaped and a second
* target implements only them.
*
* It fills a Vec the *compiler* already initialised to the right capacity —
* which is what keeps spec-memory.md's rule intact: the allocation went
* through flan_vec_init under the compiler's alloc_guard, so a failure to
* allocate is StorageExhausted with retry, and a failure to read is FileError
* with retry and use-value. Two failures, two conditions, neither swallowing
* the other. */
int8_t flan_slurp_into(flan_vec *v, const uint8_t *path, int64_t n,
int64_t size, const uint8_t *loc, int64_t loclen) {
int64_t got = 0, room;
/* The same check every other operation on a container runs, and skipped here
* until now: the Vec was sized on this turn, but a handler between the
* sizing and the read can have released the region it lives in, and this is
* the one entry point that would have written into it anyway. */
flan_vec_check(v, loc, loclen);
/* A capacity is a count of elements and a read is a count of bytes. They
* were the same number while slurp answered only (Vec u8) — the checker
* still pins it to that — and the conflation was a byte count one element
* size away from being wrong. The product is the block flan_vec_init already
* allocated, so it is representable by construction; the guard is here
* because "by construction" is an argument and not a check. */
if (!flan_mul_bytes(v->cap, size, &room)) return 0;
if (!flan_file_read(path, n, v->ptr, room, &got)) return 0;
/* Whole elements only: a file that ends mid-element leaves the partial one
* out rather than publishing a length that covers bytes nobody wrote. */
v->len = size > 0 ? got / size : 0;
return 1;
}
/* ── Time, and the environment ─────────────────────────────────────────
*
* Three clock primitives and one environment lookup, added as a block at the
* end so that the two halves of this file — the milestone-2 ABI above and the
* host services below — stay separable. <time.h> is included here rather than
* at the top for the reason <errno.h> is: an include beside the only section
* that needs it says which section that is.
*
* The rule the whole file is written to applies hardest here: a primitive is
* the only thing implemented twice, so the seconds-valued faces of all three
* (monotonic-seconds, unix-seconds, sleep-seconds) are Flan in the prelude,
* over these. Odin draws the same line — core/time/time_linux.odin is exactly
* _now, _tick_now, _sleep and _yield over clock_gettime and nanosleep, and
* duration_seconds is derived arithmetic in core/time/time.odin. */
#include <time.h>
/* The two clocks are kept apart on purpose, because the mistake they invite is
* using one for the other's job.
*
* MONOTONIC never goes backwards and is not adjusted by NTP or by the user
* setting the clock, which is what makes it the one to *measure* with: a frame
* time taken across a daylight-saving change is still a frame time. It has no
* meaning as a date — its zero is arbitrary — so it can only ever be
* subtracted from another reading of itself.
*
* REALTIME is the date, and it is the one that jumps: it can move backwards,
* and a duration computed from two readings of it can be negative. It is here
* to answer "when", not "how long". */
/* The origin is the first read of this clock in the process, not boot, and
* that is a decision rather than an accident.
*
* The reason is the f64 face above it. CLOCK_MONOTONIC counts from boot, so on
* a machine up a hundred days the raw value is past 2^53 nanoseconds — beyond
* where an f64 holds consecutive integers — and (monotonic-seconds) would
* quietly lose sub-microsecond resolution depending on how long the *machine*
* had been running, which is the worst kind of bug to be handed. Latched to
* first read, the f64 stays integer-exact for a hundred days of *process*
* life, and nothing this language builds runs that long without a restart.
*
* It also matches what a game already expects: raylib's GetTime is seconds
* since InitWindow, not seconds since boot, and the two now mix without a
* caller having to notice one of them is a much larger number.
*
* A plain static and no atomics, because the language has no threads. If it
* ever gets them, the worst a race here can do is latch two origins a few
* nanoseconds apart, which costs a reading that is early by that much and
* cannot make the clock run backwards. */
static int64_t flan_mono_origin;
static int flan_mono_armed;
static int64_t flan_clock_ns(clockid_t which) {
struct timespec ts;
/* A failure here is not reachable with a constant clock id the platform
* has, and there is no channel to report it on that a caller could act on:
* the answer to "what time is it" cannot be a condition without every
* reading of it costing a handler search. A zeroed timespec is what a
* failure reads as, and for MONOTONIC that is the origin. */
if (clock_gettime(which, &ts) != 0) { ts.tv_sec = 0; ts.tv_nsec = 0; }
return (int64_t)ts.tv_sec * 1000000000 + (int64_t)ts.tv_nsec;
}
int64_t flan_monotonic_ns(void) {
int64_t now = flan_clock_ns(CLOCK_MONOTONIC);
if (!flan_mono_armed) { flan_mono_armed = 1; flan_mono_origin = now; }
return now - flan_mono_origin;
}
int64_t flan_unix_ns(void) { return flan_clock_ns(CLOCK_REALTIME); }
/* A negative or zero request returns at once rather than being refused: the
* caller that computed "sleep until the frame's deadline" and arrived late
* wants to carry on, not to be told it is late, and that is by far the most
* common way this is called.
*
* The EINTR loop is the reason this is C and not two Flan lines over a raw
* nanosleep: a signal — a profiler's timer, the dev loop's own — otherwise
* cuts the wait short and the caller's frame pacing wobbles for reasons
* nothing in the program explains. The remaining time comes back in the same
* timespec, so resuming is a second call with no arithmetic. Odin's _sleep in
* core/time/time_linux.odin loops on EINTR for the same reason.
*
* On emscripten this is still nanosleep, which there spins rather than yields:
* the sleep is the length asked for, and it burns a core and blocks the frame
* doing it. Correct, and not what a browser build should be reaching for — a
* web frame loop waits by returning to the browser, not by sleeping. */
void flan_sleep_ns(int64_t ns) {
struct timespec ts;
if (ns <= 0) return;
ts.tv_sec = (time_t)(ns / 1000000000);
ts.tv_nsec = (long)(ns % 1000000000);
while (nanosleep(&ts, &ts) != 0 && errno == EINTR) { }
}
/* getenv, with the absent case carried in the length rather than in the
* pointer, so that the Flan side never has to compare a pointer against null —
* a test the language does not offer, since a (Ptr T) only ever arrives from a
* declare and nothing in the type says it may be nothing. Absent is *len = -1
* and a pointer to a valid empty string; present is *len >= 0 and the
* environment's own bytes, which (slice-from-ptr) then views.
*
* The bytes are the process environment's and are not copied. They outlive the
* call — nothing in this language can call setenv or spawn a process, so there
* is no writer — and they are not the caller's to free. The prelude's `getenv`
* says so where a caller will read it.
*
* A name with an embedded NUL reads as absent rather than as the shorter name
* before it, which is flan_path_cstr's rule and for its reason: the name
* looked up must be the name written. */
const uint8_t *flan_getenv(const uint8_t *name, int64_t n, int64_t *len) {
static const char empty[1] = { 0 };
char buf[FLAN_PATH_MAX];
const char *v;
*len = -1;
if (!flan_path_cstr(name, n, buf)) return (const uint8_t *)empty;
v = getenv(buf);
if (!v) return (const uint8_t *)empty;
*len = (int64_t)strlen(v);
return (const uint8_t *)v;
}
/* ── The rest of the file surface ──────────────────────────────────────
*
* Four more POSIX-shaped calls under the same rules as flan_file_size,
* flan_file_read and flan_file_write above: a path as ptr+len, 1 or 0, and the
* reason in flan_file_fail where the compiler's file_guard reads it. Nothing
* here holds a descriptor between calls, so a second target implements four
* functions and inherits the Flan that sits on them.
*
* The errno mapping is flan_errno_reason's and is not extended. Its three
* buckets — missing, denied, io — are what a *handler* can act on: retry after
* making the directory, use-value with another path, or give up. EEXIST and
* ENOTEMPTY land in io along with everything else, and that is the honest
* place for them until conditions have a hierarchy to hang a fourth reason
* off (see the FileError note in the prelude). */
#include <sys/stat.h>
#include <unistd.h>
/* One call behind both file-exists? and file-size, because they are one
* question: stat answers whether the path resolves and how big it is in the
* same breath, and two entry points would be two chances for them to disagree.
*
* stat and not the fopen-plus-ftell that flan_file_size uses. That one is
* shaped by slurp's needs — it is about to read the file, so opening it is the
* test that matters — and it is wrong as a general size: fopen on a directory
* succeeds on Linux and ftell then answers a number that is not a file size.
* The two coexist deliberately and answer different questions. */
int8_t flan_file_stat(const uint8_t *path, int64_t n, int64_t *size) {
char buf[FLAN_PATH_MAX];
struct stat st;
*size = 0;
if (!flan_path_cstr(path, n, buf)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
if (stat(buf, &st) != 0) { flan_file_fail = flan_errno_reason(); return 0; }
*size = (int64_t)st.st_size;
flan_file_fail = FLAN_FILE_OK;
return 1;
}
/* The three that change the filesystem, and they carry flan_file_write's
* decision 2 unchanged: on the web they signal, every time, with the path in
* the condition. Not a build-time refusal, because Flan has no conditional
* compilation and "isolate this to desktop" is therefore not expressible in
* source; and not a silent no-op, because that is how a save directory fails
* to appear with nothing said. */
int8_t flan_file_delete(const uint8_t *path, int64_t n) {
#if defined(__EMSCRIPTEN__)
(void)path; (void)n;
flan_file_fail = FLAN_FILE_UNSUPPORTED;
return 0;
#else
char buf[FLAN_PATH_MAX];
if (!flan_path_cstr(path, n, buf)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
/* remove(), so that an empty directory is deletable by the same call a file
* is — it is unlink or rmdir depending on what the path names, which is the
* distinction a caller of a language with one `delete-file` does not want to
* have to make. A non-empty directory fails, and that is deliberate:
* recursive deletion is a loop the caller writes and sees. */
if (remove(buf) != 0) { flan_file_fail = flan_errno_reason(); return 0; }
flan_file_fail = FLAN_FILE_OK;
return 1;
#endif
}
/* Two paths, so two conversions, and the failure of either is reported as a
* missing path — the same answer flan_path_cstr's refusal gets everywhere
* else. rename() is atomic within one filesystem and fails with EXDEV across
* two rather than copying, which lands in the io bucket; a caller that wants
* a move across devices writes slurp and barf, and sees that it did. */
int8_t flan_file_rename(const uint8_t *from, int64_t fn, const uint8_t *to,
int64_t tn) {
#if defined(__EMSCRIPTEN__)
(void)from; (void)fn; (void)to; (void)tn;
flan_file_fail = FLAN_FILE_UNSUPPORTED;
return 0;
#else
char a[FLAN_PATH_MAX], b[FLAN_PATH_MAX];
if (!flan_path_cstr(from, fn, a) || !flan_path_cstr(to, tn, b)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
if (rename(a, b) != 0) { flan_file_fail = flan_errno_reason(); return 0; }
flan_file_fail = FLAN_FILE_OK;
return 1;
#endif
}
/* 0777 and not 0755, because the process umask is what decides: a program that
* hardcodes 0755 has overridden a user's umask for no reason it could know.
* One level only — an intervening directory that does not exist is ENOENT,
* which reaches the caller as `missing` and is answerable by a handler that
* makes the parent and takes `retry`, which is the restart that path exists
* for. */
int8_t flan_file_mkdir(const uint8_t *path, int64_t n) {
#if defined(__EMSCRIPTEN__)
(void)path; (void)n;
flan_file_fail = FLAN_FILE_UNSUPPORTED;
return 0;
#else
char buf[FLAN_PATH_MAX];
if (!flan_path_cstr(path, n, buf)) {
flan_file_fail = FLAN_FILE_MISSING;
return 0;
}
errno = 0;
if (mkdir(buf, 0777) != 0) { flan_file_fail = flan_errno_reason(); return 0; }
flan_file_fail = FLAN_FILE_OK;
return 1;
#endif
}
Reference in New Issue View Git Blame Copy Permalink