Joseph Ferano
2f8436018c
A restart the innermost frame shadows could be seen and not taken; it is taken by position now, off a snapshot that stopped moving under the break loop. The editor half this was briefed as building already existed — the stale line that said otherwise is fixed.
395 lines
16 KiB
C
395 lines
16 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 <stdint.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
|
|
/* ── Conditions, spec-conditions.md ────────────────────────────────── */
|
|
|
|
/* A handler stack, and nothing more. signal walks it, calls every frame whose
|
|
* type matches, and returns; a handler that returns normally leaves the
|
|
* signalling function to carry on, and with an empty stack signal is a null
|
|
* check. Nothing here transfers control — restart-case is what will, and it
|
|
* needs a calling convention this does not.
|
|
*
|
|
* Frames are allocated by the caller, on its own stack: establishing a handler
|
|
* is two stores and a push. The condition crosses as a pointer because a
|
|
* condition is a struct and the handler runs while the signalling frame is
|
|
* still alive, so there is nothing to copy.
|
|
*
|
|
* A type is a number rather than a pointer to anything, so that a module
|
|
* compiled later against a running program agrees with it: see Check.type_id. */
|
|
|
|
typedef struct flan_handler {
|
|
struct flan_handler *prev;
|
|
uint32_t type_id;
|
|
void (*fn)(void *condition, void *xfer);
|
|
} flan_handler;
|
|
|
|
static flan_handler *handlers;
|
|
|
|
void flan_handler_push(flan_handler *h) {
|
|
h->prev = handlers;
|
|
handlers = h;
|
|
}
|
|
|
|
void flan_handler_pop(flan_handler *h) {
|
|
/* By frame, not by count: restoring what this frame displaced is correct
|
|
* even if something below it got the stack out of step. */
|
|
handlers = h->prev;
|
|
}
|
|
|
|
/* [xfer] is the signalling function's own end of the transfer channel
|
|
* (spec-conditions.md §6), threaded through so that a handler invoking a
|
|
* restart can write its target into it. That makes this C frame transparent to
|
|
* a transfer, which it has to be: a handler is always reached through here, so
|
|
* the rule that a transfer cannot cross a foreign frame would otherwise make
|
|
* restart-case useless.
|
|
*
|
|
* A handler that transfers stops the walk. The remaining handlers are for a
|
|
* signal that is still looking for someone; this one has been answered. */
|
|
void flan_signal(uint32_t type_id, void *condition, void *xfer) {
|
|
for (flan_handler *h = handlers; h != NULL; h = h->prev)
|
|
if (h->type_id == type_id) {
|
|
h->fn(condition, xfer);
|
|
if (*(void **)xfer != NULL) return;
|
|
}
|
|
}
|
|
|
|
/* A restart stack, the same shape and for the same reasons. What a transfer
|
|
* carries is the *address* of one of these frames, not a number: the frame is
|
|
* allocated by the restart-case that offers it, on its own stack, so the
|
|
* address is unique against every module a running program may later load and
|
|
* against every re-entry of the same restart-case. §4's "innermost frame
|
|
* offering the name" is then just the order of the walk. */
|
|
|
|
typedef struct flan_restart {
|
|
struct flan_restart *prev;
|
|
uint32_t name_id;
|
|
/* The name as written, beside the hash that matching uses. Matching never
|
|
* needs it; a break loop does, because it has to show someone their choices
|
|
* and nothing at run time can turn a hash back into a name. */
|
|
const uint8_t *name;
|
|
int64_t namelen;
|
|
} flan_restart;
|
|
|
|
static flan_restart *restarts;
|
|
|
|
void flan_restart_push(flan_restart *r) {
|
|
r->prev = restarts;
|
|
restarts = r;
|
|
}
|
|
|
|
void flan_restart_pop(flan_restart *r) { restarts = r->prev; }
|
|
|
|
/* What is on offer, innermost first — spec-conditions.md §4's walk, without
|
|
* committing to anything. This is [compute-restarts]' data; today its only
|
|
* caller is the break loop. */
|
|
int32_t flan_restart_count(void) {
|
|
int32_t n = 0;
|
|
for (flan_restart *r = restarts; r != NULL; r = r->prev) n++;
|
|
return n;
|
|
}
|
|
|
|
const uint8_t *flan_restart_name(int32_t i, int64_t *len) {
|
|
for (flan_restart *r = restarts; r != NULL; r = r->prev)
|
|
if (i-- == 0) { *len = r->namelen; return r->name; }
|
|
*len = 0;
|
|
return NULL;
|
|
}
|
|
|
|
void *flan_find_restart(uint32_t name_id) {
|
|
for (flan_restart *r = restarts; r != NULL; r = r->prev)
|
|
if (r->name_id == name_id) return r;
|
|
return NULL;
|
|
}
|
|
|
|
/* The i'th frame itself, innermost first — the same walk as
|
|
* [flan_restart_name] and the other half of it. A break loop that offers
|
|
* someone a *list* has to be able to take the entry they picked, and §4's
|
|
* by-name lookup cannot express "the second retry": it takes the first frame
|
|
* offering the name, by definition, so a shadowed restart is on every list
|
|
* and reachable from none of them. Identifying a restart positionally is the
|
|
* only thing that fixes that, and it is why SBCL does the same.
|
|
*
|
|
* The address is the currency: a transfer carries the frame's address, so a
|
|
* caller that holds one from before is holding the same frame the walk found,
|
|
* whatever the walk finds today. */
|
|
void *flan_restart_frame(int32_t i) {
|
|
for (flan_restart *r = restarts; r != NULL; r = r->prev)
|
|
if (i-- == 0) return r;
|
|
return NULL;
|
|
}
|
|
|
|
/* Aim the transfer channel at a frame obtained earlier. The same store
|
|
* [flan_break_resume] makes and the same one an invoke-restart makes — this
|
|
* only spells it without a lookup, for a caller that did its looking up when
|
|
* the stack was worth reading. */
|
|
void flan_restart_take(void *frame, void *xfer) { *(void **)xfer = frame; }
|
|
|
|
/* [T] and string are both ptr+len — see Emit.ll. */
|
|
typedef struct { const uint8_t *ptr; int64_t len; } flan_slice;
|
|
|
|
static int rt_argc;
|
|
static char **rt_argv;
|
|
static flan_slice *rt_args; /* argv as [string], built once, never freed */
|
|
|
|
void flan_rt_init(int32_t argc, char **argv) {
|
|
rt_argc = (int)argc;
|
|
rt_argv = argv;
|
|
/* Line buffered even when stdout is a file or a pipe, where the C default is
|
|
* a 4K block. A Flan program can run for minutes with a REPL attached to it,
|
|
* and output that only appears when it exits is output nobody can use. It is
|
|
* also what makes a program's progress observable to a test that is driving
|
|
* it. The cost is one write per line instead of per 4K. */
|
|
setvbuf(stdout, NULL, _IOLBF, 0);
|
|
}
|
|
|
|
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 */
|
|
|
|
double flan_bytes_to_f64(const uint8_t *p, int64_t n) {
|
|
char buf[512];
|
|
size_t k = (size_t)n < sizeof buf - 1 ? (size_t)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 = (size_t)n < sizeof buf - 1 ? (size_t)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 = n < 0 ? 0 : (int64_t)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 = n < 0 ? 0 : (int64_t)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 = n < 0 ? 0 : (int64_t)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();
|
|
}
|
|
|
|
/* 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();
|
|
}
|