4758 lines
211 KiB
C
4758 lines
211 KiB
C
/* 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 <stdarg.h>
|
|
#include <stdint.h>
|
|
#include <stddef.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. */
|
|
|
|
/* [env] is the establishing function's copies of whatever the clause
|
|
* captured, or NULL. It is passed after the channel, and *every* clause
|
|
* declares it whether or not it captured — this walk cannot know which one
|
|
* it is about to reach, and a call whose signature is one argument longer
|
|
* than the callee's is a trap on wasm32, where call_indirect compares them.
|
|
* Emit's env_param is where the rule is written.
|
|
*
|
|
* It points into the establishing frame, which is alive for exactly as long
|
|
* as the handler frame below it is on this stack — a handler frame is popped
|
|
* by the body that pushed it, so there is no dangling case here to defer. */
|
|
typedef struct flan_handler {
|
|
struct flan_handler *prev;
|
|
uint32_t type_id;
|
|
void (*fn)(void *condition, void *xfer, void *env);
|
|
void *env;
|
|
} 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;
|
|
}
|
|
|
|
/* What a signal site says about its condition: Emit.Rt.condesc, field for
|
|
* field, which both backends lay out from one list. A compiled signal points
|
|
* at a constant; the runtime's own conditions build one on the failing
|
|
* frame's stack.
|
|
*
|
|
* A handler that matched through a parent link is not handed the condition,
|
|
* whose layout is its own type's, but a view laid out as the prelude's
|
|
* (defstruct Error [name str message str]) — the parent's type is
|
|
* Error-shaped, which the checker requires. The view's message is the
|
|
* condition with its values: [message] for the runtime's own conditions,
|
|
* which format their sentence before signalling; what [render] prints for a
|
|
* compiled one; and the condition's own fields when its type is Error-shaped
|
|
* itself ([flags] & FLAN_CONDESC_SELF), since then it is its own view.
|
|
* [chain] is the type ids from the condition's own type to its root. */
|
|
typedef struct flan_condesc {
|
|
const uint8_t *name;
|
|
int64_t namelen;
|
|
const uint8_t *message;
|
|
int64_t messagelen;
|
|
const uint32_t *chain;
|
|
int64_t chainlen;
|
|
const uint8_t *loc;
|
|
int64_t loclen;
|
|
void (*render)(void *condition, void *xfer);
|
|
int32_t flags;
|
|
} flan_condesc;
|
|
|
|
#define FLAN_CONDESC_SELF 1
|
|
/* The runtime's own condition, whose name is this file's and whose message is
|
|
* already a copy in context/temp: a parent's view takes both as they are. */
|
|
#define FLAN_CONDESC_RT 2
|
|
|
|
/* The view a parent's handler reads: Error's layout. */
|
|
typedef struct {
|
|
const uint8_t *name;
|
|
int64_t namelen;
|
|
const uint8_t *message;
|
|
int64_t messagelen;
|
|
} flan_view;
|
|
|
|
/* The most the break loop's sentence takes, and the unhandled message. A
|
|
* fixed buffer, so a longer one is cut — at a character, and said to be cut. */
|
|
#define FLAN_SENTENCE_MAX 2048
|
|
|
|
/* How many of [p]'s [len] bytes fit in [max] without splitting a UTF-8
|
|
* character: a cut that lands on a continuation byte backs up to the start
|
|
* of that character, so a shortened text is still text. */
|
|
static int64_t utf8_fit(const uint8_t *p, int64_t len, int64_t max) {
|
|
int64_t m;
|
|
if (len <= max) return len;
|
|
m = max < 0 ? 0 : max;
|
|
while (m > 0 && (p[m] & 0xC0) == 0x80) m--;
|
|
return m;
|
|
}
|
|
|
|
static const char ellipsis[] = "\xe2\x80\xa6";
|
|
|
|
/* [n] bytes from context/temp, or NULL; defined with the temp allocator. */
|
|
static void *rt_temp_alloc(int64_t n);
|
|
|
|
/* A copy of [n] bytes in context/temp: what a handler for a parent reads, and
|
|
* what a handler-case carries past the unwind. It lives until the frame ends —
|
|
* (free-temp), or the dev agent's poll — and a program that keeps it longer
|
|
* clones it, as it does any temp text. Empty when the arena has no room. */
|
|
static const uint8_t *rt_temp_copy(const uint8_t *p, int64_t n, int64_t *len) {
|
|
uint8_t *q;
|
|
*len = 0;
|
|
if (n <= 0) return (const uint8_t *)"";
|
|
q = (uint8_t *)rt_temp_alloc(n);
|
|
if (q == NULL) return (const uint8_t *)"";
|
|
memcpy(q, p, (size_t)n);
|
|
*len = n;
|
|
return q;
|
|
}
|
|
|
|
/* Where [render] prints, set around its synchronous calls. The printer runs
|
|
* twice: once with no buffer to count the bytes, once to write them into a
|
|
* block of exactly that size, so the message is never cut. A printer only
|
|
* formats, so nothing nests inside it. */
|
|
static uint8_t *msg_out;
|
|
static int64_t msg_len;
|
|
|
|
void flan_msg_emit(const uint8_t *p, int64_t n) {
|
|
if (n <= 0) return;
|
|
if (msg_out != NULL) memcpy(msg_out + msg_len, p, (size_t)n);
|
|
msg_len += n;
|
|
}
|
|
|
|
/* The view of [condition] for a parent's handler, its name and message in
|
|
* context/temp — see [rt_temp_copy] for how long they live. An Error-shaped
|
|
* condition is its own view, and its strings are the program's own. */
|
|
static void rt_view(const flan_condesc *d, void *condition, flan_view *v) {
|
|
if (d->flags & FLAN_CONDESC_SELF) {
|
|
*v = *(const flan_view *)condition;
|
|
return;
|
|
}
|
|
if (d->flags & FLAN_CONDESC_RT) {
|
|
v->name = d->name;
|
|
v->namelen = d->namelen;
|
|
v->message = d->message;
|
|
v->messagelen = d->messagelen;
|
|
return;
|
|
}
|
|
v->name = rt_temp_copy(d->name, d->namelen, &v->namelen);
|
|
if (d->messagelen > 0)
|
|
v->message = rt_temp_copy(d->message, d->messagelen, &v->messagelen);
|
|
else if (d->render != NULL) {
|
|
void *x = NULL;
|
|
msg_out = NULL;
|
|
msg_len = 0;
|
|
d->render(condition, &x);
|
|
v->message = (const uint8_t *)"";
|
|
v->messagelen = 0;
|
|
if (msg_len > 0 && (msg_out = (uint8_t *)rt_temp_alloc(msg_len)) != NULL) {
|
|
int64_t want = msg_len;
|
|
msg_len = 0;
|
|
d->render(condition, &x);
|
|
v->message = msg_out;
|
|
v->messagelen = want;
|
|
}
|
|
msg_out = NULL;
|
|
} else {
|
|
v->message = (const uint8_t *)"";
|
|
v->messagelen = 0;
|
|
}
|
|
}
|
|
|
|
/* 1 when a handler for [type_id] answers the condition by its own type, 2
|
|
* when it answers through a parent link, 0 when it does not answer. */
|
|
static int flan_handles(uint32_t type_id, const flan_condesc *d) {
|
|
if (d->chainlen > 0 && d->chain[0] == type_id) return 1;
|
|
for (int64_t i = 1; i < d->chainlen; i++)
|
|
if (d->chain[i] == type_id) return 2;
|
|
return 0;
|
|
}
|
|
|
|
/* [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. */
|
|
/* While a clause runs, the handlers in force are the ones that were in force
|
|
* when its handler-bind was established — the frames below it — and not the
|
|
* whole stack. That is Common Lisp's rule (CLHS 9.1.4.1; SBCL's
|
|
* %handler-bind rebinds *handler-clusters* to the rest of the list around
|
|
* each call), and without it a clause that signals the condition it handles
|
|
* reaches itself again, and again, until the stack runs out. The stack is put
|
|
* back afterwards whether or not the clause transferred: a transfer's target
|
|
* can be a restart-case inside the handler-bind's own body, whose frame does
|
|
* not pop this handler on the way there. */
|
|
void flan_signal(const flan_condesc *d, void *condition, void *xfer) {
|
|
flan_handler *saved = handlers;
|
|
/* The parent's view, made the first time a parent's handler needs it. Its
|
|
* strings are in context/temp, so a signal nested inside a handler makes its
|
|
* own and cannot write over the one the outer handler is reading. */
|
|
flan_view v;
|
|
int viewed = 0;
|
|
for (flan_handler *h = saved; h != NULL; h = h->prev) {
|
|
int how = flan_handles(h->type_id, d);
|
|
if (how) {
|
|
if (how == 2 && !viewed) {
|
|
rt_view(d, condition, &v);
|
|
viewed = 1;
|
|
}
|
|
handlers = h->prev;
|
|
h->fn(how == 1 ? condition : (void *)&v, xfer, h->env);
|
|
handlers = saved;
|
|
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. */
|
|
|
|
/* Field for field Emit.Rt.restart, which both backends lay out from one list;
|
|
* a field added there is added here, in the same place. */
|
|
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;
|
|
/* §3's parameters: the buffer the clause reads them from, how many, the
|
|
* hash of their spelling, whether an invoke filled the buffer in, and the
|
|
* spelling itself. */
|
|
void *args;
|
|
int32_t arity;
|
|
uint32_t sig_id;
|
|
int32_t armed;
|
|
const uint8_t *sig;
|
|
int64_t siglen;
|
|
/* For a break loop only: where the clause is written, its :report sentence
|
|
* (empty when it wrote none), and [flags]. */
|
|
const uint8_t *loc;
|
|
int64_t loclen;
|
|
const uint8_t *report;
|
|
int64_t reportlen;
|
|
int32_t flags;
|
|
} flan_restart;
|
|
|
|
/* A clause the checker made up rather than one anybody wrote: a
|
|
* handler-case's landing, which is reached through its own handler and which
|
|
* a break loop does not offer. */
|
|
#define FLAN_RESTART_HIDDEN 1
|
|
|
|
static flan_restart *restarts;
|
|
|
|
/* The frames a C caller pushes; see [flan_restart_push_c] below, which is
|
|
* where the argument for them is. Declared up here with the stack they go on,
|
|
* because [flan_condition_stacks_reset] empties all three together. */
|
|
#define C_RESTARTS 16
|
|
static flan_restart c_restarts[C_RESTARTS];
|
|
static int32_t c_restart_depth;
|
|
|
|
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;
|
|
}
|
|
|
|
/* What a break loop shows about a frame [flan_restart_frame] handed out, read
|
|
* off the frame rather than walked for, so a snapshot taking all of them is one
|
|
* pass. The strings are the frame's own and live as long as the program. */
|
|
const uint8_t *flan_restart_frame_loc(const void *frame, int64_t *len) {
|
|
const flan_restart *r = (const flan_restart *)frame;
|
|
*len = r->loclen;
|
|
return r->loc;
|
|
}
|
|
|
|
const uint8_t *flan_restart_frame_report(const void *frame, int64_t *len) {
|
|
const flan_restart *r = (const flan_restart *)frame;
|
|
*len = r->reportlen;
|
|
return r->report;
|
|
}
|
|
|
|
const uint8_t *flan_restart_frame_sig(const void *frame, int64_t *len) {
|
|
const flan_restart *r = (const flan_restart *)frame;
|
|
*len = r->siglen;
|
|
return r->sig;
|
|
}
|
|
|
|
int32_t flan_restart_frame_arity(const void *frame) {
|
|
return ((const flan_restart *)frame)->arity;
|
|
}
|
|
|
|
int32_t flan_restart_frame_hidden(const void *frame) {
|
|
return (((const flan_restart *)frame)->flags & FLAN_RESTART_HIDDEN) != 0;
|
|
}
|
|
|
|
/* The other way a typed restart's buffer is filled: an invoke-restart writes
|
|
* it and sets [armed], and a break loop taking one by hand has an evaluated
|
|
* thunk do the same two things through these, before it aims the channel. */
|
|
void *flan_restart_frame_args(const void *frame) {
|
|
return ((const flan_restart *)frame)->args;
|
|
}
|
|
|
|
int32_t flan_restart_frame_armed(const void *frame) {
|
|
return ((const flan_restart *)frame)->armed;
|
|
}
|
|
|
|
void flan_restart_frame_arm(void *frame) { ((flan_restart *)frame)->armed = 1; }
|
|
|
|
/* Aim the transfer channel at a frame obtained earlier. The same store 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 [str], 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. [rt_flush_out]
|
|
* is the flush every one of those paths does first; its own note says why it
|
|
* is not [fflush(stdout)]. */
|
|
static _Noreturn void rt_die(void);
|
|
static void rt_flush_out(void);
|
|
/* And the sentence a stop is told with; see "What the break loop is told
|
|
* about a stop" below. */
|
|
static void rt_sentence(const char *fmt, ...);
|
|
static void rt_print_sentence(const uint8_t *loc, int64_t loclen);
|
|
|
|
/* 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) {
|
|
rt_flush_out();
|
|
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.
|
|
*
|
|
* There is no fflush before the hook, and its absence is the fix to a hang
|
|
* rather than a saving. [exit] flushes every stream itself, so the call was
|
|
* doing nothing at all for a program that is its own process; the only path it
|
|
* ever ran on was the hook's. And on that path stdout is a 64K pipe into the
|
|
* compiler thread, which is not reading it while it is answering a request —
|
|
* so this flush was the first thing to block when a printing program finished,
|
|
* and it blocked *before* the hook could say the program had. The compiler
|
|
* then answered "the program is already running" to the one key the person
|
|
* had just pressed to run it again. The hook flushes after it has said so;
|
|
* see flan_merged_park in lib/dev.ml, which carries the rest of the argument. */
|
|
void (*flan_exit_hook)(int32_t status) = 0;
|
|
|
|
void flan_exit(int32_t status) {
|
|
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 C-pushed frames below go with them. Their storage is static rather
|
|
than stack, so a second run would not scribble over it — but a depth left
|
|
where the first run stopped is a leak of the only thing that is finite
|
|
here, and a re-run that starts sixteen deep offers no restart at all. */
|
|
c_restart_depth = 0;
|
|
}
|
|
|
|
/* The same three, marked and put back rather than emptied: an evaluation that
|
|
* trapped is left by a jump past every frame it pushed, so the chains are
|
|
* returned to where they stood when it was called (see the agent's poll). */
|
|
void flan_condition_stacks_mark(void **h, void **r, int32_t *d) {
|
|
*h = handlers;
|
|
*r = restarts;
|
|
*d = c_restart_depth;
|
|
}
|
|
|
|
void flan_condition_stacks_restore(void *h, void *r, int32_t d) {
|
|
handlers = (flan_handler *)h;
|
|
restarts = (flan_restart *)r;
|
|
c_restart_depth = d;
|
|
}
|
|
|
|
/* 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.
|
|
*
|
|
* The slice points into the caller's frame, so the checker copies it into the
|
|
* temp allocator for i64->bytes and f64->bytes, whose results may outlive
|
|
* the frame. The printer writes each one out at once and takes no copy. 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. Every
|
|
* other (ptr, len) entry point in this file — flan_write_stdout,
|
|
* flan_escape_bytes, flan_dev_emit — already guarded the negative case. These
|
|
* two were the exceptions.
|
|
*
|
|
* It is worth saying why this stays now that (slice s 2 1) traps in every
|
|
* build and not only in a checked one. This clamp was written when it did not:
|
|
* lo <= hi sat behind --no-bounds-checks in both backends, so a release build
|
|
* handed a length of -1 straight to these functions, and the clamp was the
|
|
* last thing between that and a 511-byte read. check_slice no longer lets the
|
|
* value out, which makes the negative case unreachable *from Flan* — and not
|
|
* from here, because these take a raw (ptr, len) pair and the FFI, a C caller
|
|
* and slice-from's promise all reach them too. A function that is correct
|
|
* on its own arguments does not become incorrect because its callers improved,
|
|
* and two branches are not the price to argue about. */
|
|
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.
|
|
*
|
|
* NaN is rendered by hand, and the reason is that %g renders the *sign bit* of
|
|
* something that does not have a sign. glibc prints "-nan" when the bit is set
|
|
* and "nan" when it is not, and which one a program gets is decided by things
|
|
* no source line chose: LLVM's constant folder answers (/ 0.0 0.0) with a
|
|
* positive quiet NaN at compile time, divsd on this machine answers the same
|
|
* expression with the negative one at run time, so the same two-line program
|
|
* printed "nan" through one backend and "-nan" through the other. Neither is
|
|
* wrong about the arithmetic — IEEE 754 does not specify the sign of a NaN any
|
|
* operation produces — which is exactly what makes it the wrong thing to show.
|
|
*
|
|
* Reporting it unsigned is not a new rule here either: format-f64 in the
|
|
* prelude has always answered "nan" for the same value, because it reaches the
|
|
* case with (not (= x x)) and has no sign bit in its hands at all. So a build
|
|
* where (print x) said "-nan" and (show x 2) said "nan" was already disagreeing
|
|
* with itself about one value inside one backend. This makes print agree with
|
|
* show first and the two backends agree second.
|
|
*
|
|
* The test is x != x rather than isnan, which keeps math.h out of this file
|
|
* and is the same comparison the prelude uses. An infinity still prints signed:
|
|
* there the sign is the value.
|
|
*
|
|
* Spelled as a format into a caller's buffer rather than inline here, because
|
|
* the rule has a second reader: flan_dev.c's REPL emitter and its watch table
|
|
* render a f64 for an editor to show, and a build where the inspector said
|
|
* "-nan" and println said "nan" would be the same disagreement one layer out.
|
|
* That file calls this; there is one copy of the rule. */
|
|
int flan_f64_format(double x, char *buf, size_t cap) {
|
|
return (x != x) ? snprintf(buf, cap, "nan") : snprintf(buf, cap, "%g", x);
|
|
}
|
|
|
|
void flan_f64_to_bytes(double x, uint8_t *buf, flan_slice *out) {
|
|
int n = flan_f64_format(x, (char *)buf, FLAN_NUM_BYTES);
|
|
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 literal on its way to a declare-c wrapper: the same pointer, with
|
|
* the length encoded as -(n+1). No other Flan string has a negative length, so
|
|
* the wrapper knows the bytes are the compiler's NUL-terminated constant and
|
|
* hands them to C uncopied (lib/shim.ml, flan_shim_cstr). */
|
|
void flan_c_literal(const uint8_t *p, int64_t n, flan_slice *out) {
|
|
out->ptr = p;
|
|
out->len = -(n + 1);
|
|
}
|
|
|
|
/* The escape table itself: what one byte reads as inside a quoted string,
|
|
* written into [out] and returning how many bytes that took. Never more than
|
|
* four, which is what every caller's headroom is sized from.
|
|
*
|
|
* A table rather than a printer, because the callers frame the same mapping
|
|
* differently and that framing is the part that is genuinely theirs: the one
|
|
* below builds a capped slice to hand back, and flan_dev.c's streams into a
|
|
* fixed buffer it does not own the end of. What they must not differ about is
|
|
* this switch — the REPL and println disagreeing about what a struct looks
|
|
* like is two wire formats — so this switch exists once and they share it.
|
|
*
|
|
* flan_dyn.c keeps its own copy of the table on purpose; see the comment
|
|
* there and docs/SPIKE-DUPLICITY.md §9. */
|
|
int flan_escape_char(unsigned char c, char *out) {
|
|
switch (c) {
|
|
case '"': out[0] = '\\'; out[1] = '"'; return 2;
|
|
case '\\': out[0] = '\\'; out[1] = '\\'; return 2;
|
|
case '\n': out[0] = '\\'; out[1] = 'n'; return 2;
|
|
case '\t': out[0] = '\\'; out[1] = 't'; return 2;
|
|
case '\r': out[0] = '\\'; out[1] = 'r'; return 2;
|
|
default:
|
|
if (c < 0x20) {
|
|
out[0] = '\\';
|
|
out[1] = 'x';
|
|
out[2] = "0123456789abcdef"[c >> 4];
|
|
out[3] = "0123456789abcdef"[c & 0xf];
|
|
return 4;
|
|
}
|
|
out[0] = (char)c;
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
/* 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.
|
|
*
|
|
* The table is [flan_escape_char] above, which is also what flan_dev.c's
|
|
* emitters use; this function is the framing and nothing else.
|
|
*
|
|
* 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; }
|
|
char e[4];
|
|
int k = flan_escape_char(p[i], e);
|
|
memcpy(escaped + w, e, (size_t)k);
|
|
w += (size_t)k;
|
|
}
|
|
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. */
|
|
|
|
#if !defined(__wasm__)
|
|
#include <fcntl.h>
|
|
#endif
|
|
#include <unistd.h>
|
|
|
|
/* That flush, made incapable of waiting.
|
|
*
|
|
* Under a merged `flan dev' stdout is a 64K pipe into the compiler thread,
|
|
* which is not reading it while it is answering a request. A trap taken by a
|
|
* program that had filled that pipe therefore began by blocking in the flush
|
|
* meant to order its own last words — and a bounds failure that hangs instead
|
|
* of dying is the worst shape a trap can take, because the person watching has
|
|
* no message and no exit status and no reason to think anything happened.
|
|
*
|
|
* So fd 1 is put into non-blocking mode first and the flush is best-effort.
|
|
* What that costs is a truncated tail: whatever no longer fits in the pipe is
|
|
* dropped rather than waited for. What it buys is that the trap always reaches
|
|
* its message and its exit. On a terminal, a file, or a pipe with room —
|
|
* which is every run that is not this one pathological case — O_NONBLOCK
|
|
* changes nothing at all, and the acceptance corpus diffs this output.
|
|
*
|
|
* The return value is ignored deliberately, twice over: a failed fcntl leaves
|
|
* the old blocking behaviour, which is what this code did before, and a flush
|
|
* that reports EAGAIN has done as much as it is going to. There is nothing a
|
|
* dying process can do about either.
|
|
*
|
|
* Guarded on __wasm__, which this file otherwise does only for the valgrind
|
|
* client request below. The hazard is a pipe whose reader is
|
|
* the compiler thread of a merged `flan dev', which is a native host and only
|
|
* ever a native host — a wasm32 module has no compiler beside it and no such
|
|
* pipe. So the guard is not a portability apology: it says where the problem
|
|
* can exist, and keeps wasm32 from having to answer for a descriptor mode its
|
|
* runtime may model differently. */
|
|
#if defined(__wasm__)
|
|
static void rt_flush_out(void) { (void)fflush(stdout); }
|
|
#else
|
|
static void rt_flush_out(void) {
|
|
int flags = fcntl(1, F_GETFL, 0);
|
|
if (flags >= 0) (void)fcntl(1, F_SETFL, flags | O_NONBLOCK);
|
|
(void)fflush(stdout);
|
|
}
|
|
#endif
|
|
|
|
/* [_exit] and not [exit], for the reason die_now gives in
|
|
* vendor/agent/flan_agent.c and gives at length: this runs on the game thread,
|
|
* the dev agent's listener thread may be inside [dlopen] holding the loader
|
|
* lock, and [exit] runs the atexit chain and the ELF destructors, which want
|
|
* that same lock. In a merged build that chain also holds OCaml's shutdown,
|
|
* and it would be run from a thread that is not OCaml's. A trap that deadlocks
|
|
* in the runtime's teardown is the same failure as a trap that hangs on a full
|
|
* pipe, reached a few instructions later.
|
|
*
|
|
* What [_exit] skips is the atexit handler that removes the editor's socket —
|
|
* so, exactly as die_now does, this removes it by hand. A socket file left on
|
|
* disk with nothing accepting on it answers the next client with
|
|
* ECONNREFUSED, which reads like a daemon that is there and refusing rather
|
|
* than one that died; that message has already sent two investigations in this
|
|
* repository to the wrong place. FLAN_DEV_SOCK is unset in an ordinary run and
|
|
* then this does nothing.
|
|
*
|
|
* The two functions are kept saying the same thing on purpose. They are the
|
|
* two ways a Flan program dies where it stands, and a difference between them
|
|
* would be a difference nobody could predict from the outside. */
|
|
/* Set by the dev agent once it has bound its own socket, to remove it: the
|
|
* [_exit] below skips the atexit handler that otherwise would. */
|
|
void (*flan_die_hook)(void);
|
|
|
|
static _Noreturn void rt_die(void) {
|
|
const char *sock;
|
|
rt_flush_out();
|
|
fflush(stderr);
|
|
sock = getenv("FLAN_DEV_SOCK");
|
|
if (sock != NULL && *sock != '\0') unlink(sock);
|
|
if (flan_die_hook != NULL) flan_die_hook();
|
|
_exit(134);
|
|
}
|
|
|
|
/* The sentence each bounds failure is told with — to stderr when nothing
|
|
* answered, and to the break loop before it is asked. */
|
|
static void bounds_sentence(int64_t idx, int64_t len) {
|
|
rt_sentence("index %lld is out of bounds for length %lld", (long long)idx,
|
|
(long long)len);
|
|
}
|
|
|
|
_Noreturn void flan_bounds_fail(const uint8_t *loc, int64_t loclen,
|
|
int64_t idx, int64_t len) {
|
|
bounds_sentence(idx, len);
|
|
rt_print_sentence(loc, loclen);
|
|
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);
|
|
|
|
/* The other half of that, for the traps that have nowhere to resume *to*.
|
|
*
|
|
* Six refusals in this file are reached with no transfer channel in their
|
|
* hands: the emitted code calls them and falls off the end, because the
|
|
* checker has already decided the program is not going to continue. Under a
|
|
* merged `flan dev' that decision was being made on the program's behalf and
|
|
* charged to the *session*, since rt_die is [_exit] and the compiler is in the
|
|
* same process — a program that named a restart nobody established took the
|
|
* daemon down with it, which is exactly what the break loop exists to stop.
|
|
*
|
|
* So they park instead. Not with [flan_break_hook]: that hook's contract is
|
|
* that the loop may answer by aiming the channel, and there is no channel
|
|
* here — a restart chosen against one of these would be a transfer nothing
|
|
* carries out, which is the "accepted and silently dropped" shape the
|
|
* thunk-boundary refusal in flan_agent.c already went to some length to avoid.
|
|
* This hook says the other thing: stop here, let everything be read, and
|
|
* refuse a resume with a reason when one is asked for. The loop behind it
|
|
* never returns; if some future one does, the [rt_die] below is still the
|
|
* answer, which is also what a standalone build does every time, because
|
|
* nothing installs this outside a dev session.
|
|
*
|
|
* All six park, and they do not all park for the same reason. Four are guards
|
|
* that fire *before* the thing they guard — the null and capability tests
|
|
* above [a->proc], and the two restart lookups — so nothing is half done and
|
|
* the frame is as readable as any other. The other two are not: a transfer is
|
|
* already under way at [flan_transfer_fail] and at [flan_restart_unarmed],
|
|
* and this frame's defers may be half run, which is what the note on
|
|
* flan_transfer_fail says a few lines down. Those two park anyway, and only
|
|
* to be *looked at*: a half-run unwind is a thing worth seeing, and the
|
|
* resume is refused there for the same reason it is refused at the other
|
|
* four. Stopping on a torn transfer is strictly more than exiting before
|
|
* anyone could ask what tore it.
|
|
*
|
|
* The name is a trap's name and not a condition's — there is no defstruct
|
|
* behind [NullAllocator], and the `layout' op will say it cannot place it.
|
|
* That is already a case the conditions buffer draws (see flan-cnr.el, which
|
|
* treats a refusal as a reason to show rather than an error): the name is
|
|
* there to say *which* trap the program is standing in, and the sentence each
|
|
* site printed just above carries the detail. */
|
|
void (*flan_trap_hook)(const uint8_t *name, int64_t namelen);
|
|
|
|
/* The call a class migration makes to update-instance-for-redefined-class:
|
|
* [fn] is the method dispatcher's current body, and the three words are the
|
|
* instance, the vec of slots it gained and the map of the slots it lost to
|
|
* the values they held — dyn words, as [uint64_t] here because this file
|
|
* does not include flan_dyn.h.
|
|
*
|
|
* Here and not in flan_dyn.c because it is set by the agent, and the agent
|
|
* must link against a program with no collector in it; and not called from
|
|
* here because what makes it a hook is the restart it runs under, which is
|
|
* the agent's business — the floor a break inside it reads is the agent's.
|
|
* NULL, and no hook runs, outside a dev session: a class is redefined only
|
|
* by a reload, and a reload only arrives through the agent.
|
|
*
|
|
* The answer is 0 when the method returned, 1 when the restart the call
|
|
* established was taken, and 2 when some other transfer came back through
|
|
* it — one aimed at a restart below the call, which a C frame cannot carry
|
|
* on. */
|
|
int (*flan_dyn_migrate_hook)(void *fn, uint64_t instance, uint64_t added,
|
|
uint64_t discarded);
|
|
|
|
static _Noreturn void rt_trap(const uint8_t *name, int64_t namelen) {
|
|
if (flan_trap_hook != NULL) flan_trap_hook(name, namelen);
|
|
rt_die();
|
|
}
|
|
|
|
/* The same thing, exported, for the one caller outside this file: flan_dyn.c,
|
|
* whose type mismatches are traps of exactly this kind and must park exactly
|
|
* the way these six do. [rt_trap] is static and stays static — what a second
|
|
* translation unit needs is the *behaviour*, and the alternative was
|
|
* flan_dyn.c reimplementing the hook, the flush, the socket and the exit code,
|
|
* which would be a second answer to "how does a Flan program die where it
|
|
* stands" and a guarantee that the two would drift.
|
|
*
|
|
* The dependency runs that way and only that way. Nothing in this file names
|
|
* anything in flan_dyn.c, which is what lets a build that wants no collector
|
|
* leave that object out entirely; a call in the other direction would make the
|
|
* collector unconditional. The sentence belongs to the caller: this prints
|
|
* nothing, because every site that reaches it has already said what happened
|
|
* in the words that site knows. */
|
|
_Noreturn void flan_trap(const uint8_t *name, int64_t namelen) {
|
|
rt_trap(name, namelen);
|
|
}
|
|
|
|
/* ── What the break loop is told about a stop ─────────────────────────
|
|
*
|
|
* Where the expression that stopped is written, and the sentence the runtime
|
|
* wrote about it — the loc every checked site already passes, and the words
|
|
* it prints to stderr. The frame chain says where each *call* was; the site
|
|
* is the only record of the `at` or the division itself, and the sentence is
|
|
* what the condition's fields mean ("this value does not fit the integer type
|
|
* it is cast to" rather than op 4 and two bounds).
|
|
*
|
|
* Set immediately before a break hook or a trap hook runs and cleared when a
|
|
* break hook returns, so the agent's snapshot (taken on entry to the break
|
|
* loop, on this same thread) reads them while they are true, and consumes
|
|
* them so that a break nested inside that one cannot inherit them. NULL and
|
|
* empty outside that window, which is the honest answer for a stop that has
|
|
* nothing to point at. */
|
|
const uint8_t *flan_break_site;
|
|
int64_t flan_break_site_len;
|
|
char flan_break_sentence[FLAN_SENTENCE_MAX];
|
|
int64_t flan_break_sentence_len;
|
|
|
|
static void rt_sentencev(const char *fmt, va_list ap) {
|
|
int n = vsnprintf(flan_break_sentence, sizeof flan_break_sentence, fmt, ap);
|
|
if (n < 0) n = 0;
|
|
if (n >= (int)sizeof flan_break_sentence) {
|
|
/* Cut at a character and said to be cut. */
|
|
int64_t m = utf8_fit((const uint8_t *)flan_break_sentence,
|
|
(int64_t)sizeof flan_break_sentence - 1,
|
|
(int64_t)sizeof flan_break_sentence - 4);
|
|
memcpy(flan_break_sentence + m, ellipsis, 3);
|
|
n = (int)m + 3;
|
|
}
|
|
flan_break_sentence_len = n;
|
|
}
|
|
|
|
static void rt_sentence(const char *fmt, ...) {
|
|
va_list ap;
|
|
va_start(ap, fmt);
|
|
rt_sentencev(fmt, ap);
|
|
va_end(ap);
|
|
}
|
|
|
|
|
|
static void rt_break_clear(void) {
|
|
flan_break_site = NULL;
|
|
flan_break_site_len = 0;
|
|
flan_break_sentence_len = 0;
|
|
}
|
|
|
|
/* The sentence already formatted, to stderr, after the site. */
|
|
static void rt_print_sentence(const uint8_t *loc, int64_t loclen) {
|
|
rt_flush_out();
|
|
if (loc != NULL && loclen > 0)
|
|
fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc);
|
|
fprintf(stderr, "%.*s\n", (int)flan_break_sentence_len,
|
|
flan_break_sentence);
|
|
}
|
|
|
|
/* A trap's sentence: formatted once, printed where it always was, and left
|
|
* for the trap hook with the site beside it. [loc] may be NULL. Exported for
|
|
* flan_dyn.c, whose traps are this kind and must be told the same way. */
|
|
void flan_sayv(const uint8_t *loc, int64_t loclen, const char *fmt,
|
|
va_list ap) {
|
|
rt_sentencev(fmt, ap);
|
|
rt_print_sentence(loc, loclen);
|
|
flan_break_site = loc;
|
|
flan_break_site_len = loc != NULL ? loclen : 0;
|
|
}
|
|
|
|
void flan_say(const uint8_t *loc, int64_t loclen, const char *fmt, ...) {
|
|
va_list ap;
|
|
va_start(ap, fmt);
|
|
flan_sayv(loc, loclen, fmt, ap);
|
|
va_end(ap);
|
|
}
|
|
|
|
/* 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;
|
|
}
|
|
|
|
/* -- A restart frame pushed from C ----------------------------------- */
|
|
|
|
/* Every restart above is an alloca in the Flan function that established it.
|
|
* This is the one that is not: the agent runs an evaluated expression through
|
|
* a C frame of its own, and it wants a restart *at that frame* — one whose
|
|
* transfer unwinds the evaluation and leaves the program where it was called
|
|
* from. There is no Flan function there to hold the alloca, so the frames live
|
|
* here, where the struct does. Two files each declaring the shape is how the
|
|
* two stop agreeing, and the agent must not be the second one.
|
|
*
|
|
* A fixed array rather than malloc: this is pushed on the game thread at a
|
|
* frame boundary, and an allocation there is the thing the dev runtime exists
|
|
* to keep out. Sixteen is deeper than the break loop's own nesting limit, so
|
|
* running out means the nesting guard has already fired.
|
|
*
|
|
* [name] is not copied. Every caller passes a string constant that outlives
|
|
* the program, which is the same promise a Flan restart-case makes about the
|
|
* name it points at.
|
|
*
|
|
* NULL when there is no room, and then the caller simply has no restart to
|
|
* offer — an evaluation that cannot be abandoned is worse than one that can,
|
|
* and better than a scribble past the end of this array. */
|
|
void *flan_restart_push_c(const uint8_t *name, int64_t namelen,
|
|
const uint8_t *report, int64_t reportlen) {
|
|
if (c_restart_depth >= C_RESTARTS) return NULL;
|
|
flan_restart *r = &c_restarts[c_restart_depth++];
|
|
/* Every field, because the slot is reused: a frame that takes no parameters
|
|
* says so with the empty signature a written (name [] ...) has, and one
|
|
* pushed from C has no source line. */
|
|
memset(r, 0, sizeof *r);
|
|
r->name_id = flan_name_id(name, namelen);
|
|
r->name = name;
|
|
r->namelen = namelen;
|
|
r->sig = (const uint8_t *)"()";
|
|
r->siglen = 2;
|
|
r->sig_id = flan_name_id(r->sig, r->siglen);
|
|
r->loc = (const uint8_t *)"";
|
|
r->report = report;
|
|
r->reportlen = reportlen;
|
|
flan_restart_push(r);
|
|
return r;
|
|
}
|
|
|
|
/* The pop, and it is deliberately not [flan_restart_pop]'s caller's business
|
|
* whether the stack still looks the way it did. A transfer that unwound past
|
|
* this frame has already popped everything above it — each restart-case pad
|
|
* pops its own before forwarding — but a frame that died some other way would
|
|
* leave the head pointing at rubbish on a stack that has gone. Assigning
|
|
* [r->prev] repairs both: the head goes back to what it was when this frame
|
|
* was pushed, which is true in either case. */
|
|
void flan_restart_pop_c(void *frame) {
|
|
if (frame == NULL) return;
|
|
flan_restart_pop((flan_restart *)frame);
|
|
if (c_restart_depth > 0) c_restart_depth--;
|
|
}
|
|
|
|
/* [flan_break_resume] stood here: look a restart up by the name someone typed
|
|
* and aim the channel at it. It was what the break loop resumed through when a
|
|
* choice was a *name*, and nothing has called it since the loop started
|
|
* choosing by position — a name cannot say which of two [retry] frames was
|
|
* meant, which is the whole reason the snapshot hands out indices. The last
|
|
* caller went with that change; the definition did not, and it sat here
|
|
* exporting a second way to resolve a restart that could only ever disagree
|
|
* with the one in use. TODO.org, "The break loop's display pass", records the
|
|
* choice by index that left it with no caller. Now there is no function. */
|
|
|
|
void flan_error(const flan_condesc *d, void *condition, void *xfer) {
|
|
flan_signal(d, 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. The site is the (error ...) itself, and the sentence is the
|
|
* condition's static one, or none: a program's own condition says what it
|
|
* is in its fields. */
|
|
{
|
|
/* What the condition is, as a parent's handler would read it: the
|
|
* sentence, the printed condition, or an Error-shaped condition's own
|
|
* message. A condition with no parent and no sentence has none. */
|
|
flan_view v;
|
|
rt_view(d, condition, &v);
|
|
if (flan_break_hook != NULL) {
|
|
flan_break_site = d->loclen > 0 ? d->loc : NULL;
|
|
flan_break_site_len = d->loclen;
|
|
rt_sentence("%.*s", (int)v.messagelen, (const char *)v.message);
|
|
flan_break_hook(d->name, d->namelen, condition, xfer);
|
|
rt_break_clear();
|
|
if (*(void **)xfer != NULL) return;
|
|
}
|
|
if (v.messagelen > 0)
|
|
rt_sentence("unhandled %.*s: %.*s", (int)d->namelen,
|
|
(const char *)d->name, (int)v.messagelen,
|
|
(const char *)v.message);
|
|
else
|
|
rt_sentence("unhandled %.*s", (int)d->namelen, (const char *)d->name);
|
|
}
|
|
rt_print_sentence(d->loc, d->loclen);
|
|
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 *to*, which is not the same as there being
|
|
* nothing else to do — see rt_trap, which stops here instead of ending the
|
|
* process, so that the stack that offered no such name can be read. */
|
|
_Noreturn void flan_restart_fail(const uint8_t *loc, int64_t loclen,
|
|
const uint8_t *name, int64_t namelen) {
|
|
flan_say(loc, loclen, "no restart named %.*s is active", (int)namelen,
|
|
(const char *)name);
|
|
rt_trap((const uint8_t *)"NoSuchRestart", 13);
|
|
}
|
|
|
|
/* 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. */
|
|
/* The top-level items of a signature "(a b c)", where an item may itself be
|
|
* bracketed: "(Ptr i32)", "[3 f64]". Up to [max]; answers how many. */
|
|
static int sig_items(const uint8_t *s, int64_t n, const uint8_t **at,
|
|
int64_t *len, int max) {
|
|
int count = 0, depth = 0;
|
|
int64_t start = -1;
|
|
for (int64_t i = 1; i + 1 < n; i++) {
|
|
uint8_t c = s[i];
|
|
if (c == ' ' && depth == 0) {
|
|
if (start >= 0 && count < max) { at[count] = s + start; len[count] = i - start; count++; }
|
|
start = -1;
|
|
continue;
|
|
}
|
|
if (start < 0) start = i;
|
|
if (c == '(' || c == '[') depth++;
|
|
else if (c == ')' || c == ']') depth--;
|
|
}
|
|
if (start >= 0 && count < max) { at[count] = s + start; len[count] = n - 1 - start; count++; }
|
|
return count;
|
|
}
|
|
|
|
static int is_number_type(const uint8_t *s, int64_t n) {
|
|
static const char *names[] = { "i8", "i16", "i32", "i64", "u8", "u16",
|
|
"u32", "u64", "f32", "f64" };
|
|
for (size_t k = 0; k < sizeof names / sizeof names[0]; k++)
|
|
if ((int64_t)strlen(names[k]) == n && memcmp(names[k], s, (size_t)n) == 0)
|
|
return 1;
|
|
return 0;
|
|
}
|
|
|
|
/* [got] is the invoke site's signature, then after each 0x1f: the syntax
|
|
* (i or p) and every argument as written. Where the two signatures differ
|
|
* only in which number type an argument is, the fix is that argument
|
|
* converted: (f64 2.5), or f64(2.5) in the indented syntax. */
|
|
_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) {
|
|
enum { MAX = 16 };
|
|
const uint8_t *part[MAX + 2];
|
|
int64_t plen[MAX + 2];
|
|
int parts = 0;
|
|
int64_t start = 0;
|
|
for (int64_t i = 0; i <= gotlen && parts < MAX + 2; i++)
|
|
if (i == gotlen || got[i] == 0x1f) {
|
|
part[parts] = got + start; plen[parts] = i - start; parts++;
|
|
start = i + 1;
|
|
}
|
|
const uint8_t *w[MAX], *g[MAX];
|
|
int64_t wl[MAX], gl[MAX];
|
|
int nw = sig_items(want, wantlen, w, wl, MAX);
|
|
int ng = sig_items(part[0], plen[0], g, gl, MAX);
|
|
char fix[512];
|
|
size_t used = 0;
|
|
fix[0] = 0;
|
|
int ok = parts >= 2 && nw == ng && ng == parts - 2 && ng > 0;
|
|
for (int k = 0; ok && k < ng; k++) {
|
|
if (wl[k] == gl[k] && memcmp(w[k], g[k], (size_t)wl[k]) == 0) continue;
|
|
if (!is_number_type(w[k], wl[k]) || !is_number_type(g[k], gl[k])) { ok = 0; break; }
|
|
int indented = plen[1] == 1 && part[1][0] == 'i';
|
|
int wrote = indented
|
|
? snprintf(fix + used, sizeof fix - used, "%s%.*s(%.*s)", used ? ", " : "",
|
|
(int)wl[k], (const char *)w[k], (int)plen[k + 2], (const char *)part[k + 2])
|
|
: snprintf(fix + used, sizeof fix - used, "%s(%.*s %.*s)", used ? ", " : "",
|
|
(int)wl[k], (const char *)w[k], (int)plen[k + 2], (const char *)part[k + 2]);
|
|
if (wrote < 0 || (size_t)wrote >= sizeof fix - used) { ok = 0; break; }
|
|
used += (size_t)wrote;
|
|
}
|
|
/* An argument the compiler could not spell is an ellipsis, and a fix with
|
|
* a hole in it is a conversion to make, not code to paste. */
|
|
int holed = strstr(fix, "\xe2\x80\xa6") != NULL;
|
|
if (ok && used > 0)
|
|
flan_say(loc, loclen, "restart %.*s takes %.*s, given %.*s. %s %s",
|
|
(int)namelen, (const char *)name, (int)wantlen, (const char *)want,
|
|
(int)plen[0], (const char *)part[0],
|
|
holed ? "Convert the argument with" : "Write", fix);
|
|
else
|
|
flan_say(loc, loclen, "restart %.*s takes %.*s, given %.*s", (int)namelen,
|
|
(const char *)name, (int)wantlen, (const char *)want, (int)plen[0],
|
|
(const char *)part[0]);
|
|
rt_trap((const uint8_t *)"RestartArity", 12);
|
|
}
|
|
|
|
/* 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) {
|
|
flan_say(loc, loclen, "restart %.*s takes %.*s, and none was supplied",
|
|
(int)namelen, (const char *)name, (int)wantlen, (const char *)want);
|
|
rt_trap((const uint8_t *)"RestartUnarmed", 14);
|
|
}
|
|
|
|
/* 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) {
|
|
flan_say(loc, loclen, "a defer invoked a restart, which a defer may not do");
|
|
rt_trap((const uint8_t *)"TransferFromDefer", 17);
|
|
}
|
|
|
|
static void slice_sentence(int64_t lo, int64_t hi, int64_t len) {
|
|
rt_sentence("slice [%lld %lld) is out of bounds for length %lld",
|
|
(long long)lo, (long long)hi, (long long)len);
|
|
}
|
|
|
|
_Noreturn void flan_slice_fail(const uint8_t *loc, int64_t loclen,
|
|
int64_t lo, int64_t hi, int64_t len) {
|
|
slice_sentence(lo, hi, len);
|
|
rt_print_sentence(loc, loclen);
|
|
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
|
|
|
|
/* The root every built-in error descends from, and the parent link the two
|
|
* conditions this file signals itself carry. Must agree with the prelude's
|
|
* (defstruct BoundsError :parent Error ...) — the same hand-kept agreement
|
|
* flan_name_id has with Check.type_id. */
|
|
static const uint8_t flan_error_name[] = "Error";
|
|
#define FLAN_ERROR_NAMELEN 5
|
|
|
|
/* A descriptor for one of the runtime's own conditions, on the caller's
|
|
* stack; [chain] is the caller's too, two entries long. Its message is the
|
|
* sentence the caller has just formatted, copied into context/temp: that copy
|
|
* is what a parent's handler reads. The break loop does not read it — the
|
|
* caller formats the sentence again, in full, if nothing handled it. */
|
|
static void rt_condesc(flan_condesc *d, uint32_t chain[2], const uint8_t *name,
|
|
int64_t namelen, const uint8_t *loc, int64_t loclen) {
|
|
d->render = NULL;
|
|
d->flags = FLAN_CONDESC_RT;
|
|
chain[0] = flan_name_id(name, namelen);
|
|
chain[1] = flan_name_id(flan_error_name, FLAN_ERROR_NAMELEN);
|
|
d->name = name;
|
|
d->namelen = namelen;
|
|
/* The sentence just formatted, copied out of the shared buffer before the
|
|
* walk, since a handler may stop on something of its own and write over
|
|
* it. */
|
|
d->message = rt_temp_copy((const uint8_t *)flan_break_sentence,
|
|
flan_break_sentence_len, &d->messagelen);
|
|
/* Consumed: if a handler takes the condition, the next stop must not find
|
|
* this sentence waiting under its own name. */
|
|
flan_break_sentence_len = 0;
|
|
d->chain = chain;
|
|
d->chainlen = 2;
|
|
d->loc = loc;
|
|
d->loclen = loclen;
|
|
}
|
|
|
|
/* With nothing answering [d], stand in the break loop with the site and the
|
|
* sentence, which the caller has formatted after the walk and before this —
|
|
* after, because a handler the walk ran may have stopped on something of its
|
|
* own and written over it. Returns nonzero if the break loop transferred, in
|
|
* which case the caller returns and its caller's guard carries the transfer
|
|
* out. */
|
|
static int rt_error_break(const flan_condesc *d, void *condition, void *xfer) {
|
|
if (flan_break_hook != NULL) {
|
|
flan_break_site = d->loc;
|
|
flan_break_site_len = d->loclen;
|
|
flan_break_hook(d->name, d->namelen, condition, xfer);
|
|
if (*(void **)xfer != NULL) { rt_break_clear(); return 1; }
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
/* Which of the three sentences a BoundsError is told with. */
|
|
enum { BOUNDS_AT, BOUNDS_SLICE, BOUNDS_PROMISE };
|
|
static void promise_sentence(int64_t n);
|
|
|
|
static int flan_bounds_signal(const uint8_t *loc, int64_t loclen, void *xfer,
|
|
int kind, int64_t low, int64_t high,
|
|
int64_t len) {
|
|
flan_bounds_cond c;
|
|
flan_condesc d;
|
|
uint32_t chain[2];
|
|
c.low = low;
|
|
c.high = high;
|
|
c.length = len;
|
|
if (kind == BOUNDS_AT) bounds_sentence(low, len);
|
|
else if (kind == BOUNDS_SLICE) slice_sentence(low, high, len);
|
|
else promise_sentence(high);
|
|
rt_condesc(&d, chain, flan_bounds_name, FLAN_BOUNDS_NAMELEN, loc, loclen);
|
|
flan_signal(&d, &c, xfer);
|
|
if (*(void **)xfer != NULL) return 1;
|
|
/* Formatted again, in full: [said] may be cut, and a handler the walk ran
|
|
* may have written a sentence of its own over the shared one. */
|
|
if (kind == BOUNDS_AT) bounds_sentence(low, len);
|
|
else if (kind == BOUNDS_SLICE) slice_sentence(low, high, len);
|
|
else promise_sentence(high);
|
|
return rt_error_break(&d, &c, xfer);
|
|
}
|
|
|
|
void flan_bounds_error(const uint8_t *loc, int64_t loclen, int64_t idx,
|
|
int64_t len, void *xfer) {
|
|
if (flan_bounds_signal(loc, loclen, xfer, BOUNDS_AT, 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(loc, loclen, xfer, BOUNDS_SLICE, lo, hi, len)) return;
|
|
flan_slice_fail(loc, loclen, lo, hi, len);
|
|
}
|
|
|
|
/* ── (slice-from 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. */
|
|
static void promise_sentence(int64_t n) {
|
|
rt_sentence("slice-from was promised %lld elements behind the pointer, "
|
|
"and a count is never negative", (long long)n);
|
|
}
|
|
|
|
_Noreturn void flan_slice_promise_fail(const uint8_t *loc, int64_t loclen,
|
|
int64_t n) {
|
|
promise_sentence(n);
|
|
rt_print_sentence(loc, loclen);
|
|
rt_die();
|
|
}
|
|
|
|
void flan_slice_promise_error(const uint8_t *loc, int64_t loclen, int64_t n,
|
|
void *xfer) {
|
|
if (flan_bounds_signal(loc, loclen, xfer, BOUNDS_PROMISE, 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,
|
|
FLAN_ARITH_CAST_NAN = 5,
|
|
FLAN_ARITH_CAST_INF = 6
|
|
};
|
|
|
|
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, with its values in it — for the break loop
|
|
* and for stderr when nothing answered. Separate from the struct because the
|
|
* condition deliberately carries no rendered message. */
|
|
static void arith_sentence(int32_t op, int64_t lhs, int64_t rhs) {
|
|
switch (op) {
|
|
case FLAN_ARITH_DIV_ZERO:
|
|
rt_sentence("divide by zero: (/ %lld 0)", (long long)lhs);
|
|
break;
|
|
case FLAN_ARITH_REM_ZERO:
|
|
rt_sentence("remainder by zero: (%% %lld 0)", (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:
|
|
rt_sentence("(%s %lld %lld) overflows — the quotient is one past the "
|
|
"largest value the type holds",
|
|
op == FLAN_ARITH_DIV_OVERFLOW ? "/" : "%", (long long)lhs,
|
|
(long long)rhs);
|
|
break;
|
|
/* NaN and the infinities did not overshoot the range: no integer is
|
|
* their value, whatever the type. Saying "does not fit" reads as too big. */
|
|
case FLAN_ARITH_CAST_NAN:
|
|
rt_sentence("this value is NaN, which has no integer value to cast to");
|
|
break;
|
|
case FLAN_ARITH_CAST_INF:
|
|
rt_sentence("this value is infinite, which has no integer value to cast "
|
|
"to");
|
|
break;
|
|
/* An unsigned type's range starts at zero and a signed one's below it, so
|
|
* the lower bound says how to read the upper one: u64's is all ones. */
|
|
default:
|
|
if (lhs == 0)
|
|
rt_sentence("this value does not fit the integer type it is cast to, "
|
|
"which holds [0 %llu]", (unsigned long long)rhs);
|
|
else
|
|
rt_sentence("this value does not fit the integer type it is cast to, "
|
|
"which holds [%lld %lld]", (long long)lhs, (long long)rhs);
|
|
break;
|
|
}
|
|
}
|
|
|
|
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;
|
|
flan_condesc d;
|
|
uint32_t chain[2];
|
|
c.op = op;
|
|
c.lhs = lhs;
|
|
c.rhs = rhs;
|
|
arith_sentence(op, lhs, rhs);
|
|
rt_condesc(&d, chain, flan_arith_name, FLAN_ARITH_NAMELEN, loc, loclen);
|
|
flan_signal(&d, &c, xfer);
|
|
if (*(void **)xfer != NULL) return;
|
|
arith_sentence(op, lhs, rhs); /* in full; see flan_bounds_signal */
|
|
if (rt_error_break(&d, &c, xfer)) return;
|
|
rt_print_sentence(loc, loclen);
|
|
rt_die();
|
|
}
|
|
|
|
/* ── A call compiled against another signature ─────────────────────────
|
|
*
|
|
* A dev build's cell is three words: the body, the signature word it was
|
|
* installed with, and that signature as text (Emit.sig_text). Every call
|
|
* through a cell compares the word against the one the call site was
|
|
* compiled with, and lands here when they differ: the function was
|
|
* redefined with other parameters or another return since this caller was
|
|
* compiled, and making the call would pass it arguments it does not take.
|
|
* So the call is not made. A release build has no cells and never gets
|
|
* here.
|
|
*
|
|
* It signals StaleCall with `error`, BoundsError's shape and BoundsError's
|
|
* decision about restarts: nothing a handler supplies makes the old
|
|
* arguments fit the new body, so none is established here, and what answers
|
|
* it is the restart the program already has — or, in the dev loop, the
|
|
* break buffer, where evaluating the caller again and taking a restart is
|
|
* the whole of the fix.
|
|
*
|
|
* The strings are copied, and never freed. The call site's three live in
|
|
* the image of whatever module compiled it, and an expression thunk's module
|
|
* is unloaded once the thunk returns — a condition a handler kept, or the
|
|
* break site the agent's snapshot reads, must not point into it. A stale call
|
|
* is a rare event that the programmer fixes; a few leaked bytes for each one
|
|
* is the price of never pinning a module for it.
|
|
*
|
|
* The condition must agree field for field with the prelude's
|
|
* (defstruct StaleCall [callee str compiled str current str]),
|
|
* the same hand-kept agreement flan_bounds_cond has with BoundsError. */
|
|
|
|
typedef struct { flan_slice callee, compiled, current; } flan_stale_cond;
|
|
|
|
static const uint8_t flan_stale_name[] = "StaleCall";
|
|
#define FLAN_STALE_NAMELEN 9
|
|
|
|
static flan_slice flan_stale_copy(const char *s) {
|
|
flan_slice r;
|
|
size_t n = strlen(s);
|
|
char *p = malloc(n + 1);
|
|
if (p == NULL) { r.ptr = (const uint8_t *)""; r.len = 0; return r; }
|
|
memcpy(p, s, n + 1);
|
|
r.ptr = (const uint8_t *)p;
|
|
r.len = (int64_t)n;
|
|
return r;
|
|
}
|
|
|
|
static void stale_sentence(const char *callee, const char *want,
|
|
const char *now) {
|
|
rt_sentence("this call to %s was compiled for %s, and %s is defined as %s. "
|
|
"Evaluating the function this call is in again fixes its next "
|
|
"call. A function that is still running, such as main's loop, "
|
|
"is never called again: define %s with %s again, or run the "
|
|
"program again.",
|
|
callee, want, callee, now, callee, want);
|
|
}
|
|
|
|
void flan_stale_call(const char *site, const char *callee, const char *want,
|
|
void *const *cell, void *xfer) {
|
|
/* A registry cell nothing has published into yet has no text. */
|
|
const char *now = cell[2] != NULL ? (const char *)cell[2] : "(no body)";
|
|
flan_stale_cond c;
|
|
c.callee = flan_stale_copy(callee);
|
|
c.compiled = flan_stale_copy(want);
|
|
c.current = flan_stale_copy(now);
|
|
flan_slice where = flan_stale_copy(site);
|
|
flan_condesc d;
|
|
uint32_t chain[2];
|
|
stale_sentence(callee, want, now);
|
|
rt_condesc(&d, chain, flan_stale_name, FLAN_STALE_NAMELEN, where.ptr,
|
|
where.len);
|
|
flan_signal(&d, &c, xfer);
|
|
if (*(void **)xfer != NULL) return;
|
|
stale_sentence(callee, want, now); /* in full; see flan_bounds_signal */
|
|
if (rt_error_break(&d, &c, xfer)) return;
|
|
rt_print_sentence(where.ptr, where.len);
|
|
rt_die();
|
|
}
|
|
|
|
/* ── A call through a null (CFn ...) ───────────────────────────────────
|
|
*
|
|
* A (CFn ...) may sit in a struct field, a fixed array or a global, all of
|
|
* which zero-initialise, and a zeroed one is a null address. Every call
|
|
* through a CFn value tests it first and lands here on null, so the call is
|
|
* not made. It signals NullCall with `error` — BoundsError's shape and its
|
|
* decision about restarts: no value a handler supplies turns into a function
|
|
* to call, so what answers it is a restart the program already has, or the
|
|
* break loop in a dev build.
|
|
*
|
|
* `type` is copied and never freed, for flan_stale_call's reason: the text
|
|
* lives in the image of the module that compiled the call, which may be a
|
|
* thunk that is unloaded once it returns. Must agree with the prelude's
|
|
* (defstruct NullCall :parent Error [type str]). */
|
|
|
|
typedef struct { flan_slice type; } flan_nullcall_cond;
|
|
|
|
static const uint8_t flan_nullcall_name[] = "NullCall";
|
|
#define FLAN_NULLCALL_NAMELEN 8
|
|
|
|
static void nullcall_sentence(const char *ty) {
|
|
rt_sentence("this call is through a %s that holds no function — a field, "
|
|
"an array element or a global of that type starts out empty. "
|
|
"Store a function in it before calling it, or hold it as an "
|
|
"(Option %s) and match on it",
|
|
ty, ty);
|
|
}
|
|
|
|
void flan_null_call(const uint8_t *loc, int64_t loclen, const char *ty,
|
|
void *xfer) {
|
|
flan_nullcall_cond c;
|
|
flan_condesc d;
|
|
uint32_t chain[2];
|
|
c.type = flan_stale_copy(ty);
|
|
nullcall_sentence(ty);
|
|
rt_condesc(&d, chain, flan_nullcall_name, FLAN_NULLCALL_NAMELEN, loc,
|
|
loclen);
|
|
flan_signal(&d, &c, xfer);
|
|
if (*(void **)xfer != NULL) return;
|
|
nullcall_sentence(ty); /* in full; see flan_bounds_signal */
|
|
if (rt_error_break(&d, &c, xfer)) return;
|
|
rt_print_sentence(loc, loclen);
|
|
rt_die();
|
|
}
|
|
|
|
/* ── 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 names one of these — its address and the
|
|
* [incarnation] it was made for, see flan_alloc_value — and is never a copy.
|
|
* 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, "Every build detects a released region". */
|
|
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;
|
|
/* Bumped when arena-destroy retires this record. A Flan Allocator value is
|
|
* this record's address and the incarnation it was made for, and every use
|
|
* of one compares the two (flan_alloc_use), so a value kept past its
|
|
* arena's destroy traps even after arena-new has taken the record back for
|
|
* another arena. Separate from [epoch]: free-all keeps the arena, and a
|
|
* value made before a free-all is still good. */
|
|
uint64_t incarnation;
|
|
};
|
|
|
|
/* A Flan Allocator value, two words. The compiler lays it out as { ptr, i64 }
|
|
* and hands the runtime its address. */
|
|
typedef struct flan_alloc_value {
|
|
flan_allocator *rec;
|
|
uint64_t inc;
|
|
} flan_alloc_value;
|
|
|
|
/* ── 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 (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_note_owned(void *base, int64_t bytes, int64_t elem,
|
|
const char *type, int64_t typelen,
|
|
const void *owner);
|
|
int32_t flan_dev_reg_owner_check(const void *p, const void *owner,
|
|
const void **found);
|
|
void flan_dev_reg_note_sliced(void *base, int64_t bytes, int64_t elem,
|
|
const char *type, int64_t typelen,
|
|
const void *owner);
|
|
void flan_dev_reg_dead(void *base);
|
|
void flan_dev_reg_dead_range(void *base, int64_t bytes);
|
|
/* flan_dev.c: a dev build fills a block a resize moved away from, so that a
|
|
* slice still pointing into it reads visibly wrong values. */
|
|
void flan_dev_poison(void *p, 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 (size > old_size && 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);
|
|
flan_dev_poison(p, old_size);
|
|
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, 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 same fact told to AddressSanitizer: an arena's released bytes are
|
|
* poisoned at free-all, so a read through a slice kept past it reports under
|
|
* --sanitize instead of printing what is there. Every path that hands arena
|
|
* bytes back out — the bump, a resize in place, the temp arena's text fast
|
|
* path — unpoisons exactly what it hands out, and every path that writes
|
|
* over released bytes itself (the dev fill, a chunk dropped or freed)
|
|
* unpoisons first. */
|
|
#if defined(__SANITIZE_ADDRESS__)
|
|
#define FLAN_ASAN 1
|
|
#elif defined(__has_feature)
|
|
#if __has_feature(address_sanitizer)
|
|
#define FLAN_ASAN 1
|
|
#endif
|
|
#endif
|
|
#ifdef FLAN_ASAN
|
|
void __asan_poison_memory_region(void const volatile *addr, size_t size);
|
|
void __asan_unpoison_memory_region(void const volatile *addr, size_t size);
|
|
#define FLAN_ASAN_POISON(p, n) __asan_poison_memory_region((p), (size_t)(n))
|
|
#define FLAN_ASAN_UNPOISON(p, n) __asan_unpoison_memory_region((p), (size_t)(n))
|
|
#else
|
|
#define FLAN_ASAN_POISON(p, n) ((void)(p), (void)(n))
|
|
#define FLAN_ASAN_UNPOISON(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. */
|
|
|
|
/* A block the temp arena grew out of. It still holds what was allocated from
|
|
* it before the growth, so it is kept until the next free-all. */
|
|
typedef struct flan_chunk {
|
|
struct flan_chunk *next;
|
|
uint8_t *base;
|
|
int64_t cap;
|
|
} flan_chunk;
|
|
|
|
typedef struct flan_arena {
|
|
uint8_t *base;
|
|
int64_t cap;
|
|
int64_t offset;
|
|
int64_t peak;
|
|
/* The temp arena only: a request that does not fit starts a bigger block
|
|
* instead of failing, and [old] keeps the ones it outgrew until free-all,
|
|
* which keeps the biggest. A program that formats more text between two
|
|
* (free-temp)s than the first block holds gets more room rather than
|
|
* StorageExhausted, and one that never calls it grows the way the heap
|
|
* would. A program's own arena-new keeps its fixed capacity. */
|
|
int grow;
|
|
flan_chunk *old;
|
|
} flan_arena;
|
|
|
|
/* Retire the current block and start one that fits [need]. */
|
|
static int flan_arena_grow(flan_arena *ar, int64_t need) {
|
|
flan_chunk *c;
|
|
uint8_t *b;
|
|
int64_t cap = ar->cap;
|
|
while (cap < need) {
|
|
if (cap > ((int64_t)1 << 40)) { cap = need; break; }
|
|
cap *= 2;
|
|
}
|
|
if (cap == ar->cap) cap *= 2;
|
|
c = (flan_chunk *)malloc(sizeof *c);
|
|
if (!c) return 0;
|
|
b = (uint8_t *)malloc((size_t)cap);
|
|
if (!b) { free(c); return 0; }
|
|
c->base = ar->base;
|
|
c->cap = ar->cap;
|
|
c->next = ar->old;
|
|
ar->old = c;
|
|
ar->base = b;
|
|
ar->cap = cap;
|
|
ar->offset = 0;
|
|
return 1;
|
|
}
|
|
|
|
/* The blocks the arena outgrew, handed back; the dev registry and memcheck
|
|
* are told each one died, the same as the live block. */
|
|
static void flan_arena_drop_old(flan_arena *ar) {
|
|
while (ar->old) {
|
|
flan_chunk *c = ar->old;
|
|
ar->old = c->next;
|
|
flan_dev_reg_dead_range(c->base, c->cap);
|
|
FLAN_ASAN_UNPOISON(c->base, c->cap);
|
|
flan_dev_poison(c->base, c->cap);
|
|
free(c->base);
|
|
free(c);
|
|
}
|
|
}
|
|
|
|
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) && ar->grow && size < ((int64_t)1 << 40)
|
|
&& flan_arena_grow(ar, size + align)) {
|
|
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;
|
|
FLAN_ASAN_UNPOISON(ar->base + start, 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. */
|
|
/* A growing arena whose block cannot hold the new size falls through to
|
|
* the copy below, whose allocation starts a bigger block. */
|
|
if (p && (uint8_t *)p + old_size == ar->base + ar->offset
|
|
&& !(ar->grow && (int64_t)((uint8_t *)p - ar->base) + size > ar->cap)) {
|
|
int64_t end = (int64_t)((uint8_t *)p - ar->base) + size;
|
|
/* The budget is checked here as on every other path; a block grown in
|
|
* place is still more live bytes. */
|
|
if (size > old_size && flan_over_budget(a, size - old_size)) return NULL;
|
|
if (end > ar->cap || end < 0) return NULL;
|
|
ar->offset = end;
|
|
if (end > ar->peak) ar->peak = end;
|
|
a->live_bytes += size - old_size;
|
|
FLAN_ASAN_UNPOISON(p, 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));
|
|
flan_dev_poison(p, old_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_arena_drop_old(ar);
|
|
flan_dev_reg_dead_range(ar->base, ar->cap);
|
|
/* A dev build fills what was handed out with the pattern a moved Vec's
|
|
old buffer gets, so a slice or text kept past the free-all reads as
|
|
garbage rather than as the last round's values — the temp arena and a
|
|
program's own arena alike. A release build leaves the bytes. */
|
|
FLAN_ASAN_UNPOISON(ar->base, ar->offset);
|
|
flan_dev_poison(ar->base, ar->offset);
|
|
FLAN_VG_MAKE_MEM_UNDEFINED(ar->base, ar->cap);
|
|
FLAN_ASAN_POISON(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.
|
|
*
|
|
* It holds an Allocator *value*, the record and its incarnation, and not the
|
|
* bare record: with-allocator restores what it displaced, and what it displaced
|
|
* may be an arena destroyed in the meantime whose record a later arena-new
|
|
* took. Holding the incarnation is what lets the next use of the context trap
|
|
* rather than allocate from that other arena. */
|
|
|
|
static flan_alloc_value flan_ctx = { &flan_heap, 0 };
|
|
static flan_allocator *flan_ctx_tmp = NULL;
|
|
/* The agent's scratch temp arenas; see flan_temp_scratch_begin. */
|
|
#define FLAN_SCRATCH_LEVELS 16
|
|
static flan_allocator *flan_scratch[FLAN_SCRATCH_LEVELS];
|
|
/* The incarnation of the temp arena each level displaced, so the end puts it
|
|
* back only if the expression did not destroy it. */
|
|
static uint64_t flan_scratch_prev_inc[FLAN_SCRATCH_LEVELS];
|
|
static int flan_scratch_depth;
|
|
|
|
flan_allocator *flan_arena_new(int64_t cap);
|
|
_Noreturn static void flan_destroyed_fail(const uint8_t *loc, int64_t loclen);
|
|
|
|
/* The context's record, for the runtime's own callers: a zeroed container
|
|
* adopting the context on its first operation. Checked like any use. */
|
|
flan_allocator *flan_context_allocator(void) {
|
|
if (flan_ctx.rec && flan_ctx.rec->incarnation != flan_ctx.inc)
|
|
flan_destroyed_fail((const uint8_t *)"context/allocator", 17);
|
|
return flan_ctx.rec;
|
|
}
|
|
|
|
/* The same, for an operation the compiler emitted, which names its site. */
|
|
flan_allocator *flan_context_use(const uint8_t *loc, int64_t loclen) {
|
|
if (flan_ctx.rec && flan_ctx.rec->incarnation != flan_ctx.inc)
|
|
flan_destroyed_fail(loc, loclen);
|
|
return flan_ctx.rec;
|
|
}
|
|
|
|
/* context/allocator as a value: the one the context holds, incarnation and
|
|
* all, so a value read from the context goes stale with it. */
|
|
void flan_context_value(flan_alloc_value *out) { *out = flan_ctx; }
|
|
|
|
/* 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)
|
|
|
|
/* Odin's context.temp_allocator: where i64->bytes and f64->bytes put their
|
|
* text, and what context/temp names. It grows rather than failing (see
|
|
* flan_arena's [grow]), and it is wiped by (free-temp), which a program calls
|
|
* once a frame — and, in a dev build, by the agent at every frame boundary it
|
|
* polls at. Text kept past the frame is cloned out of it first. */
|
|
flan_allocator *flan_context_temp(void) {
|
|
if (!flan_ctx_tmp) {
|
|
flan_ctx_tmp = flan_arena_new(FLAN_TEMP_DEFAULT);
|
|
if (flan_ctx_tmp) ((flan_arena *)flan_ctx_tmp->data)->grow = 1;
|
|
}
|
|
return flan_ctx_tmp;
|
|
}
|
|
|
|
static void *rt_temp_alloc(int64_t n) {
|
|
flan_allocator *a = flan_context_temp();
|
|
if (a == NULL) return NULL;
|
|
return a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, n, 1);
|
|
}
|
|
|
|
/* (free-temp): everything in the temp arena dies, the same release free-all
|
|
* is, and a container made from it traps on its next use. Nothing to do when
|
|
* nothing has made it yet. */
|
|
void flan_free_temp(void) {
|
|
flan_allocator *a = flan_ctx_tmp;
|
|
if (!a) return;
|
|
a->proc(a, FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0);
|
|
a->epoch++;
|
|
}
|
|
|
|
/* An expression the agent runs while the program is stopped gets a temp
|
|
* arena of its own: [begin] points context/temp at a scratch arena and
|
|
* answers the program's, [end] wipes the scratch arena — poisoned in a dev
|
|
* build, as any free-temp is — and puts the program's back. The program's own
|
|
* temp arena is never touched, so text its stopped frames hold survives and a
|
|
* temp Vec it owns grows through its own allocator as usual. What the
|
|
* expression allocates from context/temp and stores into program state
|
|
* dangles once the expression ends, like any temp text kept past its frame,
|
|
* and reads as the poison pattern in a dev build.
|
|
*
|
|
* One scratch arena per nesting level — a stop inside an evaluated expression
|
|
* evaluates inside it — each kept and reused, so an evaluation costs a
|
|
* free-all and not a malloc. Past the last level the deepest is shared. */
|
|
|
|
void *flan_temp_scratch_begin(void) {
|
|
flan_allocator *prev = flan_ctx_tmp;
|
|
int d = flan_scratch_depth < FLAN_SCRATCH_LEVELS ? flan_scratch_depth
|
|
: FLAN_SCRATCH_LEVELS - 1;
|
|
if (!flan_scratch[d]) {
|
|
flan_scratch[d] = flan_arena_new(FLAN_TEMP_DEFAULT);
|
|
if (flan_scratch[d]) ((flan_arena *)flan_scratch[d]->data)->grow = 1;
|
|
}
|
|
flan_scratch_prev_inc[d] = prev ? prev->incarnation : 0;
|
|
flan_scratch_depth++;
|
|
if (flan_scratch[d]) flan_ctx_tmp = flan_scratch[d];
|
|
return prev;
|
|
}
|
|
|
|
void flan_temp_scratch_end(void *prev) {
|
|
int d;
|
|
if (flan_scratch_depth > 0) flan_scratch_depth--;
|
|
d = flan_scratch_depth < FLAN_SCRATCH_LEVELS ? flan_scratch_depth
|
|
: FLAN_SCRATCH_LEVELS - 1;
|
|
if (flan_scratch[d] && flan_ctx_tmp == flan_scratch[d]) {
|
|
flan_scratch[d]->proc(flan_scratch[d], FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0);
|
|
flan_scratch[d]->epoch++;
|
|
}
|
|
/* An expression that destroyed the program's temp arena through an
|
|
* Allocator value it kept has retired its record, and a later arena-new may
|
|
* have taken it; putting it back would make context/temp that other arena.
|
|
* The context is then left without one, as the destroy left it, and the
|
|
* next use makes a new one. */
|
|
{
|
|
flan_allocator *p = (flan_allocator *)prev;
|
|
flan_ctx_tmp = p && p->incarnation == flan_scratch_prev_inc[d] ? p : NULL;
|
|
}
|
|
}
|
|
|
|
/* with-allocator hands in two values in its own frame: [0] the one to install
|
|
* and [1] where the displaced one is kept. It gets the same pointer back and
|
|
* passes it to restore — on the normal path and on the transfer path both —
|
|
* so a displaced value is restored with its incarnation. A null record in [0]
|
|
* is a zeroed Allocator and leaves the context as it was. */
|
|
flan_alloc_value *flan_context_set(flan_alloc_value *v) {
|
|
v[1] = flan_ctx;
|
|
if (v[0].rec) flan_ctx = v[0];
|
|
return v;
|
|
}
|
|
|
|
void flan_context_restore(flan_alloc_value *v) {
|
|
if (v) flan_ctx = v[1];
|
|
}
|
|
|
|
/* The context as it stands, and putting it back: the agent's way out of an
|
|
* evaluation that trapped jumps past the [with-allocator] that would have
|
|
* restored it. Two words, which is room for whatever the context grows into;
|
|
* the agent only carries them. */
|
|
void flan_context_save(uint64_t m[2]) {
|
|
m[0] = (uint64_t)(uintptr_t)flan_ctx.rec;
|
|
m[1] = flan_ctx.inc;
|
|
}
|
|
|
|
void flan_context_load(const uint64_t m[2]) {
|
|
flan_allocator *a = (flan_allocator *)(uintptr_t)m[0];
|
|
flan_ctx.rec = a ? a : &flan_heap;
|
|
flan_ctx.inc = a ? m[1] : 0;
|
|
}
|
|
|
|
/* Allocator headers [flan_arena_destroy] retired, linked through [data]. See
|
|
* there for why a header is never freed; this is why that does not grow. */
|
|
static flan_allocator *flan_retired;
|
|
|
|
/* A retired header is taken back rather than a new one made. Its epoch is
|
|
* kept, never reset: it only ever rises on a header, so a container made from
|
|
* the arena this header used to serve still records an older number and still
|
|
* traps. Only the bookkeeping a new arena starts from is cleared. */
|
|
static flan_allocator *flan_header_new(void) {
|
|
flan_allocator *a = flan_retired;
|
|
if (a == NULL) return (flan_allocator *)calloc(1, sizeof *a);
|
|
flan_retired = (flan_allocator *)a->data;
|
|
a->data = NULL;
|
|
a->live_blocks = 0;
|
|
a->live_bytes = 0;
|
|
a->budget = 0;
|
|
return a;
|
|
}
|
|
|
|
static void flan_header_retire(flan_allocator *a);
|
|
|
|
flan_allocator *flan_arena_new(int64_t cap) {
|
|
flan_allocator *a;
|
|
flan_arena *ar;
|
|
if (cap <= 0) cap = FLAN_TEMP_DEFAULT;
|
|
ar = (flan_arena *)calloc(1, sizeof *ar);
|
|
if (!ar) return NULL;
|
|
ar->base = (uint8_t *)malloc((size_t)cap);
|
|
if (!ar->base) { free(ar); return NULL; }
|
|
a = flan_header_new();
|
|
if (!a) { free(ar->base); 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;
|
|
}
|
|
|
|
/* What an allocator's procedure becomes once [flan_arena_destroy] has handed
|
|
* its arena back. Every request traps, because there is nothing left to serve
|
|
* it from and answering NULL would read as exhaustion — which a retry handler
|
|
* that raises the budget would then retry for ever. Flan code does not reach
|
|
* it: a stale Allocator value traps in flan_alloc_use and a stale container on
|
|
* its epoch first. It is the backstop for a caller holding the bare record. */
|
|
static void *flan_destroyed_proc(flan_allocator *a, int32_t mode, void *p,
|
|
int64_t old_size, int64_t size, int64_t align) {
|
|
(void)a; (void)mode; (void)p; (void)old_size; (void)size; (void)align;
|
|
flan_say(NULL, 0,
|
|
"this allocator was destroyed by arena-destroy, so nothing can be "
|
|
"allocated from it or released through it");
|
|
rt_trap((const uint8_t *)"DestroyedAllocator", 18);
|
|
}
|
|
|
|
/* The pages and the arena record go; the allocator itself does not. Every
|
|
* container made from it holds this pointer and reads [epoch] through it on
|
|
* its next operation — that read is the whole of the stale-region trap — so
|
|
* freeing the header would turn the trap into a read of freed memory that
|
|
* happens to see the bumped value. The header is retired instead: epoch
|
|
* bumped, procedure swapped for one that refuses, never freed. Retired
|
|
* headers go on a list that [flan_arena_new] takes from, so a program that
|
|
* makes and destroys arenas in a loop holds as many headers as it ever had
|
|
* arenas alive at once.
|
|
*
|
|
* The Allocator value that named the arena carries the incarnation it was made
|
|
* for, which the retire bumps, so every later use of that value — a second
|
|
* destroy included — traps in flan_alloc_use before it reaches here, whether
|
|
* or not a later arena-new has taken the record back. */
|
|
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.rec) { flan_ctx.rec = &flan_heap; flan_ctx.inc = 0; }
|
|
if (a == flan_ctx_tmp) flan_ctx_tmp = NULL;
|
|
for (int i = 0; i < FLAN_SCRATCH_LEVELS; i++)
|
|
if (flan_scratch[i] == a) flan_scratch[i] = NULL;
|
|
a->epoch++;
|
|
flan_arena_drop_old(ar);
|
|
flan_dev_reg_dead_range(ar->base, ar->cap);
|
|
FLAN_ASAN_UNPOISON(ar->base, ar->cap);
|
|
free(ar->base);
|
|
free(ar);
|
|
flan_header_retire(a);
|
|
}
|
|
|
|
static void flan_header_retire(flan_allocator *a) {
|
|
a->incarnation++;
|
|
a->proc = flan_destroyed_proc;
|
|
a->live_blocks = 0;
|
|
a->live_bytes = 0;
|
|
a->data = flan_retired;
|
|
flan_retired = a;
|
|
}
|
|
|
|
flan_allocator *flan_heap_allocator(void) { return &flan_heap; }
|
|
|
|
/* An Allocator value made from a record: the record and its incarnation now.
|
|
* Through an out-pointer, since nothing here returns a struct by value. */
|
|
void flan_alloc_seal(flan_allocator *a, flan_alloc_value *out) {
|
|
out->rec = a;
|
|
out->inc = a ? a->incarnation : 0;
|
|
}
|
|
|
|
/* Every use of an Allocator value comes through here: the record, if the
|
|
* value's incarnation is still the record's. A mismatch is a value kept past
|
|
* its arena's destroy, and it traps whether the record is still retired or
|
|
* serves a newer arena — reaching the newer arena would be allocating from a
|
|
* region the program never named. A null record passes through to the
|
|
* operation's own null check, which names the site the same way. */
|
|
flan_allocator *flan_alloc_use(const flan_alloc_value *v, const uint8_t *loc,
|
|
int64_t loclen) {
|
|
flan_allocator *a = v->rec;
|
|
if (a && a->incarnation != v->inc) flan_destroyed_fail(loc, loclen);
|
|
return a;
|
|
}
|
|
|
|
_Noreturn static void flan_destroyed_fail(const uint8_t *loc, int64_t loclen) {
|
|
flan_say(loc, loclen,
|
|
"this allocator was destroyed by arena-destroy, so nothing can be "
|
|
"allocated from it or released through it");
|
|
rt_trap((const uint8_t *)"DestroyedAllocator", 18);
|
|
}
|
|
|
|
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 [defonce] 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) {
|
|
flan_say(loc, loclen,
|
|
"this allocator is null — a zeroed Allocator was never given one");
|
|
rt_trap((const uint8_t *)"NullAllocator", 13);
|
|
}
|
|
|
|
_Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) {
|
|
flan_say(loc, loclen,
|
|
"this allocator does not offer free-all — it has no region to "
|
|
"release");
|
|
rt_trap((const uint8_t *)"NoFreeAll", 9);
|
|
}
|
|
|
|
/* [x!] over an Option that is None, or a dyn that is nil. The checker writes
|
|
* the sentence, since it has the expression's text and knows which absence
|
|
* it is; this prints it at the site and stops. */
|
|
_Noreturn void flan_unwrap_fail(const uint8_t *loc, int64_t loclen,
|
|
const uint8_t *what, int64_t whatlen) {
|
|
flan_say(loc, loclen, "%.*s", (int)whatlen, (const char *)what);
|
|
rt_trap((const uint8_t *)"Unwrap", 6);
|
|
}
|
|
|
|
/* ── 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);
|
|
}
|
|
|
|
/* Whether a "file:line:col" location names an indented (.fln) file, so a
|
|
* suggestion is written in the syntax the reader's code is in. */
|
|
static int rt_loc_is_fln(const uint8_t *loc, int64_t loclen) {
|
|
for (int64_t i = 0; i + 5 <= loclen; i++)
|
|
if (memcmp(loc + i, ".fln:", 5) == 0) return 1;
|
|
return 0;
|
|
}
|
|
|
|
_Noreturn void flan_region_only_fail(const uint8_t *loc, int64_t loclen) {
|
|
rt_flush_out();
|
|
fprintf(stderr,
|
|
"%.*s: this container's elements own storage, and this allocator "
|
|
"frees one block at a time, so freeing it here would leak what the "
|
|
"elements hold. Build it against a region allocator: %s\n",
|
|
(int)loclen, (const char *)loc,
|
|
rt_loc_is_fln(loc, loclen)
|
|
? "with-allocator(context/temp): and the code under it, or an "
|
|
"arena-new(n)"
|
|
: "(with-allocator context/temp ...) or an (arena-new n)");
|
|
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 five words rather than the spec's four:
|
|
*
|
|
* ptr len cap allocator the release layout spec-memory.md fixes
|
|
* epoch the allocator's epoch when this Vec last
|
|
* touched it. Any operation on a container whose
|
|
* recorded epoch has moved traps.
|
|
*
|
|
* There used to be a sixth word, gen, the stale-slice generation
|
|
* spec-memory.md once asked for. It was bumped on every reallocation and
|
|
* consulted by nothing — a slice is ptr+len and carries neither the Vec it
|
|
* came from nor the generation it was taken at, so the check it promised had
|
|
* nothing to compare — and Odin's header (data, len, cap, allocator, and
|
|
* nothing else) is the model this one follows. Deleted 2026-09-18 with the
|
|
* ownership repeal; see docs/BUILT.md.
|
|
*
|
|
* The epoch word is 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.
|
|
*
|
|
* 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 epoch;
|
|
} flan_vec;
|
|
|
|
/* This struct's layout is restated twice more in the tree — flan_dyn.c's
|
|
* [flan_dyn_vec_hdr], for a typed container's view (M2 item 3), and
|
|
* test/dyn_ops.c's [hand_vec], which builds one by hand because it has no
|
|
* [flan_vec] type to initialise, this file being linked into it but not
|
|
* included by it. None of the three can [#include]
|
|
* this file (see [Build.compile_c]), so nothing at compile time ties them
|
|
* together — a reordered field here links and runs, and corrupts whichever
|
|
* of the other two disagrees. [flan_vec_layout] is the tie: it reports this
|
|
* struct's real size and field offsets, and test/dyn_ops.c's "layout" mode
|
|
* compares them against its own [hand_vec]'s and against flan_dyn.c's
|
|
* [flan_dyn_vec_hdr_layout], so a disagreement is a FAIL line in `dune test`
|
|
* rather than a silent corruption the next line over. */
|
|
void flan_vec_layout(int64_t out[6]) {
|
|
out[0] = (int64_t)sizeof(flan_vec);
|
|
out[1] = (int64_t)offsetof(flan_vec, ptr);
|
|
out[2] = (int64_t)offsetof(flan_vec, len);
|
|
out[3] = (int64_t)offsetof(flan_vec, cap);
|
|
out[4] = (int64_t)offsetof(flan_vec, alloc);
|
|
out[5] = (int64_t)offsetof(flan_vec, epoch);
|
|
}
|
|
|
|
/* 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; }
|
|
|
|
/* i64->bytes and f64->bytes: the number's text in the temp arena, answered
|
|
* through [out]. When the current block has FLAN_NUM_BYTES to spare and no
|
|
* budget is set, the number is rendered straight into it and the offset moved
|
|
* past what was written — no copy, no call through the arena procedure.
|
|
* Otherwise it is rendered on the stack and allocated through the procedure,
|
|
* which grows the block. 0 is a failed allocation, reported like any other for
|
|
* the compiler's StorageExhausted guard; the temp arena grows, so that is
|
|
* malloc itself failing. */
|
|
typedef int (*flan_render)(const void *x, char *buf, size_t cap);
|
|
|
|
static int render_i64(const void *x, char *buf, size_t cap) {
|
|
return snprintf(buf, cap, "%lld", (long long)*(const int64_t *)x);
|
|
}
|
|
|
|
static int render_f64(const void *x, char *buf, size_t cap) {
|
|
return flan_f64_format(*(const double *)x, buf, cap);
|
|
}
|
|
|
|
static int8_t flan_temp_text(flan_render render, const void *x,
|
|
flan_slice *out) {
|
|
flan_allocator *a = flan_context_temp();
|
|
flan_arena *ar;
|
|
uint8_t *q;
|
|
int64_t len;
|
|
if (!a) {
|
|
flan_fail_bytes = FLAN_NUM_BYTES;
|
|
flan_fail_align = 1;
|
|
flan_fail_id = 0;
|
|
return 0;
|
|
}
|
|
ar = (flan_arena *)a->data;
|
|
if (a->budget <= 0 && ar->cap - ar->offset >= FLAN_NUM_BYTES) {
|
|
q = ar->base + ar->offset;
|
|
FLAN_ASAN_UNPOISON(q, FLAN_NUM_BYTES);
|
|
len = fit(render(x, (char *)q, FLAN_NUM_BYTES));
|
|
/* The tail the text did not use goes back to released. */
|
|
FLAN_ASAN_POISON(q + len, FLAN_NUM_BYTES - len);
|
|
ar->offset += len;
|
|
if (ar->offset > ar->peak) ar->peak = ar->offset;
|
|
a->live_blocks++;
|
|
a->live_bytes += len;
|
|
} else {
|
|
char buf[FLAN_NUM_BYTES];
|
|
len = fit(render(x, buf, sizeof buf));
|
|
flan_fail_bytes = len;
|
|
flan_fail_align = 1;
|
|
flan_fail_id = (int64_t)(intptr_t)a;
|
|
q = (uint8_t *)a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, len, 1);
|
|
if (!q) return 0;
|
|
memcpy(q, buf, (size_t)len);
|
|
}
|
|
flan_dev_reg_note_sliced(q, len, 1, "u8", 2, a);
|
|
out->ptr = q;
|
|
out->len = len;
|
|
return 1;
|
|
}
|
|
|
|
int8_t flan_i64_temp(int64_t x, flan_slice *out) {
|
|
return flan_temp_text(render_i64, &x, out);
|
|
}
|
|
|
|
int8_t flan_f64_temp(double x, flan_slice *out) {
|
|
return flan_temp_text(render_f64, &x, out);
|
|
}
|
|
|
|
/* For flan_dyn.c's crossing of a dyn value into a written type
|
|
* ([flan_dyn_need_as]). A dyn vec copied into a [const T] or a text's bytes
|
|
* lent to a str live exactly as long as i64->bytes's text does: until the
|
|
* temp arena's next free-all. [flan_temp_block] is the copy's block, noted
|
|
* in a dev build's registry like any temp slice so a read after free-temp
|
|
* traps or reads poison; NULL only when malloc itself failed. The stamp is
|
|
* the arena and the incarnation and epoch it is at now, and a stamp is live
|
|
* while that arena is still at both — a free-temp, the agent's wipe, the end
|
|
* of a scratch evaluation or a destroy ends it. An arena record is never
|
|
* freed (see [flan_retired]), so an old stamp is always safe to read. */
|
|
void *flan_temp_block(int64_t bytes, int64_t align, int64_t elem,
|
|
const char *type, int64_t typelen) {
|
|
flan_allocator *a = flan_context_temp();
|
|
void *q;
|
|
if (a == NULL || bytes <= 0) return NULL;
|
|
q = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, align);
|
|
if (q != NULL) flan_dev_reg_note_sliced(q, bytes, elem, type, typelen, a);
|
|
return q;
|
|
}
|
|
|
|
const void *flan_temp_stamp(uint64_t *inc, uint64_t *epoch) {
|
|
flan_allocator *a = flan_context_temp();
|
|
*inc = a ? a->incarnation : 0;
|
|
*epoch = a ? a->epoch : 0;
|
|
return a;
|
|
}
|
|
|
|
int32_t flan_temp_stamp_live(const void *p, uint64_t inc, uint64_t epoch) {
|
|
const flan_allocator *a = (const flan_allocator *)p;
|
|
/* No temp arena could be made: the pin is kept for good. */
|
|
if (a == NULL) return 1;
|
|
return a->incarnation == inc && a->epoch == epoch;
|
|
}
|
|
|
|
/* 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) {
|
|
rt_flush_out();
|
|
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) {
|
|
rt_flush_out();
|
|
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, "Every build detects 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 (defonce 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 (defonce 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);
|
|
}
|
|
|
|
/* Told of every Vec block and every Map block this file allocates, moves or
|
|
* frees: the old block (or NULL), the new one (or NULL), its size in bytes,
|
|
* and the allocator and epoch it was made under. NULL unless flan_dyn.c's
|
|
* [flan_dyn_track_vecs] has installed its own — a program that can make a
|
|
* collector-owned closure environment or holds a dyn, either of which may sit
|
|
* in a Vec or a Map, installs it so the collector never reads a block a stale
|
|
* header copy still names. A pointer rather than a call so this file names
|
|
* nothing in flan_dyn.c. */
|
|
void (*flan_vec_block_hook)(void *old, void *fresh, int64_t bytes, void *alloc,
|
|
int64_t epoch) = NULL;
|
|
|
|
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 (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;
|
|
if (flan_vec_block_hook)
|
|
flan_vec_block_hook(v->ptr, p, bytes, v->alloc, v->epoch);
|
|
v->ptr = p;
|
|
v->cap = cap;
|
|
/* Any slice taken before this points at storage that may have moved; in a
|
|
* dev build the allocator has filled the old block (flan_dev_poison). */
|
|
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->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(loc, loclen, xfer, BOUNDS_AT, (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": (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(loc, loclen, xfer, BOUNDS_SLICE, 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);
|
|
}
|
|
|
|
/* ── String: the prelude's owned text, always valid UTF-8 ──────────────
|
|
*
|
|
* A String is a (Vec u8) the checker keeps valid (check.ml, [string_call]).
|
|
* These are the run-time halves of that: a text or a code point that could
|
|
* not be proved valid when the program was compiled is checked here, at the
|
|
* site of the append that would have stored it, and a bad one stops the
|
|
* program there. A trap and not a condition: nothing a handler could do
|
|
* makes the bytes valid, and storing them anyway is the one outcome the type
|
|
* exists to rule out. */
|
|
|
|
/* The index of the first byte that does not begin a well-formed UTF-8
|
|
* sequence, or -1. The rules are the prelude's decode-rune's: no overlong
|
|
* forms, no surrogates, nothing past U+10FFFF. */
|
|
static int64_t utf8_bad_at(const uint8_t *p, int64_t n) {
|
|
int64_t i = 0;
|
|
while (i < n) {
|
|
uint8_t b0 = p[i];
|
|
int size;
|
|
uint8_t lo = 0x80, hi = 0xbf;
|
|
if (b0 < 0x80) { i++; continue; }
|
|
if (b0 < 0xc2) return i;
|
|
else if (b0 <= 0xdf) size = 2;
|
|
else if (b0 == 0xe0) { size = 3; lo = 0xa0; }
|
|
else if (b0 <= 0xec) size = 3;
|
|
else if (b0 == 0xed) { size = 3; hi = 0x9f; }
|
|
else if (b0 <= 0xef) size = 3;
|
|
else if (b0 == 0xf0) { size = 4; lo = 0x90; }
|
|
else if (b0 <= 0xf3) size = 4;
|
|
else if (b0 == 0xf4) { size = 4; hi = 0x8f; }
|
|
else return i;
|
|
if (i + size > n) return i;
|
|
if (p[i + 1] < lo || p[i + 1] > hi) return i;
|
|
if (size > 2 && (p[i + 2] < 0x80 || p[i + 2] > 0xbf)) return i;
|
|
if (size > 3 && (p[i + 3] < 0x80 || p[i + 3] > 0xbf)) return i;
|
|
i += size;
|
|
}
|
|
return -1;
|
|
}
|
|
|
|
void flan_utf8_check(const uint8_t *p, int64_t n, const uint8_t *loc,
|
|
int64_t loclen) {
|
|
int64_t at = utf8_bad_at(p, n);
|
|
if (at < 0) return;
|
|
flan_say(loc, loclen,
|
|
"this text is not valid UTF-8 — byte %lld is 0x%02x — and a String "
|
|
"holds only valid UTF-8",
|
|
(long long)at, (unsigned)p[at]);
|
|
rt_trap((const uint8_t *)"InvalidUtf8", 11);
|
|
}
|
|
|
|
/* The same over a slice of byte slices, each a (ptr, len) pair: the parts a
|
|
* join or a concat is handed. */
|
|
void flan_utf8_check_parts(const void *parts, int64_t n, const uint8_t *loc,
|
|
int64_t loclen) {
|
|
const struct { const uint8_t *p; int64_t n; } *ps = parts;
|
|
int64_t i;
|
|
for (i = 0; i < n; i++) flan_utf8_check(ps[i].p, ps[i].n, loc, loclen);
|
|
}
|
|
|
|
void flan_rune_check(int32_t c, const uint8_t *loc, int64_t loclen) {
|
|
if (c >= 0 && c <= 0x10ffff && !(c >= 0xd800 && c <= 0xdfff)) return;
|
|
flan_say(loc, loclen,
|
|
"%lld is not a Unicode scalar value, so it has no UTF-8 encoding "
|
|
"and a String cannot hold it",
|
|
(long long)c);
|
|
rt_trap((const uint8_t *)"InvalidRune", 11);
|
|
}
|
|
|
|
/* (char n) on a value only known at run time: n itself when it is a Unicode
|
|
* scalar value. Taken as an i64 so every integer width arrives unchanged. */
|
|
uint32_t flan_char_of(int64_t n, const uint8_t *loc, int64_t loclen) {
|
|
if (n >= 0 && n <= 0x10ffff && !(n >= 0xd800 && n <= 0xdfff))
|
|
return (uint32_t)n;
|
|
flan_say(loc, loclen, "%lld is not a Unicode scalar value, so it is not a char",
|
|
(long long)n);
|
|
rt_trap((const uint8_t *)"InvalidChar", 11);
|
|
}
|
|
|
|
/* The same for a u64, which past 2^63 has no i64 to arrive as. */
|
|
uint32_t flan_char_of_u64(uint64_t n, const uint8_t *loc, int64_t loclen) {
|
|
if (n <= 0x10ffff && !(n >= 0xd800 && n <= 0xdfff)) return (uint32_t)n;
|
|
flan_say(loc, loclen, "%llu is not a Unicode scalar value, so it is not a char",
|
|
(unsigned long long)n);
|
|
rt_trap((const uint8_t *)"InvalidChar", 11);
|
|
}
|
|
|
|
/* A char plus or minus a u64 ([sub] 1 for minus), taken unsigned so no u64
|
|
* past the largest i64 wraps round to a char. */
|
|
uint32_t flan_char_step_u64(int32_t cp, uint64_t n, int32_t sub,
|
|
const uint8_t *loc, int64_t loclen) {
|
|
uint64_t r;
|
|
if (sub ? n > (uint64_t)cp : n > 0x10ffff) {
|
|
flan_say(loc, loclen, "%lld %s %llu is %s, so it is not a char",
|
|
(long long)cp, sub ? "minus" : "plus", (unsigned long long)n,
|
|
sub ? "below zero" : "past 0x10FFFF");
|
|
rt_trap((const uint8_t *)"InvalidChar", 11);
|
|
}
|
|
r = sub ? (uint64_t)cp - n : (uint64_t)cp + n;
|
|
return flan_char_of_u64(r, loc, loclen);
|
|
}
|
|
|
|
/* A char plus or minus any other integer, as an i64 ([sub] 1 for minus).
|
|
* The sum is checked for overflow first, so a trap names the true result or
|
|
* says which side of the range it left, never a wrapped number. */
|
|
uint32_t flan_char_step_i64(int32_t cp, int64_t n, int32_t sub,
|
|
const uint8_t *loc, int64_t loclen) {
|
|
int64_t r;
|
|
int over = sub ? __builtin_sub_overflow((int64_t)cp, n, &r)
|
|
: __builtin_add_overflow((int64_t)cp, n, &r);
|
|
if (over) {
|
|
flan_say(loc, loclen, "%lld %s %lld is %s, so it is not a char",
|
|
(long long)cp, sub ? "minus" : "plus", (long long)n,
|
|
(sub ? n < 0 : n > 0) ? "past 0x10FFFF" : "below zero");
|
|
rt_trap((const uint8_t *)"InvalidChar", 11);
|
|
}
|
|
return flan_char_of(r, loc, loclen);
|
|
}
|
|
|
|
/* [n] elements from [src] onto the end of a Vec, growing it once. [src] may
|
|
* point into the Vec's own block — (append s (str s)) — so where it lies is
|
|
* found before the grow and read again after it: the grow frees the old
|
|
* block. 1 when it fit, 0 when the allocator refused, as flan_vec_push. */
|
|
int8_t flan_vec_append(flan_vec *v, const void *src, int64_t n, int64_t size,
|
|
int64_t align, const uint8_t *loc, int64_t loclen) {
|
|
flan_vec_check(v, loc, loclen);
|
|
if (n <= 0) return 1;
|
|
if (v->len + n > v->cap) {
|
|
uintptr_t base = (uintptr_t)v->ptr, at = (uintptr_t)src;
|
|
int inside = v->ptr != NULL && at >= base
|
|
&& at < base + (uintptr_t)(v->cap * size);
|
|
uintptr_t off = at - base;
|
|
if (!flan_vec_grow(v, v->len + n, size, align)) return 0;
|
|
if (inside) src = (uint8_t *)v->ptr + off;
|
|
}
|
|
memmove((uint8_t *)v->ptr + v->len * size, src, (size_t)(n * size));
|
|
v->len += n;
|
|
return 1;
|
|
}
|
|
|
|
static void rt_reverse(uint8_t *p, int64_t n) {
|
|
int64_t i = 0, j = n - 1;
|
|
while (i < j) {
|
|
uint8_t t = p[i];
|
|
p[i++] = p[j];
|
|
p[j--] = t;
|
|
}
|
|
}
|
|
|
|
/* The same, stored at element [at] with the tail moved up. Appended and then
|
|
* rotated into place, three reversals, so a [src] inside the Vec's own block
|
|
* is never read after it has been moved. */
|
|
int8_t flan_vec_insert(flan_vec *v, int64_t at, const void *src, int64_t n,
|
|
int64_t size, int64_t align, const uint8_t *loc,
|
|
int64_t loclen) {
|
|
int64_t old;
|
|
uint8_t *b;
|
|
flan_vec_check(v, loc, loclen);
|
|
if (at < 0 || at > v->len) at = v->len;
|
|
old = v->len;
|
|
if (!flan_vec_append(v, src, n, size, align, loc, loclen)) return 0;
|
|
if (n <= 0 || at == old) return 1;
|
|
b = (uint8_t *)v->ptr + at * size;
|
|
rt_reverse(b, (old - at) * size);
|
|
rt_reverse(b + (old - at) * size, n * size);
|
|
rt_reverse(b, (old - at + n) * size);
|
|
return 1;
|
|
}
|
|
|
|
/* [n] elements from [at] out of a Vec, the rest moved down over them. Nothing
|
|
* is allocated, so nothing can fail but the stale-allocator check. */
|
|
void flan_vec_remove_range(flan_vec *v, int64_t at, int64_t n, int64_t size,
|
|
const uint8_t *loc, int64_t loclen) {
|
|
flan_vec_check(v, loc, loclen);
|
|
if (at < 0 || n <= 0 || at >= v->len) return;
|
|
if (n > v->len - at) n = v->len - at;
|
|
memmove((uint8_t *)v->ptr + at * size, (uint8_t *)v->ptr + (at + n) * size,
|
|
(size_t)((v->len - at - n) * size));
|
|
v->len -= n;
|
|
}
|
|
|
|
/* The width of the sequence a lead byte begins, for bytes already known to
|
|
* be valid UTF-8. */
|
|
static int64_t utf8_width(uint8_t b) {
|
|
return b < 0x80 ? 1 : b < 0xe0 ? 2 : b < 0xf0 ? 3 : 4;
|
|
}
|
|
|
|
/* A character position in a String, as a byte offset. [past_end] says
|
|
* whether the position one past the last character is one — it is for an
|
|
* insert and not for a remove. Out of range signals BoundsError with the
|
|
* character count as the length, which is what the position was counted
|
|
* against, and with [xfer] for the caller's guard; with nothing answering it
|
|
* the program stops here. */
|
|
int64_t flan_string_index(flan_vec *v, int32_t i, int32_t past_end,
|
|
const uint8_t *loc, int64_t loclen, void *xfer) {
|
|
const uint8_t *p = (const uint8_t *)v->ptr;
|
|
int64_t off = 0, count = 0, want = i, found = -1;
|
|
flan_vec_check(v, loc, loclen);
|
|
/* Stops at the position, so an insert near the front costs what it walks
|
|
* and not the whole text. The count is finished only for the message. A
|
|
* width that would run past the end is taken as 1, so a String whose bytes
|
|
* were ever wrong is never read beyond its length. */
|
|
while (off < v->len) {
|
|
int64_t w;
|
|
if (count == want) { found = off; break; }
|
|
w = utf8_width(p[off]);
|
|
off += (w <= v->len - off) ? w : 1;
|
|
count++;
|
|
}
|
|
if (found < 0 && want == count && past_end) found = v->len;
|
|
if (want < 0 || found < 0) {
|
|
while (off < v->len) {
|
|
int64_t w = utf8_width(p[off]);
|
|
off += (w <= v->len - off) ? w : 1;
|
|
count++;
|
|
}
|
|
if (flan_bounds_signal(loc, loclen, xfer, BOUNDS_AT, want, want, count))
|
|
return 0;
|
|
flan_vec_bounds_fail(loc, loclen, want, count);
|
|
}
|
|
return found;
|
|
}
|
|
|
|
/* The code point at byte [off] of a String, removed. [off] came from
|
|
* flan_string_index, so it begins a sequence and the bytes are valid. */
|
|
int32_t flan_string_remove(flan_vec *v, int64_t off, const uint8_t *loc,
|
|
int64_t loclen) {
|
|
const uint8_t *p;
|
|
int64_t w;
|
|
int32_t c;
|
|
flan_vec_check(v, loc, loclen);
|
|
if (off < 0 || off >= v->len) return 0;
|
|
p = (const uint8_t *)v->ptr + off;
|
|
w = utf8_width(p[0]);
|
|
/* Never past the length, however the bytes came to be what they are. */
|
|
if (w > v->len - off) w = 1;
|
|
if (w == 1) c = p[0];
|
|
else if (w == 2) c = ((p[0] & 0x1f) << 6) | (p[1] & 0x3f);
|
|
else if (w == 3)
|
|
c = ((p[0] & 0x0f) << 12) | ((p[1] & 0x3f) << 6) | (p[2] & 0x3f);
|
|
else
|
|
c = ((p[0] & 0x07) << 18) | ((p[1] & 0x3f) << 12) | ((p[2] & 0x3f) << 6)
|
|
| (p[3] & 0x3f);
|
|
flan_vec_remove_range(v, off, w, 1, loc, loclen);
|
|
return c;
|
|
}
|
|
|
|
/* A code point into a String at byte [off], -1 for the end: checked, encoded
|
|
* and stored. 1 when it fit, 0 when the allocator refused. */
|
|
int8_t flan_string_put_rune(flan_vec *v, int64_t off, int32_t c,
|
|
const uint8_t *loc, int64_t loclen) {
|
|
uint8_t b[4];
|
|
int64_t n;
|
|
flan_rune_check(c, loc, loclen);
|
|
if (c < 0x80) { b[0] = (uint8_t)c; n = 1; }
|
|
else if (c < 0x800) {
|
|
b[0] = (uint8_t)(0xc0 | (c >> 6));
|
|
b[1] = (uint8_t)(0x80 | (c & 0x3f));
|
|
n = 2;
|
|
} else if (c < 0x10000) {
|
|
b[0] = (uint8_t)(0xe0 | (c >> 12));
|
|
b[1] = (uint8_t)(0x80 | ((c >> 6) & 0x3f));
|
|
b[2] = (uint8_t)(0x80 | (c & 0x3f));
|
|
n = 3;
|
|
} else {
|
|
b[0] = (uint8_t)(0xf0 | (c >> 18));
|
|
b[1] = (uint8_t)(0x80 | ((c >> 12) & 0x3f));
|
|
b[2] = (uint8_t)(0x80 | ((c >> 6) & 0x3f));
|
|
b[3] = (uint8_t)(0x80 | (c & 0x3f));
|
|
n = 4;
|
|
}
|
|
if (off < 0) return flan_vec_append(v, b, n, 1, 1, loc, loclen);
|
|
return flan_vec_insert(v, off, b, n, 1, 1, loc, loclen);
|
|
}
|
|
|
|
/* spec-memory.md's first release point. The Vec is left zeroed rather than
|
|
* dangling: a later use of it is then a null deref rather than a
|
|
* use-after-free, and a slice taken of it before the free is the dev
|
|
* registry's to catch. 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);
|
|
if (v->ptr && flan_vec_block_hook)
|
|
flan_vec_block_hook(v->ptr, NULL, 0, NULL, 0);
|
|
(void)align;
|
|
v->ptr = NULL;
|
|
v->len = 0;
|
|
v->cap = 0;
|
|
v->alloc = NULL;
|
|
v->epoch = 0;
|
|
}
|
|
|
|
/* (bytes s) and (clone xs): a copy of n elements, into a block the named
|
|
* allocator owns. The header the compiler hands in is a hidden temp — the
|
|
* caller's answer is a slice over the block — but it is a real Vec, so the
|
|
* registry note, the epoch word and free-all's reclaim all work on it the way
|
|
* they work on any Vec. (bytes s) passes a size and align of 1. */
|
|
int8_t flan_bytes_dup(flan_vec *v, flan_allocator *a, const uint8_t *p,
|
|
int64_t n, int64_t size, int64_t align,
|
|
const uint8_t *loc, int64_t loclen) {
|
|
if (!flan_vec_init(v, a, n, size, align, loc, loclen)) return 0;
|
|
if (n > 0) memcpy(v->ptr, p, (size_t)(n * size));
|
|
v->len = n;
|
|
return 1;
|
|
}
|
|
|
|
/* (free s) on a slice (bytes s) or (clone xs) made: the block goes back to
|
|
* [a], the allocator the compiler passes — the context's, or the one named.
|
|
* The slice carries no allocator, so a dev build checks the registry first and
|
|
* traps on a slice that is not the start of a live block, or on a block from
|
|
* another allocator; a release build trusts the program, as Odin's delete
|
|
* does. An allocator that cannot free one block keeps it, as flan_vec_free
|
|
* does: free-all is how its region is released. */
|
|
_Noreturn static void flan_slice_free_fail(const uint8_t *loc, int64_t loclen,
|
|
int32_t why) {
|
|
rt_flush_out();
|
|
fprintf(stderr, "%.*s: %s\n", (int)loclen, (const char *)loc,
|
|
why == 5 ? "this slice is text in the temp allocator, which is "
|
|
"released all at once by (free-temp), not one slice at a "
|
|
"time"
|
|
: why == 2 ? "this slice's block came from another allocator — free "
|
|
"it through the allocator it was made with, (free s a)"
|
|
: why == 3 ? "this slice's block was already freed"
|
|
: why == 4 ? "this slice views a Vec's or a Map's storage, which "
|
|
"only freeing the Vec or the Map releases"
|
|
: "this slice is not a block an allocator handed out — "
|
|
"only a slice (bytes s) or (clone xs) made can be freed");
|
|
rt_trap((const uint8_t *)"BadFree", 7);
|
|
}
|
|
|
|
void flan_slice_free(const void *p, int64_t n, int64_t size, int64_t align,
|
|
flan_allocator *a, const uint8_t *loc, int64_t loclen) {
|
|
int32_t why;
|
|
int64_t bytes;
|
|
if (p == NULL || n <= 0) return;
|
|
if (!a) flan_null_alloc_fail(loc, loclen);
|
|
{
|
|
const void *found = NULL;
|
|
why = flan_dev_reg_owner_check(p, a, &found);
|
|
if (why == 2 && found != NULL
|
|
&& ((flan_allocator *)found)->proc == flan_arena_proc
|
|
&& ((flan_arena *)((flan_allocator *)found)->data)->grow)
|
|
why = 5;
|
|
if (why != 0) flan_slice_free_fail(loc, loclen, why);
|
|
}
|
|
if (!(a->caps & FLAN_CAN_FREE)) return;
|
|
if (!flan_mul_bytes(n, size, &bytes)) return;
|
|
a->proc(a, FLAN_ALLOC_FREE, (void *)p, bytes, 0, align);
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
/* ── (Map K V), spec-memory.md ──────────────────────────────────────────
|
|
*
|
|
* A Swiss table: open addressing with one control byte a slot, probed eight
|
|
* slots at a time. 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) — Odin's Map_Info arrangement, which this keeps. What it
|
|
* does not keep is Odin's table (base/runtime/dynamic_map_internal.odin), a
|
|
* Robin Hood map with an eight-byte hash a slot; docs/BUILT.md, "The Map is a
|
|
* Swiss table", has the measurements that replaced it.
|
|
*
|
|
* 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.
|
|
*
|
|
* The control byte, in one paragraph. Seven bits of the key's hash and one bit
|
|
* saying the slot is full. A lookup compares the seven bits of eight slots at
|
|
* once and calls the equality function only where they agree, which is one
|
|
* slot in 128 by chance, so a probe reads the control run and nothing else
|
|
* until it has a candidate. The control run is one byte a slot — a million
|
|
* entries is a megabyte of it — so a miss is usually one cache miss and a hit
|
|
* two: the control group, then the key.
|
|
*
|
|
* Header, five words, and the same five the emitter's %map and its debugger
|
|
* description name:
|
|
*
|
|
* data one allocation: a three-word head, the control bytes, then
|
|
* the slots, each a key and its value side by side
|
|
* len live entries
|
|
* log2cap 0 until something is allocated; never below 3 after
|
|
* allocator epoch as on a Vec, and checked the same way
|
|
*
|
|
* The one number a Swiss table needs beyond the header — how many more
|
|
* entries may land in empty slots before the table is rebuilt — lives in the
|
|
* block's head rather than in the header, because the header's layout is the
|
|
* emitter's as much as this file's and a sixth word would move every offset
|
|
* after it. The slot stride and value offset sit beside it; see "Block
|
|
* geometry".
|
|
*
|
|
* 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_ALIGN 64
|
|
#define FLAN_MAP_MIN_LOG2 3 /* 8 slots: one group */
|
|
#define FLAN_MAP_GROUP 8
|
|
#define FLAN_MAP_HEAD 24 /* growth, slot stride, value offset */
|
|
|
|
/* The control byte. Empty is zero, so a zeroed control run is an empty map —
|
|
* the same property the old table's zero hash word had, and Zig's encoding
|
|
* (lib/std/hash_map.zig, Metadata: free 0, tombstone 1, used bit on top). A
|
|
* full slot is the high bit and the top seven bits of the hash. */
|
|
#define FLAN_CTRL_EMPTY ((uint8_t)0x00)
|
|
#define FLAN_CTRL_DELETED ((uint8_t)0x01)
|
|
#define FLAN_CTRL_FULL ((uint8_t)0x80)
|
|
|
|
/* 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 epoch;
|
|
} flan_map;
|
|
|
|
/* The header's layout and the block geometry's constants, for the same check
|
|
* [flan_vec_layout] exists for: flan_dyn.c restates both to walk a map's full
|
|
* slots, and test/dyn_ops.c's "layout" mode compares the two. */
|
|
void flan_map_layout(int64_t out[10]) {
|
|
out[0] = (int64_t)sizeof(flan_map);
|
|
out[1] = (int64_t)offsetof(flan_map, data);
|
|
out[2] = (int64_t)offsetof(flan_map, len);
|
|
out[3] = (int64_t)offsetof(flan_map, log2cap);
|
|
out[4] = (int64_t)offsetof(flan_map, alloc);
|
|
out[5] = (int64_t)offsetof(flan_map, epoch);
|
|
out[6] = FLAN_MAP_HEAD;
|
|
out[7] = FLAN_MAP_GROUP;
|
|
out[8] = FLAN_MAP_ALIGN;
|
|
out[9] = FLAN_CTRL_FULL;
|
|
}
|
|
|
|
/* ── 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. No environment: a hasher is reached from this file and never
|
|
* through a function value, so it declares none and is handed none.
|
|
* 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);
|
|
}
|
|
|
|
/* The typed (= a b) / (!= a b) entry point for two strings — M2 queue item 5.
|
|
* [flan_key_eq_str] above is the same comparison, but shaped for the Map key
|
|
* table: it takes two addresses of a [flan_slice] and ignores [size]. This one
|
|
* takes a slice apart into its own two words, because that is what a typed
|
|
* string is at the LLVM and x86 boundaries (both explode a [String] argument
|
|
* to ptr+len rather than passing the two-word struct itself, the way every
|
|
* other runtime entry point that takes one does).
|
|
*
|
|
* Length first, then the same-pointer check: two slices can share a base
|
|
* pointer and disagree in length — a slice and the prefix it was cut from —
|
|
* so pointer equality alone would answer wrong on that pair, and has to come
|
|
* after the lengths have already been found equal. The zero-length return
|
|
* guards the [memcmp] below: [memcmp(NULL, NULL, 0)] is technically undefined
|
|
* even though every real implementation treats it as a no-op, and a 0-length
|
|
* string built from a null pointer is not a hypothetical here — an empty
|
|
* string literal is not one, its address is an interned symbol's and is never
|
|
* null, but a zero-length container converted to a string is. */
|
|
int8_t flan_str_eq(const uint8_t *ap, int64_t alen,
|
|
const uint8_t *bp, int64_t blen) {
|
|
if (alen != blen) return 0;
|
|
if (ap == bp) return 1;
|
|
if (alen == 0) return 1;
|
|
return (int8_t)(memcmp(ap, bp, (size_t)alen) == 0);
|
|
}
|
|
|
|
/* 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)));
|
|
}
|
|
|
|
/* ── Groups ───────────────────────────────────────────────────────────
|
|
*
|
|
* Eight control bytes read as one 64-bit word, and every question about them
|
|
* answered with a handful of integer operations over the whole word, which
|
|
* needs no intrinsics and so compiles for every target the runtime does. Each answer is a mask
|
|
* with 0x80 set in the byte of every slot that qualifies; a slot's index in
|
|
* the group is its byte's position, counted from the low end. */
|
|
#define FLAN_LSB 0x0101010101010101ULL
|
|
#define FLAN_MSB 0x8080808080808080ULL
|
|
|
|
static uint64_t flan_group_load(const uint8_t *p) {
|
|
uint64_t x;
|
|
memcpy(&x, p, 8);
|
|
#if defined(__BYTE_ORDER__) && __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
|
|
x = __builtin_bswap64(x);
|
|
#endif
|
|
return x;
|
|
}
|
|
|
|
/* Exactly the zero bytes. The shorter (x - LSB) & ~x form is approximate —
|
|
* a borrow out of a zero byte can mark the byte above it — and the removal
|
|
* rule below counts positions, so it wants the exact one. */
|
|
static uint64_t flan_group_zero(uint64_t x) {
|
|
return ~(((x & ~FLAN_MSB) + ~FLAN_MSB) | x) & FLAN_MSB;
|
|
}
|
|
|
|
static uint64_t flan_group_match(uint64_t g, uint8_t ctrl) {
|
|
return flan_group_zero(g ^ (FLAN_LSB * ctrl));
|
|
}
|
|
|
|
static uint64_t flan_group_empty(uint64_t g) { return flan_group_zero(g); }
|
|
|
|
/* Empty or deleted: the two states without the full bit. */
|
|
static uint64_t flan_group_free(uint64_t g) { return ~g & FLAN_MSB; }
|
|
|
|
static int64_t flan_mask_first(uint64_t m) {
|
|
return (int64_t)(__builtin_ctzll(m) >> 3);
|
|
}
|
|
|
|
static int64_t flan_mask_last_gap(uint64_t m) {
|
|
return (int64_t)(__builtin_clzll(m) >> 3);
|
|
}
|
|
|
|
/* ── Block geometry ───────────────────────────────────────────────────
|
|
*
|
|
* [growth][stride][value offset][control: cap + 7 bytes] pad to 64 | slots
|
|
*
|
|
* The control run carries seven bytes past the end that mirror its first
|
|
* seven, so a group can be read at any slot without wrapping — a group
|
|
* starting at slot cap - 3 reads three real bytes and five mirrored ones.
|
|
*
|
|
* A slot is a key and its value side by side, so a hit reads the control
|
|
* group and then one slot: two cache misses in a map too large for the cache,
|
|
* where separate key and value runs would be three. The run starts on a
|
|
* 64-byte boundary.
|
|
*
|
|
* The runtime is not told either type's alignment, and does not need to be: a
|
|
* type's size is a multiple of its alignment, so the largest power of two
|
|
* dividing the size bounds it. The value is placed at the key's size rounded
|
|
* up to the value's bound, and the stride is rounded up to the larger of the
|
|
* two — an i64 key and an i64 value make a 16-byte slot, and an i32 key with
|
|
* an i64 value makes the same one with four bytes of padding. The cost of
|
|
* over-estimating is padding and never a misaligned load.
|
|
*
|
|
* The stride and the value offset are computed once, when the block is
|
|
* allocated, and kept in its head. Recomputing them from the two sizes on
|
|
* every call measured as about a tenth of a cache-resident lookup. */
|
|
static int64_t flan_map_round(int64_t x) {
|
|
return (x + (FLAN_MAP_ALIGN - 1)) & ~(int64_t)(FLAN_MAP_ALIGN - 1);
|
|
}
|
|
|
|
static int64_t flan_map_ctrl_bytes(int64_t cap) {
|
|
return flan_map_round(FLAN_MAP_HEAD + cap + (FLAN_MAP_GROUP - 1));
|
|
}
|
|
|
|
typedef struct flan_map_geom {
|
|
uint8_t *ctrl;
|
|
uint8_t *slots;
|
|
int64_t stride;
|
|
int64_t voff;
|
|
} flan_map_geom;
|
|
|
|
/* The largest power of two dividing [size], at most 64: an upper bound on the
|
|
* alignment of any type that size, since a size is a multiple of its
|
|
* alignment. A zero size answers 1. */
|
|
static int64_t flan_map_align_bound(int64_t size) {
|
|
int64_t b = size & -size;
|
|
if (b <= 0) return 1;
|
|
return b > FLAN_MAP_ALIGN ? FLAN_MAP_ALIGN : b;
|
|
}
|
|
|
|
static int64_t flan_map_up(int64_t x, int64_t a) { return (x + a - 1) & -a; }
|
|
|
|
/* Where the value sits in a slot, and how far apart slots are. */
|
|
static void flan_map_slot(int64_t ksize, int64_t vsize, int64_t *stride,
|
|
int64_t *voff) {
|
|
int64_t ka = flan_map_align_bound(ksize), va = flan_map_align_bound(vsize);
|
|
*voff = flan_map_up(ksize, va);
|
|
*stride = flan_map_up(*voff + vsize, ka > va ? ka : va);
|
|
}
|
|
|
|
/* Saturating rather than refusing, because this is called for its number by
|
|
* the dev registry as well as by the allocation. 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 stride, voff, sb, total;
|
|
if (cap < 0 || cap > ((int64_t)1 << 40)) return FLAN_BYTES_UNREPRESENTABLE;
|
|
if (ksize < 0 || vsize < 0 || ksize > ((int64_t)1 << 40)
|
|
|| vsize > ((int64_t)1 << 40))
|
|
return FLAN_BYTES_UNREPRESENTABLE;
|
|
flan_map_slot(ksize, vsize, &stride, &voff);
|
|
if (!flan_mul_bytes(stride, cap, &sb)) return FLAN_BYTES_UNREPRESENTABLE;
|
|
if (!flan_add_bytes(flan_map_ctrl_bytes(cap), sb, &total))
|
|
return FLAN_BYTES_UNREPRESENTABLE;
|
|
return total;
|
|
}
|
|
|
|
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;
|
|
const int64_t *head = (const int64_t *)p;
|
|
(void)ksize; (void)vsize; /* read once, at allocation: see above */
|
|
g->ctrl = p + FLAN_MAP_HEAD;
|
|
g->slots = p + flan_map_ctrl_bytes(cap);
|
|
g->stride = head[1];
|
|
g->voff = head[2];
|
|
}
|
|
|
|
static uint8_t *flan_map_k(const flan_map_geom *g, int64_t i) {
|
|
return g->slots + i * g->stride;
|
|
}
|
|
|
|
static uint8_t *flan_map_v(const flan_map_geom *g, int64_t i) {
|
|
return g->slots + i * g->stride + g->voff;
|
|
}
|
|
|
|
static int64_t *flan_map_growth(const flan_map *m) {
|
|
return (int64_t *)m->data;
|
|
}
|
|
|
|
/* 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 rebuild, which is why every key is rehashed
|
|
* there. One multiply, not a full avalanche: whatever it returns is fed to
|
|
* the hasher, which mixes properly. The block is 64-byte aligned when the
|
|
* allocator honours the request, so the low six bits carry nothing. */
|
|
static uint64_t flan_map_seed(const flan_map *m) {
|
|
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;
|
|
}
|
|
|
|
/* Seven eighths. A group probe tolerates a higher load than Robin Hood's
|
|
* 75%, because a miss stops at the first group holding an empty slot rather
|
|
* than walking a run, and at seven eighths every group of eight has one. */
|
|
static int64_t flan_map_threshold_of(int64_t cap) { return cap - cap / 8; }
|
|
|
|
static int64_t flan_map_threshold(const flan_map *m) {
|
|
return flan_map_threshold_of(flan_map_cap(m));
|
|
}
|
|
|
|
/* The low bits choose the group and the top seven are the tag, so the two
|
|
* never share a bit at any capacity below 2^57. */
|
|
static uint8_t flan_map_tag(uint64_t h) {
|
|
return (uint8_t)(FLAN_CTRL_FULL | (h >> 57));
|
|
}
|
|
|
|
/* Writing a control byte writes its mirror too, when it has one. For a slot
|
|
* at or past 7 the second index is the slot itself, so the store is simply
|
|
* repeated; below 7 it is the mirrored copy past the end. No branch. */
|
|
static void flan_map_set_ctrl(uint8_t *ctrl, int64_t mask, int64_t i,
|
|
uint8_t c) {
|
|
ctrl[i] = c;
|
|
ctrl[((i - (FLAN_MAP_GROUP - 1)) & mask) + (FLAN_MAP_GROUP - 1)] = c;
|
|
}
|
|
|
|
/* The probe sequence. Groups are visited at triangular offsets — 0, 8, 24,
|
|
* 48 and on — which for a power-of-two number of groups reaches every one of
|
|
* them before repeating, so a probe that has not found an empty group has
|
|
* not yet looked everywhere. */
|
|
|
|
/* The first slot, along [h]'s probe sequence, that is empty or deleted. The
|
|
* threshold guarantees one exists. */
|
|
static int64_t flan_map_find_free(const uint8_t *ctrl, int64_t mask,
|
|
uint64_t h) {
|
|
int64_t pos = (int64_t)(h & (uint64_t)mask), stride = 0;
|
|
for (;;) {
|
|
uint64_t f = flan_group_free(flan_group_load(ctrl + pos));
|
|
if (f) return (pos + flan_mask_first(f)) & mask;
|
|
stride += FLAN_MAP_GROUP;
|
|
pos = (pos + stride) & mask;
|
|
}
|
|
}
|
|
|
|
/* Place a key known not to be in the map, already hashed, into a map known
|
|
* to have room. Used by the rebuild and by clone, where nothing needs looking
|
|
* up first. */
|
|
static void flan_map_place(flan_map *m, uint64_t h, const void *key,
|
|
const void *val, int64_t ksize, int64_t vsize) {
|
|
flan_map_geom g;
|
|
int64_t cap = flan_map_cap(m), mask = cap - 1, at;
|
|
flan_map_geometry(m, ksize, vsize, cap, &g);
|
|
at = flan_map_find_free(g.ctrl, mask, h);
|
|
if (g.ctrl[at] == FLAN_CTRL_EMPTY) (*flan_map_growth(m))--;
|
|
flan_map_set_ctrl(g.ctrl, mask, at, flan_map_tag(h));
|
|
flan_copy_small(flan_map_k(&g, at), key, ksize);
|
|
if (vsize > 0) flan_copy_small(flan_map_v(&g, at), val, vsize);
|
|
}
|
|
|
|
/* The slot holding [key], or -1. The probe stops at the first group with an
|
|
* empty slot: an insert takes the first free slot along the same sequence, so
|
|
* a key that is present was placed before any empty its probe could reach.
|
|
*
|
|
* [free_at], when not NULL, receives the first empty-or-deleted slot the
|
|
* probe passed — which is where an insert of this key goes, so a put that
|
|
* misses does not walk the sequence a second time.
|
|
*
|
|
* Inlined by force: it is called from five entry points, and at -O2 that is
|
|
* enough for clang to keep it out of line, which costs a call and a spill of
|
|
* everything the probe had in registers on every lookup. */
|
|
static inline __attribute__((always_inline)) 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 *g,
|
|
uint64_t *hout, int64_t *free_at) {
|
|
int64_t cap, mask, pos, stride = 0;
|
|
uint64_t h;
|
|
uint8_t tag;
|
|
const uint8_t *ctrl;
|
|
void *xfer = NULL;
|
|
/* The hash first: it is an indirect call, and everything computed before it
|
|
* would have to survive it. */
|
|
h = hash(key, flan_map_seed(m), ksize, &xfer);
|
|
cap = flan_map_cap(m);
|
|
mask = cap - 1;
|
|
flan_map_geometry(m, ksize, vsize, cap, g);
|
|
ctrl = g->ctrl;
|
|
if (hout) *hout = h;
|
|
if (free_at) *free_at = -1;
|
|
tag = flan_map_tag(h);
|
|
pos = (int64_t)(h & (uint64_t)mask);
|
|
for (;;) {
|
|
uint64_t grp = flan_group_load(ctrl + pos);
|
|
uint64_t hits = flan_group_match(grp, tag);
|
|
while (hits) {
|
|
int64_t at = (pos + flan_mask_first(hits)) & mask;
|
|
if (eq(key, flan_map_k(g, at), ksize, &xfer)) return at;
|
|
hits &= hits - 1;
|
|
}
|
|
if (free_at && *free_at < 0) {
|
|
uint64_t f = flan_group_free(grp);
|
|
if (f) *free_at = (pos + flan_mask_first(f)) & mask;
|
|
}
|
|
if (flan_group_empty(grp)) return -1;
|
|
stride += FLAN_MAP_GROUP;
|
|
pos = (pos + stride) & mask;
|
|
}
|
|
}
|
|
|
|
/* Allocate a block for 2^log2cap slots and zero the control run. Only the
|
|
* control run needs zeroing — a key or value slot is never read without its
|
|
* control byte saying it is full — 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_ALIGN;
|
|
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_ALIGN);
|
|
if (!p) return 0;
|
|
m->data = p;
|
|
m->log2cap = log2cap;
|
|
m->len = 0;
|
|
memset(p, 0, (size_t)flan_map_ctrl_bytes(cap));
|
|
{
|
|
int64_t *head = (int64_t *)p;
|
|
head[0] = flan_map_threshold_of(cap);
|
|
flan_map_slot(ksize, vsize, &head[1], &head[2]);
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
/* Rebuild into a fresh block of 2^log2cap slots: a grow when the capacity is
|
|
* larger, and a sweep of the deleted slots when it is the same. The seed moves
|
|
* with the block, so every key is rehashed. The old block is released only
|
|
* after the last read of it, and a failed allocation leaves the map exactly as
|
|
* it was — map-exhausted.flan retries against it. */
|
|
static int8_t flan_map_rebuild(flan_map *m, int64_t log2cap, int64_t ksize,
|
|
int64_t vsize, flan_hash_fn hash) {
|
|
flan_allocator *a = flan_map_adopt(m);
|
|
flan_map fresh;
|
|
int64_t old_cap = flan_map_cap(m);
|
|
flan_map_geom g;
|
|
int64_t i;
|
|
void *xfer = NULL;
|
|
|
|
fresh.data = NULL; fresh.len = 0; fresh.log2cap = 0;
|
|
fresh.alloc = a; 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);
|
|
for (i = 0; i < old_cap; i++) {
|
|
uint64_t h;
|
|
if (!(g.ctrl[i] & FLAN_CTRL_FULL)) continue;
|
|
h = hash(flan_map_k(&g, i), flan_map_seed(&fresh), ksize, &xfer);
|
|
flan_map_place(&fresh, h, flan_map_k(&g, i), flan_map_v(&g, i), ksize,
|
|
vsize);
|
|
}
|
|
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_ALIGN);
|
|
}
|
|
if (flan_vec_block_hook)
|
|
flan_vec_block_hook(m->data, fresh.data,
|
|
flan_map_block_size(ksize, vsize, flan_map_cap(&fresh)),
|
|
m->alloc, m->epoch);
|
|
m->data = fresh.data;
|
|
m->log2cap = fresh.log2cap;
|
|
return 1;
|
|
}
|
|
|
|
/* The smallest capacity whose threshold holds [want] entries, never below
|
|
* the map's own. 0 when no capacity the block size can describe does. */
|
|
static int64_t flan_map_log2_for(const flan_map *m, int64_t want) {
|
|
int64_t log2cap = FLAN_MAP_MIN_LOG2;
|
|
while (flan_map_threshold_of((int64_t)1 << log2cap) < want) {
|
|
if (log2cap >= 40) return 0;
|
|
log2cap++;
|
|
}
|
|
if (m->data && log2cap < m->log2cap) log2cap = m->log2cap;
|
|
return log2cap;
|
|
}
|
|
|
|
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->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 (defonce m (Map str 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.
|
|
*
|
|
* An insert that would land in an empty slot with no growth left rebuilds
|
|
* first. Deleted slots count against the growth, since each one is a slot a
|
|
* probe cannot stop at; when they are most of what is using it up — the live
|
|
* entries fit in 25/32 of the capacity — the rebuild keeps
|
|
* the capacity and only sweeps them out, so a map that churns at a steady size
|
|
* does not double without end. */
|
|
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 = -1, free_at = -1, mask;
|
|
flan_map_geom g;
|
|
uint64_t h = 0;
|
|
flan_map_check(m, loc, loclen);
|
|
|
|
if (m->data) {
|
|
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g, &h, &free_at);
|
|
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_map_v(&g, at), val, vsize);
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
if (!m->data
|
|
|| (*flan_map_growth(m) == 0 && g.ctrl[free_at] == FLAN_CTRL_EMPTY)) {
|
|
int64_t log2cap;
|
|
if (m->data && m->len * 32 <= flan_map_cap(m) * 25)
|
|
log2cap = m->log2cap;
|
|
else
|
|
log2cap = flan_map_log2_for(m, m->data ? flan_map_threshold(m) + 1
|
|
: m->len + 1);
|
|
if (log2cap == 0) {
|
|
flan_fail_bytes = FLAN_BYTES_UNREPRESENTABLE;
|
|
flan_fail_align = FLAN_MAP_ALIGN;
|
|
flan_fail_id = (int64_t)(intptr_t)flan_map_adopt(m);
|
|
return 0;
|
|
}
|
|
if (!flan_map_rebuild(m, log2cap, ksize, vsize, hash)) return 0;
|
|
{
|
|
void *xfer = NULL;
|
|
h = hash(key, flan_map_seed(m), ksize, &xfer);
|
|
}
|
|
flan_map_place(m, h, key, val, ksize, vsize);
|
|
m->len++;
|
|
return 1;
|
|
}
|
|
|
|
mask = flan_map_cap(m) - 1;
|
|
if (g.ctrl[free_at] == FLAN_CTRL_EMPTY) (*flan_map_growth(m))--;
|
|
flan_map_set_ctrl(g.ctrl, mask, free_at, flan_map_tag(h));
|
|
flan_copy_small(flan_map_k(&g, free_at), key, ksize);
|
|
if (vsize > 0) flan_copy_small(flan_map_v(&g, free_at), val, 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);
|
|
if (!m->data || m->len == 0) return 0;
|
|
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g, NULL, NULL);
|
|
if (at < 0) return 0;
|
|
if (vsize > 0) flan_copy_small(out, flan_map_v(&g, 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_geom g;
|
|
flan_map_check(m, loc, loclen);
|
|
if (!m->data || m->len == 0) return 0;
|
|
return (int8_t)(flan_map_find_g(m, key, ksize, vsize, hash, eq, &g, NULL, NULL) >= 0);
|
|
}
|
|
|
|
/* Removal, and the one place a Swiss table needs a third state.
|
|
*
|
|
* A lookup stops at the first group holding an empty slot, so emptying a slot
|
|
* could hide a key that was placed past it while it was full. The slot becomes
|
|
* DELETED instead — a slot a probe walks through and an insert may reuse —
|
|
* unless no probe can ever have walked through it: when every eight-slot
|
|
* window containing it already holds an empty slot, any probe that reached it
|
|
* stopped in that window, and it can be emptied outright. The test is that the
|
|
* empties just before and just after it are fewer than eight slots apart, and
|
|
* it is what keeps a map that is far from full from accumulating deleted slots
|
|
* at all.
|
|
*
|
|
* Nothing moves. The old table shifted the rest of the run back one slot, so
|
|
* a cursor already past them stepped over entries; here an entry stays in its
|
|
* slot until a rebuild, and removal during iteration visits every surviving
|
|
* entry once.
|
|
*
|
|
* 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.
|
|
*
|
|
* [out] takes a copy of the value that was there, or is NULL when the caller
|
|
* does not want one. */
|
|
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;
|
|
uint64_t before, after;
|
|
flan_map_check(m, loc, loclen);
|
|
if (!m->data || m->len == 0) return 0;
|
|
at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g, NULL, NULL);
|
|
if (at < 0) return 0;
|
|
if (vsize > 0 && out) flan_copy_small(out, flan_map_v(&g, at), vsize);
|
|
mask = flan_map_cap(m) - 1;
|
|
after = flan_group_empty(flan_group_load(g.ctrl + at));
|
|
before = flan_group_empty(
|
|
flan_group_load(g.ctrl + ((at - FLAN_MAP_GROUP) & mask)));
|
|
if (after && before
|
|
&& flan_mask_first(after) + flan_mask_last_gap(before) < FLAN_MAP_GROUP) {
|
|
flan_map_set_ctrl(g.ctrl, mask, at, FLAN_CTRL_EMPTY);
|
|
(*flan_map_growth(m))++;
|
|
} else {
|
|
flan_map_set_ctrl(g.ctrl, mask, at, FLAN_CTRL_DELETED);
|
|
}
|
|
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.
|
|
*
|
|
* 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: the control byte says whether a slot is full, and nothing else is
|
|
* needed to know where to resume.
|
|
*
|
|
* Invalidated by anything that moves the block, exactly as a Vec's slice is:
|
|
* a put that rebuilds rehashes into a new block and every index before it
|
|
* means a different entry. A remove moves nothing and does not invalidate it.
|
|
* The epoch check below catches a released arena and nothing catches a
|
|
* rebuild, which is the same bargain [slice] already makes.
|
|
*
|
|
* 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.ctrl[i] & FLAN_CTRL_FULL)) continue;
|
|
memcpy(kout, flan_map_k(&g, i), (size_t)ksize);
|
|
/* NULL from (map-next m cur k), the keys-only walk. */
|
|
if (vout) memcpy(vout, flan_map_v(&g, i), (size_t)vsize);
|
|
*cursor = i + 1;
|
|
return 1;
|
|
}
|
|
*cursor = cap;
|
|
return 0;
|
|
}
|
|
|
|
/* Room for [n] entries without reallocating: a block whose threshold is at
|
|
* least n, and with enough growth left that the entries not yet in it will
|
|
* not use it up. A map carrying deleted slots may have the capacity and not
|
|
* the growth, and is rebuilt at the same capacity to sweep them. */
|
|
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) {
|
|
int64_t log2cap;
|
|
flan_map_check(m, loc, loclen);
|
|
if (n <= 0) return 1;
|
|
if (m->data && n <= flan_map_threshold(m)
|
|
&& n - m->len <= *flan_map_growth(m))
|
|
return 1;
|
|
log2cap = flan_map_log2_for(m, n);
|
|
if (log2cap == 0) {
|
|
flan_fail_bytes = FLAN_BYTES_UNREPRESENTABLE;
|
|
flan_fail_align = FLAN_MAP_ALIGN;
|
|
flan_fail_id = (int64_t)(intptr_t)flan_map_adopt(m);
|
|
return 0;
|
|
}
|
|
return flan_map_rebuild(m, log2cap, 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_ALIGN);
|
|
if (m->data && flan_vec_block_hook)
|
|
flan_vec_block_hook(m->data, NULL, 0, NULL, 0);
|
|
m->data = NULL;
|
|
m->len = 0;
|
|
m->log2cap = 0;
|
|
m->alloc = NULL;
|
|
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 control bytes disagree with its own seed and whose every lookup
|
|
* missed. Reinserting also leaves the copy with no deleted slots. */
|
|
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, log2cap;
|
|
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;
|
|
log2cap = flan_map_log2_for(dst, src->len);
|
|
if (!flan_map_rebuild(dst, log2cap, ksize, vsize, hash)) return 0;
|
|
|
|
cap = flan_map_cap(src);
|
|
flan_map_geometry(src, ksize, vsize, cap, &g);
|
|
for (i = 0; i < cap; i++) {
|
|
uint64_t h;
|
|
if (!(g.ctrl[i] & FLAN_CTRL_FULL)) continue;
|
|
h = hash(flan_map_k(&g, i), flan_map_seed(dst), ksize, &xfer);
|
|
flan_map_place(dst, h, flan_map_k(&g, i), flan_map_v(&g, i), ksize, vsize);
|
|
dst->len++;
|
|
}
|
|
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. Two entry points rather than one because the two
|
|
* headers are two layouts.
|
|
*
|
|
* 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. */
|
|
|
|
/* The note for a (bytes s) or (clone xs) block: the hidden Vec that made it,
|
|
* marked as a block handed out as a slice. */
|
|
void flan_dev_reg_note_slice(flan_vec *v, int64_t size, const char *type,
|
|
int64_t typelen) {
|
|
if (v) flan_dev_reg_note_sliced(v->ptr, v->cap * size, size, type, typelen,
|
|
v->alloc);
|
|
}
|
|
|
|
void flan_dev_reg_note_vec(flan_vec *v, int64_t size, const char *type,
|
|
int64_t typelen) {
|
|
if (v) flan_dev_reg_note_owned(v->ptr, v->cap * size, size, type, typelen,
|
|
v->alloc);
|
|
}
|
|
|
|
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 control bytes, 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) {
|
|
rt_flush_out();
|
|
fprintf(stderr,
|
|
"%s: a string passed to C contains a NUL byte — C reads only up "
|
|
"to it. 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) 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;
|
|
}
|
|
|
|
/* ── Reading a file while a macro runs ─────────────────────────────────
|
|
*
|
|
* A macro is compiled and dlopened into the compiler, so it is ordinary native
|
|
* code and could always have called `slurp`. What it could not do is resolve a
|
|
* path the way the rest of the language resolves one. (embed "assets/x.edn")
|
|
* is relative to the directory of the *source file the form is written in* —
|
|
* lib/check.ml's embed_path, and Odin's rule before it — because anything else
|
|
* makes a package's assets depend on where flan happened to be invoked from.
|
|
* A macro has no idea where its call site is: a Form carries no location, on
|
|
* purpose (see the prelude's Form, and Expand.unmarshal).
|
|
*
|
|
* So the compiler tells it, here. lib/macro.ml dlsym's the two symbols below
|
|
* and pokes the call site's directory into them before every expansion; a
|
|
* macro-time read joins that to a relative path and opens the result. The
|
|
* channel is C data and not a Flan global because Build.macro_module emits the
|
|
* module with hidden visibility — only the flan.macro.* thunks stay exported —
|
|
* and "the C goes on resolving the way it always did" is the other half of
|
|
* that same comment.
|
|
*
|
|
* It is empty in a process that is not expanding anything, which is every
|
|
* process but the compiler: the module links this file, so a *program* holding
|
|
* these symbols simply has a relative path mean what it means to the shell.
|
|
*
|
|
* `slurp` is deliberately not what the prelude wraps around this. slurp
|
|
* signals a FileError, and a condition raised inside an expansion is raised in
|
|
* the compiler, through the macro module's own copy of the runtime — which is
|
|
* the failure Build.macro_module's ~hidden comment measured. Absence answers
|
|
* here as a length of -1, on getenv's pattern, so a data file that is not
|
|
* there becomes something the macro can refuse *about* rather than a trap. */
|
|
|
|
char flan_macro_dir[FLAN_PATH_MAX] = { 0 };
|
|
int64_t flan_macro_dir_n = 0;
|
|
|
|
/* The prelude's gensym counter. C data rather than a Flan global for the same
|
|
* reason as the two above: lib/macro.ml writes it into a module before every
|
|
* macro call and reads it back after, which is what keeps it counting across
|
|
* every module a compiler process loads rather than restarting in each. */
|
|
int64_t flan_gensym_n = 0;
|
|
|
|
int64_t flan_gensym_next(void) { return ++flan_gensym_n; }
|
|
|
|
/* The bytes are the caller's to read and nobody's to free: an expansion is
|
|
* bounded by the size of the program being compiled, which is exactly the
|
|
* budget lib/dynload.ml's `owned` note already spends on a macro's own
|
|
* allocations. Leaking is the same decision as there, for the same reason —
|
|
* the returned slice is read after the call returns, and there is no `drop`. */
|
|
const uint8_t *flan_macro_slurp(const uint8_t *path, int64_t n, int64_t *len) {
|
|
static const char empty[1] = { 0 };
|
|
char rel[FLAN_PATH_MAX];
|
|
char full[FLAN_PATH_MAX];
|
|
FILE *f;
|
|
long size;
|
|
uint8_t *buf;
|
|
size_t got;
|
|
*len = -1;
|
|
if (!flan_path_cstr(path, n, rel)) return (const uint8_t *)empty;
|
|
/* An absolute path is taken as written, and a relative one is joined to the
|
|
* call site's directory — embed_path's two cases, in the same order. A dir
|
|
* that was never poked leaves a relative path relative to the process, which
|
|
* is the only thing it can mean when nothing knows better. */
|
|
if (rel[0] == '/' || flan_macro_dir_n <= 0) {
|
|
memcpy(full, rel, (size_t)n + 1);
|
|
} else {
|
|
if (flan_macro_dir_n + 1 + n >= FLAN_PATH_MAX) return (const uint8_t *)empty;
|
|
memcpy(full, flan_macro_dir, (size_t)flan_macro_dir_n);
|
|
full[flan_macro_dir_n] = '/';
|
|
memcpy(full + flan_macro_dir_n + 1, rel, (size_t)n + 1);
|
|
}
|
|
f = fopen(full, "rb");
|
|
if (!f) return (const uint8_t *)empty;
|
|
/* A directory opens on Linux and fails at the read, which is the trap
|
|
* check.ml's read_embed_file records: guarding only the open turns
|
|
* (macro-slurp "somedir") into a crash rather than an answer. Both ends are
|
|
* guarded here and both answer absent. */
|
|
if (fseek(f, 0, SEEK_END) != 0) { fclose(f); return (const uint8_t *)empty; }
|
|
size = ftell(f);
|
|
if (size < 0 || fseek(f, 0, SEEK_SET) != 0) {
|
|
fclose(f);
|
|
return (const uint8_t *)empty;
|
|
}
|
|
buf = (uint8_t *)malloc((size_t)size + 1);
|
|
if (!buf) { fclose(f); return (const uint8_t *)empty; }
|
|
got = fread(buf, 1, (size_t)size, f);
|
|
fclose(f);
|
|
if (got != (size_t)size) { free(buf); return (const uint8_t *)empty; }
|
|
buf[size] = 0;
|
|
*len = (int64_t)size;
|
|
return buf;
|
|
}
|
|
|
|
/* ── 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
|
|
}
|