path: root/src/tools/zc0.c

/* zc0: stage 0 of the bootstrap. a small c compiler for the subset of zc that
   the compiler (src/compiler/) is written in. it reads zc source on stdin and writes a genome
   image (vm words placed at GORG, as little-endian 64-bit words) on stdout, in
   the same image layout the resident compiler's image mode produces. the cores
   embed that file with #embed (src/core/genome.h). no lifetime analysis, no quote, no
   parse words, no block expressions: those only exist in the compiler. tags
   (.m and .d on parameters, .u on a return) are parsed and recorded in
   signatures but not checked. u, m and d are ordinary names, as in the
   resident compiler: a recast is the letter with the star touching it, u*x,
   and it makes no code. */
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <string.h>
#include <ctype.h>
#ifdef _WIN32
#include <fcntl.h>
#include <io.h>
#endif
#include "memmap.h"
#include "fops.h"

#ifndef MAXW
#define MAXW 0x80000
#endif

enum { T_EOF, T_NUM, T_ID, T_STR, T_OP, T_FLT, T_BSTR };
enum { K_FN = 1, K_GVAR, K_GARR, K_CONST, K_KW, K_ENH, K_TYPE, K_DOC };
enum { O_Q, O_LD, O_ST, O_PICK, O_DROP, O_SWAP, O_CALL, O_JMP, O_JZ, O_RET,
	O_IN, O_EMPTY, O_OUT, O_ADD, O_SUB, O_MUL, O_AND, O_OR, O_XOR, O_SHR, O_LT };
static const char *mn = "q@!$_~cjzr,?.+-*&|^><%";

static char module_name[64];
static char *src; static int pos, line = 1, tstart, hdr_start;
/* the signature of the function being defined: its header's source text, for the language server (ZC0DOCS) */
static char sgtext[400], sgname[80];
static int tk, glue; static int64_t tv;	/* current token */
/* the token's text. it grows as a long string literal or name needs; there is no fixed limit */
static char ts0[4096]; static char *ts = ts0; static size_t tscap = sizeof ts0;
static void tsroom(size_t n)
{
	size_t c = tscap; char *nb;
	if (n < tscap) return;
	while (c <= n) c *= 2;
	nb = ts == ts0 ? malloc(c) : realloc(ts, c);
	if (!nb) { fprintf(stderr, "zc0: out of memory for a token\n"); exit(1); }
	if (ts == ts0) memcpy(nb, ts0, sizeof ts0);
	ts = nb; tscap = c;
}
static int xf, xs, lvi;	/* float, byte string; the plain local it came from, or -1 */
/* xro: the value is a local embed array (Loc.ro); lro: the lvalue is one of its elements, which zc0 refuses to write */
static int xro, lro;
static void rocheck(void);

static int64_t *img; static int imgcap, here = GORG;
static void emit(int64_t w) {
	if (!img || here - GORG >= imgcap) {
		int capacity; int64_t *next;
		if (imgcap > (0x7fffffff - GORG) / 2) { fprintf(stderr, "zc0: image address overflow\n"); exit(1); }
		capacity = imgcap ? imgcap * 2 : MAXW;
		if (capacity <= imgcap || capacity > 0x7fffffff - GORG) { fprintf(stderr, "zc0: image address overflow\n"); exit(1); }
		next = realloc(img, (size_t)capacity * sizeof *img);
		if (!next) { fprintf(stderr, "zc0: cannot grow image buffer\n"); exit(1); }
		img = next; imgcap = capacity;
	}
	img[here++ - GORG] = w;
}
static void lit(int64_t v) {
	if ((v >> 62) != 0 && (v >> 62) != -1) {
		emit((v >> 32) * 2 + 1); emit(0x100000000LL * 2 + 1); emit(O_MUL * 2);
		emit((int64_t)((uint64_t)v & 0xffffffffu) * 2 + 1); emit(O_OR * 2);
	} else emit(v * 2 + 1);
}
static void op(int k) { emit((int64_t)k * 2); }
static void setlit(int at, int64_t v) { img[at - GORG] = v * 2 + 1; }

static int pguess, pbad;	/* inside a speculative type parse: an error is noted instead of stopping */
static void die(const char *m) { if (pguess) { pbad = 1; return; } fprintf(stderr, "zc0: line %d: %s (at '%s')\n", line, m, ts); exit(1); }

/* ---- lexer ---- */
static const char *ops3[] = { "<<=", ">>=", 0 };
static const char *ops2[] = { "==", "!=", "<=", ">=", "<<", ">>", "&&", "||", "++", "--", "+=", "-=", "*=", "/=", "%=", "&=", "|=", "^=", "->", 0 };
static int esc(void)
{
	int c = src[pos++];
	if (c != '\\') return c;
	c = src[pos++];
	switch (c) { case 'n': return 10; case 't': return 9; case 'r': return 13; case '0': return 0; case 'e': return 27; }
	return c;
}
/* line tables, as the self-hosted compiler makes them with lines on (see rt.line_blocks in rt.zc).
   they are off until a program says lines on; or a marker comment //:lines NAME comes by, which
   src/tools/automap.sh puts in front of the program of a run-only image: it turns them on, names
   the file, and counts the lines from the next one. */
static int zl_on, zl_base, zl_head, zl_entry, zl_open, zl_fline, zl_file_at, zl_n, zl_cap;
static char zl_file[256] = "<stdin>", zl_file_done[256], zl_name[64];
static int64_t *zl_pairs;
/* doc comments, as the self-hosted compiler reads them with docs on: the //
   lines directly above a declaration, up to a blank line or any other text */
static char dbuf[2100], dsnap[2100], dnm[64]; static int dn, dlast, dline, dsn, docpending;
static void doccomment(void)	/* pos is on the first slash */
{
	int cl = line, k = pos - 1, bol;
	while (k >= 0 && (src[k] == ' ' || src[k] == '\t')) k--;
	bol = k < 0 || src[k] == '\n';
	pos += 2;
	if (src[pos] == ':') {
		if (!strncmp(src + pos, ":lines ", 7)) {
			int n = 0;
			pos += 7;
			while (src[pos] && src[pos] != '\n' && src[pos] != '\r' && n < 255) zl_file[n++] = src[pos++];
			zl_file[n] = 0; zl_on = 1; zl_base = cl;
		}
		dn = 0; dlast = cl; docpending = 0; while (src[pos] && src[pos] != '\n') pos++; return;
	}
	if (!bol) { while (src[pos] && src[pos] != '\n') pos++; return; }
	if (dn && dlast != cl - 1) dn = 0;
	if (src[pos] == ' ') pos++;
	while (src[pos] && src[pos] != '\n') { if (dn < 2040) dbuf[dn++] = src[pos]; pos++; }
	while (dn && (dbuf[dn - 1] == ' ' || dbuf[dn - 1] == '\t' || dbuf[dn - 1] == '\r')) dn--;
	dbuf[dn++] = '\n';
	dlast = cl; docpending = 1;
}
/* block comments may document a declaration on the same line */
static void docblock(void)
{
	int cl = line, k = pos - 1, bol, start = 1, c;
	while (k >= 0 && (src[k] == ' ' || src[k] == '\t')) k--;
	bol = k < 0 || src[k] == '\n';
	if (!bol || (dn && dlast != cl - 1)) dn = 0;
	pos += 2;
	if (src[pos] == '*') { pos++; if (src[pos] == '/') { pos++; return; } }
	while (src[pos]) {
		if (start) {
			while (src[pos] == ' ' || src[pos] == '\t') pos++;
			if (src[pos] == '*') {
				pos++;
				if (src[pos] == '/') { pos++; break; }
				if (src[pos] == ' ') pos++;
			}
			start = 0;
		}
		c = src[pos++];
		if (c == '*' && src[pos] == '/') { pos++; break; }
		if (dn < 2040) dbuf[dn++] = (char)c;
		if (c == '\n') { line++; start = 1; }
	}
	while (dn && (dbuf[dn - 1] == ' ' || dbuf[dn - 1] == '\t' || dbuf[dn - 1] == '\r' || dbuf[dn - 1] == '\n')) dn--;
	dbuf[dn++] = '\n'; dlast = line; docpending = 1;
}
/* an integer literal at pos, as the compiler reads it: decimal digits (a leading 0 is
   not octal: 010 is 10), or 0x and hex digits (0x alone is 0). the value wraps modulo
   2^64 instead of saturating. the token text is the literal's source. */
