path: root/src/compiler/stmt.zc

// ---- statements ----

// after a syntax error: skip to the end of the statement
// statements. stmt is the dispatcher: a keyword statement (if, while, return,
// a parse word...), a declaration, an empty statement, a block, or an
// expression statement whose value is dropped. after a syntax error panic is
// set and stmt calls resync to skip to the next ; or }.
int resync() {
	while (tk != T_EOF && !is_op(s_semi) && !is_op(s_rb)) next();
	if (is_op(s_semi)) next();
	panic = 0;
	return 0;
}
// compile one statement.
int stmt() {
 word before = borrow_slots; int result; emit_statement_hooks(); result = stmt_inner(); borrow_cleanup_since(before); return result;
}
int stmt_inner() {
	int s, c;
	if (probe_off >= 0) probe_stmt();
	if (panic) return resync();
	if (tk == T_ID && findloc(tv) < 0) {
		s = lookup(tv);
		if (s >= 0 && skind[s] == K_KW && (sflag[s] & F_STMT)) { kwcall(s, 0); return 0; }
	}
	if (untyped_const()) { next(); localdecl(2); return 0; }
	if (typedef_ahead() && findloc(tv) < 0) return kw_typedef();
	if (tstart()) { localdecl(1); return 0; }
	if (tk == T_OP) {
		if (tv == s_semi) { next(); return 0; }
		if (tv == s_lb) { block(); return 0; }
	}
	c = expr(); rval(); op(O_DROP);
	expect(s_semi);
	discard(c);
	return 0;
}
// compile a block, with its own scope for the locals it declares.
int block() {
	int save = nloc;
	expect(s_lb);
	fdepth++;
	while (!is_op(s_rb)) { if (tk == T_EOF) { die("missing }"); break; } stmt(); }
	if (probe_off >= 0 && !chkabort && !dry && !ginst && incdepth == 0 && ctxsp <= nclo && toff >= probe_off) { probe_snap(); chkabort = 1; }
	block_close(save);	// before the }, so its line is the one reported
	next();
	fdepth--;
	return 0;
}
// the body of if/while/for: its own block, even without braces
// (the body of if/while/for is always its own block, even without braces, so
// variables declared in it die with it)
int substmt() {
	int save = nloc;
	if (is_op(s_lb)) return block();
	fdepth++;
	stmt();
	block_close(save);
	fdepth--;
	return 0;
}
// let a = e, b[10];   or, typed:   int a = 1, b;   node*.m p = new(node);   .u r;
// let infers pointer, struct and function types from the initializer and
// keeps numbers as plain words.
// (each declared name gets a slot; an initializer is compiled and stored, and
// assigncheck gives the new local its analyzer state. an initializer that is a
// constant number marks the local as a const candidate for the hints, and a
// new records the size and leaf-ness for the matching recycle.)
// the type of each untyped local while the language server checks a document:
// the byte offset of its name in the document, and the type's text in ltxt
// (one character per word). the server turns it into the hover of the local.
// record a parsed type expression so arrays, stars, and function types have hovers.
int ht_note(int start, int end, word t) {
	if (!lt_on || isp != 0 || dry || !t || start < 0 || end <= start) return 0;
	if (!ht_start || ht_n == htcap) {
		if (ht_start) htcap = htcap * 2;
		ht_start = chk_resize(ht_start, ht_n, htcap);
		ht_end = chk_resize(ht_end, ht_n, htcap);
		ht_type = chk_resize(ht_type, ht_n, htcap);
	}
	ht_start[ht_n] = start; ht_end[ht_n] = end; ht_type[ht_n] = t; ht_n++;
	return 0;
}
// record the type of a local at byte offset o for the language server.
int lt_note(int o, int t) {
	int sm, sb, sn, sc, sl, need;
	if (!lt_on || isp != 0 || dry || o < 0 || !t) return 0;
	if (!lt_off || lt_n == ltcap) {
		if (lt_off) ltcap = ltcap * 2;
		lt_off = chk_resize(lt_off, lt_n, ltcap); lt_at = chk_resize(lt_at, lt_n, ltcap);
		lt_len = chk_resize(lt_len, lt_n, ltcap); lt_type = chk_resize(lt_type, lt_n, ltcap);
	}
	sm = rt.outmode; sb = rt.outbuf; sn = rt.outn; sc = rt.outcap;
	rt.outmode = 3; rt.outn = 0; tprint(t); need = ltxn + rt.outn;
	if (!ltxt || need > ltxtcap) {
		while (need > ltxtcap) ltxtcap = ltxtcap * 2;
		ltxt = chk_resize(ltxt, ltxn, ltxtcap);
	}
	rt.outmode = 2; rt.outbuf = ltxt; rt.outn = ltxn; rt.outcap = ltxtcap;
	tprint(t);
	sl = rt.outn;
	rt.outmode = sm; rt.outbuf = sb; rt.outn = sn; rt.outcap = sc;
	lt_off[lt_n] = o; lt_at[lt_n] = ltxn; lt_len[lt_n] = sl - ltxn; lt_type[lt_n] = t; lt_n++;
	ltxn = sl;
	return 0;
}
// compile a local declaration, typed or let-style.
// does `const name =` start here? a const with no type takes the initializer's type.
int untyped_const() {
	if (tk != T_ID || tv != s_const) return 0;
	peekat(0); if (pk_tk != T_ID || istypename(pk_tv)) return 0;
	peekat(1); return pk_tk == T_OP && (pk_tv == s_eq || pk_tv == s_semi || pk_tv == s_comma);
}
// typed is 1 after a type, 0 after let, and 2 after an untyped const.
int localdecl(int typed) {
	int n, i, c, k, t = 0, tg = 0, pp, kc, kp = ifkp, gty = 0, gok = !typed && ifon && !dry, o, vr, ro = typed == 2; word iq, it;
	if (ro) typed = 0;
	if (typed) { dtype(); t = dty; tg = dtag; if (t == tvoid) serr("a variable can't be void"); }
	if ((o3on || o3one) && !typed) serr("o3 variables need a type");
	while (1) {
		pp = tpack();
		o = toff;
		rs_note(RS_LOCAL, o); vr = rsn - 1;
		n = name();
		i = newloc(n);
		lrsoff[i] = o;
		ltag[i] = tg | LDECL; lpos[i] = pp; lnsz[i] = 0; lleaf[i] = 0;
		if (o3on || o3one) ltag[i] = ltag[i] | 16;
		if (accept(s_lk)) {
			k = cexpr(); expect(s_rk);
			if (!t) t = tword;
			larr[i] = 1; ltype[i] = tarr(t, k); fslots = fslots + tsz(ltype[i]);
			if (gok) { if (!gty) gty = tint; else if (gty != tint) gok = 0; }
		} else if (t && isagg(t)) { larr[i] = 1; ltype[i] = t; fslots = fslots + tsz(t); }
		else { fslots++; if (t) ltype[i] = t; if (isfl(t)) setflt(i, 1); if (o3on) { o3promote(i); o3mkcache(i); } }
		capture_cell(i, 0);
		if (accept(s_eq)) {
			if (larr[i] && ltype[i][0] == TY_ARR && (is_op(s_lb) || tk == T_STR || tk == T_BSTR)) {
				iq = array_initializer_tokens(ltype[i]); it = array_measure(iq, ltype[i]);
				fslots = fslots + tsz(it) - tsz(ltype[i]);
				ltype[i] = it; array_initialize(iq, it, lslot[i], 1); rt.free(iq);
			} else {
			if (larr[i]) serr("an array or a struct needs an initializer list");
			newsz = -1; newleaf = 0; if (tk == T_NUM) nomagic = 1;
			if (t && t[0] == TY_DYN && is_op(s_lb)) c = array_dynamic_literal(t); else c = expr();
			rval(); nomagic = 0; kc = xconst && !xfloat;
			if (kc) ltag[i] = ltag[i] | LCONST;
			if (c == C_FRESH) { lnsz[i] = newsz; lleaf[i] = newleaf; }
			if (t) fcoerce(t);
			vaddr(i);
			op(O_ST);
			o3refresh(i);
			setflt(i, xfloat);
			setstr(i, xstr);
			note_store(i); af_store(i); vf_store(i);
			if (t) { if (!compat(t, xty)) tcerr("initializer", t, xty); }
			else if (!isnum(xty)) {
				if (xty[0] == TY_ARR) ltype[i] = decay(xty);
				else if (xty[0] == TY_STRUCT) ltype[i] = tptr(xty);
				else ltype[i] = xty;
			}
			assigncheck(LV_LOCAL, i, c);
			if (ro) { k = ltype[i]; if (!k) { k = tword; if (isnum(xty)) k = xty; } ltype[i] = tconst(k); }
			if (gok) { k = xty; if (isagg(k)) k = ltype[i]; if (!ifpure(k) || (gty && gty != k)) gok = 0; else gty = k; }
			}
		} else if (ro) serr("a const needs an initializer");
		else if (gok && !larr[i]) gok = 0;	// no initializer: nothing says what it is
		if (larr[i] && ltype[i][0] == TY_ARR && ltype[i][3] < 0) serr("T[] needs an initializer to determine its length");
		if (larr[i]) { k = 1; if (ltype[i][0] == TY_ARR) k = ltype[i][3]; lafact[i] = af_new(k, 1, pp); laaddr[i] = lafact[i]; if (lafact[i]) lafact[i][5] = i; }
		af_declaration(o, lafact[i]); os_at(o, i);
		if (cmode) vf_at(vr, lvkind[i], lvvalue[i]);
		kc = tword;
		if (ltype[i]) kc = ltype[i];
		lt_note(((pp >> 40) & 0x1FFFFF) - 1, kc);
		if (!accept(s_comma)) break;
	}
	expect(s_semi);
	if (gok && gty && kp) fact_add(kp, 0 - 1, gty, "");
	return 0;
}
// compile a variable declaration.
int kw_var() {
	stmtonly();
	ifkp = 0;
	if (isp == 0) ifkp = tpack();	// only the document itself: an include has other offsets
	next();
	return localdecl(0);
}
// if / else. the shape of every branching construct is the same: snapshot the
// analyzer state, compile one path, restore the snapshot, compile the other,
// then join the two end states (join2). a path that does not reach the join
// (it returned or broke) is left out. without an else the "other path" is
// the state before the branch.
int kw_if() {
	int a, b, c, s0, sa, live0, livea, n0 = nloc, nt, cj;
	stmtonly();
	next();
	expect(s_lp); c = borrow_condition(); expect(s_rp);
	a = hole(); op(O_JZ);
	live0 = live;
	s0 = snap_push();
	substmt();
	livea = live; sa = snap_push();
	if (is_id(s_else)) {
		next();
		b = hole(); op(O_JMP);
		setlit(a, here);
		snap_restore(s0); live = live0;
		substmt();
		join2(sa, livea, b, live, n0, "ends the branches of an if in different states");
	} else {
		// the path that skips the then branch still has the states from before it
		njps = 0; if (livea) jadd(R_SNAP + sa); if (live0) jadd(R_SNAP + s0);
		join(n0, "ends the branches of an if in different states");
		if (livea) fixups(R_SNAP + sa, n0, 1);
		nt = 0; if (live0) nt = fixups(R_SNAP + s0, n0, 0);
		if (nt) {
			cj = hole();
			op(O_JMP);
			setlit(a, here);
			fixups(R_SNAP + s0, n0, 1);
			setlit(cj, here);
		}
		else setlit(a, here);
		live = livea || live0;
	}
	snap_pop(s0);
	return 0;
}
// loop frame: 0 continue target (-1 for a switch)  2 depth  3 snapshot at the top
// 4 block-expression depth  5 locals at the start  6 its first exit record
// loops and switches share a frame stack (R_LOOP, 8 words each). a break adds
// an exit record (the analyzer state at that point) with a jump to patch;
// loop_end joins all of them with the normal fall-out and patches the jumps.
int loop_push(int cont, int s0) {
	word f;
	reserve_R_LOOP((lsp + 1) * 8);
	if (lsp >= loopfacts_cap) { lpfact = chk_resize(lpfact, loopfacts_cap, loopfacts_cap * 2); loopfacts_cap = loopfacts_cap * 2; }
	f = R_LOOP + lsp * 8;
	f[0] = cont;
	f[1] = 0;
	f[2] = fdepth;
	f[3] = s0;
	f[4] = bxdepth;
	f[5] = nloc;
	f[6] = extop;
	f[7] = 0;
	lpfact[lsp] = -1;
	lsp++;
	return 0;
}
// the end of a loop or switch: join its exits (the fall-out path sc through
// the jump at a, if there is one, and every break) and lay out each path's
// fixups on its way to the end
int loop_end(int a, int sc) {
	word f, p; int e, n0, outs = 0;
	lsp--;
	f = R_LOOP + lsp * 8;
	n0 = f[5];
	njps = 0;
	if (sc >= 0) jadd(R_SNAP + sc);
	p = R_EXIT + f[6]; e = R_EXIT + extop;
	while (p < e) { jadd(p + 1); p = p + 3 + 3 * (p[2] - p[1]); }
	join(n0, "leaves the loop in different states on different paths");
	live = njps > 0;
	p = R_EXIT + f[6];
	while (p < e) {
		if (fixups(p + 1, n0, 0)) {
			setlit(p[0], here);
			fixups(p + 1, n0, 1);
			outs = fixnew(hole(), outs);
			op(O_JMP);
		}
		else outs = fixnew(p[0], outs);
		p = p + 3 + 3 * (p[2] - p[1]);
	}
	if (a >= 0) setlit(a, here);
	if (sc >= 0) fixups(R_SNAP + sc, n0, 1);
	fixall(outs, here);
	extop = f[6];
	return 0;
}
// while. the back edge is checked against the snapshot taken at the top, so a
// loop body that gives something away and comes around again is an error. a
// literal while (1) has no fall-out path, only its breaks.
int kw_while() {
	int c0 = here, a, s0, sc = -1, c, inf = 0;
	stmtonly();
	next();
	s0 = snap_push();
	expect(s_lp);
	// while (1): no way out but break
	if (tk == T_NUM && tv) {
		peek();
		if (pk_tk == T_OP && pk_tv == s_rp) inf = 1;
	}
	c = borrow_condition(); expect(s_rp);
	a = hole(); op(O_JZ);
	if (!inf && live) sc = snap_push();
	loop_push(c0, s0);
	substmt();
	backedge(s0);
	jmp(c0);
	loop_end(a, sc);
	snap_pop(s0);
	return 0;
}
// for (init; test; step) body. the code is laid out test first, then a jump
// over the step into the body, and the step jumps back to the test, so the
// step is compiled before the body but runs after it. while the test and the
// step are parsed, fortest and forstep record the shape "i < bound ... i++":
// if it holds and the bound is len(a) of a fixed array, the body is told that
// a[i] is in range (lpfact), and its bounds check disappears.
int kw_for() {
	int save = nloc, s0, sc = -1, c0, a, b, st, c, inf = 0; word borrow_mark = borrow_slots;
	stmtonly();
	next();
	expect(s_lp);
	fdepth++;
	if (is_id(s_var)) kw_var();
	else if (tstart()) localdecl(1);
	else { if (!is_op(s_semi)) { c = expr(); rval(); op(O_DROP); discard(c); } expect(s_semi); }
 borrow_cleanup_since(borrow_mark);
	s0 = snap_push();
	c0 = here;
	ft_iv = -1; fs_ok = 0; fortest = 1;
	if (!is_op(s_semi)) {
		if (tk == T_NUM && tv) { peek(); if (pk_tk == T_OP && pk_tv == s_semi) inf = 1; }
		c = borrow_condition();
	} else { lit(1); inf = 1; xfloat = 0; }
	fortest = 0;
	expect(s_semi);
	a = hole(); op(O_JZ);
	if (!inf && live) sc = snap_push();
	b = hole(); op(O_JMP);
	st = here;
	forstep = 1; borrow_mark = borrow_slots;
	if (!is_op(s_rp)) { c = expr(); rval(); op(O_DROP); discard(c); }
 borrow_cleanup_since(borrow_mark);
	forstep = 0;
	expect(s_rp);
	jmp(c0);
	setlit(b, here);
	loop_push(st, s0);
	if (ft_iv >= 0 && ft_bd >= 0 && fs_ok && getlo(ft_iv) >= 0 && getln(ft_bd) >= 0) {
		lpfact[lsp - 1] = pfact(ft_iv, ft_bd, getln(ft_bd));
	}
	substmt();
	backedge(s0);
	jmp(st);
	loop_end(a, sc);
	snap_pop(s0);
	block_close(save);
	fdepth--;
	return 0;
}
// do stmt while (cond);  the body runs once before the test. continue jumps
// to the test, which is patched in after the body (f[0] == -2 marks that).
int kw_do() {
	int body, s0, sc = -1, a, c; word f; int inf = 0;
	stmtonly();
	next();
	s0 = snap_push();
	body = here;
	loop_push(-2, s0);
	substmt();
	f = R_LOOP + (lsp - 1) * 8;
	fixall(f[7], here);
	backedge(s0);
	if (!is_id(s_while)) die("expected while after do");
	next();
	expect(s_lp);
	if (tk == T_NUM && tv) { peek(); if (pk_tk == T_OP && pk_tv == s_rp) inf = 1; }
	c = borrow_condition();
	expect(s_rp);
	expect(s_semi);
	if (!inf && live) sc = snap_push();
	a = hole(); op(O_JZ);
	jmp(body);
	loop_end(a, sc);
	snap_pop(s0);
	return 0;
}
// break and continue unwind the scopes they leave (exit_vars frees what those
// blocks own on the way out). break records the analyzer state for the join
// at the end of the loop; continue checks the state against the loop top.
int kw_break() {
	word f;
	stmtonly();
	next(); expect(s_semi);
	if (lsp <= loopbase) { serr("break outside a loop or a switch"); return 0; }
	f = R_LOOP + (lsp - 1) * 8;
	if (f[4] != bxdepth) { serr("break can't leave a block expression"); return 0; }
	exit_vars(f[2] + 1, 0);
	if (live) exit_rec(hole()); else hole();
	op(O_JMP);
	live = 0;
	return 0;
}
// compile continue: jump to the test of the innermost loop.
int kw_continue() {
	int j = lsp - 1; word f;
	stmtonly();
	next(); expect(s_semi);
	while (j >= loopbase && R_LOOP[j * 8] == -1) j--;	// past any switch
	if (j < loopbase) { serr("continue outside a loop"); return 0; }
	f = R_LOOP + j * 8;
	if (f[4] != bxdepth) { serr("continue can't leave a block expression"); return 0; }
	backedge(f[3]);
	exit_vars(f[2] + 1, 0);
	if (f[0] == -2) { f[7] = fixnew(hole(), f[7]); op(O_JMP); }	// do/while: the condition isn't placed yet
	else jmp(f[0]);
	live = 0;
	return 0;
}
// switch (e) { case 1, 2: ... case 'x': ... default: ... }
// cases don't fall through: each one ends where the next begins, and break
// leaves the switch early. case labels are constants.
// one case's statements, analyzed from the state at the top of the switch.
// the end of a case jumps out of the switch, so cases never fall through.
int casebody(int s0, int live0) {
	int save = nloc;
	snap_restore(s0); live = live0;
	fdepth++;
	while (!is_op(s_rb) && !is_id(s_case) && !is_id(s_default)) {
		if (tk == T_EOF) { die("missing }"); break; }
		stmt();
	}
	block_close(save);
	fdepth--;
	if (live) { exit_rec(hole()); op(O_JMP); }	// the end of a case leaves the switch
	live = 0;
	return 0;
}
// compile a switch statement.
int kw_switch() {
	int sl = tline;
	int save = nloc, tmp, c, s0, live0, defent = -1, skip, nxt, bj, v, a = -1, st, tg = 0, cov = 0, gi, nb = 0, j, arm, bi;
	word[8] pbn; word[8] pbl;
	stmtonly();
	next();
	expect(s_lp); c = expr(); st = xty; rval(); plainuse(c); expect(s_rp);
	tg = ptagged(st);
	fdepth++;
	tmp = newloc(0); fslots++;	// a hidden local holds the value
	laddr(lslot[tmp]); op(O_ST);
	live0 = live;
	s0 = snap_push();
	loop_push(-1, s0);
	expect(s_lb);
	while (!is_op(s_rb)) {
		if (tk == T_EOF) { die("missing }"); break; }
		if (is_id(s_case)) {
			next();
			if (tk == T_ID && rt.eq_w(tv, "_")) {
				next(); expect(s_colon);
				if (defent >= 0) serr("a switch has one catch-all case");
				skip = hole(); op(O_JMP); defent = here;
				casebody(s0, live0); setlit(skip, here);
				continue;
			}
			bj = 0;
			gi = -1;
			peek();
			if (tg && tk == T_ID && pk_tk == T_OP && pk_tv == s_lp) gi = pm_find(tv);
			if (gi >= 0) {
				// case member(a, b): a member of a tagged enum, its fields bound to the names
				next(); next();
				nb = 0;
				while (!is_op(s_rp)) {
					if (nb >= 8) { die("too many names in a case"); break; }
					pbn[nb] = name(); nb++;
					if (!accept(s_comma)) break;
				}
				expect(s_rp);
				if (nb != pm_nf[gi]) serr("a case binds every field of its member");
				v = pm_tag[gi];
				if (v < 63) cov = cov | (1 << v);
				laddr(lslot[tmp]); op(O_LD); op(O_LD); lit(v); op(O_SUB);
				bj = fixnew(hole(), bj); op(O_JZ);
				expect(s_colon);
				arm = nloc;
				for (j = 0; j < nb && j < pm_nf[gi]; j++) {
					bi = newloc(pbn[j]); fslots++;
					ltype[bi] = pm_ft[gi * 8 + j];
					if (isfl(ltype[bi])) setflt(bi, 1);
					pbl[j] = bi;
				}
				nxt = hole(); op(O_JMP);
				fixall(bj, here);
				for (j = 0; j < nb && j < pm_nf[gi]; j++) {
					capture_cell(pbl[j], 0);
					laddr(lslot[tmp]); op(O_LD); lit(pm_off[gi * 8 + j]); op(O_ADD); op(O_LD);
					vaddr(pbl[j]); op(O_ST);
				}
				casebody(s0, live0);
				block_close(arm);
				setlit(nxt, here);
			} else {
				while (1) {
					v = cexpr();
					if (tg && v >= 0 && v < 63) cov = cov | (1 << v);
					laddr(lslot[tmp]); op(O_LD);
					if (tg) op(O_LD);
					lit(v); op(O_SUB);
					bj = fixnew(hole(), bj); op(O_JZ);
					if (!accept(s_comma)) break;
				}
				expect(s_colon);
				nxt = hole(); op(O_JMP);
				fixall(bj, here);
				casebody(s0, live0);
				setlit(nxt, here);
			}
		} else if (is_id(s_default)) {
			next(); expect(s_colon);
			if (defent >= 0) serr("a switch has one default");
			skip = hole(); op(O_JMP);	// only reached when nothing matched
			defent = here;
			casebody(s0, live0);
			setlit(skip, here);
		} else die("expected case or default");
	}
	next();
	snap_restore(s0); live = live0;
	if (tg && defent < 0) cover_warn(tg - 1, cov, sl);
	if (defent >= 0) { jmp(defent); loop_end(-1, -1); }
	else { a = hole(); op(O_JMP); loop_end(a, s0); }	// nothing matched: out with the states from the top
	snap_pop(s0);
	block_close(save);
	fdepth--;
	return 0;
}
// return: coerce and check the value, run the analyzer's return rule, free
// everything the function owns (exit_vars from depth 1), and jump to the
// epilogue, which is a patch chain resolved when the function ends.
int kw_return() {
	int c, returned = tint;
	stmtonly();
	next();
	if (!infn) serr("return outside a function");
	if (bxdepth) serr("return can't leave a block expression");
	if (is_op(s_semi)) { lit(0); c = C_PLAIN; if_ret(0, 1); }
	else {
		c = expr(); rval();
		returned = xty;
		if (!nclo && !xzero) {
			if (!fn_return_type) fn_return_type = returned;
			else if (fn_return_type != returned) fn_return_type = 0 - 1;
		}
		if_ret(xty, xzero);
		if (fty && fty != tvoid) fcoerce(fty);
		if (fty == tvoid) tcerr("return value", tvoid, xty);
		else if (fty && !compat(fty, xty)) tcerr("return value", fty, xty);
	}
	if (nclo) {
		if (!clo_ret[nclo - 1]) clo_ret[nclo - 1] = returned;
		else if (clo_ret[nclo - 1] != returned) clo_ret[nclo - 1] = 0 - 1;
	}
	expect(s_semi);
	retcheck(c);
 borrow_cleanup();
	exit_vars(1, 0);
	epichain = fixnew(here, epichain);
	lit(rt.MW - 1); op(O_JMP);
	live = 0;
	return 0;
}
// o3 { ... }: an optimized region.  o3 T x = e;: one o3 variable
// (a block is compiled as normal code behind a jump and handed to the core
// as a region once the function is complete: o3pend queues them. variables
// declared outside that are o3 get registers too, and anything with a pointer
// in it is fattened when control leaves the region.)
int kw_o3() {
	int lo, i; word p; int save, outer;
	stmtonly();
	next();
	if (!is_op(s_lb)) { o3one = 1; localdecl(1); o3one = 0; return 0; }
	if (o3on || !infn) return block();
	reserve_code(2); lo = here + 2; lit(lo); op(O_JMP);
	o3on = 1; o3reset();
	save = nloc; outer = nloc;
	i = lbase;
	// o3 variables declared outside
	while (i < outer) {
		if (ltag[i] & 16) {
			o3promote(i);
			o3mkcache(i);
			o3refresh(i);
		}
		i++;
	}
	block();
	o3on = 0;
	if (no3pend >= o3pendcap) { o3pend = chk_resize(o3pend, no3pend * 67, o3pendcap * 2 * 67); o3pendcap = o3pendcap * 2; }
	{
		p = o3pend + no3pend * 67; p[0] = lo; p[1] = here; p[2] = no3sl;
		rt.copy_w(p + 3, o3sl, no3sl); rt.copy_w(p + 35, o3rg, no3sl); no3pend++;
	}
	local_drop(save); fdrop(save);	// the hidden cache variables
	i = lbase;
	while (i < outer) {
		ltag[i] = ltag[i] - (ltag[i] & 1792); o3cache[i] = 0;
		// leaving o3: fatten what they hold
		if ((ltag[i] & 16) && hasptr(ltype[i])) {
			vaddr(i);
			op(O_LD);
			lit(ltype[i]);
			callname(s_fatten);
			op(O_DROP);
		}
		i++;
	}
	return 0;
}
// unchecked turns the analyzer off for one statement
int kw_unchecked() {
	int old = fchk;
	stmtonly();
	next();
	fchk = 0;
	substmt();
	fchk = old;
	return 0;
}

