diff options
Diffstat (limited to 'src/compiler/expr.zc')
| -rw-r--r-- | src/compiler/expr.zc | 1912 |
1 files changed, 1912 insertions, 0 deletions
diff --git a/src/compiler/expr.zc b/src/compiler/expr.zc new file mode 100644 index 0000000..c6d29c6 --- /dev/null +++ b/src/compiler/expr.zc @@ -0,0 +1,1912 @@ +// ---- expressions ---- + +// every expression leaves its value on the stack, returns its analyzer class, +// and sets xty to its type. lv means the stack holds an address that hasn't +// been loaded yet; structs and arrays are never loaded, their address is +// their value. +// memdebug: the address on top of the stack, checked before a heap load +// (dbg_addr duplicates the address on top and calls the runtime's checkptr on +// the copy, so memdebug catches a load from a freed object) +int dbg_addr() { + if (mdbg && !dry) { + lit(0); + op(O_PICK); + callname(s_check); + op(O_DROP); + } + return 0; +} +// turn an lvalue into a value. when lv is set the stack holds the address of a +// variable, field or element that has not been loaded; rval loads it, unless +// the thing is an array or struct, whose address is its value. every place +// that needs a value calls this after parsing an expression. +int rval() { + if (lv && lvk == LV_LOCAL) { + ltag[lvi] = ltag[lvi] | LREAD; + if (rt.eq_w(lname[lvi], "_") && af_warning(lreadpos[lvi])) { + rt.put_s("discard placeholder `_` is read\nhelp: give the parameter or pattern binding a name when its value is needed"); + af_warning_end(); + } + } + if (lv) { + if (ispk(xty)) pkld(xty); + else if (!isagg(xty)) { dbg_addr(); op(O_LD); } + lv = 0; + } + return 0; +} +// run a keyword's handler (kw_len, kw_struct, a parse word...) from the spot +// where the parser met it. e is 1 in expression position, where statement-only +// keywords refuse to run. the handler reports the class of what it produced +// in xcls. +int kwcall(int s, int e) { + int f = sval[s], old = kw_expr, c, n0 = ntok; + kw_expr = e; xcls = C_PLAIN; xty = tword; xzero = 0; + f(); xaf = 0; xvk = 0; + // a handler that never reads a token (not even its own name) would be called + // again on the same token forever, so it is an error, and the token is skipped + if (ntok == n0) die("a parse word has to read its own name with next()"); + xbor = -1; + kw_expr = old; + c = xcls; + lv = 0; lvk = LV_NONE; + return c; +} +// report an error when a statement is used inside an expression. +int stmtonly() { + if (kw_expr) serr("this can't be used inside an expression"); + return 0; +} +// the arguments of a call. ft is the callee's type (or 0), bs the generic bindings +// (tags packs two bits per parameter: 0 lend, 1 .m, 2 .d. bs collects type +// parameter bindings as the argument types are unified with the signature. +// fat asks for every pointer argument to be fattened first, for o3 code +// calling code that is not o3.) +int args(int tags, word ft, int bs, int fat) { + int np = 0, c, pt, t, cs = ifcall, freeing = 0, harmless = 0; word first = 0; int origin = -1, anytemp = 0, current, tag, place, parameter_base = effect_argument_base, owner = -1, current_owner, owner_seen = 0, aliases; word origins = 0, current_mask, owner_fact = 0; + if (cs >= 0 && cs < ubase) { + freeing = sname[cs] == s_free || sname[cs] == s_recycle; + harmless = sname[cs] == s_put_s || rt.eq_w(sname[cs], "rt.put_n") || rt.eq_w(sname[cs], "rt.put_c") || rt.eq_w(sname[cs], "len") || rt.eq_w(sname[cs], "cap"); + } + xgive = 0; ifcall = 0 - 1; effect_argument_base = 0; + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + word expected = closure_expected; + closure_expected = 0; + if (ft && np + parameter_base < ft[3] && is_id(s_fn)) closure_expected = subst(ft[7 + np + parameter_base], bs); + place = tpack(); c = expr(); rval(); closure_expected = expected; + current = effect_origin(c); current_mask = effect_mask(c); origins = origins | current_mask; effect_args_mask(cs, np + parameter_base, current_mask); + if (!np) origin = current; else if (origin != current) origin = -1; + tag = (tags >> (np + np)) & 3; + current_owner = xbor; + if (c >= C_VAR && tracked(c - C_VAR)) current_owner = lroot(c - C_VAR); + if (tag <= 1 && current_owner >= 0 && tracked(current_owner)) effect_require_mode(cs, np + parameter_base, place, 1); + aliases = effect_get(cs, np + parameter_base); + if (aliases & (EF_ALIAS | EF_IDENTITY | EF_UNKNOWN)) { + if (!owner_seen) { owner = current_owner; owner_fact = xaf; owner_seen = 1; } + else if (owner != current_owner) { owner = -1; owner_fact = 0; } + } + if (fchk && c == C_FRESH && tag != 2) { + if (!(cs < 0 && tag == 1)) effect_require(cs, np + parameter_base, place); emit_borrow_hold(); c = C_PLAIN; anytemp = 1; + } + if (xaf && xaf[2] == 5) { anytemp = 1; if (!(cs < 0 && tag == 1)) effect_require(cs, np + parameter_base, place); } + if (fchk && xaf && xaf[2] == 4 && (isptr(xty) || isagg(xty)) && !(cs < 0 && tag == 1)) effect_require(cs, np + parameter_base, place); + if (!np) first = xaf; + if (!freeing && !harmless && (effect_get(cs, np + parameter_base) & (EF_WRITE | EF_RETAIN | EF_CONSUME | EF_UNKNOWN))) af_escape(xaf); + if (ifs && if_value && cs >= 0 && sname[cs] == s_new && !np) if_join(if_value, tint); + if (cs >= 0) if_arg(cs, np + parameter_base, xty, xzero); + if (if_value && cs >= 0 && np + parameter_base < IFP) { + word infer_callee = if_get(cs); + if (infer_callee) { + if (ft && np + parameter_base < ft[3]) if_join(infer_callee + 8 + 3 * (np + parameter_base), subst(ft[7 + np + parameter_base], bs)); + if_link(if_value, infer_callee + 8 + 3 * (np + parameter_base)); + } + } + if (ft && np + parameter_base < ft[3]) fcoerce(subst(ft[7 + np + parameter_base], bs)); + t = xty; + argcheck(c, (tags >> (np + np)) & 3); + // o3 data handed to normal code + if (fat && hasptr(t)) { + lit(t); + callname(s_fatten); + xty = t; + } + if (ft && np + parameter_base < ft[3]) { + pt = ft[7 + np + parameter_base]; + if (cs >= 0 && sname[cs] == s_put_s && np == 0 && xstr) pt = tbstr; + if (!unify(pt, xty, bs)) tcerr("argument", subst(pt, bs), xty); + } + np++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + argfact = first; argorigin = origin; argorigin_mask = origins; argtemporary = anytemp; argowner = owner; argowner_fact = owner_fact; xaf = 0; vf_effect(); + return np; +} +// memdebug records the source line on the next new, via the runtime global +// memdebug: store the current line in the runtime's alloc_line just before an +// allocation, so a leak report can say where the object came from +int stamp_site() { + int s; + if (!mdbg || dry || o3on) return 0; + s = lookup(s_alloc); + if (s < 0) return 0; + lit(tline); lit(sval[s]); op(O_ST); + return 0; +} +// new(T) and new(T, count): a typed object, its type stamped into the header +// new(T), new(T, n), new(T[?]), new(fixed T[?], n). a growable array goes to +// dnew. otherwise the call is new_t(size, type), unless the size is known at +// compile time and we are not in o3 or a dry run: then the size class is +// computed here and the call is new_k(size, type, class), which pops a block +// straight off the class list. newsz and newleaf record what was allocated so +// the variable it lands in can later be freed with the matching fast path. +int newtyped() { + word t; int c, fast = 0, length = 1, place = tpack(); + t = ptype(); + if (t[0] == TY_DYN) { // a growable array: element size, length, type + if (tbytes(t[4])) lit(0 - tbytes(t[4])); else lit(tsz(t[4])); // packed elements say so with a negative size: minus their bytes + if (accept(s_comma)) { c = expr(); rval(); plainuse(c); length = -1; if (xconst && xcval >= 0) length = xcval; } + else { length = 0; lit(0); if (t[3]) serr("a fixed array needs its length: new(fixed T[?], n)"); } + lit(t); + expect(s_rp); + stamp_site(); + callname(s_dnew); vf_effect(); + xaf = af_new(length, 3, place); + lv = 0; lvk = LV_NONE; xty = t; xzero = 0; xstamp = 1; + return C_FRESH; + } + if (accept(s_comma)) { + c = expr(); rval(); plainuse(c); + length = -1; if (xconst && xcval >= 0) length = xcval; + if (tbytes(t)) { // packed: n elements take (n * bytes + 7) / 8 words + if (tbytes(t) != 1) { lit(tbytes(t)); op(15); } + lit(7); op(O_ADD); lit(3); op(19); + } else if (tsz(t) != 1) { lit(tsz(t)); op(15); } + lit(tarr(t, 0)); + newsz = -1; newleaf = 0; + } else { + lit(tsz(t)); lit(t); + newsz = tsz(t); newleaf = 0; + if (isleaf(t)) newleaf = t; + if (!o3on && !dry && lookup(s_new_k) >= 0) { lit(szclass(newsz)); fast = 1; } + } + expect(s_rp); + stamp_site(); + if (fast) callname(s_new_k); else callname(s_new_t); vf_effect(); + xaf = af_new(length, 2, place); + lv = 0; lvk = LV_NONE; xty = tptr(t); xzero = 0; xstamp = 1; + return C_FRESH; +} +// ld8/st8 and the 16- and 32-bit pair. 0 when this call should stay a call. +// a store's opcode is odd: the arguments arrive address then value, and the +// opcode wants the address on top. +// (the byte-access functions become single opcodes inside o3 code) +int byteop(int s) { + if (sname[s] == s_ld8) return 612; + if (sname[s] == s_st8) return 613; + if (sname[s] == s_ld16) return 614; + if (sname[s] == s_st16) return 615; + if (sname[s] == s_ld32) return 616; + if (sname[s] == s_st32) return 617; + return 0; +} +// ---- type facts ---- + +// annotate mode (the language server asks for it, ifon) collects the types the +// untyped declarations of a document could be given, as edits: a place, how +// many chars it replaces (0 inserts) and the text. a local gets the type of +// its initializer, a parameter the type every call passes it, and a function +// the type of what it returns. only types that change nothing are offered: no +// floats and no sized integers, because a typed one converts or cuts to size +// where the untyped word did not, so the annotated program is the same program. +// the declarations are found while they compile, the calls too, and the +// edits are written at the end of the unit, when every call has been seen. +// a type that can be written in front of a name and changes nothing +word ifpure(word t) { + int k; + if (!t || t == tword || t == tvoid) return 0; + k = t[0]; + if (k == TY_INT) return t[5] == 0; + if (k == TY_CHAR || k == TY_BOOL || k == TY_STRUCT || k == TY_BSTR) return t[2] != 0; + if (k == TY_PTR) { + k = t[4][0]; + if (k == TY_ARR || k == TY_DYN || k == TY_FN) return 0; + return t[4] == tword || ifpure(t[4]); + } + if (k == TY_ARR || k == TY_DYN) return t[4] == tword || ifpure(t[4]); + return 0; +} +// one edit: the token at place p is replaced by the type t and then the text +// after (len < 0: the token's own length; 0: nothing is replaced) +int fact_add(int p, int len, int t, int after) { + int sv, o, at, n; word e; int osm = rt.outmode, osb = rt.outbuf, osn = rt.outn, osc = rt.outcap; + // the text is printed with tprint into the pool: output mode 2 writes into outbuf + if (!ifx || dry || panic || chkabort) return 0; + sv = tpack(); tunpack(p); o = toff; if (len < 0) len = toklen; tunpack(sv); + if (o < 0) return 0; + at = nift; + rt.outn = 0; rt.outmode = 3; tprint(t); rt.put_s(after); n = rt.outn; + if (nifx >= ifxcap) { ifxcap = ifxcap * 2; ifx = chk_resize(ifx, nifx * 4, ifxcap * 4); } + if (at + n > iftcap) { while (at + n > iftcap) iftcap = iftcap * 2; ift = chk_resize(ift, at, iftcap); } + rt.outbuf = ift + at; rt.outn = 0; rt.outcap = n; rt.outmode = 2; + tprint(t); rt.put_s(after); + n = rt.outn; + rt.outmode = osm; rt.outbuf = osb; rt.outn = osn; rt.outcap = osc; + e = ifx + nifx * 4; + e[0] = o; e[1] = len; e[2] = at; e[3] = n; + nifx++; nift = at + n; + return 0; +} +// the record of function symbol s: calls can come before the definition +word if_get(int s) { + int id; word r; + if (!ifs || s < 0 || s >= symcap) return 0; + id = ifs[s]; + if (id) return ifr[id - 1]; + if (nif >= ifrcap) { ifrcap = ifrcap * 2; ifr = chk_resize(ifr, nif, ifrcap); } + nif++; ifs[s] = nif; + r = chk_resize(0, 0, IFW); ifr[nif - 1] = r; + rt.fill_w(r, 0, IFW); + r[0] = s; + return r; +} +// a state is 0 (nothing seen), a type, or -1 (no single type): p points at it +int if_join(word p, int t) { + if (!t || t == tword) return 0; + if (*p == 0 - 1) return 0; + if (!ifpure(t)) *p = 0 - 1; + else if (!*p) *p = t; + else if (*p != t) *p = 0 - 1; + return 0; +} +// equal type flows connect caller parameters, callee parameters and results. +// nodes are addresses of inference states, retained by the function records. +int if_link(word a, word b) { + word edge; + if (!ifs || !a || !b || a == b || dry) return 0; + edge = chk_resize(0, 0, 3); edge[0] = if_edges; edge[1] = a; edge[2] = b; if_edges = edge; + return 0; +} +int if_solve() { + word edge, a, b, record; int changed = 1, left, right, index = 0; + while (index < nif) { + record = ifr[index]; + if (!record[3] && (!record[2] || !record[1])) record[3] = -1; + index++; + } + while (changed) { + changed = 0; edge = if_edges; + while (edge) { + a = edge[1]; b = edge[2]; left = *a; right = *b; + if (left == -1 || right == -1 || (left && right && left != right)) { *a = -1; *b = -1; } + else if (left) *b = left; else if (right) *a = right; + if (*a != left || *b != right) changed = 1; + edge = edge[0]; + } + } + return 0; +} +// argument j of a call of s has the type t (a literal 0 says nothing: it is a +// null pointer as often as a number) +int if_arg(int s, int j, int t, int zero) { + int r; + if (!ifs || dry || j >= IFP || zero) return 0; + r = if_get(s); + if (r) if_join(r + 8 + 3 * j, t); + return 0; +} +// a function at the top level starts: its header is at ifkp and ifkk says how +// to edit it (1: fn becomes the type, 2: the type goes in front of a .u) +int if_begin(int s, int k) { + word r = if_get(s); + ifcur = 0; + if (!r) return 0; + r[2] = 1; r[5] = ifkp; r[6] = k; + ifcur = r; + return 0; +} +// parameter j: p is where its type would go, kind 0 for a typed one, 1 to +// insert the type and a space, 2 to insert it right in front of a tag +int if_param(int j, int p, int kind, word type) { + word r = ifcur; + if (!r || j >= IFP) return 0; + if_join(r + 8 + 3 * j, type); r[9 + 3 * j] = p; r[10 + 3 * j] = kind; + if (kind) r[7] = j + 1; + return 0; +} +// a return statement: t is what it returns, zero if that is a bare 0 +int if_ret(int t, int zero) { + word r = ifcur; + if (!r || nclo || dry) return 0; + r[1] = 1; + if (if_value && !zero) if_link(r + 3, if_value); + if (zero) r[4] = 1; else if_join(r + 3, t); + return 0; +} +// the function ends: which of its parameters were used as addresses +int if_fin() { + word r = ifcur; int j = 0; + while (j < r[7]) { + if (lptr[lbase + j]) r[10 + 3 * j] = r[10 + 3 * j] | 4; + j++; + } + return 0; +} +// the edits of every function, once all the calls have been seen +int if_emit() { + int i = 0, j; word r; int t, k; + if_solve(); + while (i < nif) { + r = ifr[i]; + i++; + if (!r[2]) continue; + j = 0; + while (j < r[7]) { + k = r[10 + 3 * j]; t = r[8 + 3 * j]; + if ((k & 3) && !t && (k & 4)) t = tptr(tword); // no call says more, but the body uses it as an address + if ((k & 3) == 1 && t > 0) fact_add(r[9 + 3 * j], 0, t, " "); + else if ((k & 3) == 2 && t > 0) fact_add(r[9 + 3 * j], 0, t, ""); + j++; + } + t = r[3]; + if (r[1] && t != 0 - 1) { + if (!t && r[4]) t = tint; + if (t && r[6] == 1) fact_add(r[5], 0 - 1, t, ""); + else if (t && r[6] == 2) fact_add(r[5], 0, t, ""); + } + } + return 0; +} +// ---- hints ---- + +// findings that are not errors. each is written only in check mode, through +// hint_begin, and none of them changes the code the compiler emits. +int magic(int v) { + if (literal_documented(toff) || !hint_begin(tpack(), HINT_ALL)) return 0; + rt.put_s("unannotated numeric literal "); rt.put_n(v); + rt.put_s("\nhelp: use a named constant or add an inline block comment before the literal to suppress this hint"); + dg_close(); + return 0; +} +// warn that a new inside a loop allocates on every pass. +int newloop(int p) { + if (!hint_begin(p, HINT_SMALL)) return 0; + rt.put_s("new inside a loop allocates on every pass; allocate once above the loop if the object can be reused"); + dg_close(); + return 0; +} +// hint when a shift by v is past the width of the value. +int shifthint(int p, int v) { + int k = 0; + if (!hint_begin(p, HINT_ALL)) return 0; + while ((1 << k) < v) k++; + rt.put_s("multiplying by "); rt.put_n(v); rt.put_s(" is a shift; write << "); rt.put_n(k); + dg_close(); + return 0; +} +// a call to function symbol s, with the callee name already consumed and the +// ( next. in order: +// 1. new(...) with a type argument is redirected to newtyped +// 2. in o3 code, untyped new becomes new_oz and the byte accessors turn into +// opcodes +// 3. the arguments are parsed against the signature (args), checking each +// against its parameter tag; generic type parameters are bound here +// 4. free whose argument was a given-away last pointer becomes recycle; a +// constant-size new becomes new_k with its class; put_s of a byte string +// becomes put_bs +// 5. the call is emitted (fnref pushes the address, or a patch site if the +// function isn't defined yet) +// 6. the result's type and class are set: .u functions return C_FRESH, which +// is how the analyzer knows the caller now owns a new object +int call(int s) { + int np, tags = 0, ret = 0; word ft = stype[s]; word[8] bs; int rs, rhs_type = 0, kop, cp = callpos, original = s; word storage; int origin, temporary, owner; word origins, owner_fact; + word requirements = effect_requirements, edges = effect_edges; + borrow_depth++; + if (sname[s] == s_new && skind[s] == K_FN) { + peek(); + if (pk_tk == T_OP && pk_tv == s_lk) { next(); borrow_depth--; return newtyped(); } + if (pk_tk == T_ID && (istypename(pk_tv) || pk_tv == s_fn)) { next(); borrow_depth--; return newtyped(); } + } + if (o3on && sname[s] == s_new) { tags = lookup(s_new_oz); if (tags >= 0) s = tags; tags = 0; } + if (o3on) { + kop = byteop(s); + if (kop) { + np = args(0, 0, bs, 0); + if (kop & 1) { + if (np != 2) serrn(sname[s], "wrong number of arguments"); + op(O_SWAP); op(kop); lit(0); + } else { + if (np != 1) serrn(sname[s], "wrong number of arguments"); + op(kop); + } + lv = 0; lvk = LV_NONE; xty = tword; xzero = 0; xbor = -1; + xfloat = 0; xstr = 0; xlenloc = -1; xstamp = 0; + borrow_depth--; return C_PLAIN; + } + } + if (sflag[s] & F_SIG) { tags = ssig[s] >> 6; ret = ssig[s] & 1; } + else sflag[s] = sflag[s] | F_UNTYPED; + if (sflag[s] & F_RETOWN) ret = 1; + rt.fill_w(bs, 0, 8); + if (ngbind) { rt.copy_w(bs, gbind, ngbind); ngbind = 0; } + np = 0; + if (o3on && !(sflag[s] & F_O3) && sname[s] != s_free && sname[s] != s_recycle) np = 1; // o3 calling normal code: fatten the arguments + ifcall = s; effect_argument_base = 0; + np = args(tags, ft, bs, np); + storage = argfact; origin = argorigin; origins = argorigin_mask; temporary = argtemporary; owner = argowner; owner_fact = argowner_fact; + if (original < ubase && (sname[original] == s_free || sname[original] == s_recycle)) af_end(storage, cp); + if (sflag[s] & F_GEN) { int template = s; s = ginstance(s, bs); effect_specialize(template, s, requirements, edges); } + if (sname[s] == s_free && xgive) { // the last pointer: straight back to the size-class list + rs = lookup(s_recycle); + if (rs >= 0) s = rs; + } + if ((sflag[s] & F_SIG) && np != ((ssig[s] >> 1) & 31)) serrn(sname[s], "wrong number of arguments"); + if (sname[s] == s_new) { + stamp_site(); newsz = -1; newleaf = 0; + if (np == 1 && xconst && xcval >= 0) newsz = xcval; + xaf = af_new(newsz, 2, cp); + if (lsp > 0) newloop(cp); + // a constant size: the class is known now, so use the allocator's direct path + if (newsz >= 0 && !o3on && !dry && lookup(s_new_k) >= 0) { + lit(0); + lit(szclass(newsz)); + s = lookup(s_new_k); + } + } + if (sname[s] == s_put_s && np == 1 && xstr) { + s = lookup(s_put_bs); + if (s < 0) s = fwdfn(s_put_bs); + } + if (!(sflag[s] & F_DEF) || s == finsym) sflag[s] = sflag[s] | F_EARLY; // called before its body: an owned return is not inferred for it + if (sflag[s] & F_EXT) { lit(sval[s][-1]); op(620); } // an extern: the native call opcode, with the block's address + else { fnref(s); op(O_CALL); } + if (!o3on && (sflag[s] & F_O3) && ft) { // non-o3 called o3: fatten the result here, not inside the callee + rhs_type = subst(ft[4], bs); + if (hasptr(rhs_type)) { lit(rhs_type); callname(s_fatten); } + } + xstr = 0; + if (sname[s] == s_cat_s || sname[s] == s_slice_s || sname[s] == s_n_to_s || sname[s] == s_new_s) { + xstr = 1; + } + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; xconst = 0; + xty = tword; + if (ft) xty = subst(ft[4], bs); + if (xstr || xty == tbstr) { xstr = 1; xty = tbstr; } + xfloat = 0; + if (isfl(xty)) xfloat = 1; + xlenloc = -1; xstamp = 0; + if (o3on && (sflag[s] & F_O3) && ft && hasptr(xty)) xstamp = 1; + borrow_depth--; effect_value = 0; + if (!ret && (isptr(xty) || xty == tword)) { + effect_value = origins; + if (owner >= 0 && (isptr(xty) || (effect_get(original, 0) & EF_IDENTITY))) xbor = owner; + if (owner_fact && (effect_get(original, 0) & EF_IDENTITY)) xaf = owner_fact; + if (origin >= 0 && owner < 0) { int oi = lbase; while (oi < nloc) { if (lrskind[oi] == RS_PARAM && oi - lbase == origin) { xbor = oi; break; } oi++; } } + if (temporary) { int ai = 0, aliases = 0; while (ai < np) { aliases = aliases | effect_get(original, ai); ai++; } if (aliases & (EF_ALIAS | EF_UNKNOWN)) xaf = af_new(-1, 5, cp); } + } + if_value = 0; + if (ifs && !dry) { + word result_node = if_get(original); + if (result_node) { + if (sname[original] == s_new && !result_node[3]) result_node[3] = tword; + else if_join(result_node + 3, xty); + if_value = result_node + 3; + } + } + if (ret) return C_FRESH; + return C_PLAIN; +} +// an enhancement used like a function: the arguments, then its one opcode +// an enhancement (a custom opcode declared with "enhance") called like a +// function. it compiles to the one opcode, or to a call of its fallback +// function when the cpu does not have the opcode. +int enhcall(int s) { + int nin = ssig[s] & 15, nout = (ssig[s] >> 4) & 15, n = 0, c; + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + c = expr(); + rval(); + plainuse(c); + n++; + if (!accept(s_comma)) break; + } + } + expect(s_rp); + vf_effect(); + if (n != nin) serrn(sname[s], "wrong number of inputs"); + lv = 0; lvk = LV_NONE; xty = tword; xzero = 0; xbor = -1; xlenloc = -1; xstamp = 0; + if (sflag[s] & F_FALLBACK) { fnref(sfix[s] - 1); op(O_CALL); return C_PLAIN; } + op(XOP0 + sval[s]); + if (nout == 0) lit(0); + if (nout > 1) serrn(sname[s], "leaves several values; use it from asm"); + return C_PLAIN; +} +// ---- closures ---- + +// fn(a, b) { ... } is a function whose last, hidden parameter is a pointer to +// its environment. the closure value is a heap block: word 0 is the body's +// entry, and the captured variables start at word 3. the block itself is never +// run as code. callable_code distinguishes plain function addresses, including +// linked heap code segments, from closure blocks. a plain function is called +// as it is. a closure is called with block + 3 as its env, at the entry in +// word 0. a capture is a shared cell. the enclosing function and every closure +// read and write the same value; cells remain reachable through escaping closures. +// scan with the compiler lexer, restoring its source and lookahead. only functions containing a closure +// need cells; their scalars get cells from declaration time, so loop back edges and earlier references agree. +int capture_scan() { + word old, f; int depth = 1, found = 0, docs = docs_on, record = grec; + if (isp < 0 || R_SRC[isp * 32] == 0 || !is_op(s_lb)) return 0; + old = R_SRC + isp * 32; + src_push(1, capture_dummy, 0, 0); old = R_SRC + (isp - 1) * 32; f = R_SRC + isp * 32; + f[0] = old[0]; f[1] = old[1]; f[2] = old[2]; f[3] = old[3]; f[4] = 0; pq_n = f[14]; + docs_on = 0; grec = 0; dry++; + while (depth) { + next(); if (tk == T_EOF) break; + if (is_op(s_lb)) depth++; + else if (is_op(s_rb)) depth--; + else if (is_id(s_fn)) { peek(); if (pk_tk == T_OP && (pk_tv == s_lp || pk_tv == s_colon)) found = 1; } + } + dry--; src_pop(); docs_on = docs; grec = record; return found; +} +int capture_cell(int i, int copy) { + if (!capture_enabled || o3on || (ltag[i] & 16) || larr[i] || local_cell[i]) return 0; + if (copy) { laddr(lslot[i]); op(O_LD); } + lit(1); lit(ltype[i]); callname(s_new_t); callname(intern("share")); + if (copy) { lit(0); op(O_PICK); laddr(lslot[i]); op(O_ST); op(O_ST); } + else { laddr(lslot[i]); op(O_ST); } + local_cell[i] = 1; return 0; +} +int capture_prepare() { + int i = lbase; capture_enabled = capture_scan(); + if (!capture_enabled) return 0; + while (i < nloc) { if (lrskind[i] == RS_PARAM) capture_cell(i, 1); i++; } + return 0; +} +// grow closure frames and capture rows while keeping closure and capture indices. +int reserve_closures(int need) { + int cap = closure_cap; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + clo_lo = chk_resize(clo_lo, nclo, cap); + clo_hi = chk_resize(clo_hi, nclo, cap); + clo_n = chk_resize(clo_n, nclo, cap); + clo_env = chk_resize(clo_env, nclo, cap); + clo_ret = chk_resize(clo_ret, nclo, cap); + clo_name = chk_resize(clo_name, nclo * capture_width, cap * capture_width); + clo_loc = chk_resize(clo_loc, nclo * capture_width, cap * capture_width); + clo_via = chk_resize(clo_via, nclo * capture_width, cap * capture_width); + closure_cap = cap; return cap; +} +int reserve_captures(int need) { + int cap = capture_width, i = 0; char** names; word locals, via; + if (need <= cap) return cap; + while (cap < need) cap = cap * 2; + names = chk_resize(0, 0, closure_cap * cap); + locals = chk_resize(0, 0, closure_cap * cap); + via = chk_resize(0, 0, closure_cap * cap); + while (i < nclo) { + rt.copy_w(names + i * cap, clo_name + i * capture_width, clo_n[i]); + rt.copy_w(locals + i * cap, clo_loc + i * capture_width, clo_n[i]); + rt.copy_w(via + i * cap, clo_via + i * capture_width, clo_n[i]); i++; + } + clo_name = names; clo_loc = locals; clo_via = via; capture_width = cap; return cap; +} +// find or create the capture slot for variable n in the innermost closure +// being compiled: if the name is one of the enclosing function's locals, it is +// recorded once and the body reads its shared cell through the environment. +// a name from further out is captured through each closure in between: the +// closure that encloses this one captures it too, and this one copies it from +// that closure's environment (clo_via is the slot there, -1 for a local). +word clocap(int n) { return clocap_at(nclo - 1, n); } +// the slot of the name n in closure c's captures, adding it when the closure has +// not captured it yet. returns the capture index, or -1 when no such name is visible. +word clocap_at(int c, int n) { + int i = 0, j, base = c * capture_width, r, root; + while (i < clo_n[c]) { if (clo_name[base + i] == n) return i; i++; } + j = clo_hi[c]; + while (j > clo_lo[c]) { + j--; + if (lname[j] != n) continue; + effect_note(effect_origin(C_VAR + j), EF_RETAIN); + root = lroot(j); local_captured[j] = 1; local_captured[root] = 1; + if (lafact[j] && (lafact[j][2] == 1 || lafact[j][2] == 4 || lafact[j][2] == 5)) serrn(n, "a stack or temporary borrow cannot escape through a closure"); + if (root != j && lname[root]) { clocap_at(c, lname[root]); base = c * capture_width; } + if (ltag[j] & 16) serrn(n, "an o3 variable cannot be captured by reference; use an ordinary local"); + if (larr[j]) serrn(n, "an array can't be captured; capture a pointer to it"); + reserve_captures(clo_n[c] + 1); base = c * capture_width; + clo_name[base + clo_n[c]] = n; clo_loc[base + clo_n[c]] = j; clo_via[base + clo_n[c]] = 0 - 1; clo_n[c]++; + return clo_n[c] - 1; + } + if (c == 0) return 0 - 1; + r = clocap_at(c - 1, n); base = c * capture_width; + if (r < 0) return 0 - 1; + reserve_captures(clo_n[c] + 1); base = c * capture_width; + clo_name[base + clo_n[c]] = n; clo_loc[base + clo_n[c]] = clo_loc[(c - 1) * capture_width + r]; clo_via[base + clo_n[c]] = r; clo_n[c]++; + return clo_n[c] - 1; +} +// closure environments retain precise capture-cell types for runtime reflection. +word closure_layout(int closure_index, int count) { + word t = tnew(TY_STRUCT, 3 + count, 0, 0), fields = talloc((3 + count) * 3); int i = 0, local; + t[3] = 3 + count; t[4] = fields; + while (i < 3 + count) { + fields[i * 3 + 2] = i; + if (i < 3) fields[i * 3 + 1] = tword; + else { local = clo_loc[closure_index * capture_width + i - 3]; fields[i * 3 + 1] = tptr(ltype[local]); } + i++; + } + return t; +} +// fn(params) { body } as an expression. the body is compiled in place behind +// a jump (hop) as a nested function with a hidden last parameter, env. when +// the code that creates the closure runs, it allocates the block (code, then +// captured values), writes the three code words and copies each captured +// variable in. ctx_push / ctx_pop save and restore the enclosing function's +// compiler state around the body. +int closure() { + int np = 0; char*[20] pn; word[20] pty; int hop, entry, i, t, envl, ncap, c, result, declared = 0, tags = 0, tag; word[20] ptags; + word expected = closure_expected; closure_expected = 0; + reserve_closures(nclo + 1); + if (o3on) serr("closures can't be made inside an o3 region"); + next(); + // fn:type(args) names the result; returns are coerced and checked against it + if (accept(s_colon)) declared = ptype0(); + expect(s_lp); + if (!is_op(s_rp)) { + while (1) { + pty[np] = tword; + if (expected && expected[0] == TY_FN && np < expected[3]) pty[np] = expected[7 + np]; + if (!is_op(s_dot) && paramstart()) { + pty[np] = ptype(); if (pty[np][0] == TY_ARR) pty[np] = decay(pty[np]); + } + tag = 0; + if (accept(s_dot)) { if (is_id(s_m)) tag = 1; else if (is_id(s_d)) tag = 2; else die("a parameter tag is .m or .d"); next(); } + ptags[np] = tag; if (np < 12) tags = tags | (tag << (np + np)); else if (tag) die("only the first 12 parameters can be tagged"); + if (expected && expected[0] == TY_FN && !tag && (isptr(pty[np]) || pty[np][0] == TY_DYN || pty[np][0] == TY_FN)) ptags[np] = 1; + pnoffs[np] = toff; pnplaces[np] = tpack(); rs_note(RS_PARAM, toff); pn[np] = name(); + np++; + if (np >= 20) { die("too many parameters"); break; } + if (!accept(s_comma)) break; + } + } + expect(s_rp); + ctx_push(); ifcur = 0; ifcall = -1; + clo_lo[nclo] = lbase; clo_hi[nclo] = nloc; clo_n[nclo] = 0; clo_ret[nclo] = 0; + nclo++; + hop = hole(); op(O_JMP); + entry = here; + fn_begin(1, 0); + if (declared) fty = declared; + prologue(); borrow_prologue(); + i = 0; + while (i < np) { + t = newloc(pn[i]); lrskind[t] = RS_PARAM; lrsoff[t] = pnoffs[i]; lpos[t] = pnplaces[i]; fslots++; lsmark(1, pn[i]); + ltype[t] = pty[i]; + if (fchk && ptags[i] == 1) lstate[t] = S_BORROW; + if (fchk && ptags[i] == 2) { lstate[t] = S_M; lown[t] = 1; } + if (isfl(pty[i])) setflt(t, 1); + i++; + } + envl = newloc(intern("<env>")); fslots++; + clo_env[nclo - 1] = envl; + i = np + 1; + while (i) { i--; laddr(i); op(O_ST); } + body(); + result = clo_ret[nclo - 1]; + if (result <= 0 || live) result = tword; + if (declared) result = declared; + epilogue(); + nclo--; + c = nclo; + ncap = clo_n[c]; + setlit(hop, here); + ctx_pop(); + if (probe_off >= 0 && probe_has == 1 && tpend <= probe_off && !ginst) probe_snap(); // past the closure: what the function around it has + // the block: [push env][push body][jump] and the captured values + // the block: word 0 is the body's entry, words 3 on are the captured values. + // a call through the closure pushes block + 3 as the env and jumps to word 0. + lit(3 + ncap); lit(closure_layout(c, ncap)); callname(s_new_t); + lit(entry); lit(1); op(O_PICK); op(O_ST); + i = 0; + while (i < ncap) { + t = clo_loc[c * capture_width + i]; + if (clo_via[c * capture_width + i] < 0) { + touch(t); effect_note_mask(effect_mask(C_VAR + t), EF_RETAIN); ev_put(t, EV_CAPTURE, -1); + if (cmode && !dry) { lvescaped[t] = 1; lvkind[t] = 0; } + if (!isalias(t)) { vaddr(t); op(O_LD); callname(intern("share")); op(O_DROP); } + vaddr(t); + } + else { vaddr(clo_env[c - 1]); op(O_LD); lit(clo_via[c * capture_width + i]); op(O_ADD); op(O_LD); } + lit(1); op(O_PICK); lit(3 + i); op(O_ADD); op(O_ST); + i++; + } + lv = 0; + lvk = LV_NONE; + xzero = 0; + xbor = -1; + xconst = 0; + xfloat = 0; + xstr = 0; + xlenloc = -1; + xstamp = 0; + xty = tfn(result, np, pty, np + np + tags * 64); + return C_FRESH; +} + +// ---- array initializer lists and compound literals ---- + +// keep original token places while measuring and replaying an initializer. measurement never evaluates +// value expressions: values run once, in source order, after zero filling the storage. +word array_tokens() { + word q = chk_resize(0, 0, 97); int cap = 32, n = 0, depth = 0; + while (tk != T_EOF) { + if (n == cap) { cap = cap * 2; q = chk_resize(q, n * 3 + 1, cap * 3 + 1); } + q[1 + n * 3] = tk; q[2 + n * 3] = tv; q[3 + n * 3] = tpack(); n++; + if (is_op(s_lb)) depth++; + if (is_op(s_rb)) depth--; + next(); if (!depth) break; + } + if (depth) die("unterminated array initializer"); + q[0] = n; return q; +} +word array_string_tokens(word t) { + int count, i = 0, place = tpack(); char* text = tv; word q; + count = rt.len_w(text); + if (t[3] >= 0 && t[3] == count) count--; // the array has no room for the optional terminating zero + q = chk_resize(0, 0, (count + 3) * 6 + 1); q[0] = 1; + q[1] = T_OP; q[2] = s_lb; q[3] = place; + while (i <= count) { + if (i) { q[1 + q[0] * 3] = T_OP; q[2 + q[0] * 3] = s_comma; q[3 + q[0] * 3] = place; q[0]++; } + q[1 + q[0] * 3] = T_NUM; q[2 + q[0] * 3] = text[i]; + q[3 + q[0] * 3] = place; q[0]++; i++; + } + q[1 + q[0] * 3] = T_OP; q[2 + q[0] * 3] = s_rb; q[3 + q[0] * 3] = place; q[0]++; + next(); return q; +} +word array_initializer_tokens(word t) { + if (tk == T_STR || tk == T_BSTR) return array_string_tokens(t); + return array_tokens(); +} +int array_skip_value() { + int depth = 0; + while (tk != T_EOF) { + if (!depth && (is_op(s_comma) || is_op(s_rb))) break; + if (is_op(s_lp) || is_op(s_lk) || is_op(s_lb)) depth++; + if (is_op(s_rp) || is_op(s_rk) || is_op(s_rb)) depth--; + next(); + } + return 0; +} +int ar_flat; word ar_target; +int array_scalar_count(word t) { + if (t[0] != TY_ARR) return 1; + if (t[3] < 0) return 0; + return t[3] * array_scalar_count(t[4]); +} +// a chain [row][column] selects a subarray or scalar; flat positions resume after that subobject. +int array_designator(word t) { + int index, stride; word part = t; + ar_flat = 0; + while (accept(s_lk)) { + index = cexpr(); expect(s_rk); + if (index < 0) { serr("a negative array designator"); index = 0; } + if (part[0] != TY_ARR) { serr("too many indices in array designator"); break; } + if (part[3] >= 0 && index >= part[3]) serr("array designator index is out of range"); + stride = array_scalar_count(part[4]); if (!stride) { serr("array designator needs a complete element type"); stride = 1; } + ar_flat = ar_flat + index * stride; part = part[4]; + } + expect(s_eq); ar_target = part; return 0; +} +word array_shape(word t) { + int flat = 0, count = 0, width, stride, end; word elem = t[4], row, target; + expect(s_lb); + while (tk != T_EOF && !is_op(s_rb)) { + stride = array_scalar_count(elem); if (!stride) stride = 1; + target = elem; + if (is_op(s_lk)) { array_designator(t); flat = ar_flat; target = ar_target; } + if (is_op(s_lb)) { + if (target[0] != TY_ARR) { serr("nested initializer needs an array element type"); array_skip_value(); flat++; } + else { + row = array_shape(target); + if (elem[0] == TY_ARR && elem[3] < 0) { elem = row; stride = array_scalar_count(elem); } + width = array_scalar_count(row); flat = flat + width; + } + } else { array_skip_value(); flat++; } + end = (flat + stride - 1) / stride; if (end > count) count = end; + if (t[3] >= 0 && count > t[3]) serr("too many elements in array initializer"); + if (!accept(s_comma)) break; + } + expect(s_rb); + if (t[3] >= 0) count = t[3]; + return tarr(elem, count); +} +word array_measure(word q, word t) { + word result; + src_push(1, q, 0, 0); next(); result = array_shape(t); src_pop(); + if (treadonly(t)) result = tconst(result); + return result; +} +int array_address(int base, int local, int offset) { + if (local) laddr(base + offset); else lit(base + offset); + return 0; +} +// flatten a scalar position while preserving each packed row's independent word alignment. +int array_store_scalar(word t, int flat, int base, int local, int offset) { + int c, at, stride, bytes, value, address, shift, mask; word elem = t; + while (elem[0] == TY_ARR) { + stride = array_scalar_count(elem[4]); if (!stride) stride = 1; + at = flat / stride; flat = flat % stride; + if (elem[4][0] == TY_ARR) offset = offset + at * tsz(elem[4]); + else { flat = at; elem = elem[4]; break; } + elem = elem[4]; + } + if (isagg(elem)) { serr("aggregate array elements need nested initializer lists"); array_skip_value(); return 0; } + if (local) { + c = expr(); rval(); plainuse(c); fcoerce(elem); + if (!compat(elem, xty)) tcerr("array initializer", elem, xty); + if (tbytes(elem)) { array_address(base, 1, offset); lit(8); op(15); lit(flat * tbytes(elem)); op(O_ADD); pkst(elem); } + else { array_address(base, 1, offset + flat * tsz(elem)); op(O_ST); } + } else { + if (isfl(elem) && tk == T_FLT) { value = tv; next(); if (elem == tf32) value = rt.zf2s(value); } + else { value = cnorm(elem, cexpr()); if (isfl(elem)) { value = vf_i2f(value); if (elem == tf32) value = rt.zf2s(value); } } + bytes = tbytes(elem); + if (bytes) { + address = base + offset + (flat * bytes >> 3) + hdelta; shift = ((flat * bytes) & 7) * 8; + mask = ((1 << (bytes * 8)) - 1) << shift; *address = (*address & ~mask) | ((value << shift) & mask); + } else *(base + offset + flat * tsz(elem) + hdelta) = value; + } + return 0; +} +// globals use constant expressions, locals use ordinary expressions. brace elision walks scalar elements. +int array_suboffset(word t, int flat, word target) { + int offset = 0, stride, at; + while (t != target && t[0] == TY_ARR) { + stride = array_scalar_count(t[4]); if (!stride) stride = 1; + at = flat / stride; flat = flat % stride; offset = offset + at * tsz(t[4]); t = t[4]; + } + return offset; +} +int array_values(word t, int base, int local, int offset) { + int flat = 0, total = array_scalar_count(t), stride = array_scalar_count(t[4]), dest, width; + word target; + expect(s_lb); + while (tk != T_EOF && !is_op(s_rb)) { + target = t[4]; + if (is_op(s_lk)) { array_designator(t); flat = ar_flat; target = ar_target; } + if (flat < 0 || flat >= total) { serr("array initializer index is out of range"); array_skip_value(); } + else if (target[0] == TY_ARR && is_op(s_lb)) { + // the selected subarray starts at its scalar position, converted to an in-place word offset. + dest = array_suboffset(t, flat, target); + array_values(target, base, local, offset + dest); flat = flat + array_scalar_count(target); + } else { array_store_scalar(t, flat, base, local, offset); flat++; } + if (!accept(s_comma)) break; + } + expect(s_rb); return 0; +} +int array_initialize(word q, word t, int base, int local) { + if (local && tsz(t)) { array_address(base, 1, 0); lit(0); lit(tsz(t)); callname(intern("fill_w")); op(O_DROP); } + src_push(1, q, 0, 0); next(); array_values(t, base, local, 0); src_pop(); + return 0; +} +int array_literal_tokens(word q, word t) { + if (!infn) { + int base, cells; t = array_measure(q, t); cells = tsz(t); reserve_code(cells); base = here; + while (cells) { emit(0); cells--; } array_initialize(q, t, base, 0); rt.free(q); + if_value = 0; + xty = t; lv = 0; lvk = LV_NONE; xbor = -1; xaf = 0; xconst = 1; xcval = base; + return C_PLAIN; + } + int i = newloc(intern("<array literal>")), place = tpack(); + t = array_measure(q, t); ltype[i] = t; larr[i] = 1; fslots = fslots + tsz(t); + array_initialize(q, t, lslot[i], 1); + lafact[i] = af_new(t[3], 4, place); laaddr[i] = lafact[i]; if (lafact[i]) lafact[i][5] = i; + laddr(lslot[i]); xty = t; lv = 0; lvk = LV_NONE; xbor = i; xaf = lafact[i]; + xzero = 0; xfloat = 0; xstr = 0; xconst = 0; xvk = 0; rt.free(q); + return C_PLAIN; +} +// a typed growable initializer owns a heap handle, filled from temporary in-place values. +int array_dynamic_literal(word t) { + word q = array_tokens(), shape = array_measure(q, tarr(t[4], -1)); + int slot = fslots, cells = tsz(shape), place = tpack(); fslots = fslots + cells; + if (!infn) serr("a growable array initializer requires function scope"); + array_initialize(q, shape, slot, 1); rt.free(q); + if (tbytes(t[4])) lit(0 - tbytes(t[4])); else lit(tsz(t[4])); + lit(shape[3]); lit(t); callname(s_dnew); vf_effect(); + lit(0); op(O_PICK); lit(2); op(O_ADD); op(O_LD); laddr(slot); lit(cells); callname(intern("copy_w")); op(O_DROP); + xty = t; lv = 0; lvk = LV_NONE; xbor = -1; xaf = af_new(shape[3], 3, place); + xzero = 0; xfloat = 0; xstr = 0; xconst = 0; xvk = 0; xstamp = 1; newsz = -1; newleaf = 0; + return C_FRESH; +} +int array_literal(word t) { word q = array_tokens(); return array_literal_tokens(q, t); } +// statement-bearing braces keep block-expression semantics; expression-only braces are array literals. +int brace_primary() { + word q = array_tokens(); int k = 0, depth = 0, block = 0, c; + while (k < q[0]) { + if (q[1 + k * 3] == T_OP) { + if (q[2 + k * 3] == s_lb) depth++; + if (q[2 + k * 3] == s_rb) depth--; + if (q[2 + k * 3] == s_semi && depth == 1) block = 1; + } + k++; + } + if (!block) return array_literal_tokens(q, tarr(tint, -1)); + src_push(1, q, 0, 0); next(); c = blockexpr(); src_pop(); rt.free(q); return c; +} + +// ---- the expression grammar ---- + +// precedence, loosest to tightest: +// expr (assignment, ?:) -> bin (binary operators by precedence) -> +// unary (prefix operators, casts, recasts) -> postfix (index, field, call, +// ++ --, as) -> primary (literals, names, parentheses, blocks, closures) +// each level leaves its value on the stack and sets the x* globals: xty is the +// type, xfloat / xstr say the value is a float or byte string, xzero and +// xconst mark a literal 0 or constant (xcval holds it), xbor names the local a +// pointer value was borrowed from, and lv / lvk / lvi say the stack holds an +// unloaded address and what it is the address of. +// +// primary: one operand. a number, string, parenthesized expression, block +// expression, closure, or a name. a name is looked up in this order: a local +// of the current function, a variable captured by an enclosing closure, then +// the symbol table (keyword, constant, global, enhancement, function). a local +// the analyzer tracks returns C_VAR + its index so the caller can tell which +// variable the value is. +int primary() { + effect_value = 0; xprojection = 0; if_value = 0; + int n, i, s, c, k, npos, sv; word[8] bs0; int ft, mn, ms; + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; + xconst = 0; xfloat = 0; xstr = 0; xlenloc = -1; xstamp = 0; xaf = 0; xvk = 0; + if (tk == T_FLT) { op(OP_FLIT); emit(tv); xvk = 2; xvv = tv; xfloat = 1; xty = tfloat; next(); return C_PLAIN; } + if (tk == T_NUM) { + if (cmode && tv >= 100 && tglue != 3 && !nomagic && (tv & (tv - 1)) && (tv & (tv + 1))) { + magic(tv); + } + lit(tv); xvk = 1; xvv = tv; xzero = tv == 0; xconst = 1; xcval = tv; xty = tint; next(); return C_PLAIN; + } + if (tk == T_BSTR) { xvk = 4; xvv = vf_string(tv); bstrlit(tv); xstr = 1; xty = tbstr; next(); return C_PLAIN; } + if (tk == T_STR) { xvk = 3; xvv = vf_string(tv); strlit(tv); next(); xty = tptr(tchar); return C_PLAIN; } + if (tk == T_OP) { + if (rt.eq_w(tv, "$")) { next(); return quote_tokens(); } + if (tv == s_lp) { next(); c = expr(); expect(s_rp); return c; } + if (tv == s_lb) return brace_primary(); + diefound("expected an expression"); lit(0); xty = tword; return C_PLAIN; + } + if (tk != T_ID) { diefound("expected an expression"); lit(0); xty = tword; return C_PLAIN; } + if (tv == s_fn) { peek(); if (pk_tk == T_OP && (pk_tv == s_lp || pk_tv == s_colon)) return closure(); } + n = tv; callpos = tpack(); + i = findloc(n); + if (i < 0 && nclo) { + k = clocap(n); + if (k >= 0) { + rs_note(RS_LOCAL, 0 - 1); + next(); + i = nclo - 1; + vaddr(clo_env[i]); op(O_LD); lit(k); op(O_ADD); op(O_LD); + i = clo_loc[i * capture_width + k]; + xty = ltype[i]; xfloat = getflt(i); if (isfl(xty)) xfloat = 1; xstr = getstr(i); + lv = 1; lvk = LV_OTHER; + return C_PLAIN; + } + } + if (i >= 0) { + if (if_local) if_value = if_local[i]; + lreadpos[i] = tpack(); + luse(i); effect_note_mask(effect_mask(C_VAR + i), EF_READ); + rs_note(lrskind[i], lrsoff[i]); os_at(toff, i); + xaf = lafact[i]; af_record(toff, xaf); + if (cmode) { xvk = lvkind[i]; xvv = lvvalue[i]; vf_at(rsn - 1, xvk, xvv); } + next(); + if (!fchk && tracked(i)) { + serrn(n, "is tracked by the analyzer and can't be used in unchecked code"); + } + vaddr(i); + xty = ltype[i]; + if (larr[i]) return C_PLAIN; + xfloat = getflt(i); + if (isfl(ltype[i])) xfloat = 1; + xstr = getstr(i); if (xty == tbstr) xstr = 1; + lv = 1; lvk = LV_LOCAL; lvi = i; + if (isalias(i)) { touch(i); xbor = lroot(i); return C_VAR + i; } + if (tracked(i) || lrskind[i] == RS_PARAM || (local_origin_mask && local_origin_mask[i])) return C_VAR + i; + return C_PLAIN; + } + s = source_lookup(n); + if (mstruct && !ginst) { ms = lookup(methname(mstruct, n)); if (ms >= 0 && skind[ms] == K_CONST) s = ms; } + if (s < 0 && rt.eq_w(n, "new")) s = source_lookup(s_new); + if (s >= 0) rs_put(toff, RS_SYM, rs_sym(s), s); + if (s >= 0 && skind[s] == K_KW) { + if (!(sflag[s] & F_EXPR)) dien(n, "can't be used inside an expression"); + return kwcall(s, 1); + } + if (s >= 0 && skind[s] == K_TYPE) { + next(); + if (is_op(s_dot)) { // Struct.name(args): a static function of the struct + c = toff + toklen; + next(); + if (probe_off >= 0 && cmode && !dry && !ginst && incdepth == 0 && probe_off >= c && ((tk == T_ID && probe_off <= toff + toklen) || (tk != T_ID && probe_off <= toff))) { probe_static = n; probe_has = 3; chkabort = 1; } + k = toff; sv = tpack(); mn = name(); + ms = lookup(methname(sname[s], mn)); + if (ms >= 0) rs_put(k, RS_SYM, rs_sym(ms), ms); + if (ms >= 0 && skind[ms] == K_CONST) { // Enum.MEMBER + xvk = 1; xvv = sval[ms]; + lit(sval[ms]); + xty = tint; + if (stype[ms]) xty = stype[ms]; + xzero = sval[ms] == 0; + xconst = 1; + xcval = sval[ms]; + return C_PLAIN; + } + if (ms >= 0 && skind[ms] == K_FN && (sflag[ms] & F_STATIC)) { + if (!is_op(s_lp)) die("a static function is called with ( after its name"); + return call(ms); + } + if (!panic && !dry) { + c = tpack(); tunpack(sv); // the error sits on the member name, where the quick fix replaces it + errat(); rt.put_s(mn); rt.put_s(": is not a static function of this struct"); suggest_member(sname[s], 0, mn, 1); errend(); + tunpack(c); + } + lit(0); + xty = tword; + return C_PLAIN; + } + dien(n, "is a type, not a value"); + lit(0); + xty = tword; + return C_PLAIN; + } + npos = tpack(); + next(); + xty = tword; + if (s >= 0 && skind[s] == K_CONST) { + xvk = 1; xvv = sval[s]; + lit(sval[s]); + xty = tint; + if (stype[s]) xty = stype[s]; + xzero = sval[s] == 0; + xconst = 1; + xcval = sval[s]; + return C_PLAIN; + } + if (s >= 0 && skind[s] == K_GVAR) { + if (cmode) { vf_symbols(); xvk = svkind[s]; xvv = svvalue[s]; vf_at(rsn - 1, xvk, xvv); } + lit(sval[s]); + if (stype[s]) xty = stype[s]; + if (isfl(xty)) xfloat = 1; if (xty == tbstr) xstr = 1; + lv = 1; + lvk = LV_GLOBAL; lvi = s; + return C_PLAIN; + } + if (s >= 0 && skind[s] == K_GARR) { lit(sval[s]); if (stype[s]) xty = stype[s]; return C_PLAIN; } + if (s >= 0 && skind[s] == K_ENH) return enhcall(s); + if (s < 0 && is_op(s_dot)) { + peekat(0); + if (pk_tk == T_ID && lib_file(n)) { + // lib.name before include lib, for a library read from a file: the lexer only joins names of loaded modules + sv = tpack(); tunpack(npos); + errat(); rt.put_s("module access requires `include "); rt.put_s(n); rt.put_s(";`"); errend(); + tunpack(sv); + word link = chk_resize(0, 0, 2); link[0] = missing_imports; link[1] = n; missing_imports = link; + next(); n = methname(n, tv); next(); + } + // Text.itoa with no std: a library's static function, reported as one missing name + else if (pk_tk == T_ID && export_owner(methname(n, pk_tv))) { next(); n = methname(n, tv); next(); } + } + if (s < 0) s = fwdfn_at(n, callpos); + if (is_op(s_lt) && (sflag[s] & F_GEN)) { // f<int, char*>(...) + next(); ngbind = 0; + while (1) { + if (ngbind >= 8) die("too many type arguments"); + gbind[ngbind] = ptype(); + ngbind++; + if (!accept(s_comma)) break; + } + closeangle(); + if (!is_op(s_lp)) { // f<int> alone is that instance, as a function value + rt.fill_w(bs0, 0, 8); rt.copy_w(bs0, gbind, ngbind); ngbind = 0; + ft = stype[s]; + s = ginstance(s, bs0); + fnref(s); + xty = tword; + if (ft) xty = subst(ft, bs0); + return C_PLAIN; + } + } + if (is_op(s_lp)) return call(s); + fnref(s); + if (stype[s]) xty = stype[s]; + return C_PLAIN; +} +// ++ and -- on the address at the top of the stack. post says the old value +// is the result; dlt is +1 or -1. it also updates the loop-bound facts: a +// decrement or a store of an unknown value ends any proof about the variable. +int incdec(int post, int dlt) { + require_mutable(xty); + int t; + if (cmode && !dry) { if (lvk == LV_LOCAL) lvkind[lvi] = 0; else vf_effect(); } xvk = 0; + if (lv && lvk == LV_LOCAL) lafact[lvi] = 0; xaf = 0; + if (!lv) die("++ and -- need something to assign to"); + if (lvk == LV_LOCAL && fchk && tracked(lvi) && !isalias(lvi)) { + cerrn(lvi, "owns an object and can't be incremented"); + } + tcneed(isnum(xty) || xty[0] == TY_PTR || xty == tword, "++ and -- need a number or a pointer", xty); + if (lvk == LV_LOCAL) { + ltag[lvi] = ltag[lvi] | LASG; + setflt(lvi, 0); setstr(lvi, 0); + if (forstep && lvi == ft_iv && dlt == 1) fs_ok = 1; + if (dlt < 0) putfact(lvi, -1, -1); else putfact(lvi, getlo(lvi), -1); + bpoison(lvi); + } + lv = 0; lvk = LV_NONE; xzero = 0; xfloat = 0; xstr = 0; + t = xty; + lit(0); op(O_PICK); + if (ispk(t)) pkld(t); else { dbg_addr(); op(O_LD); } + // a sized integer wraps: the new value is cut to size before it is stored + if (post) { + lit(0); op(O_PICK); lit(dlt); op(O_ADD); + if (tbytes(t)) tnorm(t); + lit(2); op(O_PICK); + if (ispk(t)) pkst(t); else op(O_ST); + } else { + lit(dlt); op(O_ADD); + if (tbytes(t)) tnorm(t); + lit(0); op(O_PICK); lit(2); op(O_PICK); + if (ispk(t)) pkst(t); else op(O_ST); + } + op(O_SWAP); op(O_DROP); + return C_PLAIN; +} +// p.x and p->x: a field of a struct, or of the struct a pointer points at +// the field access after a dot or arrow: c is the class of the left side. a +// field of a typed struct is its offset added to the address. an untyped word +// is searched for the one struct that has that field name (fieldscan). if the +// name is followed by ( it is a method call instead. a pointer-valued field +// of a tracked variable is a borrow of that variable (xbor). +word field(int c) { + int readonly = treadonly(xty); + if_value = 0; + int n, fieldoff, fieldpos, sv; word st; + word borrowed = xaf, base_mask = effect_mask(c); af_use(xaf, tpack(), c); xaf = 0; xvk = 0; int i, b = xbor, k = 0, scanned = 0, ms, de, pmatch = 0; + de = toff + toklen; + next(); + // is the place asked about on this member name (or just after the dot, with none typed) + if (probe_off >= 0 && cmode && !dry && !ginst && incdepth == 0 && probe_off >= de) { + if (tk == T_ID) { if (probe_off <= toff + toklen) pmatch = 1; } + else if (probe_off <= toff) pmatch = 1; + } + fieldpos = tpack(); n = name(); fieldoff = nameoff; + st = xty; + if (st[0] == TY_ARR || st[0] == TY_DYN) { + if (pmatch) probe_member(st); + if (is_op(s_lp) && array_method(n)) { xaf = borrowed; return array_member(c, n); } + if (is_op(s_lp)) { + ms = receiver_method(st, n); + if (ms == -2) serrn(n, "matches more than one receiver method"); + if (ms >= 0) { + rval(); plainuse(c); + if (c >= C_VAR) b = lroot(c - C_VAR); + if (st[0] == TY_ARR && stype[ms][7][0] == TY_DYN) { + int slot = fslots; fslots = fslots + 4; + laddr(slot + 2); op(O_ST); + lit(st[3]); laddr(slot); op(O_ST); lit(st[3]); laddr(slot + 1); op(O_ST); + if (tbytes(st[4])) lit(0 - tbytes(st[4])); else lit(tsz(st[4])); + laddr(slot + 3); op(O_ST); laddr(slot); st = tdyn(st[4], 1); + } + return methcall(ms, st, borrowed, b, base_mask); + } + } + } + rval(); + if (c == C_FRESH) cerr("use a field of a new object only after binding it to a name"); + else if (c >= C_VAR) { touch(c - C_VAR); b = c - C_VAR; } + st = xty; + if (st[0] == TY_PTR) st = st[4]; + if (pmatch) probe_member(st); + if (is_op(s_lp)) { // e.name(...): a method, unless the struct has a field of that name + ms = 0 - 1; + if (st[0] == TY_STRUCT) { if (tfindfield(st, n) < 0) ms = methof(st, n); } + else if (st == tword || isnum(st)) { if (fieldscan(n) == 0) ms = methscan(n); } + if (ms == 0 - 2) { serrn(n, "is a method of more than one struct"); ms = 0 - 1; } + if (ms >= 0) { + return methcall(ms, st, borrowed, b, base_mask); + } + } + if (st[0] != TY_STRUCT && (st == tword || isnum(st))) { + k = fieldscan(n); + if (k == 1) { st = fldst; scanned = 1; } + else if (k > 1) { + if (!panic && !dry) { + errat(); + rt.put_c('.'); + rt.put_s(n); + rt.put_s(" is a field of more than one struct"); + errend(); + } + xty = tword; lv = 1; lvk = LV_OTHER; xbor = -1; return C_PLAIN; + } + } + if (st[0] != TY_STRUCT) { + if (!panic && !dry) { + errat(); + rt.put_c('.'); + rt.put_s(n); + rt.put_s(": that's a "); + tprint(xty); + rt.put_s(", not a struct or a pointer to one"); + errend(); + } + xty = tword; lv = 1; lvk = LV_OTHER; xbor = -1; return C_PLAIN; + } + if (scanned) i = fldi; else i = tfindfield(st, n); + if (i < 0) { + if (!panic && !dry) { + sv = tpack(); tunpack(fieldpos); // the error sits on the field name, where the quick fix replaces it + errat(); tprint(st); rt.put_s(" has no field "); rt.put_s(n); suggest_member(st[2], st, n, 0); errend(); + tunpack(sv); + } + xty = tword; lv = 1; lvk = LV_OTHER; xbor = -1; return C_PLAIN; + } + rs_put(fieldoff, RS_FIELD, field_decl(st, n), st[4][i * 3 + 1]); + k = st[4][i * 3 + 2]; + xty = st[4][i * 3 + 1]; + if (readonly) xty = tconst(xty); + if (k < 0) { // a packed field: the lvalue is a byte address, of the packed twin + lit(8); op(15); + k = 0 - k - 1; + if (k) { lit(k); op(O_ADD); } + xty = tpk(xty); + } else if (k) { lit(k); op(O_ADD); } + if (isref(xty)) { if (b >= 0) xbor = lroot(b); } + else xbor = -1; + if (borrowed && borrowed[2] == 5) xaf = borrowed; + effect_value = base_mask; + xprojection = af_project(borrowed, k, tsz(xty), tpack(), 0); + lv = 1; xzero = 0; + if (b >= 0) { lvk = LV_ELEM; lvi = b; } else lvk = LV_OTHER; + return C_PLAIN; +} +// array indexing, address arithmetic. mulsz scales an index by the element +// size. the addr_ functions build the address of element ix of a growable +// array in the different situations the bounds-check removal produces: the +// stack holds handle and index (addr_stk), the items pointer is cached in a +// hidden o3 variable (addr_cached), or only the handle is available +// (addr_hdr). range_jz is the inline bounds check, one "outside" enhancement +// and a branch to the oob report. +int mulsz(int et) { + if (tsz(et) != 1) { lit(tsz(et)); op(15); } + return 0; +} +// address of an element of a stack array, from the index on the stack. +int addr_stk(int et) { + op(O_SWAP); + lit(2); + op(O_ADD); + op(O_LD); + op(O_SWAP); + mulsz(et); + op(O_ADD); + return 0; +} +// address of an element of an array whose base is cached in a register. +int addr_cached(int ci, int ix, int et) { + vaddr(ci); + op(O_LD); + vaddr(ix); + op(O_LD); + mulsz(et); + op(O_ADD); + return 0; +} +// address of an element of a growable array, reading its header. +int addr_hdr(int al, int ix, int et) { + vaddr(al); op(O_LD); lit(2); op(O_ADD); op(O_LD); + vaddr(ix); op(O_LD); mulsz(et); op(O_ADD); + return 0; +} +// reload the index and the length on each side of the branch, so neither is a stack temporary +int range_jz(int ix, int src, int fld) { + int k, s; + vaddr(ix); op(O_LD); vaddr(src); op(O_LD); if (fld) op(O_LD); + s = lookup(s_outside); op(XOP0 + sval[s]); + k = hole(); op(O_JZ); + vaddr(ix); op(O_LD); vaddr(src); op(O_LD); if (fld) op(O_LD); + callname(s_oob); + setlit(k, here); + return 0; +} +// suffixes after a primary, in a loop: e as T, [index], .field, ->field, +// (call through a value), ++ and --. the index case is the long one. a byte +// string takes an index or a slice. a growable array is checked: through dat() +// normally, but inline when the compiler can prove or cheaply test the bound +// (o3 code with the cache variables, or an index the loop test already +// compared with the length). a plain pointer or fixed array is just base + +// index * size, and a constant index against a known length is checked at +// compile time. +int postfix() { return postfix_tail(primary()); } +int postfix_tail(int c) { + int b, n, t, et; word ft; word[8] bs; int k, ci, was, al, ix, enh, cz, cj, place, offset, temporary, call_owner, readonly; word storage, storage_mask, call_origins; + while (1) { + if (tk == T_ID && tv == s_as) { // e as T: same bits, another type + next(); t = ptype(); rval(); if (!xaf || xaf[2] != 5) xaf = 0; vf_coerce(t, 0); + if (tbytes(t) && !xfloat && !samesz(t, xty)) { tnorm(t); xconst = 0; } // x as u8 cuts the value to size + if_value = 0; + xty = t; xfloat = 0; lvk = LV_NONE; + if (isfl(t)) xfloat = 1; + continue; + } + if (tk != T_OP) return c; + if (tv == s_lk) { + readonly = treadonly(xty); + xvk = 0; + storage = xaf; storage_mask = effect_mask(c); offset = -1; n = -1; place = tpack(); af_use(storage, place, c); + was = xstr; + ci = 0; + if (lv && lvk == LV_LOCAL) lptr[lvi] = 1; + if (o3on && lv && lvk == LV_LOCAL && o3cache[lvi]) ci = o3cache[lvi]; + next(); + rval(); + if (was) { + c = expr(); rval(); plainuse(c); + if (accept(s_colon)) { + c = expr(); rval(); plainuse(c); + expect(s_rk); + callname(s_slice_s); xvk = 0; + lv = 0; lvk = LV_NONE; xty = tbstr; xfloat = 0; xstr = 1; xzero = 0; xbor = -1; + c = C_PLAIN; + continue; + } + expect(s_rk); + callname(s_at_s); xvk = 0; + lv = 0; lvk = LV_NONE; xty = tint; xfloat = 0; xstr = 0; xzero = 0; xbor = -1; + c = C_PLAIN; + continue; + } + b = -1; + if (c == C_FRESH) cerr("index a new object only after binding it to a name"); + else if (c >= C_VAR) { touch(c - C_VAR); b = c - C_VAR; } + if (xty[0] == TY_DYN && tbytes(xty[4])) { // packed elements: the runtime checks and gives the byte address + et = xty[4]; + c = expr(); rval(); plainuse(c); + if (xconst) offset = xcval; af_index(storage, place); + tcneed(isnum(xty) || xty == tword, "an index has to be a number", xty); + expect(s_rk); + callname(intern("datb")); + et = tpk(et); + } else if (xty[0] == TY_DYN) { // a growable array: bounds-checked, through the runtime + et = xty[4]; + al = -1; + if (lvk == LV_LOCAL) al = lvi; + if (ci && !mdbg && lookup(s_outside) >= 0) op(O_DROP); + c = expr(); + ix = -1; + if (lv && lvk == LV_LOCAL) ix = lvi; + rval(); plainuse(c); + if (xconst) offset = xcval; af_index(storage, place); + tcneed(isnum(xty) || xty == tword, "an index has to be a number", xty); + expect(s_rk); + k = lookup(s_outside); + enh = k >= 0 && skind[k] == K_ENH; + if (!mdbg && ix >= 0 && al >= 0 && proven(al, ix)) { // the loop test already compared this index with the length + if (ci) { vaddr(ci); op(O_LD); op(O_SWAP); mulsz(et); op(O_ADD); } + else addr_stk(et); + } else if (ci && !mdbg && enh && ix >= 0) { + op(O_DROP); + range_jz(ix, ci + 1, 0); + addr_cached(ci, ix, et); + } else if (ci && !mdbg && enh) { + lit(0); op(O_PICK); vaddr(ci + 1); op(O_LD); op(XOP0 + sval[k]); + k = hole(); op(O_JZ); + vaddr(ci + 1); op(O_LD); callname(s_oob); + setlit(k, here); + vaddr(ci); op(O_LD); op(O_SWAP); + mulsz(et); op(O_ADD); + } else if (!mdbg && o3on && enh && ix >= 0 && al >= 0) { + op(O_DROP); op(O_DROP); + range_jz(ix, al, 1); + addr_hdr(al, ix, et); + } else if (!mdbg && o3on && enh && ix >= 0) { + op(O_DROP); + vaddr(ix); op(O_LD); + lit(1); op(O_PICK); op(O_LD); op(XOP0 + sval[k]); + k = hole(); op(O_JZ); + vaddr(ix); op(O_LD); lit(1); op(O_PICK); op(O_LD); callname(s_oob); + setlit(k, here); + lit(2); op(O_ADD); op(O_LD); vaddr(ix); op(O_LD); + mulsz(et); op(O_ADD); + } else if (!mdbg && o3on && enh) { + lit(0); op(O_PICK); lit(2); op(O_PICK); op(O_LD); op(XOP0 + sval[k]); + k = hole(); op(O_JZ); + lit(1); op(O_PICK); op(O_LD); callname(s_oob); + setlit(k, here); + op(O_SWAP); lit(2); op(O_ADD); op(O_LD); op(O_SWAP); + mulsz(et); op(O_ADD); + } else callname(s_dat); + } else { + tcneed(isptr(xty) || xty == tword, "only pointers and arrays can be indexed", xty); + et = telem(xty); + n = 0 - 1; if (xty[0] == TY_ARR && xty[3] > 0) n = xty[3]; + xconst = 0; + c = expr(); rval(); plainuse(c); + if (xconst) offset = xcval; if (n < 0) af_index(storage, place); + if (n >= 0 && xconst && (xcval < 0 || xcval >= n)) { + serr("the index is out of range for this array"); + } + tcneed(isnum(xty) || xty == tword, "an index has to be a number", xty); + expect(s_rk); + if (tbytes(et)) { // packed: byte address = base * 8 + index * bytes + if (tbytes(et) != 1) { lit(tbytes(et)); op(15); } + op(O_SWAP); lit(8); op(15); op(O_ADD); + et = tpk(et); + } else { + if (tsz(et) != 1) { lit(tsz(et)); op(15); } + op(O_ADD); + } + } + xprojection = af_project(storage, offset, 1, place, 1); + if (xprojection && n >= 0 && offset >= 0) { xprojection[0] = n - offset; xprojection[13] = 0 - offset; xprojection[14] = 1; } + xaf = 0; if (storage && storage[2] == 5) xaf = storage; + effect_value = 0; if (isptr(et) || et == tword) effect_value = storage_mask; + if_value = 0; + if (readonly) et = tconst(et); + lv = 1; xty = et; xzero = 0; xconst = 0; xvk = 0; xlenloc = -1; xstamp = 0; + if (isref(xty)) { if (b >= 0) xbor = lroot(b); } + else xbor = -1; + if (b >= 0) { lvk = LV_ELEM; lvi = b; } else lvk = LV_OTHER; + c = C_PLAIN; + xfloat = 0; if (isfl(xty)) xfloat = 1; xstr = 0; + continue; + } + if (tv == s_dot || tv == s_arrow) { + xconst = 0; + c = field(c); + xfloat = 0; + if (isfl(xty)) xfloat = 1; + xstr = xty == tbstr; + continue; + } + if (tv == s_lp) { // call through a value + effect_note_mask(effect_mask(c), EF_READ); + rval(); plainuse(c); + ft = 0; + if (xty[0] == TY_FN) ft = xty; + else tcneed(xty == tword, "only functions can be called", xty); + rt.fill_w(bs, 0, 8); + ifcall = -1; effect_argument_base = 0; + int call_tags = 0; if (ft) call_tags = ft[5] >> 6; + n = args(call_tags, ft, bs, o3on); temporary = argtemporary; call_owner = argowner; call_origins = argorigin_mask; + // raw code can live in a heap segment; a closure has an environment block + lit(n); op(O_PICK); callname(intern("callable_code")); + cz = hole(); op(O_JZ); + lit(n); op(O_PICK); op(O_CALL); + cj = hole(); op(O_JMP); + setlit(cz, here); + lit(n); op(O_PICK); lit(3); op(O_ADD); // env: the captures start 3 words into the block + lit(n + 1); op(O_PICK); op(O_LD); // the body's entry, word 0 of the block + op(O_CALL); + setlit(cj, here); + op(O_SWAP); op(O_DROP); + if_value = 0; + lv = 0; lvk = LV_NONE; c = C_PLAIN; xzero = 0; xbor = -1; xconst = 0; + xty = tword; + if (ft) xty = subst(ft[4], bs); + if (ft && (ft[5] & 1)) c = C_FRESH; + else if (isptr(xty) || xty == tword) { effect_value = call_origins; if (isptr(xty)) xbor = call_owner; if (temporary) xaf = af_new(-1, 5, place); } + xfloat = 0; if (isfl(xty)) xfloat = 1; xstr = 0; + continue; + } + if (tv == s_inc) { next(); c = incdec(1, 1); continue; } + if (tv == s_dec) { next(); c = incdec(1, -1); continue; } + return c; + } + return c; +} +// prefix operators: the u*x / d*x / m*x recasts (the star has to touch the +// tag), casts like (int)x and (node*)x, dereference, address-of, prefix ++ and +// --, and any unary operator a program added (- ! ~ built in). +int unary() { + int c, un, t, place, constant, value; word storage, dependency; + if (tk == T_ID && (tv == s_u || tv == s_m || tv == s_d)) { // u*x, d*x, m*x: recast only when * is glued + peek(); + if (pk_tk == T_OP && pk_tv == s_star && pq_gl[0]) { + t = S_M; if (tv == s_u) t = S_U; if (tv == s_d) t = S_D; + next(); expect(s_star); + c = unary(); place = -1; if (lvk == LV_LOCAL) place = lvi; rval(); + lvk = LV_NONE; + if (c < C_VAR && c != C_FRESH && place >= 0 && fchk) { cerrn(place, "isn't an owned object, so there is no ownership to recast"); return c; } + c = recast(c, t); + if (t == S_M && c >= C_VAR && lstate[c - C_VAR] == S_M && lown[c - C_VAR]) xlend = c - C_VAR; + return c; + } + } + if (tk == T_OP && tv == s_lp && caststart()) { // (int)x, (node*)x: same bits, the type changes + next(); + t = ptype(); + expect(s_rp); + if (t[0] == TY_ARR && is_op(s_lb)) return postfix_tail(array_literal(t)); + if (t[0] == TY_DYN && is_op(s_lb)) return postfix_tail(array_dynamic_literal(t)); + c = unary(); dependency = effect_mask(c); rval(); plainuse(c); effect_value = dependency; if (!xaf || xaf[2] != 5) xaf = 0; vf_coerce(t, 1); + if (isfl(t)) { if (!xfloat) { op(OP_I2F); xfloat = 1; } if (t == tf32) { xenh("zf2s"); xenh("zs2f"); } } + else if (xfloat && isnum(t)) { op(OP_F2I); xfloat = 0; } + else xfloat = 0; + if (tbytes(t) && !samesz(t, xty)) { tnorm(t); xconst = 0; } // (u8)x cuts the value to size + if_value = 0; + xty = t; lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; + return C_PLAIN; + } + if (tk == T_OP) { + if (tv == s_star) { + place = tpack(); next(); c = unary(); dependency = effect_mask(c); + storage = xaf; af_use(xaf, place, c); xaf = 0; if (storage && storage[2] == 5) xaf = storage; xvk = 0; + if (lv && lvk == LV_LOCAL) lptr[lvi] = 1; + rval(); plainuse(c); + tcneed(xty[0] == TY_PTR || xty == tword, "only pointers can be dereferenced", xty); + if_value = 0; + xty = telem(xty); effect_value = 0; if (isptr(xty) || xty == tword) effect_value = dependency; + if (tbytes(xty)) { lit(8); op(15); xty = tpk(xty); } // the first packed element: a byte address + lv = 1; + lvk = LV_OTHER; + xzero = 0; + xbor = -1; + xfloat = 0; + if (isfl(xty)) xfloat = 1; + xstr = 0; + return C_PLAIN; + } + if (tv == s_amp) { + place = tpack(); next(); c = unary(); + storage = xprojection; if (xaf && xaf[2] == 5) storage = xaf; + if (lv && lvk == LV_LOCAL) { + if (cmode && !dry) { lvescaped[lvi] = 1; lvkind[lvi] = 0; } + storage = laaddr[lvi]; + if (!storage) { int storage_kind = 1; if (local_cell[lvi]) storage_kind = 2; storage = af_new(1, storage_kind, place); laaddr[lvi] = storage; if (storage) storage[5] = lvi; } + af_forget(); + } + else if (isagg(xty)) storage = 0; + if (!lv && !isagg(xty)) die("& needs something addressable"); + if (lv && ispk(xty)) serr("an element of a sized-integer array has no address; it is a byte inside a word"); + if (lv && lvk == LV_LOCAL && (ltag[lvi] & 16)) serr("an o3 variable has no address"); + if (lv && lvk == LV_LOCAL) ltag[lvi] = ltag[lvi] | LREAD | LASG; + if (c >= C_VAR) touch(c - C_VAR); + if (lvk == LV_ELEM && lvi >= 0) xbor = lroot(lvi); + lv = 0; lvk = LV_NONE; xzero = 0; xfloat = 0; xstr = 0; + if_value = 0; + xty = tptr(xty); xaf = storage; xvk = 0; + return C_PLAIN; + } + if (tv == s_inc) { next(); unary(); return incdec(0, 1); } + if (tv == s_dec) { next(); unary(); return incdec(0, -1); } + un = unfind(tv); + if (un >= 0) { + next(); c = unary(); rval(); plainuse(c); + constant = xconst && !xfloat && uname[un] == s_minus; value = xcval; xaf = 0; + if (uname[un] == s_minus && xvk == 1) xvv = 0 - xvv; + else if (uname[un] == s_minus && xvk == 2) xvv = vf_negf(xvv); + else xvk = 0; + if (un <= 1) ftest(); + if (uname[un] == s_minus && xfloat) { + op(OP_FLIT); + emit(0); + op(O_SWAP); + op(OP_FSUB); + xty = tfloat; + } + else { + emitseq(useq[un], ulen[un]); xfloat = 0; + if (un <= 1) xty = tbool; + else if (xty != tword && !isfl(xty)) { tcneed(isnum(xty), "this operator needs a number", xty); xty = tint; } + } + if (un <= 1) if_value = 0; + xstr = 0; + xconst = constant; if (constant) xcval = 0 - value; xlenloc = -1; xstamp = 0; + lv = 0; lvk = LV_NONE; xzero = 0; xbor = -1; + return C_PLAIN; + } + } + return postfix(); +} +// binary operators by precedence climbing: parse an operand, then while the +// next token is a binary operator of at least minp, parse its right side at one +// level tighter and emit its code sequence from the operator table. && and || +// short-circuit with jumps; floats get their own opcodes; a * or / by a +// constant that is a power of two gets a shift hint in check mode. +int if_comparison(int name) { + return name == s_eqeq || name == s_ne || name == s_lt || name == s_gt || name == s_le || name == s_ge; +} +int bin(int minp) { + int c = unary(), b, p, a, j, lt, lb, rb, src, lf, rf, ls, rs, fresh, top = 0, il = -1, opp; word borrowed, rightborrow, left_mask, right_mask, infer_left, infer_right; + if (fortest == 1) { fortest = 2; top = 1; ft_nops = 0; } + while (tk == T_OP) { + b = binfind(tv); + if (b < 0) return c; + p = bprec[b]; + if (p < minp) return c; + lb = -1; + if (c >= C_VAR && tracked(c - C_VAR)) lb = lroot(c - C_VAR); else lb = xbor; + borrowed = xaf; left_mask = effect_mask(c); lf = xfloat; ls = xstr; fresh = 0; + il = -1; + if (top && lv && lvk == LV_LOCAL) il = lvi; + infer_left = if_value; infer_right = 0; + opp = tpack(); + next(); rval(); plainuse(c); + lt = xty; + if (isfl(lt)) lf = 1; + src = -1; + if (blen[b] == -1) { // && : 0 if the left side is 0, else the right side as 0 or 1 + af_forget(); + ftest(); + a = hole(); op(O_JZ); + c = bin(p + 1); rval(); plainuse(c); + ftest(); + emitseq(useq[1], ulen[1]); // !! normalizes + j = hole(); op(O_JMP); + setlit(a, here); lit(0); setlit(j, here); + xfloat = 0; xstr = 0; + } else if (blen[b] == -2) { // || : 1 if the left side isn't 0, else the right side as 0 or 1 + af_forget(); + ftest(); + a = hole(); op(O_JZ); + lit(1); j = hole(); op(O_JMP); + setlit(a, here); + c = bin(p + 1); rval(); plainuse(c); + ftest(); + emitseq(useq[1], ulen[1]); + setlit(j, here); + xfloat = 0; xstr = 0; + } else { + c = bin(p + 1); infer_right = if_value; rightborrow = xaf; right_mask = effect_mask(c); + rb = -1; + if (c >= C_VAR && tracked(c - C_VAR)) rb = lroot(c - C_VAR); else rb = xbor; + if (top) { ft_ir = -1; if (lv && lvk == LV_LOCAL) ft_ir = lvi; } + rval(); plainuse(c); + if (cmode && bname[b] == s_star && xconst && xcval >= 2 && !(xcval & (xcval - 1)) && !lf) { + shifthint(opp, xcval); + } + rf = xfloat; rs = xstr; + if (isfl(xty)) rf = 1; + if ((ls || rs) && (bname[b] == s_plus || bname[b] == s_eqeq || bname[b] == s_ne || bname[b] == s_lt || bname[b] == s_gt || bname[b] == s_le || bname[b] == s_ge)) { + if (!(ls && rs)) serr("a byte string needs a byte string on the other side"); + if (bname[b] == s_plus) { callname(s_cat_s); xstr = 1; xfloat = 0; } + else if (bname[b] == s_eqeq) { callname(s_eq_s); xstr = 0; xfloat = 0; } + else if (bname[b] == s_ne) { callname(s_eq_s); lit(1); op(18); xstr = 0; xfloat = 0; } + else if (bname[b] == s_lt) { callname(s_lt_s); xstr = 0; xfloat = 0; } + else if (bname[b] == s_gt) { op(O_SWAP); callname(s_lt_s); xstr = 0; xfloat = 0; } + else if (bname[b] == s_le) { callname(s_le_s); xstr = 0; xfloat = 0; } + else { op(O_SWAP); callname(s_le_s); xstr = 0; xfloat = 0; } + } else if ((lf || rf) && isfop(bname[b])) { femit(bname[b], lf, rf); xstr = 0; } + else { emitseq(bseq[b], blen[b]); xfloat = 0; xstr = 0; } + if (bname[b] == s_plus || bname[b] == s_minus) { + if ((!borrowed || borrowed[2] != 5) && rightborrow && rightborrow[2] == 5) borrowed = rightborrow; + if (lb >= 0) src = lb; else src = rb; + if (bname[b] == s_minus && lb >= 0 && rb >= 0) src = -1; // pointer difference is a distance + } + } + if (blen[b] < 0) af_forget(); + if (xstr) xty = tbstr; else xty = bintype(b, lt, xty); + if_value = 0; + if (blen[b] > 0 && !if_comparison(bname[b]) && !xstr && !lf && !rf && (xty == tint || xty == tword) && (infer_left || infer_right)) { + if_link(infer_left, infer_right); + if_value = infer_left; if (!if_value) if_value = infer_right; + if_join(if_value, xty); + } + if (src >= 0 && xty[0] != TY_PTR && xty != tword) src = -1; + xbor = src; + if (top) { + ft_nops++; + if (ft_nops > 1) ft_iv = -1; + else if (bname[b] == s_lt && blen[b] > 0 && il >= 0 && ft_ir >= 0 && !lf && !rf && !ls && !rs) { ft_iv = il; ft_bd = ft_ir; } + } + lv = 0; lvk = LV_NONE; c = C_PLAIN; xzero = 0; xconst = 0; xlenloc = -1; xstamp = 0; xaf = 0; xvk = 0; + effect_value = 0; if (isptr(xty) || xty == tword) effect_value = left_mask | right_mask; + if (fresh) c = C_FRESH; + if (borrowed && borrowed[2] == 5 && (isptr(xty) || xty == tword) && (bname[b] == s_plus || bname[b] == s_minus)) xaf = borrowed; + } + return c; +} +// ---- assignment, conditionals and blocks as expressions ---- + +int storekeep(int t) { + if (mdbg && !dry && !ispk(t)) { lit(1); op(O_PICK); callname(s_check); op(O_DROP); } + op(O_SWAP); lit(1); op(O_PICK); op(O_SWAP); + if (ispk(t)) pkst(t); else op(O_ST); + return 0; +} +// c ? a : b. both sides are analyzed from the same starting state (a snapshot, +// restored for the second side) and then joined, so a variable can't be given +// away on one side only. both sides are fresh objects, or neither is. +int ternary(int c) { + int a, b, s0, sa, livea, live0 = live, n0 = nloc, ca, cb, ta, ba, bb; word temp_a, temp_b, mask_a, mask_b; + rval(); plainuse(c); + ftest(); + next(); + a = hole(); op(O_JZ); + s0 = snap_push(); + ca = expr(); rval(); ta = xty; ba = xbor; temp_a = xaf; mask_a = effect_mask(ca); + if (ca != C_FRESH) plainuse(ca); + livea = live; sa = snap_push(); + b = hole(); op(O_JMP); + expect(s_colon); + setlit(a, here); + snap_restore(s0); live = live0; + cb = expr(); rval(); bb = xbor; temp_b = xaf; mask_b = effect_mask(cb); + if (cb != C_FRESH) plainuse(cb); + join2(sa, livea, b, live, n0, "ends the two sides of ?: in different states"); + snap_pop(s0); + if (isfl(ta) && !isfl(xty)) { op(OP_I2F); xfloat = 1; xty = tfloat; } + if (!compat(ta, xty) && !compat(xty, ta)) tcerr("the two sides of ?:", ta, xty); + if (ta != tword && !isfl(ta)) xty = ta; + else if (isfl(ta) || isfl(xty)) { xty = tfloat; xfloat = 1; } + if_value = 0; + effect_value = mask_a | mask_b; + if (ba != bb) xbor = -1; + if (temp_a && temp_a[2] == 5) xaf = temp_a; else if (temp_b && temp_b[2] == 5) xaf = temp_b; + lv = 0; lvk = LV_NONE; xzero = 0; xvk = 0; + if (ca == C_FRESH && cb == C_FRESH) return C_FRESH; + if (ca == C_FRESH || cb == C_FRESH) cerr("both sides of ?: have to be new objects, or neither"); + return C_PLAIN; +} +// the top of the expression grammar: a binary expression, then possibly ?: or +// an assignment. plain = stores the value and leaves it on the stack; the +// analyzer's assigncheck decides what the store means for ownership (a fresh +// object makes the target an owner, a u object moves up a block, and so on). +// compound assignment (+= etc.) loads the old value, applies the operator +// sequence from the table and stores the result. an o3 variable is stored with +// the value first and the address after, so no address waits on the stack +// across a branch. +int expr() { + int c = bin(1), k, i, a, rc, lt, lf, rf, fk; + if (tk != T_OP) return c; + if (tv == s_q) return ternary(c); + if (tv == s_eq) { + if (!lv) die("this can't be assigned to"); + k = lvk; i = lvi; lt = xty; require_mutable(lt); + if (isagg(lt)) serr("a whole struct or array can't be assigned; assign its fields"); + next(); + a = o3on && k == LV_LOCAL && (ltag[i] & 16) && !larr[i]; + if (a) op(O_DROP); // an o3 variable: its address comes after the value, so it never waits on the stack across a branch + xlend = -1; + rc = expr(); rval(); + if (k != LV_LOCAL) af_escape(xaf); + fcoerce(lt); + if (k == LV_LOCAL) { + ltag[i] = ltag[i] | LASG; + setflt(i, xfloat); + setstr(i, xstr); + note_store(i); af_store(i); vf_store(i); + } + if (cmode && !dry && k == LV_GLOBAL) { vf_symbols(); svkind[i] = xvk; svvalue[i] = xvv; } + else if (k != LV_LOCAL) vf_effect(); + if (!compat(lt, xty)) tcerr("assignment", lt, xty); + if (a) { lit(0); op(O_PICK); vaddr(i); op(O_ST); o3refresh(i); } + else { + if (o3on && k != LV_ELEM && hasptr(lt)) { lit(lt); callname(s_fatten); } // o3 data going somewhere normal code can see + storekeep(lt); + } + lv = 0; lvk = LV_NONE; xty = lt; xzero = 0; + return assigncheck(k, i, rc); + } + a = asgfind(tv); + if (a >= 0) { + if (!lv) die("this can't be assigned to"); + if (lvk == LV_LOCAL && fchk && tracked(lvi) && !isalias(lvi)) { + cerrn(lvi, "owns an object; compound assignment would lose it"); + } + lt = xty; require_mutable(lt); + fk = -1; lf = xfloat; + if (lvk == LV_LOCAL) fk = lvi; + if (isfl(lt)) lf = 1; + next(); + i = o3on && lvk == LV_LOCAL && (ltag[lvi] & 16) && !larr[lvi]; + if (i) { i = lvi; op(O_DROP); vaddr(i); op(O_LD); i = i + 1; } + else if (ispk(lt)) { lit(0); op(O_PICK); pkld(lt); } + else { lit(0); op(O_PICK); op(O_LD); } + lv = 0; + rc = expr(); rval(); plainuse(rc); + rf = xfloat; + if ((lf || rf) && isfop(bname[abin[a]])) femit(bname[abin[a]], lf, rf); + else { emitseq(bseq[abin[a]], blen[abin[a]]); xfloat = 0; } + fcoerce(lt); + if (fk >= 0) { + lafact[fk] = 0; xaf = 0; if (cmode && !dry) lvkind[fk] = 0; + ltag[fk] = ltag[fk] | LASG; + setflt(fk, xfloat); setstr(fk, 0); + if (forstep && fk == ft_iv && bname[abin[a]] == s_plus && xconst && xcval == 1) fs_ok = 1; + if (bname[abin[a]] == s_plus && xconst && xcval > 0) putfact(fk, getlo(fk), -1); + else putfact(fk, -1, -1); + bpoison(fk); + } + if (fk < 0) vf_effect(); xvk = 0; + k = bintype(abin[a], lt, xty); + if (!compat(lt, k)) tcerr("compound assignment", lt, k); + if (i) { lit(0); op(O_PICK); vaddr(i - 1); op(O_ST); } else storekeep(lt); + lv = 0; lvk = LV_NONE; xty = lt; xzero = 0; + return C_PLAIN; + } + return c; +} +// does the current token start a statement rather than an expression? +// a block as an expression: { stmts; tail }. it opens a scope like any block, +// so its variables are freed when it closes, and the tail is how a u object +// leaves the block with a value (handup). +word stmtstart() { + int s; + if (tk == T_OP) return tv == s_semi || tv == s_lb || tstart(); + if (tk != T_ID || findloc(tv) >= 0) return 0; + if (tstart() || typedef_ahead()) return 1; + s = lookup(tv); + return s >= 0 && skind[s] == K_KW && !(sflag[s] & F_EXPR); +} +// { stmts; tail } as an expression: its value is the tail, or 0 +int blockexpr() { + int save = nloc, c = C_PLAIN, tail = 0, t = tint; + next(); + fdepth++; bxdepth++; + while (!is_op(s_rb)) { + if (tk == T_EOF) { die("missing }"); break; } + if (stmtstart()) { stmt(); continue; } + c = expr(); rval(); + if (accept(s_semi)) { op(O_DROP); discard(c); c = C_PLAIN; continue; } + if (!is_op(s_rb)) die("expected ; or } after an expression"); + tail = 1; t = xty; + } + next(); + if (tail) c = handup(c); else { lit(0); xbor = -1; xfloat = 0; xstr = 0; xvk = 1; xvv = 0; } + if (xbor >= save) xbor = -1; // that local dies with this block; the pointer leaves untracked + block_close(save); + fdepth--; bxdepth--; + lv = 0; lvk = LV_NONE; xty = t; xzero = 0; + return c; +} + +// ---- constant expressions ---- + +// constant expressions, evaluated while compiling: numbers, named constants, +// addresses of globals and functions, unary minus and ~, parentheses, and the +// operators + - * | & << >>. used for array lengths, enum values, const +// initializers and asm operands. +word cprim() { + int v, s, mc; + if (tk == T_NUM) { v = tv; next(); return v; } + if (accept(s_minus)) return 0 - cprim(); + if (tk == T_OP && tv == uname[2]) { next(); return ~cprim(); } + if (accept(s_lp)) { v = cexpr(); expect(s_rp); return v; } + if (tk == T_ID) { + s = lookup(tv); + if (mstruct && !ginst) { mc = lookup(methname(mstruct, tv)); if (mc >= 0 && skind[mc] == K_CONST) s = mc; } + if (s >= 0 && (skind[s] == K_CONST || skind[s] == K_GARR || (skind[s] == K_FN && (sflag[s] & F_DEF)) || skind[s] == K_GVAR)) { + next(); + return sval[s]; + } + if (s >= 0 && skind[s] == K_TYPE) { // Enum.MEMBER in a constant expression + peekat(0); + if (pk_tk == T_OP && pk_tv == s_dot) { + peekat(1); + if (pk_tk == T_ID) { + mc = lookup(methname(tv, pk_tv)); + if (mc >= 0 && skind[mc] == K_CONST) { next(); next(); next(); return sval[mc]; } + } + } + } + } + die("expected a constant"); + return 0; +} +// compile an expression: a primary, then the operators that follow it. +int cexpr() { + int v = cprim(), o; + while (tk == T_OP) { + o = tv; + if (o == bname[3]) { next(); v = v + cprim(); } + else if (o == bname[4]) { next(); v = v - cprim(); } + else if (o == bname[0]) { next(); v = v * cprim(); } + else if (o == bname[15]) { next(); v = v | cprim(); } + else if (o == bname[13]) { next(); v = v & cprim(); } + else if (o == bname[5]) { next(); v = v << cprim(); } + else if (o == bname[6]) { next(); v = v >> cprim(); } + else return v; + } + return v; +} + |