static void intlit(int base)
{
	int p = pos, d; uint64_t u = 0;
	if (base == 16) pos += 2;
	for (;;) {
		int c = (unsigned char)src[pos];
		if (c >= '0' && c <= '9') d = c - '0';
		else if (base == 16 && c >= 'a' && c <= 'f') d = c - 'a' + 10;
		else if (base == 16 && c >= 'A' && c <= 'F') d = c - 'A' + 10;
		else break;
		u = u * (uint64_t)base + (uint64_t)d; pos++;
	}
	tsroom((size_t)(pos - p) + 1); memcpy(ts, src + p, (size_t)(pos - p)); ts[pos - p] = 0;
	tv = (int64_t)u; tk = T_NUM;
}
static void next(void)
{
	int ws = 0, i;
	for (;;) {
		while (src[pos] && isspace((unsigned char)src[pos])) { if (src[pos] == '\n') line++; pos++; ws = 1; }
		if (src[pos] == '/' && src[pos + 1] == '/') { doccomment(); ws = 1; continue; }
		if (src[pos] == '/' && src[pos + 1] == '*') { docblock(); ws = 1; continue; }
		break;
	}
	glue = !ws;
	tstart = pos;
	if (docpending) {
		dline = 0;
		if (dn && (line == dlast || line == dlast + 1)) dline = line;
		docpending = 0;
	}
	if (!src[pos] || src[pos] == '`') { tk = T_EOF; strcpy(ts, "<eof>"); return; }
	if (isdigit((unsigned char)src[pos]) || (src[pos] == '.' && isdigit((unsigned char)src[pos + 1]))) {
		int p = pos, fl = 0;
		if (src[pos] == '0' && (src[pos + 1] == 'x' || src[pos + 1] == 'X')) {
			intlit(16); return;
		}
		if (src[p] == '.') {
			int nch = (unsigned char)src[p + 1];
			if (isdigit(nch) || nch == 'e' || nch == 'E' || !(isalpha(nch) || nch == '_')) fl = 1;
		} else {
			while (isdigit((unsigned char)src[p])) p++;
			if (src[p] == '.') {
				int nch = (unsigned char)src[p + 1];
				/* 1.5 and 1. and 1.e2 are floats. 1.field is an integer and a field. */
				if (isdigit(nch) || nch == 'e' || nch == 'E' || !(isalpha(nch) || nch == '_')) fl = 1;
			}
		}
		if (!fl && (src[p] == 'e' || src[p] == 'E')) {
			int q = p + 1; if (src[q] == '+' || src[q] == '-') q++; if (isdigit((unsigned char)src[q])) fl = 1;
		}
		if (fl) {
			char b[80]; int n = 0, frac = 0;
			while (src[pos] == '.' || isdigit((unsigned char)src[pos])) {
				if (src[pos] == '.') { if (frac) break; frac = 1; }
				if (n < 78) b[n++] = src[pos];
				pos++;
			}
			if (src[pos] == 'e' || src[pos] == 'E') {
				int q = pos + 1; if (src[q] == '+' || src[q] == '-') q++;
				if (isdigit((unsigned char)src[q])) {
					if (n < 78) b[n++] = src[pos++];
					if (src[pos] == '+' || src[pos] == '-') { if (n < 78) b[n++] = src[pos++]; }
					while (isdigit((unsigned char)src[pos]) && n < 78) b[n++] = src[pos++];
				}
			}
			b[n] = 0; memcpy(ts, b, (size_t)n + 1); tv = (int64_t)fop_parse(b); tk = T_FLT; return;
		}
		intlit(10); return;
	}
	if (isalpha((unsigned char)src[pos]) || src[pos] == '_') {
		i = 0; while (isalnum((unsigned char)src[pos]) || src[pos] == '_') { tsroom((size_t)i + 2); ts[i++] = src[pos++]; }
		ts[i] = 0;
		if (i == 1 && ts[0] == 'b' && src[pos] == '"') {
			pos++; i = 0;
			while (src[pos] && src[pos] != '"') {
				tsroom((size_t)i + 2); ts[i++] = (char)esc();
			}
			ts[i] = 0; if (src[pos] == '"') pos++; tk = T_BSTR; return;
		}
        if (src[pos] == '.' && (!strcmp(ts,"rt") || !strcmp(ts,"run") || !strcmp(ts,"core") || !strcmp(ts,"lsp") || !strcmp(ts,"std") || !strcmp(ts,"icon"))) {
            tsroom((size_t)i + 2); ts[i++] = src[pos++];
            while (isalnum((unsigned char)src[pos]) || src[pos] == '_') { tsroom((size_t)i + 2); ts[i++] = src[pos++]; }
            ts[i] = 0;
        }
		tk = T_ID; return;
	}
	if (src[pos] == '\'') { pos++; tv = esc(); if (src[pos++] != '\'') die("bad char literal"); tk = T_NUM; strcpy(ts, "'c'"); return; }
	if (src[pos] == '"') {
		pos++; i = 0;
		while (src[pos] && src[pos] != '"') {
			tsroom((size_t)i + 2); ts[i++] = (char)esc();
		}
		ts[i] = 0; pos++; tk = T_STR; return;
	}
	tk = T_OP;
	for (i = 0; ops3[i]; i++) if (!strncmp(src + pos, ops3[i], 3)) { strcpy(ts, ops3[i]); pos += 3; return; }
	for (i = 0; ops2[i]; i++) if (!strncmp(src + pos, ops2[i], 2)) { strcpy(ts, ops2[i]); pos += 2; return; }
	ts[0] = src[pos++]; ts[1] = 0;
}
/* a saved lexer position. ts is a copy of the token text (malloc), released by lexrest */
typedef struct { char *src; int pos, line, tk, glue; int64_t tv; char *ts; size_t tn; int xf, xs; } Lex;
static void lexsave(Lex *L) { L->src = src; L->pos = pos; L->line = line; L->tk = tk; L->glue = glue; L->tv = tv; L->tn = strlen(ts) + 1; L->ts = malloc(L->tn); if (!L->ts) { fprintf(stderr, "zc0: out of memory\n"); exit(1); } memcpy(L->ts, ts, L->tn); L->xf = xf; L->xs = xs; }
static void lexrest(Lex *L) { src = L->src; pos = L->pos; line = L->line; tk = L->tk; glue = L->glue; tv = L->tv; tsroom(L->tn); memcpy(ts, L->ts, L->tn); free(L->ts); L->ts = 0; xf = L->xf; xs = L->xs; }
static int is(const char *s) { return (tk == T_OP || tk == T_ID) && !strcmp(ts, s); }
static int accept(const char *s) { if (is(s)) { next(); return 1; } return 0; }
static void expect(const char *s) { if (!accept(s)) { char b[64]; sprintf(b, "expected '%s'", s); die(b); } }
static char *ident(void) { static char b[8][256]; static int k; char *r = b[k++ & 7]; if (tk != T_ID) die("expected a name"); strcpy(r, ts); next(); return r; }
/* u, m and d are ordinary names. u*x, m*x and d*x are recasts when the star touches
   the letter and no variable of that name is visible, which the raw character after the name tells: u * x is a product, and
   so is u*=x. the current token is the name, so pos is just past it. */

/* ---- symbols ---- */
typedef struct { char name[64]; int kind, sig, defd, str; int64_t val; } Sym;	/* str: a global holding a byte string, or a function returning one */
static Sym sy[16384]; static int nsy;
typedef struct { int at, sym; } Fix;
static Fix fx[65536]; static int nfx;
static Sym *find_raw(const char *n) { int i; for (i = nsy; i--;) if (!strcmp(sy[i].name, n)) return &sy[i]; return 0; }
static void qualify(char *dst, size_t size, const char *name) {
    if (!module_name[0] || strchr(name, '.')) snprintf(dst, size, "%s", name);
    else if (!strncmp(name, "doc ", 4) || !strncmp(name, "sig ", 4)) snprintf(dst, size, "%.4s%s.%s", name, module_name, name + 4);
    else snprintf(dst, size, "%s.%s", module_name, name);
}
static Sym *find(const char *name) {
    char full[256]; Sym *s;
    qualify(full, sizeof full, name); s = find_raw(full); if (s) return s;
    s = find_raw(name); if (s || strchr(name, '.')) return s;
    const char *modules[] = { "rt", "run", "core", "lsp", 0 };
    for (int i = 0; modules[i]; i++) { snprintf(full,sizeof full,"%s.%s",modules[i],name); s=find_raw(full); if(s) return s; }
    return 0;
}
static Sym *add(const char *n, int kind, int64_t val)
{
	char full[256]; qualify(full, sizeof full, n); n = full;
	Sym *s = find_raw(n);
	if (s && s->kind == K_FN && kind == K_FN && !s->defd) { s->val = val; return s; }	/* prototype or forward use */
	s = &sy[nsy++]; strncpy(s->name, n, 63); s->kind = kind; s->val = val; s->defd = 1; s->sig = 0; s->str = 0; return s;
}
static void fnref(const char *n)	/* push a function address, fixing it up later if needed */
{
	Sym *s = find(n);
	if (!s) { s = add(n, K_FN, 0); s->defd = 0; }
	if (s->kind != K_FN) die("not a function");
	if (s->defd) { lit(s->val); return; }
	fx[nfx].at = here; fx[nfx++].sym = (int)(s - sy); lit(0);
}