// ---- asm blocks: raw vm words, one per token ----

// numbers push, -n pushes a negative number, #n emits a raw word, one-char
// tokens from the mnemonic table are opcodes, names push the address of a
// variable or function, :name defines a label for this block.
// (labels are local to the block: :name defines one, a later name refers to it,
// and references to labels not yet defined are resolved when the block ends)
word asm_names = R_ASM, asm_sites = R_ASM + ASM_LABELS;
word asm_refs = R_ASM + ASM_LABELS + ASM_LABELS, asm_fixes = R_ASM + ASM_LABELS + ASM_LABELS + ASM_REFS;
int asm_labelcap = ASM_LABELS, asm_refcap = ASM_REFS;
int reserve_asm_labels(int need) {
	int cap = asm_labelcap;
	if (need <= cap) return cap;
	while (cap < need) cap = cap * 2;
	asm_names = chk_resize(asm_names, asm_labelcap, cap); asm_sites = chk_resize(asm_sites, asm_labelcap, cap);
	asm_labelcap = cap; return cap;
}
int reserve_asm_references(int need) {
	int cap = asm_refcap;
	if (need <= cap) return cap;
	while (cap < need) cap = cap * 2;
	asm_refs = chk_resize(asm_refs, asm_refcap, cap); asm_fixes = chk_resize(asm_fixes, asm_refcap, cap);
	asm_refcap = cap; return cap;
}
int asmblock() {
	af_forget();
	int nl = 0, nr = 0, i, k, c, s; word ln = asm_names, la = asm_sites, rn = asm_refs, ra = asm_fixes;
	expect(s_lb);
	while (!is_op(s_rb)) {
		if (tk == T_EOF) { die("unterminated asm block"); break; }
		if (tk == T_FLT) { op(OP_FLIT); emit(tv); next(); continue; }
		if (tk == T_NUM) { lit(tv); next(); continue; }
		if (tk == T_BSTR) { bstrlit(tv); next(); continue; }
		if (tk == T_STR) { strlit(tv); next(); continue; }
		if (is_op(s_hash)) {
			next();
			if (tk != T_NUM) die("# needs a number");
			emit(tv);
			next();
			continue;
		}
		if (is_op(s_minus)) {
			next();
			if (tk == T_NUM && tglue) {
				lit(0 - tv);
				next();
			} else {
				op(O_SUB);
			}
			continue;
		}
		if (is_op(s_colon)) {
			next();
			reserve_asm_labels(nl + 1); ln = asm_names; la = asm_sites;
			ln[nl] = name();
			la[nl] = here;
			nl++;
			continue;
		}
		if (tv[0] && !tv[1] && (c = mnemidx(tv[0])) >= 0) { op(c); next(); continue; }
		if (tk != T_ID) die("bad token in asm");
		i = findloc(tv);
		if (i >= 0 && (ltag[i] & 16) && !larr[i]) serr("asm can't reach an o3 variable");
		if (i >= 0) { luse(i); ltag[i] = ltag[i] | LREAD | LASG; vaddr(i); next(); continue; }
  if (nclo) {
   k = clocap(tv);
   if (k >= 0) { vaddr(clo_env[nclo - 1]); op(O_LD); lit(k); op(O_ADD); op(O_LD); next(); continue; }
  }
		k = -1; i = 0;
		while (i < nl) { if (ln[i] == tv) k = i; i++; }
		if (k >= 0) { lit(la[k]); next(); continue; }
		s = lookup(tv);
		if (s >= 0 && skind[s] == K_ENH) { op(XOP0 + sval[s]); next(); continue; }
		if (s >= 0 && skind[s] != K_FN && skind[s] != K_KW) { lit(sval[s]); next(); continue; }
		if (s >= 0 && skind[s] == K_FN) { fnref(s); next(); continue; }
		reserve_asm_references(nr + 1); rn = asm_refs; ra = asm_fixes;
		rn[nr] = tv; ra[nr] = hole(); nr++; next();	// a label further down this block
	}
	next();
	i = 0;
	while (i < nr) {
		k = -1; c = 0;
		while (c < nl) { if (ln[c] == rn[i]) k = c; c++; }
		if (k < 0) serrn(rn[i], "unknown name in asm");
		setlit(ra[i], la[k]);
		i++;
	}
	return 0;
}
// virtual enhancement bodies are recipes read as a flat range by the host.
int contiguous_asm() {
	word q = grab(), wrapped; int n = q[0], i = 0, need = 2, entry, at;
	while (i < n) {
		need = need + 16;
		if (q[1 + i * 3] == T_STR || q[1 + i * 3] == T_BSTR) need = need + rt.len_w(q[2 + i * 3]);
		i++;
	}
	reserve_code(need); entry = here;
	wrapped = chk_resize(0, 0, n * 3 + 7); wrapped[0] = n + 2;
	wrapped[1] = T_OP; wrapped[2] = s_lb; wrapped[3] = tpack();
	rt.copy_w(wrapped + 4, q + 1, n * 3); at = 4 + n * 3;
	wrapped[at] = T_OP; wrapped[at + 1] = s_rb; wrapped[at + 2] = tpack();
	src_push(1, wrapped, 0, 0); next(); asmblock(); src_pop(); op(O_RET);
	rt.free(d*q); return entry;
}
// asm as a keyword (statement or expression): the block's own stack effect is
// the program's responsibility, so the result is a plain word
int kw_asm() {
 if (effect_current) effect_current[0] = 2;
	next();
	asmblock();
	xcls = C_PLAIN;
	return 0;
}

