hold blocks: top-level hold { shared let ...; fn ... } monitors; shared values kept by the host and copied in/out at the outermost call, reentrant per-block locks in declaration order (core, micro)

3 files changed, 71 insertions, 1 deletions

diff --git a/src/compiler/base.zc b/src/compiler/base.zc
index 7e4b5bc..bd27e28 100644
--- a/src/compiler/base.zc
+++ b/src/compiler/base.zc
@@ -323,6 +323,12 @@ int s_ld8, s_st8, s_ld16, s_st16, s_ld32, s_st32;
 // ---- o3 region state ----
 
 // each promoted slot maps to a register; pending regions use 67-word records and a descriptor buffer.
+// hold blocks: hold_cur is the rank of the block being compiled (0 outside one), fhold the
+// rank of the function being compiled, hold_desc the word that will point at the block's
+// table of shared variables, hold_count the blocks so far. a shared variable's symbol has
+// F_SHARED and its block's rank above it in sflag.
+const int F_SHARED = 131072, F_SHARED_RANK = 262144;
+int hold_cur, fhold, hold_count, hold_desc, hold_nshared; word[128] hold_tab;
 int o3on, o3nxt, o3one; word[32] o3sl; word[32] o3rg; int no3sl; word[O3_REGIONS * 67] o3pend_initial; word o3pend = o3pend_initial; int o3pendcap = O3_REGIONS, no3pend; word[80] o3dsc; int o3fs, o3na, o3fn0;
 // o3free holds registers released by closed scopes; o3cache holds the items pointer and length slots for fixed arrays.
 word[8] o3free; int no3free, o3nreg; word[NL] o3cache_initial; word o3cache = o3cache_initial; int argloc, s_hitems, s_hlen, s_fatten;
diff --git a/src/compiler/decl.zc b/src/compiler/decl.zc
index 52d08c7..fed7b8d 100644
--- a/src/compiler/decl.zc
+++ b/src/compiler/decl.zc
@@ -230,11 +230,61 @@ int prologue() {
 	setlit(k, here); setlit(done, here); op(O_DROP); setlit(busy, here);
 	return 0;
 }