/* ---- locals ---- */
typedef struct { char name[64]; int slot, arr, flt, str, dstr, ro; } Loc;	/* dstr: declared bstr, so always a byte string; ro: a local embed array, whose elements are in the code */
static Loc lo[1024]; static int nlo, nslot, infn;
static Loc *findl(const char *n) { int i; for (i = nlo; i--;) if (!strcmp(lo[i].name, n)) return &lo[i]; return 0; }
static int isrecast(void)
{
	Sym *g;
	if (!(tk == T_ID && ts[1] == 0 && (ts[0] == 'u' || ts[0] == 'm' || ts[0] == 'd') && src[pos] == '*' && src[pos + 1] != '=')) return 0;
	if (findl(ts)) return 0;	/* a visible variable named u, m or d: a product (spec 1.6.3) */
	g = find(ts); return !(g && (g->kind == K_GVAR || g->kind == K_GARR));
}
static void laddr(int k) { lit(ZFP); op(O_LD); if (k) { lit(k); op(O_ADD); } }

/* ---- operator tables ---- */
static void seq_isz(void) { lit(0); op(O_PICK); lit(0); op(O_SWAP); op(O_SUB); op(O_OR); lit(63); op(O_SHR); lit(1); op(O_ADD); }
/* ±0 is false. a float becomes 0 or 1 before the integer test. */
static void ftest(void) { if (!xf) return; emit(1200); emit(0); op(605); lit(1); op(18); xf = 0; }
static void seq_nz(void) { lit(0); op(O_PICK); lit(0); op(O_SWAP); op(O_SUB); op(O_OR); lit(63); op(O_SHR); lit(0); op(O_SWAP); op(O_SUB); }
static int binprec(void)
{
	static const char *n[] = { "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=", ">=", "==", "!=", "&", "^", "|", "&&", "||", 0 };
	static int p[] = { 10, 10, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 5, 4, 3, 2, 1 };
	int i;
	if (tk != T_OP) return 0;
	for (i = 0; n[i]; i++) if (!strcmp(ts, n[i])) return p[i];
	return 0;
}
static int fis(const char *o)
{
	return !strcmp(o, "+") || !strcmp(o, "-") || !strcmp(o, "*") || !strcmp(o, "/")
		|| !strcmp(o, "<") || !strcmp(o, ">") || !strcmp(o, "<=") || !strcmp(o, ">=")
		|| !strcmp(o, "==") || !strcmp(o, "!=");
}
static void fbinop(const char *o, int lf, int rf)
{
	if (!lf) { op(O_SWAP); op(608); op(O_SWAP); }
	if (!rf) op(608);
	if (!strcmp(o, "+")) { op(601); xf = 1; }
	else if (!strcmp(o, "-")) { op(602); xf = 1; }
	else if (!strcmp(o, "*")) { op(603); xf = 1; }
	else if (!strcmp(o, "/")) { op(604); xf = 1; }
	else if (!strcmp(o, "==")) { op(605); xf = 0; }
	else if (!strcmp(o, "!=")) { op(605); lit(1); op(18); xf = 0; }
	else if (!strcmp(o, "<")) { op(606); xf = 0; }
	else if (!strcmp(o, ">")) { op(O_SWAP); op(606); xf = 0; }
	else if (!strcmp(o, "<=")) { op(607); xf = 0; }
	else if (!strcmp(o, ">=")) { op(O_SWAP); op(607); xf = 0; }
	else xf = 0;
}
static int sis(const char *o)
{
	return !strcmp(o, "+") || !strcmp(o, "<") || !strcmp(o, ">") || !strcmp(o, "<=")
		|| !strcmp(o, ">=") || !strcmp(o, "==") || !strcmp(o, "!=");
}
static void sbinop(const char *o)
{
	if (!strcmp(o, "+")) { fnref("cat_s"); op(O_CALL); xs = 1; }
	else if (!strcmp(o, "==")) { fnref("eq_s"); op(O_CALL); xs = 0; }
	else if (!strcmp(o, "!=")) { fnref("eq_s"); op(O_CALL); lit(1); op(O_XOR); xs = 0; }
	else if (!strcmp(o, "<")) { fnref("lt_s"); op(O_CALL); xs = 0; }
	else if (!strcmp(o, ">")) { op(O_SWAP); fnref("lt_s"); op(O_CALL); xs = 0; }
	else if (!strcmp(o, "<=")) { fnref("le_s"); op(O_CALL); xs = 0; }
	else { op(O_SWAP); fnref("le_s"); op(O_CALL); xs = 0; }
	xf = 0;
}
static void binop(const char *o)
{
	if (!strcmp(o, "*")) op(O_MUL);
	else if (!strcmp(o, "/")) { fnref("zdiv"); op(O_CALL); }
	else if (!strcmp(o, "%")) { fnref("zmod"); op(O_CALL); }
	else if (!strcmp(o, "+")) op(O_ADD);
	else if (!strcmp(o, "-")) op(O_SUB);
	else if (!strcmp(o, "<<")) { fnref("zshl"); op(O_CALL); }
	else if (!strcmp(o, ">>")) op(O_SHR);
	else if (!strcmp(o, "<")) op(O_LT);
	else if (!strcmp(o, ">")) { op(O_SWAP); op(O_LT); }
	else if (!strcmp(o, "<=")) { op(O_SWAP); op(O_LT); lit(1); op(O_XOR); }
	else if (!strcmp(o, ">=")) { op(O_LT); lit(1); op(O_XOR); }
	else if (!strcmp(o, "==")) { op(O_SUB); seq_isz(); }
	else if (!strcmp(o, "!=")) { op(O_SUB); seq_nz(); }
	else if (!strcmp(o, "&")) op(O_AND);
	else if (!strcmp(o, "^")) op(O_XOR);
	else if (!strcmp(o, "|")) op(O_OR);
	else die("bad operator");
}

/* ---- constant expressions (globals, array sizes, const) ---- */
static int64_t cexpr(void);
static int64_t cprim(void)
{
	int64_t v; Sym *s;
	if (tk == T_NUM) { v = tv; next(); return v; }
	if (accept("-")) return -cprim();
	if (accept("~")) return ~cprim();
	if (accept("(")) { v = cexpr(); expect(")"); return v; }
	if (tk == T_ID && (s = find(ts)) && (s->kind == K_CONST || (s->kind != K_GVAR && s->defd))) { next(); return s->val; }
	die("constant expected"); return 0;
}
static int64_t cexpr(void)
{
	int64_t v = cprim();
	for (;;) {
		if (accept("+")) v += cprim(); else if (accept("-")) v -= cprim();
		else if (accept("*")) v *= cprim(); else if (accept("|")) v |= cprim();
		else if (accept("&")) v &= cprim(); else if (accept("<<")) v <<= cprim();
		else if (accept(">>")) v >>= cprim(); else return v;
	}
}

/* ---- types ----
   zc0 has no types: a type is read and thrown away. all it has to know is the
   shape, so that T[n] still reserves n words and the rest reserve one. the
   grammar is the compiler's own (see ptype in src/compiler/types.zc):
     ptype   a type, then any number of (params): int(int, int) is a function type
     ptype0  a type with its stars: int*, vec<T>*, point**
     ptype1  a base: T[n], T[?], fixed T[?], fn, a name, or a generic instance
   each returns the words a variable of the type takes: n for a fixed array, 1
   for a growable handle or anything scalar. */
