1 files changed, 218 insertions, 0 deletions
diff --git a/src/compiler/ops.zc b/src/compiler/ops.zc
new file mode 100644
index 0000000..a396f72
--- /dev/null
+++ b/src/compiler/ops.zc
@@ -0,0 +1,218 @@
+// ---- operator tables ----
+
+// a sequence is written like asm: one-char mnemonics, numbers, and names
+// (resolved when the operator is used, so image builds stay self-contained)
+int seqasm(char* s) {
+	int start = seqtop, n, neg, v, k, c;
+	while (1) {
+		while (*s == 32) s++;
+		if (!*s) break;
+		n = 0;
+		while (s[n] && s[n] != 32) { n = token_char(n, s[n]); }
+		tbuf[n] = 0;
+		s = s + n;
+		reserve_R_SEQ(seqtop + 2);
+		neg = tbuf[0] == '-' && isdig(tbuf[1]);
+		if (isdig(tbuf[neg])) {
+			v = 0; k = neg;
+			while (tbuf[k]) { v = v * 10 + tbuf[k] - '0'; k++; }
+			if (neg) v = 0 - v;
+			if ((v >> 62) != 0 && (v >> 62) != -1) { R_SEQ[seqtop] = SEQWORD; R_SEQ[seqtop + 1] = v; seqtop = seqtop + 2; }
+			else { R_SEQ[seqtop] = v + v + 1; seqtop++; }
+		} else if (n == 1 && (c = mnemidx(tbuf[0])) >= 0) {
+			R_SEQ[seqtop] = c + c; seqtop++;
+		} else {
+			R_SEQ[seqtop] = SEQREF; R_SEQ[seqtop + 1] = intern(tbuf); seqtop = seqtop + 2;
+		}
+	}
+	return start;
+}
+// the index of an assembler mnemonic in the table, or -1 when there is none.
+int mnemidx(int c) {
+	int i = 0;
+	while (mnem[i]) {
+		if (mnem[i] == c) return i;
+		i++;
+	}
+	return -1;
+}
+// emit n words of a stored sequence, resolving its references.
+int emitseq(int a, int n) {
+	int e = a + n, s;
+	while (a < e) {
+		if (R_SEQ[a] == SEQWORD) { lit(R_SEQ[a + 1]); a = a + 2; }
+		else if (R_SEQ[a] == SEQREF) {
+			s = lookup(R_SEQ[a + 1]);
+			if (s < 0) s = fwdfn(R_SEQ[a + 1]);
+			if (skind[s] == K_FN) {
+				fnref(s);
+			} else if (skind[s] == K_ENH) op(XOP0 + sval[s]); else lit(sval[s]);
+			a = a + 2;
+		} else { emit(R_SEQ[a]); a++; }
+	}
+	return 0;
+}
+// add an operator name to the table of known operators, once.
+int addkop(int p) {
+	int i = 0;
+	while (i < nkop) {
+		if (kops[i] == p) return 0;
+		i++;
+	}
+	reserve_operators(nkop + 1);
+	kops[nkop] = p;
+	nkop++;
+	return 0;
+}
+// find a binary operator by its name.
+int binfind(int p) {
+	int i = nbin;
+	while (i) {
+		i--;
+		if (bname[i] == p) return i;
+	}
+	return -1;
+}
+// find a unary operator by its name.
+int unfind(int p) {
+	int i = nun;
+	while (i) {
+		i--;
+		if (uname[i] == p) return i;
+	}
+	return -1;
+}
+// find an assignment operator by its name.
+int asgfind(int p) {
+	int i = nasg;
+	while (i) {
+		i--;
+		if (aname[i] == p) return i;
+	}
+	return -1;
+}
+// add or replace a binary operator. code is a sequence string, or 0 for the
+// built-in && (prec 2) and || (prec 1) behaviour, chosen by -1 / -2 in prec.
+int add_binop(char* nm, int prec, char* code) {
+	int p = intern(nm), i = binfind(p), a, n;
+	if (i < 0) { reserve_binary(nbin + 1); i = nbin; nbin++; }
+	bname[i] = p; bprec[i] = prec;
+	// && (-1) and || (-2) short-circuit: they bind below |, and && above ||, as in c
+	if (prec < 0) { bprec[i] = 3 + prec; blen[i] = prec; bseq[i] = 0; addkop(p); return i; }
+	bseq[i] = seqasm(code); blen[i] = seqtop - bseq[i];
+	addkop(p);
+	// and its compound assignment, x op= y
+	n = rt.len_w(nm);
+	while (1002 + n > tbufcap) { tbuf = chk_resize(tbuf, 0, tbufcap * 2); tbufcap = tbufcap * 2; }
+	rt.copy_w(tbuf + 1000, nm, n);
+	tbuf[1000 + n] = '='; tbuf[1001 + n] = 0;
+	a = intern(tbuf + 1000);
+	if (prec >= 8 || prec == 5 || prec == 4 || prec == 3) {
+		if (asgfind(a) < 0) { reserve_assignment(nasg + 1); aname[nasg] = a; nasg++; }
+		abin[asgfind(a)] = i;
+		addkop(a);
+	}
+	return i;
+}
+// register a unary operator and the sequence it expands to.
+int add_unop(char* nm, char* code) {
+	int p = intern(nm), i = unfind(p);
+	if (i < 0) { reserve_unary(nun + 1); i = nun; nun++; }
+	uname[i] = p; useq[i] = seqasm(code); ulen[i] = seqtop - useq[i];
+	addkop(p);
+	return i;
+}
+// register a keyword with its handler and flags.
+int add_kw(char* nm, int handler, int flags) {
+	int s = addsym(intern(nm), K_KW, handler);
+	sflag[s] = F_DEF | flags;
+	return s;
+}
+// register a library function as a receiver method. its first parameter
+// determines the receiver type; remaining parameters follow the member name.
+word receiver_methods, closure_expected;
+int add_method(char* member, char* function_name) {
+	int s = lookup_raw(intern(function_name)); word link;
+	if (s < 0 || skind[s] != K_FN || !stype[s] || !stype[s][3]) {
+		serr("a receiver method requires a function with at least one typed parameter"); return -1;
+	}
+	link = chk_resize(0, 0, 3);
+	link[0] = receiver_methods; link[1] = intern(member); link[2] = s; receiver_methods = link;
+	return s;
+}
+int receiver_method(word receiver_type, int member) {
+	word link = receiver_methods, ft, actual; word[8] bs; int found = -1, s;
+	while (link) {
+		s = link[2];
+		if (s < nsym && link[1] == member) {
+			ft = stype[s]; actual = receiver_type;
+			if (actual[0] == TY_ARR && ft[7][0] == TY_DYN && ft[7][3]) actual = tdyn(actual[4], 1);
+			rt.fill_w(bs, 0, 8);
+			if (unify(ft[7], actual, bs)) { if (found >= 0 && found != s) return -2; found = s; }
+		}
+		link = link[0];
+	}
+	return found;
+}
+// run.method("member", function) registers a receiver extension while parsing
+// the importing source, including when its code is emitted into an image.
+int kw_method() {
+	char* member; int s;
+	stmtonly(); next(); expect(s_lp);
+	if (tk != T_STR) { die("a receiver method name must be a character string"); return 0; }
+	member = tv; next(); expect(s_comma);
+	s = -1; if (tk == T_ID) s = source_lookup(tv);
+	if (s < 0 || skind[s] != K_FN) serr("a receiver extension requires a function name");
+	next(); expect(s_rp); expect(s_semi);
+	if (s >= 0) add_method(member, sname[s]);
+	return 0;
+}
+// publish a reference for shallow copies while preserving its declared type.
+// scalar values are unchanged; in-place aggregates require explicit copying.
+int kw_share_value() {
+	int c; word t;
+	next(); expect(s_lp); c = expr(); rval(); plainuse(c); t = xty; expect(s_rp);
+	if (isagg(t)) serr("sharing an aggregate requires sharing its pointer fields explicitly");
+	else if (isptr(t) || t[0] == TY_DYN || t[0] == TY_FN || t == tword) callname(intern("rt.share"));
+	xbor = -1; xaf = 0; effect_value = 0; xty = t; xconst = 0; xvk = 0;
+	return C_PLAIN;
+}
+
+word statement_hooks;
+
+// source libraries can register syntax without emitting a runtime registration call.
+int kw_syntax() {
+ char* keyword; int handler, entry = -1;
+ stmtonly(); next(); expect(s_lp);
+ if (tk != T_STR) { die("a syntax keyword must be a character string"); return 0; }
+ keyword = tv; next(); expect(s_comma); handler = -1;
+ if (tk == T_ID) handler = source_lookup(tv);
+ if (handler < 0 || skind[handler] != K_FN) serr("a syntax extension requires a function name");
+ next(); expect(s_rp); expect(s_semi);
+ if (handler >= 0) {
+  if (hdelta && handler >= ubase) entry = syntax_resident(handler); else entry = sval[handler];
+  if (entry >= 0) add_kw(keyword, entry, F_TOP | F_STMT);
+ }
+ return 0;
+}
+int kw_statement_hook() {
+ int handler = -1; word link;
+ stmtonly(); next(); expect(s_lp); if (tk == T_ID) handler = source_lookup(tv);
+ if (handler < 0 || skind[handler] != K_FN) serr("a statement hook requires a function name");
+ next(); expect(s_rp); expect(s_semi);
+ if (handler >= 0) { link = chk_resize(0, 0, 3); link[0] = statement_hooks; link[1] = handler; link[2] = 1; statement_hooks = link; }
+ return 0;
+}
+// optional statement callbacks installed by source extensions at include time.
+// callbacks execute at ordinary vm call boundaries and must guard reentrancy.
+int add_statement_hook(int callback) {
+ word link = chk_resize(0, 0, 3); link[0] = statement_hooks; link[1] = callback; link[2] = 0; statement_hooks = link;
+ return 0;
+}
+int emit_statement_hooks() {
+ word link = statement_hooks;
+ if (dry || o3on || cmode || incdepth || !infn) return 0;
+ while (link) { if (link[2]) fnref(link[1]); else lit(link[1]); op(O_CALL); op(O_DROP); link = link[0]; }
+ return 0;
+}
+