+// a function of a hold block takes the block's lock on entry (op 57 of the syscall gate)
+// and gives it back at its one exit (op 58), with the return value left on the stack. the
+// host keeps the shared values: entering the block from outside copies them into the
+// block's variables, leaving copies them back, so inside, every read and write is a plain
+// global access on every backend. the lock is reentrant and held for the whole call.
+int hold_gate(int code) {
+	if (!fhold || nclo) return 0;
+	lit(fhold); lit(rt.SYSGATE + 1); op(O_ST);
+	lit(hold_desc); lit(rt.SYSGATE + 2); op(O_ST);
+	lit(code); lit(rt.SYSGATE); op(O_ST);
+	return 0;
+}
+// hold { shared let c; fn a() { ... } ... }: a monitor. the shared variables can be used
+// only by the functions written in the block; each call holds the block's lock.
+int kw_hold() {
+	int rank, d, before, s, i, w; word t;
+	if (hold_cur) serr("hold blocks don't nest");
+	next(); expect(s_lb);
+	rank = hold_count + 1; hold_count = rank;
+	reserve_code(1); d = here; emit(0);
+	hold_cur = rank; hold_desc = d; hold_nshared = 0;
+	while (!is_op(s_rb)) {
+		if (tk == T_EOF) { die("missing } at the end of a hold block"); break; }
+		if (panic) { topsync(); continue; }
+		if (tk == T_ID && rt.eq_w(tv, "shared")) {
+			next(); before = nsym;
+			if (is_id(s_var)) gdecl(0);
+			else if (tstart()) { rettype(); gdecl2(dty, dtag, name()); }
+			else { die("expected let or a type after shared"); continue; }
+			s = before;
+			while (s < nsym) {
+				if (skind[s] == K_GVAR || skind[s] == K_GARR) {
+					t = stype[s]; w = 1;
+					if (skind[s] == K_GARR) { w = tsz(t); if (t[0] == TY_ARR) t = t[1]; }
+					if (t && (isptr(t) || isagg(t) || t == tbstr || t[0] == TY_DYN || t[0] == TY_FN)) serrn(sname[s], "is shared, so it holds numbers: no pointers, strings or structs (each actor has its own heap)");
+					sflag[s] = sflag[s] | F_SHARED | rank * F_SHARED_RANK;
+					if (hold_nshared >= 64) serr("too many shared variables in one hold block (64)");
+					else { hold_tab[hold_nshared * 2] = sval[s]; hold_tab[hold_nshared * 2 + 1] = w; hold_nshared++; }
+				}
+				s++;
+			}
+		} else topitem0();
+	}
+	next();
+	reserve_code(1 + hold_nshared * 2); *(d + hdelta) = here; emit(hold_nshared);
+	i = 0; while (i < hold_nshared * 2) { emit(hold_tab[i]); i++; }
+	hold_cur = 0; hold_desc = 0;
+	return 0;
+}
 // emit the function epilogue, patching every return to it.
 int epilogue() {
 	int k, node, done, helper = !nclo && (sname[finsym] == s_frame_grow || sname[finsym] == s_frame_leave);
 	lit(0);
 	fixall(epichain, here);
+	hold_gate(58);
 	lit(rt.ZFP); op(O_LD); lit(fslots); op(O_ADD); lit(rt.ZFP); op(O_ST);
 	if (!helper) {
 		lit(sval[lookup(s_frame_node)]); op(O_LD); node = hole(); op(O_JZ);
@@ -404,7 +454,9 @@ int fndef(int chk, int rty, int ret, int n) {
 	if (typed && explicit_rty) fty = rty;
 	no3pend = 0;
 	if (o3f) { o3on = 1; o3reset(); sflag[s] = sflag[s] | F_O3; }
-	prologue(); borrow_prologue();
+	fhold = hold_cur;
+	if (fhold && o3f) serrn(n, "is in a hold block and can't be o3");
+	prologue(); borrow_prologue(); hold_gate(57);
 	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]);
@@ -431,6 +483,7 @@ int fndef(int chk, int rty, int ret, int n) {
 	}
 	hi = here;
 	epilogue();
+	fhold = 0;
 	lend = here;
 	if (o3f) {
 		o3on = 0;
@@ -720,6 +773,7 @@ int topitem1() {
 		if (!is_op(s_lp)) { die("expected a function"); return 0; }
 		return fndone(fndef(chk, dty, dtag == S_U, n), imm);
 	}
+	if (tk == T_ID && rt.eq_w(tv, "hold")) { peek(); if (pk_tk == T_OP && pk_tv == s_lb) return kw_hold(); }
 	if (is_id(s_var)) return gdecl(0);
 	if (is_id(s_struct)) { kw_struct(); return 0; }
 	if (is_id(s_type)) return kw_type();
diff --git a/src/compiler/expr.zc b/src/compiler/expr.zc
index a6cc55c..141ca16 100644
--- a/src/compiler/expr.zc
+++ b/src/compiler/expr.zc
@@ -657,6 +657,15 @@ word closure_layout(int closure_index, int count) {
 // 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
+// a shared variable is reachable only from a function of its own hold block, which holds
+// the block's lock for the whole call. a closure might run after the call returns.
+int shared_use(int s) {
+	int rank = sflag[s] / F_SHARED_RANK;
+	if (fhold == rank && !nclo && infn) return 0;
+	if (fhold == rank && nclo) { serrn(sname[s], "is shared; a closure can't use it, because it may run after the hold block's lock is released"); return 0; }
+	serrn(sname[s], "is shared in a hold block; only the functions written inside that block can use it (they hold its lock)");
+	return 0;
+}
 // compiler state around the body.
 int closure() {
 	char* xcf;
@@ -1095,6 +1104,7 @@ int primary() {
 		xcval = sval[s];
 		return C_PLAIN;
 	}
+	if (s >= 0 && (skind[s] == K_GVAR || skind[s] == K_GARR) && (sflag[s] & F_SHARED)) shared_use(s);
 	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]);