static int ptype0(void);
static int ptype(void);
static int ptagname(void);
static int ptstr;	/* the type just read is bstr itself, with no stars, brackets or parameters after it */
static int ptype1(void)
{
	int n, e, isb;
	ptstr = 0;
	if (is("[")) { die("array types are postfix: T[N], T[] or T[?]"); return 1; }
	if (is("fixed")) { next(); return ptype0(); }
	if (is("fn")) { next(); return 1; }	/* fn(int): the parameters follow, in ptype */
	if (tk != T_ID) { die("a type name"); return 1; }
	isb = !strcmp(ts, "bstr");
	ident();
	if (accept("<")) {	/* generic arguments: vec<node*> */
		isb = 0;
		do { ptype(); } while (accept(","));
		if (is(">>")) ts[1] = 0;	/* >> closes two lists: leave the second > */
		else expect(">");
	}
	ptstr = isb;
	return 1;
}
static int ptype0(void)
{
	int n = ptype1();
	while (is("*") || is("[")) {
		ptstr = 0;
		if (accept("*")) n = 1;
		else {
			int count = 0, cap = 8, *dims = malloc(cap * sizeof(int));
			if (!dims) die("cannot allocate array dimensions");
			while (accept("[")) {
				int length;
				if (accept("?")) { expect("]"); length = -2; }
				else if (accept("]")) length = -1;
				else { length = (int)cexpr(); expect("]"); }
				if (count == cap) { cap *= 2; int *more = realloc(dims, cap * sizeof(int)); if (!more) die("cannot grow array dimensions"); dims = more; }
				dims[count++] = length;
			}
			while (count) { int length = dims[--count]; if (length == -2) n = 1; else n = length < 0 ? 0 : n * length; }
			free(dims);
		}
	}
	return n;
}
static int ptype(void)
{
	int n = ptype0();
	while (accept("(")) {
		if (!accept(")")) { do { ptype(); if (accept(".")) ptagname(); } while (accept(",")); expect(")"); }
		n = 1; ptstr = 0;
	}
	return n;
}
/* the name of an ownership tag, after its dot: 1 for m, 2 for d, 3 for u. zc0 does
   nothing with them but record .m and .d on parameters and .u on a return. */
static int ptagname(void)
{
	int t = 0;
	if (is("m")) t = 1; else if (is("d")) t = 2; else if (is("u")) t = 3; else die("a tag is .u, .m or .d");
	next();
	return t;
}
/* the ownership tag after a type, .u .m or .d: 0 when there is none */
static int ptag;
static void ptagopt(void)
{
	ptag = 0;
	if (!accept(".")) return;
	ptag = ptagname();
}
/* an optional type in front of a name. the words it needs, or -1 when there is
   no type here at all, which is how an untyped name is told from a type. the
   parse is taken back when what follows is not a name. */
/* words that open a statement or an expression, so a type never starts with
   one of them. they are all plain identifiers to the lexer. */
static int notatype(void)
{
	static const char *w[] = { "return", "if", "else", "while", "for", "do", "break", "continue",
		"let", "var", "fn", "const", "enhance", "struct", "enum", "asm", "switch", "case",
		"default", "immediate", "type", "include", "as", "in", "new", "sizeof", "typeof",
		"o3", "unchecked", "unbounded", 0 };
	int i;
	if (tk != T_ID) return 0;
	for (i = 0; w[i]; i++) if (!strcmp(ts, w[i])) return 1;
	return 0;
}
static int optype(void)
{
	Lex L; int n;
	if (notatype() || isrecast() || (tk != T_ID && !is("["))) return -1;
	lexsave(&L); pguess = 1; pbad = 0; n = ptype(); ptagopt(); pguess = 0;
	if (tk == T_ID && !pbad) return n;
	lexrest(&L);
	return -1;
}
/* a name followed by ( : a function definition rather than a variable */
static int isfn(void)
{
	Lex L; int r;
	lexsave(&L); pguess = 1;
	r = tk == T_ID;
	if (r) { ident(); r = is("("); }
	pguess = 0; lexrest(&L);
	return r;
}

/* ---- expressions ---- */
static int lv;	/* the stack top is an address not yet loaded */
static void rval(void) { if (lv) { op(O_LD); lv = 0; } }
static void expr(void);
static void strlit(void)	/* inline word string: jump over it, push its address */
{
	int j = here, a, i, n = (int)strlen(ts);
	lit(0); op(O_JMP); a = here;
	for (i = 0; i < n; i++) emit((unsigned char)ts[i]);
	emit(0); setlit(j, here); lit(a); next();
}
/* a byte string's words: the length, then the bytes packed 8 per word, little-endian,
   and a 0 after the last byte when the length is a multiple of 8, as bstrdata does in
   compiler.zc. the result is the address of the length word, which is the string. */
static int bstrwords(const unsigned char *b, long n)
{
	int a = here; long i = 0; int k; uint64_t w;
	emit(n);
	while (i < n) {
		w = 0; k = 0;
		while (k < 8 && i < n) { w |= (uint64_t)b[i] << (k * 8); k++; i++; }
		emit((int64_t)w);
	}
	if ((n & 7) == 0) emit(0);
	return a;
}
/* line tables. zl_begin starts recording the function whose code begins at entry, zl_stmt notes
   that a statement starts at the current line, and zl_end puts the function's line block among
   the code, as lt_end does in the resident compiler: [next, entry, end, name, file, count, then
   count words of offset << 32 | line]. */
