/* 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; } /* [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(); }