// ---- quote: code as data ----

// a token list is an object: [n] then kind, value, line for each token. names,
// strings and operators are interned pointers.
// grab reads the { ... } after quote or times (a parse word) into a token list,
// stopping at the matching brace. it buffers the tokens in R_QBUF, then copies
// them to a fresh object. quote compiles a list into the program as data and
// returns a copy at run time; feed (below) pushes a list back as input.
word .u grab() {
	int n = 0, depth = 0; word q;
	if (!is_op(s_lb)) die("expected {");
	next();
	while (1) {
		if (tk == T_EOF) { die("unterminated quote"); break; }
		if (is_op(s_lb)) depth++;
		if (is_op(s_rb)) { if (!depth) break; depth--; }
		reserve_R_QBUF((n + 1) * 3);
		R_QBUF[n * 3] = tk; R_QBUF[n * 3 + 1] = tv; R_QBUF[n * 3 + 2] = tline; n++;
		next();
	}
	next();
	q = rt.new(n * 3 + 1);
	q[0] = n;
	rt.copy_w(q + 1, R_QBUF, n * 3);
	return u*q;
}
word .u qnew(word src) { int n = src[0] * 3 + 1; word q = rt.new(n); rt.copy_w(q, src, n); return q; }
word .u qdup(.m q) { int n = q[0] * 3 + 1; word r = rt.new(n); rt.copy_w(r, q, n); return u*r; }
// emit n words copied from a well-formed token buffer q; references in the emitted words must outlive the image.
int wcopyto(.m q, int n) {
	int i = 0; reserve_code(n);
	while (i < n) { emit(q[i]); i++; }
	return 0;
}
// quote { tokens }: the list is emitted into the code behind a jump, and the
// expression's value is a fresh copy of it (qnew), so a program can edit its
// copy without touching the original
int quote_tokens() {
	word q; int j, a, n;
	q = grab();
	j = hole(); op(O_JMP);
	n = q[0] * 3 + 1; reserve_code(n); a = here;
	wcopyto(q, n);
	rt.free(d*q);
	setlit(j, here);
	lit(a);
	callname(s_qnew);
	xcls = C_FRESH;
	return 0;
}
int kw_quote() { next(); return quote_tokens(); }
// tokens of a string, as a token list
word*.u tokens(char* s) {
	int n = 0; word q;
	src_push(2, s, 0, 0);
	next();
	while (tk != T_EOF) {
		reserve_R_QBUF((n + 1) * 3);
		R_QBUF[n * 3] = tk; R_QBUF[n * 3 + 1] = tv; R_QBUF[n * 3 + 2] = tline; n++;
		next();
	}
	src_pop();
	q = rt.new(n * 3 + 1);
	q[0] = n;
	rt.copy_w(q + 1, R_QBUF, n * 3);
	return u*q;
}
// feed a token list into the input: the parser reads it next, then carries
// on where it was. the list is freed once it has been read.
int feed(.d q) {
	src_push(1, q, 1, 1);
	next();
	return 0;
}