static void zl_begin(int entry, const char *name, int fline)
{
	if (!zl_on) { zl_open = 0; return; }
	zl_open = 1; zl_entry = entry; zl_n = 0; zl_fline = fline - zl_base;
	strncpy(zl_name, name, 63); zl_name[63] = 0;
	if (zl_n == zl_cap) { zl_cap = zl_cap ? zl_cap * 2 : 1024; zl_pairs = realloc(zl_pairs, (size_t)zl_cap * sizeof *zl_pairs); }
	zl_pairs[zl_n++] = zl_fline;
}
static void zl_stmt(void)
{
	int off = here - zl_entry;
	if (!zl_open) return;
	if (zl_n == zl_cap) { zl_cap *= 2; zl_pairs = realloc(zl_pairs, (size_t)zl_cap * sizeof *zl_pairs); }
	if (zl_n && (zl_pairs[zl_n - 1] >> 32) == off) zl_n--;
	if (zl_n && (zl_pairs[zl_n - 1] & 0xffffffffLL) == line - zl_base) return;
	zl_pairs[zl_n++] = (int64_t)off * 4294967296LL + (line - zl_base);
}
static void zl_end(void)
{
	int end = here, name, file, blk, i;
	if (!zl_open) return;
	zl_open = 0;
	name = bstrwords((const unsigned char *)zl_name, (long)strlen(zl_name));
	if (!zl_file_at || strcmp(zl_file, zl_file_done)) {
		zl_file_at = bstrwords((const unsigned char *)zl_file, (long)strlen(zl_file)); strcpy(zl_file_done, zl_file);
	}
	file = zl_file_at;
	blk = here;
	emit(zl_head); emit(zl_entry); emit(end); emit(name); emit(file); emit(zl_n);
	for (i = 0; i < zl_n; i++) emit(zl_pairs[i]);
	zl_head = blk;
}
/* b"...": the words inline, jumped over, then the address pushed */
static void bstrlit(void)
{
	int j = here, a;
	lit(0); op(O_JMP); a = bstrwords((const unsigned char *)ts, (long)strlen(ts));
	setlit(j, here); lit(a); next();
}
static int returns_bstr(const char *n)
{
	if (!strncmp(n, "rt.", 3)) n += 3;
	return !strcmp(n, "cat_s") || !strcmp(n, "slice_s") || !strcmp(n, "n_to_s") || !strcmp(n, "new_s");
}
static int args(void) { int n = 0; expect("("); if (!accept(")")) { do { expr(); rval(); n++; } while (accept(",")); expect(")"); } return n; }
static void asmblock(void);
static void rocheck(void) { if (lro) die("a local embed array is part of the code; zc0 does not let a program write it (embed it at the top level)"); }
static void primary(void)
{
	char n[64]; Loc *l; Sym *s;
	lv = 0; lvi = -1; xf = 0; xs = 0; xro = 0; lro = 0;
	if (tk == T_FLT) { emit(1200); emit(tv); xf = 1; next(); return; }
	if (tk == T_NUM) { lit(tv); next(); return; }
	if (tk == T_BSTR) { bstrlit(); xs = 1; return; }
	if (tk == T_STR) { strlit(); return; }
	if (accept("(")) { expr(); expect(")"); return; }
	if (is("asm")) { next(); asmblock(); return; }
	strcpy(n, ident());
	if ((l = findl(n))) { laddr(l->slot); lv = !l->arr; if (!l->arr) { xf = l->flt; xs = l->str; lvi = (int)(l - lo); } xro = l->ro; return; }
	s = find(n);
	if (s && s->kind == K_CONST) { lit(s->val); return; }
	if (s && s->kind == K_GVAR) { lit(s->val); lv = 1; xs = s->str; return; }
	if (s && s->kind == K_GARR) { lit(s->val); return; }
	if (is("(")) {
		int na = args();
		if (s && s->kind == K_ENH) {
			if (na != (s->sig & 15)) die("wrong number of enhancement inputs");
			op(22 + (int)s->val);
			if (((s->sig >> 4) & 15) == 0) lit(0);
			else if (((s->sig >> 4) & 15) != 1) die("multiple enhancement outputs need asm");
			xs = 0; xf = 0; return;
		}
		if ((!strcmp(n, "put_s") || !strcmp(n, "rt.put_s")) && na == 1 && xs) fnref(n[0] == 'r' ? "rt.put_bs" : "put_bs");
		else if (!strcmp(n, "len")) fnref("len_s");
		else fnref(n);
		op(O_CALL);
		xs = returns_bstr(n) || (s && s->kind == K_FN && s->str); xf = 0;
		return;
	}
	fnref(n);
}
static void incdec(int post, int d)
{
	if (!lv) die("++/-- needs an lvalue");
	rocheck();
	lv = 0;
	if (lvi >= 0) lo[lvi].str = lo[lvi].dstr;
	xs = 0;
	if (post) { lit(0); op(O_PICK); op(O_LD); lit(0); op(O_PICK); lit(d); op(O_ADD); lit(2); op(O_PICK); op(O_ST); op(O_SWAP); op(O_DROP); }
	else { lit(0); op(O_PICK); op(O_LD); lit(d); op(O_ADD); lit(0); op(O_PICK); lit(2); op(O_PICK); op(O_ST); op(O_SWAP); op(O_DROP); }
}
static void postfix(void)
{
	int n, was;
	primary();
	for (;;) {
		if (accept("[")) {
			int ro = xro;
			was = xs; rval(); expr(); rval();
			if (was && accept(":")) {
				expr(); rval(); expect("]"); fnref("slice_s"); op(O_CALL);
				lv = 0; xs = 1; xf = 0; lvi = -1;
			} else if (was) {
				expect("]"); fnref("at_s"); op(O_CALL);
				lv = 0; xs = 0; xf = 0; lvi = -1;
			} else { expect("]"); op(O_ADD); lv = 1; xs = 0; xf = 0; lvi = -1; }
			xro = 0; lro = ro;
		}
		else if (is("(")) { rval(); n = args(); lit(n); op(O_PICK); op(O_CALL); op(O_SWAP); op(O_DROP); xf = 0; xs = 0; lvi = -1; xro = 0; lro = 0; }
		else if (accept("++")) incdec(1, 1);
		else if (accept("--")) incdec(1, -1);
		else if (accept("as")) ptype0();	/* the whole type, as the compiler reads it: x as int*, x as char** */
		else return;
	}
}
static void unary(void)
{
	if (accept("-")) {
		unary(); rval(); xs = 0;
		if (xf) { emit(1200); emit(0); op(O_SWAP); op(602); }
		else { lit(0); op(O_SWAP); op(O_SUB); }
	}
	else if (accept("!")) { unary(); rval(); ftest(); seq_isz(); xf = 0; xs = 0; }
	else if (accept("~")) { unary(); rval(); lit(-1); op(O_XOR); xf = 0; xs = 0; }
	else if (accept("*")) { unary(); rval(); lv = 1; xs = 0; xro = 0; lro = 0; }
	else if (accept("&")) { unary(); if (!lv) die("& needs an lvalue"); lv = 0; xs = 0; }
	else if (accept("++")) { unary(); incdec(0, 1); }
	else if (accept("--")) { unary(); incdec(0, -1); }
	else if (isrecast()) { next(); expect("*"); unary(); rval(); lvi = -1; }	/* u*x: a recast, no code, and not a place to store */
	else postfix();
}
static void bin(int minp)
{
	int p, a, b, lf, rf, ls, rs; char o[8];
	unary();
	while ((p = binprec()) && p >= minp) {
		lf = xf; ls = xs; strcpy(o, ts); next(); rval();
		if (!strcmp(o, "&&")) {
			ftest(); a = here; lit(0); op(O_JZ); bin(p + 1); rval(); ftest(); seq_nz();
			b = here; lit(0); op(O_JMP); setlit(a, here); lit(0); setlit(b, here); xf = 0; xs = 0;
		} else if (!strcmp(o, "||")) {
			ftest(); a = here; lit(0); op(O_JZ); lit(1); b = here; lit(0); op(O_JMP);
			setlit(a, here); bin(p + 1); rval(); ftest(); seq_nz(); setlit(b, here); xf = 0; xs = 0;
		} else {
			bin(p + 1); rval(); rf = xf; rs = xs;
			if ((ls || rs) && sis(o)) {
				if (!(ls && rs)) die("a byte string needs a byte string on the other side");
				sbinop(o);
			} else if ((lf || rf) && fis(o)) { fbinop(o, lf, rf); xs = 0; }
			else { binop(o); xf = 0; xs = 0; }
		}
		lv = 0; lvi = -1; xro = 0; lro = 0;
	}
}
static void expr(void)
{
	char o[8]; int dst, lf;
	bin(1); dst = lvi;
	if (is("=")) {
		if (!lv) die("assignment needs an lvalue");
		rocheck();
		next(); expr(); rval();
		op(O_SWAP); lit(1); op(O_PICK); op(O_SWAP); op(O_ST); lv = 0;
		if (dst >= 0) { lo[dst].flt = xf; lo[dst].str = xs || lo[dst].dstr; }
	} else if (tk == T_OP && strlen(ts) >= 2 && ts[strlen(ts) - 1] == '=' && strcmp(ts, "==") && strcmp(ts, "!=") && strcmp(ts, "<=") && strcmp(ts, ">=")) {
		if (!lv) die("assignment needs an lvalue");
		rocheck();
		lf = xf; strcpy(o, ts); o[strlen(o) - 1] = 0; next();
		lit(0); op(O_PICK); op(O_LD); lv = 0; expr(); rval();
		if ((lf || xf) && fis(o)) fbinop(o, lf, xf);
		else { binop(o); xf = 0; }
		op(O_SWAP); lit(1); op(O_PICK); op(O_SWAP); op(O_ST); lv = 0;
		if (dst >= 0) { lo[dst].flt = xf; lo[dst].str = lo[dst].dstr; }
	}
}

/* ---- asm blocks: raw vm words ---- */
static void asmblock(void)
{
	char ln[128][64], rn[256][64]; int la[128], nl = 0, ra[256], nr = 0, i, k; const char *c;
	Loc *l; Sym *s;
	expect("{");
	while (!accept("}")) {
		if (tk == T_EOF) die("unterminated asm");
		if (tk == T_FLT) { emit(1200); emit(tv); next(); continue; }
		if (tk == T_NUM) { lit(tv); next(); continue; }
		if (tk == T_BSTR) { bstrlit(); continue; }
		if (tk == T_STR) { strlit(); continue; }
		if (accept("#")) { if (tk != T_NUM) die("# needs a number"); emit(tv); next(); continue; }
		if (is("-")) { next(); if (tk == T_NUM && glue) { lit(-tv); next(); } else op(O_SUB); continue; }
		if (accept(":")) { strcpy(ln[nl], ident()); la[nl++] = here; continue; }
		if (strlen(ts) == 1 && (c = strchr(mn, ts[0]))) { op((int)(c - mn)); next(); continue; }
		if (tk != T_ID) die("bad asm token");
		if ((l = findl(ts))) { laddr(l->slot); next(); continue; }
		if ((s = find(ts)) && s->kind == K_ENH) { op(22 + (int)s->val); next(); continue; }	/* an enhancement is its opcode */
		if ((s = find(ts)) && s->kind != K_FN) { lit(s->val); next(); continue; }
		if (s) { fnref(ts); next(); continue; }
		strcpy(rn[nr], ts); ra[nr++] = here; lit(0); next();	/* a label of this block */
	}
	for (i = 0; i < nr; i++) {
		for (k = -1; ++k < nl && strcmp(ln[k], rn[i]);) ;
		if (k == nl) die("unknown asm label");
		setlit(ra[i], la[k]);
	}
}

