zc: add the defer statement

defer expr; and defer { ... } register code that runs when the enclosing
block ends: at the end of the block, and at return, break and continue
that leave it. the tokens are kept at the defer and compiled again at each
exit (block_close, body, kw_return, kw_break, kw_continue), newest first,
before the block's variables are released, so the analyzer sees a deferred
rt.free(p) as the transfer of p where it runs. names mean what they meant
at the defer; values are read when it runs. return, break and continue
inside a deferred statement are errors, reported once. works in unchecked
code and closures (own base per function context).

6 files changed, 117 insertions, 2 deletions

diff --git a/src/compiler/analyzer.zc b/src/compiler/analyzer.zc
index 505ac09..8c63bdf 100644
--- a/src/compiler/analyzer.zc
+++ b/src/compiler/analyzer.zc
@@ -682,6 +682,7 @@ int local_hints(int from) {
 // object is an error, not a free.
 int block_close(int save) {
 	int i = save, k;
+	defer_run(fdepth, 1);	// deferred statements of this block, before its variables go
 	af_close(save);
 	local_hints(save);
 	if (o3on) {
diff --git a/src/compiler/base.zc b/src/compiler/base.zc
index 17ec80b..d83dc9d 100644
--- a/src/compiler/base.zc
+++ b/src/compiler/base.zc
@@ -248,6 +248,14 @@ word xprojection; int af_mutation_tick;
 int xbor = -1;		// local a pointer value is borrowed from, or -1
 int mdbg, mdbg_flags;	// memdebug: compile checks in, and the flags start() turns on
 int lsp, loopbase, ctxsp, snaptop;
+// defer: the statements registered and not yet run, DFR_W words each (the block
+// depth of the defer, its token list, whether the analyzer was on, whether compiling
+// it failed, so the error is reported once, and the locals there were at the defer),
+// newest last. dfr_base is where the current function's entries start. dfr_on is set
+// while a deferred statement is compiled; dfr_lsp and dfr_ctx say where its own loops
+// and function begin.
+const int DFR_MAX = 256, DFR_W = 5;
+word[1280] dfr; int ndfr, dfr_base, dfr_on, dfr_lsp, dfr_ctx;
 int lv, lvk, lvi, kw_expr, xcls, fty;
 // interned spellings the parser compares against
 
diff --git a/src/compiler/check.zc b/src/compiler/check.zc
index a22bcdd..f3374b1 100644
--- a/src/compiler/check.zc
+++ b/src/compiler/check.zc
@@ -29,6 +29,7 @@ int chk_reset() {
 	tline = 1;
 	toff = 0 - 1; toklen = 0; tpend = 0 - 1; tpline = 1;
 	infn = 0;
+	defer_drop(0); dfr_base = 0; dfr_on = 0;
 	fdepth = 0;
 	fslots = 0;
 	fchk = 0;
diff --git a/src/compiler/decl.zc b/src/compiler/decl.zc
index 45269a4..19b1811 100644
--- a/src/compiler/decl.zc
+++ b/src/compiler/decl.zc
@@ -153,7 +153,7 @@ int unit_stdin() {
 // that a nested compile would otherwise clobber (locals, depth, frame size,
 // loop stack position, the expression-state globals). closures use the same
 // pair.
-const int CTX_WORDS = 48;
+const int CTX_WORDS = 49;
 int ctx_push() {
 	af_forget();
 	word f;
@@ -164,7 +164,7 @@ int ctx_push() {
 	f[13] = lv; f[14] = lvk; f[15] = lvi; f[16] = kw_expr; f[17] = xcls; f[18] = snaptop;
 	f[19] = fty; f[20] = ntp; f[21] = xty; rt.copy_w(f + 22, tpn, 8);
 	f[30] = finsym; f[31] = finfer; f[32] = ifcur; f[33] = ifcall; f[34] = effect_current; f[35] = borrow_slots; f[36] = borrow_pending; f[37] = borrow_depth; f[38] = borrow_jump; f[39] = borrow_entry; f[40] = capture_enabled; f[41] = effect_value; f[42] = xprojection; f[43] = effect_floor; f[44] = module_name; f[45] = module_imports;
-	f[46] = fn_return_type; f[47] = if_value;
+	f[46] = fn_return_type; f[47] = if_value; f[48] = dfr_base;
 	return 0;
 }
 // pop the innermost function context.
@@ -175,6 +175,7 @@ int ctx_pop() {
 	local_drop(f[0]);
 	fdrop(nloc);
 	lend_drop(1 << 30, f[0]);
+	defer_drop(dfr_base); dfr_base = f[48];
 	lbase = f[1];
 	fdepth = f[2];
 	fslots = f[3];
@@ -204,6 +205,7 @@ int fn_begin(int chk, int ret) {
 	capture_enabled = 0; effect_value = 0; effect_current = 0; borrow_slots = 0; borrow_pending = 0; borrow_depth = 0; borrow_jump = -1; borrow_entry = 0;
 	if (cmode && svkind && !dry) rt.fill_w(svkind, 0, nsym); xvk = 0;
 	lend_drop(1 << 30, nloc);
+	dfr_base = ndfr;
 	lbase = nloc; fdepth = 1; fslots = 0; fchk = chk && check_on; fret = ret; fty = 0; finfer = 0; fn_return_type = 0;
 	live = 1; bxdepth = 0; epichain = 0; infn = 1; loopbase = lsp; lv = 0; lvk = LV_NONE; xbor = -1;
 	return 0;
@@ -258,6 +260,7 @@ int body() {
 	}
 	closed = is_op(s_rb); endplace = toff + toklen;
 	if (probe_off >= 0 && !chkabort && !dry && !ginst && incdepth == 0 && ctxsp <= nclo && toff >= probe_off) { probe_snap(); chkabort = 1; }
+	defer_run(1, 1);	// the function's own deferred statements, before its locals are checked
 	local_hints(lbase);
 	unused_check(lbase);
 	if (ifcur) if_fin();
@@ -1343,6 +1346,7 @@ int compile_list_context(int q, int top, char* module, word imports) {
 		fn_begin(1, 0);
 		prologue(); borrow_prologue(); borrow_begin();
 		while (tk != T_EOF) stmt();
+		defer_run(1, 1);
 		unused_check(lbase);
 		if (fchk && live) exit_vars(1, 1);
 		epilogue();
diff --git a/src/compiler/setup.zc b/src/compiler/setup.zc
index 4986fc3..1d8ce6f 100644
--- a/src/compiler/setup.zc
+++ b/src/compiler/setup.zc
@@ -110,6 +110,7 @@ int zc_tables() {
 	add_kw("switch", kw_switch, F_STMT);
 	add_kw("break", kw_break, F_STMT);
 	add_kw("continue", kw_continue, F_STMT);
+	add_kw("defer", kw_defer, F_STMT);
 	add_kw("return", kw_return, F_STMT);
 	add_kw("unchecked", kw_unchecked, F_STMT);
 	add_kw("asm", kw_asm, F_STMT | F_EXPR);
diff --git a/src/compiler/stmt.zc b/src/compiler/stmt.zc
index a2ad0d1..21d5801 100644
--- a/src/compiler/stmt.zc
+++ b/src/compiler/stmt.zc
@@ -391,6 +391,8 @@ int kw_break() {
 	if (lsp <= loopbase) { serr("break outside a loop or a switch"); return 0; }
 	f = R_LOOP + (lsp - 1) * 8;
 	if (f[4] != bxdepth) { serr("break can't leave a block expression"); return 0; }
+	if (dfr_on && dfr_ctx == ctxsp && lsp <= dfr_lsp) { serr("break can't leave a deferred statement"); return 0; }
+	defer_run(f[2] + 1, 0);
 	exit_vars(f[2] + 1, 0);
 	if (live) exit_rec(hole()); else hole();
 	op(O_JMP);
@@ -406,6 +408,8 @@ int kw_continue() {
 	if (j < loopbase) { serr("continue outside a loop"); return 0; }
 	f = R_LOOP + j * 8;
 	if (f[4] != bxdepth) { serr("continue can't leave a block expression"); return 0; }
+	if (dfr_on && dfr_ctx == ctxsp && j < dfr_lsp) { serr("continue can't leave a deferred statement"); return 0; }
+	defer_run(f[2] + 1, 0);
 	backedge(f[3]);
 	exit_vars(f[2] + 1, 0);
 	if (f[0] == -2) { f[7] = fixnew(hole(), f[7]); op(O_JMP); }	// do/while: the condition isn't placed yet
@@ -413,6 +417,100 @@ int kw_continue() {
 	live = 0;
 	return 0;
 }
+// ---- defer ----
+
+// defer expr;  or  defer { statements }  registers code that runs when the
+// enclosing block ends. nothing is compiled at the defer: its tokens are kept
+// on the dfr stack (DFR_W words per entry: block depth, token list, whether
+// the analyzer was on, whether it failed, locals at the defer) and compiled
+// again, inline, at every exit that leaves the block: the end of the block
+// (block_close, and body for a function), return, break and continue. so the
+// deferred code is evaluated when it runs and sees the variables as they are
+// then, and the analyzer sees its frees and moves at the exit, where they
+// happen. a defer a branch never reached is not on the stack at an exit on
+// another path, because the stack only holds the defers read so far in the
+// blocks still open. the entries of an exit run newest first.
+word .u defer_tokens() {
+	int n = 0, depth = 0, blk = is_op(s_lb), semi, bad = 0; word q;
+	while (1) {
+		if (tk == T_EOF) { bad = 1; break; }
+		semi = 0;
+		if (tk == T_OP) {
+			if (tv == s_lb || tv == s_lp || tv == s_lk) depth++;
+			else if (tv == s_rb || tv == s_rp || tv == s_rk) depth--;
+			else if (tv == s_semi && depth == 0) semi = 1;
+		}
+		if (depth < 0) { bad = 1; break; }
+		reserve_R_QBUF((n + 1) * 3);
+		R_QBUF[n * 3] = tk; R_QBUF[n * 3 + 1] = tv; R_QBUF[n * 3 + 2] = tpack(); n++;
+		next();
+		if (semi) break;
+		if (blk && depth == 0) { accept(s_semi); break; }
+	}
+	if (bad) { die("missing ; after the deferred statement"); n = 0; }
+	q = rt.new(n * 3 + 1);
+	q[0] = n;
+	rt.copy_w(q + 1, R_QBUF, n * 3);
+	return u*q;
+}
+int kw_defer() {
+	int k; word q;
+	stmtonly();
+	if (!infn) { serr("defer outside a function"); return 0; }
+	if (ndfr >= DFR_MAX) { die("too many pending defers in one function"); return 0; }
+	next();
+	q = defer_tokens();
+	k = ndfr * DFR_W;
+	dfr[k] = fdepth; dfr[k + 1] = d*q; dfr[k + 2] = fchk; dfr[k + 3] = 0; dfr[k + 4] = nloc;
+	ndfr++;
+	return 0;
+}
+// forget the deferred statements from entry base up
+int defer_drop(int base) {
+	word q;
+	while (ndfr > base) { ndfr--; q = dfr[ndfr * DFR_W + 1]; dfr[ndfr * DFR_W + 1] = 0; rt.free(q); }
+	return 0;
+}
+// compile one deferred statement here. the locals declared after the defer are
+// hidden while it is compiled, so its names mean what they meant where it was
+// written (a name declared later in the block, or one that an inner block
+// declares again, is not seen).
+int defer_one(int e) {
+	word q = dfr[e * DFR_W + 1]; int j, k, mark = dfr[e * DFR_W + 4], top = nloc, e0 = nerr;
+	int ofchk = fchk, oon = dfr_on, olsp = dfr_lsp, octx = dfr_ctx, n0 = ndfr;
+	j = nloc;
+	while (j > mark) { j--; k = local_key(lname[j]); lheads[k] = lprev[j]; }
+	fchk = dfr[e * DFR_W + 2]; dfr_on = 1; dfr_lsp = lsp; dfr_ctx = ctxsp;
+	src_push(1, q, 0, 0); next(); stmt();
+	if (tk != T_EOF) serr("unexpected tokens after the deferred statement");
+	src_pop();
+	defer_drop(n0);
+	if (nloc > top) local_drop(top);
+	j = mark;
+	while (j < top) { k = local_key(lname[j]); lheads[k] = j; j++; }
+	fchk = ofchk; dfr_on = oon; dfr_lsp = olsp; dfr_ctx = octx;
+	if (nerr != e0) dfr[e * DFR_W + 3] = 1;
+	return 0;
+}
+// compile the deferred statements registered at block depth dep or deeper in
+// this function, newest first, here. pop is for the end of a block, which
+// forgets them; an early exit (return, break, continue) leaves them, the
+// block's normal end still runs them on the other path. nothing is emitted
+// where control can't arrive, and a statement that failed once is not
+// compiled again, so its error is reported once.
+int defer_run(int dep, int pop) {
+	int i = ndfr;
+	if (live) {
+		while (i > dfr_base && dfr[(i - 1) * DFR_W] >= dep) {
+			i--;
+			if (!dfr[i * DFR_W + 3]) defer_one(i);
+		}
+	}
+	if (pop) {
+		while (ndfr > dfr_base && dfr[(ndfr - 1) * DFR_W] >= dep) defer_drop(ndfr - 1);
+	}
+	return 0;
+}
 // switch (e) { case 1, 2: ... case 'x': ... default: ... }
 // cases don't fall through: each one ends where the next begins, and break
 // leaves the switch early. case labels are constants.
@@ -540,6 +638,7 @@ int kw_return() {
 	next();
 	if (!infn) serr("return outside a function");
 	if (bxdepth) serr("return can't leave a block expression");
+	if (dfr_on && dfr_ctx == ctxsp) { serr("return can't be used in a deferred statement"); return resync(); }
 	if (is_op(s_semi)) { lit(0); c = C_PLAIN; if_ret(0, 1); }
 	else {
 		c = expr(); rval();
@@ -560,6 +659,7 @@ int kw_return() {
 	expect(s_semi);
 	retcheck(c);
  borrow_cleanup();
+	defer_run(1, 0);	// the value is on the stack; the deferred code is stack neutral
 	exit_vars(1, 0);
 	epichain = fixnew(here, epichain);
 	lit(rt.MW - 1); op(O_JMP);