aboutsummaryrefslogtreecommitdiff
path: root/src/compiler/stmt.zc
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/stmt.zc')
-rw-r--r--src/compiler/stmt.zc816
1 files changed, 816 insertions, 0 deletions
diff --git a/src/compiler/stmt.zc b/src/compiler/stmt.zc
new file mode 100644
index 0000000..a2ad0d1
--- /dev/null
+++ b/src/compiler/stmt.zc
@@ -0,0 +1,816 @@
+// ---- 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;
+}
+
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-27 20:28:24 +0000