/* ---- statements ---- */
static int brk[256][64], nbrk[256], cont[256], nloop;
static int epi[1024], nepi;
static void stmt(void);
static void embeddecl(int local);
static void block(void)
{
	int save = nlo;
	expect("{");
	while (!accept("}")) { if (tk == T_EOF) die("missing }"); stmt(); }
	nlo = save;
}
static void jmp_to(int t) { lit(t); op(O_JMP); }
static void loopbody(int contaddr)
{
	nbrk[nloop] = 0; cont[nloop++] = contaddr;
	stmt();
	nloop--;
}
static void patchbreaks(void) { int i; for (i = 0; i < nbrk[nloop]; i++) setlit(brk[nloop][i], here); }
static void stmt(void)
{
	int a, b, c, d;
	zl_stmt();
	if (accept(";")) return;
	if (is("{")) { block(); return; }
	{
		int nw = optype(), n, tstr = 0;
		if (nw >= 0) tstr = ptstr;
		else if (is(".")) { next(); ptagname(); nw = 1; }	/* a bare tag: .m p = new(3); */
		else if (is("embed")) {	/* embed "file" as [type] name; makes a local */
			Lex L; lexsave(&L); next();
			if (tk == T_STR) { free(L.ts); embeddecl(1); return; }	/* the saved token is not restored */
			lexrest(&L);
		}
		if (nw >= 0 || accept("let") || accept("var")) {
			if (nw < 0) nw = 1;
			do {
				Loc *l = &lo[nlo++]; strcpy(l->name, ident()); l->arr = 0;
				if (nw > 1) { l->slot = nslot; nslot += nw; l->arr = 1; }
				else {
					if (accept("[")) { n = cexpr(); expect("]"); nslot += n; l->slot = nslot - n; l->arr = 1; }
					else l->slot = nslot++;
				}
				l->flt = 0; l->dstr = tstr && !l->arr; l->str = l->dstr;
				if (accept("=")) { expr(); rval(); laddr(l->slot); op(O_ST); l->flt = xf; l->str = xs || l->dstr; }
			} while (accept(","));
			expect(";"); return;
		}
	}
	if (accept("unchecked") || accept("unbounded")) { stmt(); return; }
	if (accept("if")) {
		expect("("); expr(); rval(); ftest(); expect(")");
		a = here; lit(0); op(O_JZ); stmt();
		if (accept("else")) { b = here; lit(0); op(O_JMP); setlit(a, here); stmt(); setlit(b, here); }
		else setlit(a, here);
		return;
	}
	if (accept("while")) {
		c = here; expect("("); expr(); rval(); ftest(); expect(")");
		a = here; lit(0); op(O_JZ);
		loopbody(c); jmp_to(c); setlit(a, here); patchbreaks(); return;
	}
	if (accept("for")) {
		int save = nlo;
		expect("(");
		if (!is(";")) { if (is("let") || is("var") || tk == T_ID || is("[") || is(".")) { stmt(); goto cond; } expr(); rval(); op(O_DROP); }
		expect(";");
	cond:	c = here;
		if (!is(";")) { expr(); rval(); ftest(); } else { lit(1); xf = 0; }
		expect(";");
		a = here; lit(0); op(O_JZ); b = here; lit(0); op(O_JMP);
		d = here;
		if (!is(")")) { expr(); rval(); op(O_DROP); }
		expect(")"); jmp_to(c);
		setlit(b, here);
		loopbody(d); jmp_to(d); setlit(a, here); patchbreaks();
		nlo = save; return;
	}
	if (accept("break")) { if (!nloop) die("break outside a loop"); brk[nloop - 1][nbrk[nloop - 1]++] = here; lit(0); op(O_JMP); expect(";"); return; }
	if (accept("continue")) { if (!nloop) die("continue outside a loop"); jmp_to(cont[nloop - 1]); expect(";"); return; }
	if (accept("return")) {
		if (!is(";")) { expr(); rval(); } else lit(0);
		expect(";"); epi[nepi++] = here; lit(0); op(O_JMP); return;
	}
	if (is("asm")) { next(); asmblock(); return; }
	expr(); rval(); op(O_DROP); expect(";");
}

/* ---- top level ---- */
static void fndef(int ret, int rstr)	/* rstr: the return type is bstr */
{
	char *n = ident(); int zfl = line; Sym *s; int np = 0, tags = 0, t, frame, i, helper, busy, done, check, node;
	if (dsn && !dnm[0]) strcpy(dnm, n);
	char pn[16][64]; int pstr[16];
	char full_name[256]; qualify(full_name, sizeof full_name, n); s = find_raw(full_name);
	if (!s || s->kind != K_FN) { s = add(n, K_FN, 0); s->defd = 0; }
	expect("(");
	if (!accept(")")) {
		do {
			t = 0; ptag = 0; pstr[np & 15] = 0;
			if (optype() >= 0) {	/* the type is read and dropped */
				if (ptag == 3) die("a parameter tag is .m or .d");	/* the compiler's message: .u is only a return tag */
				t = ptag == 1 ? 1 : ptag == 2 ? 2 : 0; pstr[np & 15] = ptstr;
			}
			else if (accept(".")) {	/* .m name, .d name */
				if (is("m")) t = 1; else if (is("d")) t = 2; else die("a parameter tag is .m or .d");
				next();
			}
			if (np < 12) tags += t << (2 * np);
			strcpy(pn[np++], ident());
		} while (accept(","));
		expect(")");
	}
	s->sig = ret + 2 * np + 64 * tags; s->str = rstr;
	if (accept(";")) return;	/* prototype */
	if (s->defd) die("function defined twice");
	s->val = here; s->defd = 1;
#ifdef ZC0DOCS
	{	/* the header is the source from the item's first token to the { that opens the body */
		int hl = tstart - hdr_start;
		sgname[0] = 0;
		if (hl > 0 && hl < (int)sizeof sgtext - 1) {
			memcpy(sgtext, src + hdr_start, hl); sgtext[hl] = 0;
			while (hl && isspace((unsigned char)sgtext[hl - 1])) sgtext[--hl] = 0;
			strcpy(sgname, n);
		}
	}
#endif
	nlo = 0; nslot = 0; nepi = 0; infn = 1;
	zl_begin(here, s->name, zfl);
	for (i = 0; i < np; i++) { strcpy(lo[nlo].name, pn[i]); lo[nlo].arr = 0; lo[nlo].flt = 0; lo[nlo].dstr = lo[nlo].str = pstr[i & 15]; lo[nlo++].slot = nslot++; }
	/* retain the caller's pointer until the frame has its final segment. */
	helper = !find("frame_busy") || !strcmp(s->name, "rt.frame_grow") || !strcmp(s->name, "rt.frame_leave");
	lit(ZFP); op(O_LD); if (!helper) { lit(0); op(O_PICK); }
	frame = here; lit(0); op(O_SUB); lit(ZFP); op(O_ST);
	if (!helper) {
		lit(find("frame_busy")->val); op(O_LD); busy = here; lit(0); op(O_JZ);
		done = here; lit(0); op(O_JMP); setlit(busy, here);
		lit(ZFP); op(O_LD); lit(find("frame_floor")->val); op(O_LD);
		lit(find("frame_guard")->val); op(O_LD); op(O_ADD); op(O_LT); check = here; lit(0); op(O_JZ);
		lit(ZFP); op(O_LD); lit(1); op(O_PICK); lit(ZFP); op(O_ST);
		fnref("frame_grow"); op(O_CALL); lit(ZFP); op(O_ST);
		busy = here; lit(0); op(O_JMP);
		setlit(check, here); setlit(done, here); op(O_DROP); setlit(busy, here);
	}
	for (i = np; i--;) { laddr(i); op(O_ST); }
	block();
	lit(0);
	for (i = 0; i < nepi; i++) setlit(epi[i], here);
	lit(ZFP); op(O_LD); lit(nslot); op(O_ADD); lit(ZFP); op(O_ST);
	if (!helper) {
		lit(find("frame_node")->val); op(O_LD); node = here; lit(0); op(O_JZ);
		lit(ZFP); op(O_LD); lit(find("frame_top")->val); op(O_LD); op(O_SUB); check = here; lit(0); op(O_JZ);
		done = here; lit(0); op(O_JMP); setlit(check, here);
		fnref("frame_leave"); op(O_CALL); lit(ZFP); op(O_ST); setlit(done, here); setlit(node, here);
	}
	op(O_RET);
	setlit(frame, nslot);
	infn = 0;
	zl_end();
}
/* enhance name(params) [-> n] micro "recipe"; or ... vm { asm };
   emits the install descriptor; the booted genome installs it */
