/* 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 #include #include #include /* ── Conditions, spec-conditions.md ────────────────────────────────── */ /* A handler stack, and nothing more. signal walks it, calls every frame whose * type matches, and returns; a handler that returns normally leaves the * signalling function to carry on, and with an empty stack signal is a null * check. Nothing here transfers control — restart-case is what will, and it * needs a calling convention this does not. * * Frames are allocated by the caller, on its own stack: establishing a handler * is two stores and a push. The condition crosses as a pointer because a * condition is a struct and the handler runs while the signalling frame is * still alive, so there is nothing to copy. * * A type is a number rather than a pointer to anything, so that a module * compiled later against a running program agrees with it: see Check.type_id. */ typedef struct flan_handler { struct flan_handler *prev; uint32_t type_id; void (*fn)(void *condition, void *xfer); } flan_handler; static flan_handler *handlers; void flan_handler_push(flan_handler *h) { h->prev = handlers; handlers = h; } void flan_handler_pop(flan_handler *h) { /* By frame, not by count: restoring what this frame displaced is correct * even if something below it got the stack out of step. */ handlers = h->prev; } /* [xfer] is the signalling function's own end of the transfer channel * (spec-conditions.md §6), threaded through so that a handler invoking a * restart can write its target into it. That makes this C frame transparent to * a transfer, which it has to be: a handler is always reached through here, so * the rule that a transfer cannot cross a foreign frame would otherwise make * restart-case useless. * * A handler that transfers stops the walk. The remaining handlers are for a * signal that is still looking for someone; this one has been answered. */ void flan_signal(uint32_t type_id, void *condition, void *xfer) { for (flan_handler *h = handlers; h != NULL; h = h->prev) if (h->type_id == type_id) { h->fn(condition, xfer); if (*(void **)xfer != NULL) return; } } /* A restart stack, the same shape and for the same reasons. What a transfer * carries is the *address* of one of these frames, not a number: the frame is * allocated by the restart-case that offers it, on its own stack, so the * address is unique against every module a running program may later load and * against every re-entry of the same restart-case. §4's "innermost frame * offering the name" is then just the order of the walk. */ typedef struct flan_restart { struct flan_restart *prev; uint32_t name_id; /* The name as written, beside the hash that matching uses. Matching never * needs it; a break loop does, because it has to show someone their choices * and nothing at run time can turn a hash back into a name. */ const uint8_t *name; int64_t namelen; } flan_restart; static flan_restart *restarts; void flan_restart_push(flan_restart *r) { r->prev = restarts; restarts = r; } void flan_restart_pop(flan_restart *r) { restarts = r->prev; } /* What is on offer, innermost first — spec-conditions.md §4's walk, without * committing to anything. This is [compute-restarts]' data; today its only * caller is the break loop. */ int32_t flan_restart_count(void) { int32_t n = 0; for (flan_restart *r = restarts; r != NULL; r = r->prev) n++; return n; } const uint8_t *flan_restart_name(int32_t i, int64_t *len) { for (flan_restart *r = restarts; r != NULL; r = r->prev) if (i-- == 0) { *len = r->namelen; return r->name; } *len = 0; return NULL; } void *flan_find_restart(uint32_t name_id) { for (flan_restart *r = restarts; r != NULL; r = r->prev) if (r->name_id == name_id) return r; return NULL; } /* The i'th frame itself, innermost first — the same walk as * [flan_restart_name] and the other half of it. A break loop that offers * someone a *list* has to be able to take the entry they picked, and §4's * by-name lookup cannot express "the second retry": it takes the first frame * offering the name, by definition, so a shadowed restart is on every list * and reachable from none of them. Identifying a restart positionally is the * only thing that fixes that, and it is why SBCL does the same. * * The address is the currency: a transfer carries the frame's address, so a * caller that holds one from before is holding the same frame the walk found, * whatever the walk finds today. */ void *flan_restart_frame(int32_t i) { for (flan_restart *r = restarts; r != NULL; r = r->prev) if (i-- == 0) return r; return NULL; } /* Aim the transfer channel at a frame obtained earlier. The same store * [flan_break_resume] makes and the same one an invoke-restart makes — this * only spells it without a lookup, for a caller that did its looking up when * the stack was worth reading. */ void flan_restart_take(void *frame, void *xfer) { *(void **)xfer = frame; } /* [T] and string are both ptr+len — see Emit.ll. */ typedef struct { const uint8_t *ptr; int64_t len; } flan_slice; static int rt_argc; static char **rt_argv; static flan_slice *rt_args; /* argv as [string], built once, never freed */ void flan_rt_init(int32_t argc, char **argv) { rt_argc = (int)argc; rt_argv = argv; /* Line buffered even when stdout is a file or a pipe, where the C default is * a 4K block. A Flan program can run for minutes with a REPL attached to it, * and output that only appears when it exits is output nobody can use. It is * also what makes a program's progress observable to a test that is driving * it. The cost is one write per line instead of per 4K. */ setvbuf(stdout, NULL, _IOLBF, 0); } 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); 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); } void flan_exit(int32_t status) { fflush(stdout); exit((int)status); } /* 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. */ #define SCRATCH 64 static char scratch[SCRATCH]; /* rendered text lives here until the next call */ /* 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 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 a * static buffer" 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 < SCRATCH ? (int64_t)n : (int64_t)(SCRATCH - 1); } /* The length is clamped below *and* above. Above is obvious and was always * here. Below was not, and it was the real one: a slice's length is a signed * 64-bit count, (slice s 2 1) computes 2 - 1 - 2 = -1, and `(size_t)n` on a * negative n is 18446744073709551615, which is not less than 511, so k became * 511 and the memcpy read 511 bytes from wherever the slice pointed. A checked * build traps on the reversed slice before it gets here; an unchecked one does * not, and every other (ptr, len) entry point in this file — flan_write_stdout, * flan_escape_bytes, flan_dev_emit — already guards the negative case. These * two were the exceptions. */ static size_t clamp_len(int64_t n, size_t cap) { if (n <= 0) return 0; return (uint64_t)n < (uint64_t)cap ? (size_t)n : cap; } double flan_bytes_to_f64(const uint8_t *p, int64_t n) { char buf[512]; size_t k = clamp_len(n, sizeof buf - 1); memcpy(buf, p, k); buf[k] = '\0'; return strtod(buf, NULL); } int64_t flan_bytes_to_i64(const uint8_t *p, int64_t n) { char buf[64]; size_t k = clamp_len(n, sizeof buf - 1); memcpy(buf, p, k); buf[k] = '\0'; return (int64_t)strtoll(buf, NULL, 10); } /* %g so that 3.5 prints as "3.5" and not "3.500000" — calc-me's expected * output is a table of exact strings. */ void flan_f64_to_bytes(double x, flan_slice *out) { int n = snprintf(scratch, SCRATCH, "%g", x); out->ptr = (const uint8_t *)scratch; out->len = fit(n); } void flan_i64_to_bytes(int64_t x, flan_slice *out) { int n = snprintf(scratch, SCRATCH, "%lld", (long long)x); out->ptr = (const uint8_t *)scratch; 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, flan_slice *out) { int n = snprintf(scratch, SCRATCH, "%llu", (unsigned long long)x); out->ptr = (const uint8_t *)scratch; out->len = fit(n); } /* A string *inside* a printed structure, quoted and escaped, so that the run * of bytes can be told from the punctuation around it — (S {:name "a b"}) has * two fields if the quotes are missing and one if they are there. * * This is the same escape table as flan_dev_emit_str in flan_dev.c, and * deliberately so: the REPL and println must not disagree about what a struct * looks like. It cannot be the *same function* because the dev one streams * into the result buffer and this one has to hand back a slice; if either * table changes, change both. * * Its own buffer, not `scratch`: escaping is the one conversion whose output * is not a bounded handful of characters. Over-long input is truncated with an * ellipsis rather than silently cut, because a value that prints as a shorter * value is the failure nobody notices. */ #define ESCAPE_MAX 1024 static char escaped[ESCAPE_MAX]; void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) { size_t len = n < 0 ? 0 : (size_t)n; size_t w = 0; int cut = 0; /* The guard reserves 9 bytes, and all 9 are spoken for: 4 for the longest * single escape (\xNN), 3 for the ellipsis, 1 for the closing quote, 1 * spare. So the loop never writes a partial escape and the three writes * after it never need a bound of their own. Swept over every length to 1300 * against \x01, '"', '\\' and 'a': the worst output is 1021 of 1024. If the * escape table ever grows a longer form, this 9 grows with it. */ escaped[w++] = '"'; for (size_t i = 0; i < len; i++) { if (w + 5 + 4 >= ESCAPE_MAX) { cut = 1; break; } unsigned char c = p[i]; switch (c) { case '"': escaped[w++] = '\\'; escaped[w++] = '"'; break; case '\\': escaped[w++] = '\\'; escaped[w++] = '\\'; break; case '\n': escaped[w++] = '\\'; escaped[w++] = 'n'; break; case '\t': escaped[w++] = '\\'; escaped[w++] = 't'; break; case '\r': escaped[w++] = '\\'; escaped[w++] = 'r'; break; default: if (c < 0x20) { w += (size_t)snprintf(escaped + w, 5, "\\x%02x", c); } else { escaped[w++] = (char)c; } } } if (cut) { escaped[w++] = '.'; escaped[w++] = '.'; escaped[w++] = '.'; } escaped[w++] = '"'; out->ptr = (const uint8_t *)escaped; out->len = (int64_t)w; } /* Bounds failures. The emitted code branches here and then falls off the end * with `unreachable`, so these must not return — the same explicit shape as * every other non-local exit, which is what keeps wasm32 free of unwinding. * * The location is passed as ptr+len because that is what a Flan string already * is; nothing here allocates. Exit 134 is abort()'s status without abort()'s * signal, so the same assertion should hold once wasm32 builds. * * stdout is flushed *before* the message: stderr is unbuffered and a * redirected stdout is not, so without this the error appears above the output * that led to it. */ static _Noreturn void rt_die(void) { fflush(stdout); fflush(stderr); exit(134); } _Noreturn void flan_bounds_fail(const uint8_t *loc, int64_t loclen, int64_t idx, int64_t len) { fflush(stdout); fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n", (int)loclen, (const char *)loc, (long long)idx, (long long)len); rt_die(); } /* §2's diverging variant: the same walk, but a handler that returns normally * has not answered it. Only a transfer gets past here — the caller's guard * sees the channel and forwards it — so with nothing transferring the program * stops. In a dev build this is where the break loop will go; until it exists, * stopping is all there is, and it says which condition it was. * * [flan_signal] is not reused with a flag because the two differ in what they * do when the walk ends, which is the whole of §1 against §2. */ /* The dev-build break loop, spec-conditions.md §2. A hook rather than a direct * call because the loop lives in the *agent*, which is an optional package, and * this file is the release runtime — it must not depend on something a program * may not have imported. A program with no agent leaves this NULL and dies the * way it always did. * * The hook may resume by writing a restart into the transfer channel, which is * the same channel an invoke-restart writes and reaches the same guard. So * choosing a restart from the break loop and choosing one from a handler are * the same act, lowered the same way. */ void (*flan_break_hook)(const uint8_t *name, int64_t namelen, void *condition, void *xfer); /* Must agree with Check.type_id, byte for byte, or a name typed at the break * loop matches nothing. FNV-1a over the name, 32 bits. */ static uint32_t flan_name_id(const uint8_t *s, int64_t n) { uint32_t h = 0x811c9dc5u; for (int64_t i = 0; i < n; i++) { h ^= (uint32_t)s[i]; h *= 0x01000193u; } return h; } /* What the break loop calls to resume: look a restart up by the name someone * typed and aim the channel at it. 0 if no frame offers it, and then the loop * says so rather than resuming into nothing. */ int32_t flan_break_resume(const uint8_t *name, int64_t namelen, void *xfer) { void *r = flan_find_restart(flan_name_id(name, namelen)); if (r == NULL) return 0; *(void **)xfer = r; return 1; } void flan_error(uint32_t type_id, void *condition, void *xfer, const uint8_t *name, int64_t namelen) { flan_signal(type_id, condition, xfer); if (*(void **)xfer != NULL) return; /* Nothing handled it. In a dev build that is a place to stand, not the end * of the program — which is the whole of §2 and the reason it is worth * having. */ if (flan_break_hook != NULL) { flan_break_hook(name, namelen, condition, xfer); if (*(void **)xfer != NULL) return; } fflush(stdout); fprintf(stderr, "unhandled %.*s\n", (int)namelen, (const char *)name); rt_die(); } /* Nothing on the restart stack offers the name. It is reported where the * invoke was, because that is the only place that knows what was asked for; * there is nowhere to resume, so there is nothing else to do. */ _Noreturn void flan_restart_fail(const uint8_t *loc, int64_t loclen, const uint8_t *name, int64_t namelen) { fflush(stdout); fprintf(stderr, "%.*s: no restart named %.*s is active\n", (int)loclen, (const char *)loc, (int)namelen, (const char *)name); rt_die(); } /* The frame the name found does not take these arguments — spec-conditions.md * §3's run-time check. It has to be at run time: a restart is resolved on a * dynamic stack, so the invoke site cannot see what it will find, and the * frame cannot see who will find it. What each end knows is its own parameter * list, so the message is both of them side by side. */ _Noreturn void flan_restart_args_fail(const uint8_t *loc, int64_t loclen, const uint8_t *name, int64_t namelen, const uint8_t *want, int64_t wantlen, const uint8_t *got, int64_t gotlen) { fflush(stdout); fprintf(stderr, "%.*s: restart %.*s takes %.*s, given %.*s\n", (int)loclen, (const char *)loc, (int)namelen, (const char *)name, (int)wantlen, (const char *)want, (int)gotlen, (const char *)got); rt_die(); } /* A clause with parameters was reached by a transfer that filled none of them * in. No [invoke-restart] can do that — it writes the arguments before it aims * the channel — so this is the other way a transfer starts: the break loop, * which today takes a restart by position and has no way to supply a value. * Refused at the clause rather than run on a buffer nobody wrote. */ _Noreturn void flan_restart_unarmed(const uint8_t *loc, int64_t loclen, const uint8_t *name, int64_t namelen, const uint8_t *want, int64_t wantlen) { fflush(stdout); fprintf(stderr, "%.*s: restart %.*s takes %.*s, and whatever took it supplied no " "arguments — a restart with parameters cannot be taken from the " "break loop yet\n", (int)loclen, (const char *)loc, (int)namelen, (const char *)name, (int)wantlen, (const char *)want); rt_die(); } /* Something a defer called invoked a restart. A defer is the cleanup a * transfer runs on its way out (§5), so a transfer starting there would leave * this frame's defers half run with two targets and no way to choose. The * lexical case is refused by the checker; this is the one that reaches a * function through a call, where nothing static could see it. */ _Noreturn void flan_transfer_fail(const uint8_t *loc, int64_t loclen) { fflush(stdout); fprintf(stderr, "%.*s: a defer invoked a restart, which a defer may not do — it is " "the cleanup a transfer runs on its way out\n", (int)loclen, (const char *)loc); rt_die(); } _Noreturn void flan_slice_fail(const uint8_t *loc, int64_t loclen, int64_t lo, int64_t hi, int64_t len) { fflush(stdout); fprintf(stderr, "%.*s: slice [%lld %lld) is out of bounds for length %lld\n", (int)loclen, (const char *)loc, (long long)lo, (long long)hi, (long long)len); rt_die(); } /* ── Allocators, spec-memory.md ──────────────────────────────────────── * * One type-erased procedure plus an opaque data pointer, which is Odin's * shape (base/runtime/core.odin, Allocator_Proc), and every operation takes * size and align as parameters because the only place the concrete type is * known is the call site. * * A Flan `Allocator` value is a *pointer* to one of these, not a copy of it. * That is forced by two things in the spec and is not a convenience: the * capability set has to be readable at run time from wherever a container * landed, and `free-all` bumps an epoch that every container made from the * allocator has to observe. A copied-by-value allocator would give each copy * its own epoch and the dev trap would never fire. * * Nothing here returns a struct by value, per the file header. */ enum { FLAN_ALLOC_ALLOC = 0, FLAN_ALLOC_RESIZE = 1, FLAN_ALLOC_FREE = 2, FLAN_ALLOC_FREE_ALL = 3 }; /* The capability set. Odin reads its own back through the procedure * (Query_Features returning an Allocator_Mode_Set); a field is the same * information without the round trip, and `can-free` is the one that is * load-bearing — spec-memory.md refuses a drop-carrying container against an * allocator that lacks it. */ enum { FLAN_CAN_ALLOC = 1u << 0, FLAN_CAN_RESIZE = 1u << 1, FLAN_CAN_FREE = 1u << 2, FLAN_CAN_FREE_ALL = 1u << 3 }; typedef struct flan_allocator flan_allocator; /* Returns NULL on failure and never reports failure any other way. The * condition, the restart and the message are all the compiler's job; this * layer says yes or no. */ typedef void *(*flan_alloc_proc)(flan_allocator *a, int32_t mode, void *p, int64_t old_size, int64_t size, int64_t align); struct flan_allocator { flan_alloc_proc proc; void *data; uint32_t caps; /* Bumped on every free-all. A container records it and traps if it moved: * spec-memory.md, "Dev builds detect a released region". Separate from the * per-Vec generation word, which answers a different question. */ uint64_t epoch; /* Dev accounting for the general-purpose tier: "did you forget to free" is * an allocator-tier question and this is the allocator's answer. */ int64_t live_blocks; int64_t live_bytes; /* A cap on live bytes, or 0 for none. It is here because * spec-memory.md's retry restart is only answerable by a handler that can * make the *same* request succeed, and for a fixed backing buffer the only * such handler is one that raises the ceiling: releasing the region a * container lives in invalidates the container, which is what the epoch * check exists to catch. So "grow the arena and then invoke retry", which * the spec names as the handler that works, needs a ceiling to raise. It * doubles as the knob a test exhausts an allocator with on purpose. */ int64_t budget; }; /* Would this request put the allocator over its budget? */ static int flan_over_budget(flan_allocator *a, int64_t size) { return a->budget > 0 && a->live_bytes + size > a->budget; } /* -- The heap allocator: malloc, realloc, free. ---------------------- */ static void *flan_heap_proc(flan_allocator *a, int32_t mode, void *p, int64_t old_size, int64_t size, int64_t align) { switch (mode) { case FLAN_ALLOC_ALLOC: { void *q = NULL; size_t al, sz; if (size <= 0) return NULL; if (flan_over_budget(a, size)) return NULL; al = (size_t)(align < (int64_t)sizeof(void *) ? (int64_t)sizeof(void *) : align); sz = (size_t)size; /* aligned_alloc requires a size that is a multiple of the alignment. */ if (sz % al) sz += al - (sz % al); q = aligned_alloc(al, sz); if (q) { a->live_blocks++; a->live_bytes += size; } return q; } case FLAN_ALLOC_RESIZE: { /* aligned_alloc has no realloc, so growth is a new block and a copy. The * caller passes old_size for exactly this reason, and it is the one * number a wrong answer here would read off the end of. */ void *q; if (flan_over_budget(a, size - old_size)) return NULL; q = flan_heap_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align); if (!q) return NULL; if (p && old_size > 0) memcpy(q, p, (size_t)(old_size < size ? old_size : size)); if (p) { free(p); a->live_blocks--; a->live_bytes -= old_size; } return q; } case FLAN_ALLOC_FREE: if (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 }; /* -- 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 BUILT.md) and * it is what Odin's arena_free_all already does in effect. Handing the pages * back is `arena-destroy`, a separate operation, because a frame arena reset * every frame must not return memory only to ask for it again. * * The epoch is bumped either way: the pages are the same but every container * made before the reset is invalid, which is the whole point of the trap. */ typedef struct flan_arena { uint8_t *base; int64_t cap; int64_t offset; int64_t peak; } flan_arena; static int64_t flan_align_up(int64_t x, int64_t a) { if (a <= 1) return x; return (x + a - 1) / a * a; } static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p, int64_t old_size, int64_t size, int64_t align) { flan_arena *ar = (flan_arena *)a->data; switch (mode) { case FLAN_ALLOC_ALLOC: { int64_t start, end; if (size <= 0) return NULL; if (flan_over_budget(a, size)) return NULL; if (align < 1) align = 1; start = flan_align_up(ar->offset, align); end = start + size; if (end > ar->cap || end < start) return NULL; /* exhausted, or overflow */ ar->offset = end; if (end > ar->peak) ar->peak = end; a->live_blocks++; a->live_bytes += size; return ar->base + start; } case FLAN_ALLOC_RESIZE: { void *q; /* Growing the most recent block in place is the one case worth special * casing: a Vec that is the only thing pushing into a frame arena grows * without copying, which is the common shape. */ if (p && (uint8_t *)p + old_size == ar->base + ar->offset) { int64_t end = (int64_t)((uint8_t *)p - ar->base) + size; if (end > ar->cap || end < 0) return NULL; ar->offset = end; if (end > ar->peak) ar->peak = end; a->live_bytes += size - old_size; return p; } q = flan_arena_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align); if (!q) return NULL; if (p && old_size > 0) memcpy(q, p, (size_t)(old_size < size ? old_size : size)); return q; /* the old block is not reclaimable */ } case FLAN_ALLOC_FREE: return NULL; /* refused by the capability set above */ case FLAN_ALLOC_FREE_ALL: 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 BUILT.md says so. * * There are no threads in Flan, so a plain global is the whole of it. */ static flan_allocator *flan_ctx_alloc = &flan_heap; static flan_allocator *flan_ctx_tmp = NULL; flan_allocator *flan_arena_new(int64_t cap); flan_allocator *flan_context_allocator(void) { return flan_ctx_alloc; } /* The default temp arena, made on first use. 1 MiB: big enough that the * per-frame tier does not fail on a toy program, small enough that a program * which never touches it has not paid for a heap. */ #define FLAN_TEMP_DEFAULT (1 << 20) flan_allocator *flan_context_temp(void) { if (!flan_ctx_tmp) flan_ctx_tmp = flan_arena_new(FLAN_TEMP_DEFAULT); return flan_ctx_tmp; } /* Returns the previous one, which is what with-allocator restores — on the * normal path and on the transfer path both. */ flan_allocator *flan_context_set(flan_allocator *a) { flan_allocator *prev = flan_ctx_alloc; if (a) flan_ctx_alloc = a; return prev; } void flan_context_restore(flan_allocator *a) { if (a) flan_ctx_alloc = a; } flan_allocator *flan_arena_new(int64_t cap) { flan_allocator *a; flan_arena *ar; if (cap <= 0) cap = FLAN_TEMP_DEFAULT; a = (flan_allocator *)calloc(1, sizeof *a); ar = (flan_arena *)calloc(1, sizeof *ar); if (!a || !ar) { free(a); free(ar); return NULL; } ar->base = (uint8_t *)malloc((size_t)cap); if (!ar->base) { free(a); free(ar); return NULL; } ar->cap = cap; a->proc = flan_arena_proc; a->data = ar; /* No FLAN_CAN_FREE: an arena cannot release one block, which is Odin's * answer too (allocators.odin returns Mode_Not_Implemented for .Free). */ a->caps = FLAN_CAN_ALLOC | FLAN_CAN_RESIZE | FLAN_CAN_FREE_ALL; return a; } void flan_arena_destroy(flan_allocator *a) { flan_arena *ar; if (!a || a->proc != flan_arena_proc) return; ar = (flan_arena *)a->data; if (a == flan_ctx_alloc) flan_ctx_alloc = &flan_heap; if (a == flan_ctx_tmp) flan_ctx_tmp = NULL; a->epoch++; free(ar->base); free(ar); free(a); } flan_allocator *flan_heap_allocator(void) { return &flan_heap; } int8_t flan_alloc_can_free(flan_allocator *a) { return (int8_t)(a && (a->caps & FLAN_CAN_FREE) ? 1 : 0); } int8_t flan_alloc_can_free_all(flan_allocator *a) { return (int8_t)(a && (a->caps & FLAN_CAN_FREE_ALL) ? 1 : 0); } int64_t flan_alloc_epoch(flan_allocator *a) { return a ? (int64_t)a->epoch : 0; } int64_t flan_alloc_live_blocks(flan_allocator *a) { return a ? a->live_blocks : 0; } int64_t flan_alloc_budget(flan_allocator *a) { return a ? a->budget : 0; } void flan_alloc_set_budget(flan_allocator *a, int64_t n) { if (a) a->budget = n < 0 ? 0 : n; } _Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen); _Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen); /* free-all on an allocator that does not offer it is a trap, not a silent * no-op: "I released the region" and "I leaked the region" must not be the * same program text. */ void flan_alloc_free_all(flan_allocator *a, const uint8_t *loc, int64_t loclen) { /* A null allocator is a zeroed [defvar] nobody assigned yet. Silently doing * nothing would make "I released the region" and "I never made one" the same * program text, which is the thing this trap exists to prevent. */ if (!a) flan_null_alloc_fail(loc, loclen); if (!(a->caps & FLAN_CAN_FREE_ALL)) flan_free_all_fail(loc, loclen); a->proc(a, FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0); a->epoch++; } _Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen) { fflush(stdout); fprintf(stderr, "%.*s: this allocator is null — a zeroed Allocator was never given " "one\n", (int)loclen, (const char *)loc); rt_die(); } _Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) { fflush(stdout); fprintf(stderr, "%.*s: this allocator does not offer free-all — it has no region to " "release, and releasing nothing is not the same as releasing " "everything\n", (int)loclen, (const char *)loc); rt_die(); } /* ── (Vec T), spec-memory.md ──────────────────────────────────────────── * * One type-erased runtime over (size, align), which is Odin's arrangement * (base/runtime/dynamic_array_internal.odin): the monomorphised wrapper is the * only place the concrete type is known, so it is the only place that can * produce the numbers, and it passes them in. There are no generics here and * none are needed. * * Header, and it is six words rather than the spec's four: * * ptr len cap allocator the release layout spec-memory.md fixes * gen bumped on every reallocation — the stale-slice * word. It has no reader yet; see BUILT.md. * epoch the allocator's epoch when this Vec last * touched it. Any operation on a container whose * recorded epoch has moved traps. * * The two dev words are present in every build, not only a dev one, and that * is not laziness: a redefinition module is built by llc and ld against a host * that was built separately, and nothing makes the two agree on a struct size. * A layout that changes with a build flag is a layout that can disagree across * that boundary silently. Dropping them in release is deferred and BUILT.md * says what it is blocked on. * * Every entry point returns int8_t 1/0 for "did it fit", and never reports * failure any other way: the condition, the restart and the message are the * compiler's job (see Check's alloc_guard). */ typedef struct flan_vec { void *ptr; int64_t len; int64_t cap; flan_allocator *alloc; int64_t gen; int64_t epoch; } flan_vec; /* The request that did not fit, for the condition the compiler builds at the * failing site. A pair of globals rather than out-parameters because the * condition is a value struct on the signalling frame's stack with fixed * numeric fields and no rendered message — spec-memory.md is explicit that * this is the one path that must not allocate, and reading two words is the * cheapest way to carry the numbers out. */ static int64_t flan_fail_bytes = 0; static int64_t flan_fail_align = 0; static int64_t flan_fail_id = 0; int64_t flan_alloc_fail_bytes(void) { return flan_fail_bytes; } int64_t flan_alloc_fail_align(void) { return flan_fail_align; } int64_t flan_alloc_fail_id(void) { return flan_fail_id; } /* The allocator's identity, for the condition's :allocator field. The pointer * is the identity — the same thing the epoch hangs off. */ int64_t flan_alloc_id(flan_allocator *a) { return (int64_t)(intptr_t)a; } _Noreturn void flan_vec_stale_fail(const uint8_t *loc, int64_t loclen, int64_t was, int64_t now) { fflush(stdout); fprintf(stderr, "%.*s: this container's allocator was released — it was made at " "epoch %lld and the allocator is at %lld now\n", (int)loclen, (const char *)loc, (long long)was, (long long)now); rt_die(); } _Noreturn void flan_vec_bounds_fail(const uint8_t *loc, int64_t loclen, int64_t i, int64_t len) { fflush(stdout); fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n", (int)loclen, (const char *)loc, (long long)i, (long long)len); rt_die(); } /* spec-memory.md, "Dev builds detect a released region". This is the check * that makes the epoch word worth carrying, and it runs on every operation, * not only in a dev build — see the header on why the words are unconditional. * A Vec that never allocated has no allocator and nothing to check. */ static void flan_vec_check(flan_vec *v, const uint8_t *loc, int64_t loclen) { if (v->alloc) { int64_t now = (int64_t)v->alloc->epoch; if (now != v->epoch) flan_vec_stale_fail(loc, loclen, v->epoch, now); } } /* A zeroed Vec — a struct field nobody assigned, or a (defvar xs (Vec i32)) — * has a null allocator, and the first operation that needs storage adopts the * context allocator. That is Odin's behaviour, and the alternative was to * refuse a Vec-typed struct field outright until step 5. Shipping the null * silently was not an option: it is a null deref on the first push. */ static flan_allocator *flan_vec_adopt(flan_vec *v) { if (!v->alloc) { v->alloc = flan_context_allocator(); v->epoch = (int64_t)v->alloc->epoch; } return v->alloc; } 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; 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; } flan_fail_bytes = cap * size; 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, cap * size, align); else p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, cap * size, align); if (!p) return 0; v->ptr = p; v->cap = cap; /* Any slice taken before this points at storage that may have moved. The * word is bumped here and read nowhere yet; see BUILT.md. */ v->gen++; return 1; } int8_t flan_vec_init(flan_vec *v, flan_allocator *a, int64_t cap, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen) { /* [a] is NULL only when no allocator was named at the site and the context * is being used. An allocator *named* at the site and null is a zeroed * Allocator nobody assigned, and substituting the heap for it would be the * same "released the region / never made one" collapse flan_alloc_free_all * traps for — except silent, and discovered as a leak. The checker cannot * see it, because a null is a run-time value. * * The no-allocator-named case never arrives here as NULL: the checker passes * flan_context_allocator(), which always answers one. */ if (!a) flan_null_alloc_fail(loc, loclen); v->ptr = NULL; v->len = 0; v->cap = 0; v->gen = 0; v->alloc = a; v->epoch = (int64_t)v->alloc->epoch; if (cap <= 0) return 1; return flan_vec_grow(v, cap, size, align); } int8_t flan_vec_reserve(flan_vec *v, int64_t n, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen) { flan_vec_check(v, loc, loclen); if (n <= v->cap) return 1; return flan_vec_grow(v, n, size, align); } int8_t flan_vec_push(flan_vec *v, const void *elem, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen) { flan_vec_check(v, loc, loclen); if (v->len + 1 > v->cap && !flan_vec_grow(v, v->len + 1, size, align)) return 0; memcpy((uint8_t *)v->ptr + v->len * size, elem, (size_t)size); v->len++; return 1; } int64_t flan_vec_len(flan_vec *v, const uint8_t *loc, int64_t loclen) { flan_vec_check(v, loc, loclen); return v->len; } void *flan_vec_at(flan_vec *v, int32_t i, int64_t size, const uint8_t *loc, int64_t loclen) { 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) flan_vec_bounds_fail(loc, loclen, (int64_t)i, v->len); return (uint8_t *)v->ptr + (int64_t)i * size; } /* [hi] of -1 means "to the end": (as-slice v) has no static length to write. */ void flan_vec_as_slice(flan_vec *v, void *out, int32_t lo, int32_t hi, int64_t size, const uint8_t *loc, int64_t loclen) { 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) flan_vec_bounds_fail(loc, loclen, l, v->len); s.p = (uint8_t *)v->ptr + l * size; s.n = h - l; memcpy(out, &s, sizeof s); } /* spec-memory.md's first release point. The Vec is left zeroed rather than * dangling — the checker has already made using it afterwards a compile error, * and zeroing costs nothing and makes a bug that slips past the checker a null * deref rather than a use-after-free. An allocator without can-free keeps the * block: releasing it is free-all's job, and pretending otherwise here is the * silent-no-op this file refuses elsewhere. */ void flan_vec_free(flan_vec *v, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen) { flan_vec_check(v, loc, loclen); if (v->ptr && v->alloc && (v->alloc->caps & FLAN_CAN_FREE)) v->alloc->proc(v->alloc, FLAN_ALLOC_FREE, v->ptr, v->cap * size, 0, align); (void)align; v->ptr = NULL; v->len = 0; v->cap = 0; v->alloc = NULL; v->gen++; v->epoch = 0; } int8_t flan_vec_clone(flan_vec *dst, flan_vec *src, flan_allocator *a, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen) { flan_vec_check(src, loc, loclen); if (!flan_vec_init(dst, a, src->len, size, align, loc, loclen)) return 0; if (src->len > 0) memcpy(dst->ptr, src->ptr, (size_t)(src->len * size)); dst->len = src->len; return 1; } /* ── 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 #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 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 got = 0; if (!flan_file_read(path, n, v->ptr, v->cap, &got)) return 0; v->len = got; return 1; }