From ce920b6ff47f32bc06dd27124e1b882f82f3d6ae Mon Sep 17 00:00:00 2001 From: zinc Date: Wed, 14 Oct 2026 10:05:40 +0000 Subject: split compiler.zc into files by phase src/compiler/compiler.zc is now twelve files under src/compiler/, listed in order in src/compiler/parts. cat of the parts in order is byte-identical to the old file, so every compiler and image except the language server's is unchanged. no function was edited. consumers read the list: the makefile, bootstrap-check, genmap (which still writes one compiler.zc into a generated map directory), tinyvm.bat, test.sh, test_win.ps1 and the lsp drivers. the language server embeds each part and serves them joined as the one document tinyvm:/compiler.zc. --- src/compiler/stmt.zc | 816 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 816 insertions(+) create mode 100644 src/compiler/stmt.zc (limited to 'src/compiler/stmt.zc') 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; +} + -- cgit v1.2.3