static int nenh;
static void enhdef(void)
{
	char *n, pn[8][64]; int np = 0, nout = 1, d, na, pay, len = 0, i, j; Sym *s;
	if (tk == T_NUM) { nout = tv; next(); }	/* enhance 2 name(...) */
	n = ident();
	expect("(");
	if (!accept(")")) { do { if (np == 8) die("at most 8 inputs"); strcpy(pn[np++], ident()); } while (accept(",")); expect(")"); }
	d = here; for (i = 0; i < 7; i++) emit(0);
	na = here; for (i = 0; i < np; i++) emit(0);
	for (i = 0; i < np; i++) { img[na + i - GORG] = here; for (j = 0; pn[i][j]; j++) emit((unsigned char)pn[i][j]); emit(0); }
	if (accept("micro")) { pay = here; while (tk == T_STR) { for (j = 0; ts[j]; j++) emit((unsigned char)ts[j]); next(); } emit(0); }
	else if (accept("vm")) { pay = here; asmblock(); op(O_RET); len = here - pay; img[d + 1 - GORG] = 1; }
	else die("expected micro or vm");
	img[d - GORG] = nenh; img[d + 2 - GORG] = np; img[d + 3 - GORG] = nout;
	img[d + 4 - GORG] = pay; img[d + 5 - GORG] = len; img[d + 6 - GORG] = na;
	s = add(n, K_ENH, nenh++); s->sig = np + nout * 16 + d * 256;
	expect(";");
}
/* embed "path" as [type] name; at the top level: a global holding the file's bytes,
   read when the image is built. the path is relative to the working directory.
   in a function it declares a local: the bytes of a bstr or char* sit in the code,
   jumped over, and the local starts as their address; a number is stored in the
   local. an array takes the top level.
   bstr (the default) packs the bytes; char* keeps one character to a word; a
   number takes them little-endian; T[] and T[n] have one element per file chunk
   of T's size. the checks are the resident compiler's (kw_embed). zc0 drops
   types, so its arrays are one word per element whatever T is: an element is
   stored as the value it reads as (sign extended for i8, i16 and i32, widened
   for f32), and zc0 code indexing the array sees the same values. */
static int embed_width(const char *t, int star)
{
	if (star) return 0;
	if (!strcmp(t, "char") || !strcmp(t, "u8") || !strcmp(t, "i8") || !strcmp(t, "byte")) return 1;
	if (!strcmp(t, "u16") || !strcmp(t, "i16")) return 2;
	if (!strcmp(t, "u32") || !strcmp(t, "i32") || !strcmp(t, "f32")) return 4;
	if (!strcmp(t, "int") || !strcmp(t, "word") || !strcmp(t, "bool") || !strcmp(t, "float") || !strcmp(t, "f64")) return 8;
	return 0;
}
static Loc *newloc(const char *n)
{
	Loc *l = &lo[nlo++]; strcpy(l->name, n); l->slot = nslot++; l->arr = l->flt = l->str = l->dstr = l->ro = 0;
	return l;
}
static void embeddecl(int local)
{
	char path[1024], ty[64] = "", *n; int star = 0, arr = -2, w, i, a, j; long len; unsigned char *buf; FILE *f; Loc *l;
	if (tk != T_STR) die("embed takes a path in quotes: embed \"file\" as name;");
	snprintf(path, sizeof path, "%s", ts); next();
	expect("as");
	if (tk == T_ID) {
		Lex L; lexsave(&L); next();
		int named = is(";"); lexrest(&L);
		if (!named) {
			snprintf(ty, sizeof ty, "%s", ts); next();
			while (accept("*")) star++;
			if (accept("[")) { arr = -1; if (tk == T_NUM) { arr = (int)tv; next(); } expect("]"); }
		}
	}
	n = ident(); expect(";");
	if (!(f = fopen(path, "rb"))) die("can't read the file named by embed");
	fseek(f, 0, SEEK_END); len = ftell(f); fseek(f, 0, SEEK_SET);
	buf = malloc((size_t)len + 1);
	if (!buf || fread(buf, 1, (size_t)len, f) != (size_t)len) die("can't read the file named by embed");
	fclose(f);
	if (arr == -2 && (!ty[0] || (!strcmp(ty, "bstr") && !star))) {
		if (local) {
			j = here; lit(0); op(O_JMP); a = bstrwords(buf, len); setlit(j, here);
			l = newloc(n); l->str = l->dstr = 1; lit(a); laddr(l->slot); op(O_ST);
		} else {
			a = here; add(n, K_GVAR, a)->str = 1; emit(0); w = bstrwords(buf, len); img[a - GORG] = w;
		}
	} else if (arr == -2 && !strcmp(ty, "char") && star == 1) {
		if (local) {
			j = here; lit(0); op(O_JMP); a = here;
			for (i = 0; i < len; i++) emit(buf[i]);
			emit(0); setlit(j, here);
			l = newloc(n); lit(a); laddr(l->slot); op(O_ST);
		} else {
			a = here; add(n, K_GVAR, a); emit(0); img[a - GORG] = here;
			for (i = 0; i < len; i++) emit(buf[i]);
			emit(0);
		}
	} else if (arr == -2) {
		uint64_t u = 0; w = embed_width(ty, star);
		if (!w) die("embed declares a bstr, a char*, a number or an array of numbers");
		if (len > w) die("the embedded file is larger than the type it is declared as");
		if (!strcmp(ty, "f32") && len != 4) die("an embedded f32 takes exactly 4 bytes");
		if ((!strcmp(ty, "float") || !strcmp(ty, "f64")) && len != 8) die("an embedded float takes exactly 8 bytes");
		for (i = 0; i < len; i++) u |= (uint64_t)buf[i] << (i * 8);
		if (ty[0] == 'i' && w < 8 && (u >> (w * 8 - 1) & 1)) u |= ~(uint64_t)0 << (w * 8);
		if (!strcmp(ty, "f32")) u = fop_s2f(u);
		if (local) {
			l = newloc(n); l->flt = !strcmp(ty, "float") || !strcmp(ty, "f64") || !strcmp(ty, "f32");
			lit((int64_t)u); laddr(l->slot); op(O_ST);
		} else {
			a = here; add(n, K_GVAR, a); emit((int64_t)u);
		}
	} else {
		int count; w = embed_width(ty, star);
		if (!w) die("embed declares a bstr, a char*, a number or an array of numbers");
		if (len % w) die("the embedded file's size is not a whole number of elements");
		count = (int)(len / w);
		if (arr >= 0 && count > arr) die("the embedded file is larger than the array it is declared as");
		if (arr >= 0) count = arr;
		/* in a function the elements sit in the code, jumped over, and the local holds their address */
		if (local) { j = here; lit(0); op(O_JMP); }
		a = here;
		for (i = 0; i < count; i++) {
			uint64_t u = 0; int k;
			for (k = 0; k < w && (long)i * w + k < len; k++) u |= (uint64_t)buf[(long)i * w + k] << (k * 8);
			if (ty[0] == 'i' && w < 8 && (u >> (w * 8 - 1) & 1)) u |= ~(uint64_t)0 << (w * 8);
			if (!strcmp(ty, "f32")) u = fop_s2f(u);
			emit((int64_t)u);
		}
		if (!count) emit(0);
		if (local) { setlit(j, here); l = newloc(n); l->ro = 1; lit(a); laddr(l->slot); op(O_ST); }
		else add(n, K_GARR, a);
	}
	free(buf);
}
static void top1(void)
{
    if (accept("namespace")) {
        if (is(";")) module_name[0] = 0;
        else { snprintf(module_name, sizeof module_name, "%s", ident()); }
        expect(";"); return;
    }
    if (accept("include")) { do { ident(); } while (accept(",")); expect(";"); return; }
	if (is("lines")) {	/* lines on; and lines off; (anything else is a name) */
		Lex L; lexsave(&L); next();
		if (is("on") || is("off")) { zl_on = is("on"); next(); expect(";"); return; }
		lexrest(&L);
	}
	if (accept("embed")) { embeddecl(0); return; }
	{
		if (accept("unbounded")) { if (accept(";")) return; top1(); return; }
		if (accept("unchecked")) { top1(); return; }
		if (accept("fn")) { fndef(0, 0); return; }
		if (accept("const")) { optype(); do { char *n = ident(); if (dsn && !dnm[0]) strcpy(dnm, n); expect("="); add(n, K_CONST, cexpr()); } while (accept(",")); expect(";"); return; }
		if (accept("enhance")) { enhdef(); return; }
		{
			int nw, typed, k, a, rt, gstr = 0; Sym *gs;
			ptag = 0; nw = optype(); typed = nw >= 0; if (typed) gstr = ptstr; else ptag = 0;
			if (!typed && is(".")) { next(); ptag = ptagname(); typed = 1; nw = 1; }	/* .u name(...), or a bare tag on a global */
			rt = ptag == 3;
			if (typed || accept("let") || accept("var")) {
				if (isfn()) { if (ptag && !rt) die("the only return tag is .u"); fndef(rt, gstr); return; }
				do {
					char *n = ident();
					if (dsn && !dnm[0]) strcpy(dnm, n);
					k = 0;
					if (typed) k = nw > 1 ? nw : 0;
					else if (accept("[")) { k = (int)cexpr(); expect("]"); }
					if (k > 1) {
						a = here; while (k--) emit(0); add(n, K_GARR, a);
					} else {
						a = here; gs = add(n, K_GVAR, a); gs->str = gstr; emit(0);
						if (accept("=")) {
							if (tk == T_STR) { int i, l = (int)strlen(ts); img[a - GORG] = here; for (i = 0; i < l; i++) emit((unsigned char)ts[i]); emit(0); next(); }
							else if (tk == T_BSTR) { int d = bstrwords((const unsigned char *)ts, (long)strlen(ts)); img[a - GORG] = d; gs->str = 1; next(); }
							else img[a - GORG] = cexpr();
						}
					}
				} while (accept(","));
				expect(";"); return;
			}
		}
		die("expected fn, var or const");
	}
}

/* section headings organize the source; they do not document a symbol. */
static int doc_section(const char *text, int length)
{
	int start = 0, end, a, b;
	while (start < length) {
		end = start; while (end < length && text[end] != '\n') end++;
		a = start; b = end;
		while (a < b && isspace((unsigned char)text[a])) a++;
		while (b > a && isspace((unsigned char)text[b - 1])) b--;
		if (b - a >= 4 && text[a] == '-' && text[a + 1] == '-' && text[b - 1] == '-' && text[b - 2] == '-') return 1;
		start = end + 1;
	}
	return 0;
}

/* one item, with the doc comment above it kept under the name it declares */
static void top(void)
{
	while (tk != T_EOF) {
		dsn = 0; dnm[0] = 0;
#ifdef ZC0DOCS
		sgname[0] = 0; hdr_start = tstart;
#endif
		if (dn && dline == line) { memcpy(dsnap, dbuf, dn); dsn = dn; dline = 0; }
		top1();
#ifdef ZC0DOCS		/* enabled for images that carry editor documentation */
		if (dsn && dnm[0] && !doc_section(dsnap, dsn)) {
			int j = here, a, i = 0, k, c; uint64_t w; char nm[80];
			lit(0); op(O_JMP); a = here;
			emit(dsn);
			while (i < dsn) {
				w = 0; k = 0;
				while (k < 8 && i < dsn) { c = (unsigned char)dsnap[i]; if (c > 255) c = 63; w |= (uint64_t)c << (k * 8); k++; i++; }
				emit((int64_t)w);
			}
			if (!(dsn & 7)) emit(0);
			setlit(j, here);
			sprintf(nm, "doc %s", dnm);
			add(nm, K_DOC, a);
		}
		if (sgname[0]) {	/* the signature, as the header's own text, under "sig name" */
			int j = here, a, i = 0, k, c, sl = (int)strlen(sgtext); uint64_t w; char nm[96];
			lit(0); op(O_JMP); a = here;
			emit(sl);
			while (i < sl) {
				w = 0; k = 0;
				while (k < 8 && i < sl) { c = (unsigned char)sgtext[i]; w |= (uint64_t)c << (k * 8); k++; i++; }
				emit((int64_t)w);
			}
			if (!(sl & 7)) emit(0);
			setlit(j, here);
			sprintf(nm, "sig %s", sgname);
			add(nm, K_DOC, a);
		}
#endif
		dsn = 0; dnm[0] = 0;
	}
}

int main(int argc, char **argv)
{
	if (argc == 2 && (!strcmp(argv[1], "--help") || !strcmp(argv[1], "-h"))) {
		fputs("usage: zc0 [--help|-h] < source.zc > genome.bin\n"
		      "compiles bootstrap source from stdin into a genome image on stdout:\n"
		      "little-endian 64-bit words, the format the cores #embed.\n"
		      "source must define start(); memory layout is selected when zc0 is built.\n"
		      "options:\n  --help, -h  show this help and exit\n", stdout);
		return 0;
	}
	if (argc != 1) { fputs("zc0: unexpected arguments; use --help for usage\n", stderr); return 2; }
#ifdef _WIN32
	_setmode(_fileno(stdin), _O_BINARY);
	_setmode(_fileno(stdout), _O_BINARY);
#endif
	char *buf = malloc(65536); int capacity = 65536, n = 0, i, j; Sym *st;
	if (!buf) { fprintf(stderr, "zc0: cannot allocate source buffer\n"); return 1; }
	for (;;) {
		size_t got;
		if (n + 1 == capacity) {
			char *next;
			if (capacity > 0x7fffffff / 2) { fprintf(stderr, "zc0: source is too large\n"); return 1; }
			capacity *= 2; next = realloc(buf, (size_t)capacity);
			if (!next) { fprintf(stderr, "zc0: cannot grow source buffer\n"); return 1; }
			buf = next;
		}
		got = fread(buf + n, 1, (size_t)(capacity - n - 1), stdin); n += (int)got;
		if (!got) { if (ferror(stdin)) { fprintf(stderr, "zc0: source read failed\n"); return 1; } break; }
	}
	buf[n] = 0; src = buf; next();
	/* image header: set the frame pointer, jump to start, then the symbol blob pointer and image end */
	lit(FTOP); lit(ZFP); op(O_ST); fnref(strstr(src, "namespace run;") ? "run.start" : "start"); op(O_JMP); emit(0); emit(0);
	top();
	for (i = 0; i < nfx; i++) {
		Sym *s = &sy[fx[i].sym];
		if (!s->defd) { fprintf(stderr, "zc0: undefined function %s\n", s->name); return 1; }
		setlit(fx[i].at, s->val);
	}
	if (!(st = find("start")) || !st->defd) { fprintf(stderr, "zc0: no start\n"); return 1; }
	/* the line tables are reached through rt.line_blocks, which starts out as the newest block */
	if (zl_head && (st = find_raw("rt.line_blocks"))) img[st->val - GORG] = zl_head;
	/* symbol blob: kind, value, sig, name chars, 0 ... then a 0 kind */
	img[5] = here;
	for (i = 0; i < nsy; i++) {
		emit(sy[i].kind); emit(sy[i].val); emit(sy[i].sig);
		for (j = 0; sy[i].name[j]; j++) emit((unsigned char)sy[i].name[j]);
		emit(0);
	}
	emit(0);
	img[6] = here;
	for (i = 0; i < here - GORG; i++) {
		unsigned char b[8]; uint64_t u = (uint64_t)img[i];
		for (j = 0; j < 8; j++) b[j] = (unsigned char)(u >> (j * 8));
		if (fwrite(b, 1, 8, stdout) != 8) { fprintf(stderr, "zc0: write failed\n"); return 1; }
	}
	return fflush(stdout) ? 1 : 0;
}