namespace rt;
include run;

// the runtime pokes at headers and raw memory on purpose and runs at full speed: no index bounds checks
unbounded;

// ============================================================================
// rt.zc: the runtime half of the genome. memory map, i/o, arithmetic helpers,
// the heap (size-class free lists) and the mark-sweep collector.
// ============================================================================

// how the runtime is laid out, for a reader coming in cold:
//
//   memory map     generated constants name the regions used by a build. the
//                  compiler and runtime use the same names and values.
//   i/o, strings   thin wrappers over the cpu's i/o opcodes, plus the two
//                  string forms (char* strings and packed byte strings).
//   heap           a buddy allocator with a 5 word header on every block.
//                  new/free/recycle are built on it. every heap object has at
//                  most one owner (the container that holds it), and freeing
//                  an owner frees what it owns.
//   growable arrays  T[?] handles, built on the heap.
//   mark-sweep     a conservative collector. it is the safety net behind
//                  free: anything the compiler's ownership analysis could not
//                  free gets reclaimed here.
//   memory debug   optional checks (use after free, double free, leaks).
//   syscalls       file and environment access through one gate word.
//
// everything is a 64-bit word, and an address is a word index, not a byte
// index. the cpu is a stack machine, so "asm { a @ . }" pushes a, fetches the
// word at that address with @, then outputs it with . (see the vm reference).
//
// ---- memory map (words) ----

// src/tools/genmap writes the map values for each build between these markers.
// keep the names and order stable so programs can use the same map interface
// across targets and image sizes.

// @map-rt
const MW = 0x1DD000;
const CODE_END = 0x80000;
const HEAP_LO = 0x1DD000;
const HEAP_HI = 0x23D000;
const HEAP_GROW = 0x1;
const ZFP = 0x90000;
const GORG = 0x114100;
const FBOT = 0x17C100;
const FTOP = 0x1BC100;
const RS0 = 0x1BC100;
const MARK0 = 0x1CC100;
const MARKN = 0x8000;
const DSLO = 0x1D4100;
const DSHI = 0x1DCFF0;
const MAGIC = 0x2B7E1516;
// @end-map

// frames grow in stable segments so pointers to a caller's locals stay valid.

word frame_floor = FBOT, frame_top = FTOP, frame_node;
int frame_chunk = FTOP - FBOT, frame_guard = (FTOP - FBOT) >> 2, frame_busy, gc_active;
word[17] frame_control;
word data_low = DSLO, data_top = DSHI, data_node;
word return_low = RS0, return_top = MARK0 - 8, return_node;
const int F_STACK = 1024;
const int F_INTERNAL = 512;

// ---- virtual enhancements ----

// install(desc) passes a descriptor to the core through the % opcode. the core
// reads it and installs the region it describes in the cpu, so the compiler can replace
// a run of vm code with native code. the descriptor is laid out by the compiler
// for each enhance and o3 region (see install in compiler.zc). the enhance lines
// below are the micro forms of the same thing: a single machine instruction each.
// zdiv, zmod and zshl further down do the same arithmetic in software. this block
// comes first, since the compiler resolves / % and << to these names.


// install the descriptor for an optimized region.
int install(int desc) { return asm { desc @ % }; }
// signed division of a by b, as one machine instruction.
enhance idiv(a, b) micro "a = sdiv a b";
// signed remainder of a divided by b, as one machine instruction.
enhance imod(a, b) micro "a = srem a b";
// a shifted left by b, as one machine instruction.
enhance ishl(a, b) micro "a = shl a b";
// for o3: the address of a variable at fp + k.
enhance lfa(k) micro "r1 = ld 589824; k = add r1 k";
// 1 when i is outside 0..n-1 (the unsigned compare also catches negative i), else 0.
enhance outside(i, n) micro "i = ltu i n; i = xor i 1";
//: the block length has exactly two definitions, which must agree: the r7 lines of this
//: recipe (the inline check on every backend; the x86-64 and arm64 jits lower it to
//: registers, with nothing pointer-specific of their own) and paylen below (bchk's report).
//: an exact-size check or a new header layout changes those two places and nothing else.
// the index check of a pointer, as one instruction: 1 when p is the start of a heap
// block (its check word p[-3] is p ^ MAGIC) and the byte or word offset i * m is not
// inside the block's payload (q units per word: 1 for word elements, 8 for packed
// ones), else 0. a load outside memory reads 0, so any p is safe to ask about. the
// payload is paylen (p[-5] - HDR words, at most the size an o3 raw block was asked for,
// which is the complement of its type word p[-1] when that is negative). see bchk.
enhance bnd(p, i, m, q) micro "r6 = sub p 3; r6 = ld r6; r7 = xor p 0x2B7E1516; r6 = eq r6 r7; r7 = sub p 5; r7 = ld r7; r7 = sub r7 5; r8 = sub p 1; r8 = ld r8; r8 = not r8; r7 = minu r7 r8; r7 = mul r7 q; r8 = mul i m; r8 = ltu r8 r7; r8 = xor r8 1; r0 = and r6 r8";
// ---- bit operations and float conversions ----

// these use single machine instructions where the cpu has them.


// the number of leading zero bits in a.
enhance clz(a) micro "a = clz a";
// the number of trailing zero bits of a.
enhance ctz(a) micro "a = ctz a";
// the number of one bits in a.
enhance popcnt(a) micro "a = popcnt a";
// a with its bytes in reverse order.
enhance bswap(a) micro "a = bswap a";
// a rotated left by n bits.
enhance rotl(a, n) micro "a = rotl a n";
// a rotated right by n bits.
enhance rotr(a, n) micro "a = rotr a n";
// the high word of the signed product of a and b.
enhance mulhi(a, b) micro "a = mulhs a b";
// the high word of the unsigned product of a and b.
enhance umulhi(a, b) micro "a = mulhu a b";
// the float a, converted to a signed integer.
enhance f2s(a) micro "a = f2s a";
// the signed integer a, converted to a float.
enhance s2f(a) micro "a = s2f a";
// f2s, the software form used where the cpu has none.
enhance zf2s(a) micro "a = f2s a";
// s2f, the software form used where the cpu has none.
enhance zs2f(a) micro "a = s2f a";

// runtime code segments retain the addresses of earlier functions and globals.
word code_blocks;
// distinguish a raw function address from a heap closure's environment block.
int callable_code(word f) {
	word p = code_blocks;
	if (f < HEAP_LO) return 1;
	while (p) { if (f >= p[1] && f < p[2]) return 1; p = p[0]; }
	return 0;
}

// ---- i/o ----

// output can be redirected. mode 1 drops what is written and mode 2 appends
// it to a buffer; mode 3 counts characters without storing them (the server
// uses these modes while it checks a document,
// so a parse word that prints can't write into the protocol stream).
// raw_c always reaches the terminal.

int outmode; char* outbuf; int outn, outcap; word outgrow;
// write one character to the terminal with no translation.
int raw_c(int ch) { asm { ch @ . } return 0; }
// write one character. normally it goes to the terminal; while a capture is
// running (see capture in src/lib/std.zc) it goes into the capture buffer instead.
int put_c(int ch) {
	if (outmode) {
		if (outmode == 3) outn++;
		else if (outmode == 2) {
			if (outn >= outcap && outgrow) outgrow();
			if (outn < outcap) { outbuf[outn] = ch; outn++; }
		}
		return 0;
	}
	asm { ch @ . }
	return 0;
}
// read one character from the input, as a byte value. -1 means the input has
// ended, so check eof when a -1 could be a real value.
int get_c() { return asm { , }; }
// true when the input has no more characters. a get_c after this gives -1.
int eof() { return asm { ? }; }
// stop the machine now. nothing after it runs, and the exit status is 0.
int halt() { asm { q } return 0; }
// write a zero-terminated string, one character at a time. it is the same as
// put_c on each byte of s, so a capture sees the text too.
int put_s(char* s) {
	int i = 0;
	while (s[i]) { put_c(s[i]); i++; }
	return 0;
}
// write the decimal form of a number, with a minus sign for a negative one.
// the smallest integer is handled as its own case.
int put_n(int n) {
	char[24] b; int i = 0;
	if (n < 0) { put_c('-'); n = 0 - n; }
	if (n < 0) { put_s("9223372036854775808"); return 0; }
	while (1) { b[i++] = '0' + n % 10; n = n / 10; if (!n) break; }
	while (i) put_c(b[--i]);
	return 0;
}
// the length of a zero-terminated character string, not counting its 0.
int len_w(char* s) {
	int n = 0;
	while (s[n]) n++;
	return n;
}
// true when two zero-terminated character strings hold the same characters.
int eq_w(char* a, char* b) {
	int i = 0;
	while (a[i] && a[i] == b[i]) i++;
	return a[i] == b[i];
}
// ---- word helpers ----

// copy and fill by word. copy_w copies forward, so overlapping ranges are only
// valid when dst is below src. a long run above the program area goes to the
// host in one call (ops 18 and 19 of the syscall gate); a host that answers -1
// (a board, the js vm, a range that overlaps itself) gets the plain loop.

const int SYS_FILL = 18, SYS_COPY = 19;
// copy n words from src to dst.
unchecked int copy_w(word*.m dst, word*.m src, int n) {
	int i = 0; word g = ZFP + 2;
	if (n >= 16 && dst >= MW) {
		g[1] = dst; g[2] = src; g[3] = n; g[0] = SYS_COPY;
		if (g[0] == n) return 0;
	}
	while (i < n) { dst[i] = src[i]; i++; }
	return 0;
}
// set n words at dst to v.
unchecked int fill_w(word*.m dst, int v, int n) {
	int i = 0; word g = ZFP + 2;
	if (n >= 16 && dst >= MW) {
		g[1] = dst; g[2] = v; g[3] = n; g[0] = SYS_FILL;
		if (g[0] == n) return 0;
	}
	while (i < n) { dst[i] = v; i++; }
	return 0;
}

// byte addresses sit beside word addresses. word w is bytes (w << 3) through
// (w << 3) + 7, and byte 0 of a word is its low 8 bits. a byte address is a
// plain integer: the odd/even tag is only for code words, and u/m/d stay on
// the word pointer of a heap object. 16- and 32-bit accesses are little-endian
// and may cross a word. an access that runs off the end of memory loads 0 and
// stores nothing. a byte store never fires the syscall gate; that is a word
// store at SYSGATE. opcodes 612..617, words 1224..1234.

int addr_b(int w) { return w << 3; }
// the word address of a byte address b.
int addr_w(int b) { return b >> 3; }
// load the byte at address a.
int ld8(int a) { return asm { a @ #1224 }; }
// store the low byte of v at address a.
int st8(int a, int v) { asm { v @ a @ #1226 }; return 0; }
// load the 16-bit value at address a.
int ld16(int a) { return asm { a @ #1228 }; }
// store the low 16 bits of v at address a.
int st16(int a, int v) { asm { v @ a @ #1230 }; return 0; }
// load the 32-bit value at address a.
int ld32(int a) { return asm { a @ #1232 }; }
// store the low 32 bits of v at address a.
int st32(int a, int v) { asm { v @ a @ #1234 }; return 0; }

// a byte string: word 0 is the length, then the bytes packed little-endian
// starting at the next word, and a 0 byte after the last character. literals
// b"..." live in the code and are not heap objects. cat_s, slice_s, n_to_s and
// new_s return a shared heap object with the same layout: many pointers may
// hold it, free does nothing, and the collector reclaims it. char* strings
// (one character per word) are unchanged.

// exposes the length header and packed storage for low-level runtime operations.
word* bstr_storage(bstr s) { return asm { s @ }; }
// forms a packed-string handle from storage with a valid length header.
bstr bstr_handle(word* p) { return asm { p @ }; }
// the number of bytes in a packed byte string.
int len_s(bstr s) { return bstr_storage(s)[0]; }
// byte i of a packed byte string.
int at_s(bstr s, int i) {
	if (i < 0 || i >= len_s(s)) return 0;
	return ld8(addr_b(bstr_storage(s) + 1) + i);
}
// a new packed byte string of n bytes, managed by the collector.
bstr new_s(int n) {
	word* p = new(1 + ((n + 8) >> 3));
	p[0] = n;
	return bstr_handle(share(p));
}
// store byte v at position i of a packed byte string.
int sput(bstr s, int i, int v) { st8(addr_b(bstr_storage(s) + 1) + i, v); return 0; }
// a new string with a followed by b, managed by the collector.
bstr cat_s(bstr a, bstr b) {
	int n = len_s(a) + len_s(b); bstr p = new_s(n); int i = 0;
	while (i < len_s(a)) { sput(p, i, at_s(a, i)); i++; }
	i = 0;
	while (i < len_s(b)) { sput(p, len_s(a) + i, at_s(b, i)); i++; }
	sput(p, n, 0);
	return p;
}
// a new string with the characters from i to j of s, managed by the collector.
bstr slice_s(bstr s, int i, int j) {
	int n; bstr p; int k = 0;
	if (i < 0) i = 0;
	if (j > len_s(s)) j = len_s(s);
	if (j < i) j = i;
	n = j - i;
	p = new_s(n);
	while (k < n) { sput(p, k, at_s(s, i + k)); k++; }
	sput(p, n, 0);
	return p;
}
// compare two packed byte strings: negative, 0 or positive, like strcmp.
int cmp_s(bstr a, bstr b) {
	int i = 0, n = len_s(a), ca, cb;
	if (len_s(b) < n) n = len_s(b);
	while (i < n) {
		ca = at_s(a, i); cb = at_s(b, i);
		if (ca != cb) { if (ca < cb) return 0 - 1; return 1; }
		i++;
	}
	if (len_s(a) == len_s(b)) return 0;
	if (len_s(a) < len_s(b)) return 0 - 1;
	return 1;
}
// true when two packed byte strings are equal.
int eq_s(bstr a, bstr b) { return cmp_s(a, b) == 0; }
// true when packed byte string a sorts before b.
int lt_s(bstr a, bstr b) { return cmp_s(a, b) < 0; }
// true when packed byte string a sorts before b or equals it.
int le_s(bstr a, bstr b) { return cmp_s(a, b) <= 0; }
// write a packed byte string.
int put_bs(bstr s) {
	int i = 0;
	while (i < len_s(s)) { put_c(at_s(s, i)); i++; }
	return 0;
}
// the decimal number at the start of a packed byte string.
int s_to_n(bstr s) {
	int n = 0, i = 0, sign = 1; word c;
	if (len_s(s) && at_s(s, 0) == '-') { sign = 0 - 1; i = 1; }
	while (i < len_s(s)) {
		c = at_s(s, i);
		if (c < '0' || c > '9') break;
		n = n * 10 + c - '0';
		i++;
	}
	return n * sign;
}
// a new packed byte string holding the decimal form of n.
bstr n_to_s(int n) {
	word[24] b; int i = 0, j = 0, neg = 0; bstr p; char* t;
	if (!n) { p = new_s(1); sput(p, 0, '0'); sput(p, 1, 0); return p; }
	if (n < 0) { neg = 1; n = 0 - n; }
	if (n < 0) {
		t = "-9223372036854775808";
		p = new_s(20);
		while (t[i]) { sput(p, i, t[i]); i++; }
		sput(p, i, 0);
		return p;
	}
	while (n) { b[i] = '0' + n % 10; i++; n = n / 10; }
	p = new_s(i + neg);
	if (neg) { sput(p, 0, '-'); j = 1; }
	while (i) { i--; sput(p, j, b[i]); j++; }
	sput(p, j, 0);
	return p;
}

// ---- arithmetic the hardware doesn't have ----

word[64] pow2;
int zrem;
// unsigned division of a by dv.
int zudiv(int n, int dv) {
	int q = 0, r = 0, i = 62;
	if (n < dv) { zrem = n; return 0; }
	while (i >= 0) {
		r = r + r + ((n >> i) & 1);
		q = q + q;
		if (r >= dv) { r = r - dv; q++; }
		i--;
	}
	zrem = r;
	return q;
}
// signed division of a by b, rounding toward zero, as c does.
int zdiv(int a, int b) {
	word s = 0; int q;
	if (b == 0) { zrem = a; return 0; }
	if (a < 0) { a = 0 - a; s = 1; }
	if (b < 0) { b = 0 - b; s = s ^ 1; }
	q = zudiv(a, b);
	if (s) return 0 - q;
	return q;
}
// signed remainder of a divided by b, with the sign of a, as c does.
int zmod(int a, int b) {
	int neg = a < 0;
	if (b == 0) return a;
	zdiv(a, b);
	if (neg) return 0 - zrem;
	return zrem;
}
// a shifted left by b bits, for b under 64.
int zshl(int a, int b) { return a * pow2[b & 63]; }

// ---- heap ----

// a buddy allocator. the heap is cut into aligned power-of-two chunks, every
// block is a power of two words, and a freed block merges with its buddy
// (the other half of the block they were split from) whenever that one is
// free too, so freed space can be reused at any size. every block has a 5
// word header before the pointer the program sees:
//   p[-5] block size
//   p[-4] flags in the low 16 bits, size class in the next 5
//     0 free (check word cleared) or quarantined (check word still p ^ MAGIC)
//     1 live   2 releasing   3 marked   4 quarantined but a word still points at it
//   bit 8 (value 8) is orthogonal: the object is shared. free is a no-op,
//   own and release do not follow it, and the sweep still collects it when
//   nothing points at it. bits 0..2 keep the meanings above.
//   p[-3] p ^ MAGIC    p[-2] owner (the container that owns it, or 0)
//   p[-1] its type (a type record from new(T), 0 from new(n), -(n + 1) from o3's new_raw)
// free blocks sit on a doubly linked list per class, linked through p[0], p[1].
// free quarantines: the block stays intact until a sweep finds nothing pointing
// at it. recycle is the fast path for a pointer the program has already
// dropped: it pushes the block onto its size-class list and does not walk the
// heap. a two-word node is still 8 words (the smallest block); a three-word
// node fits in 8 instead of 16.

const int HDR = 5;
// p[-4] bit, orthogonal to live / mark / releasing.
const int F_SHARE = 8;
// flags live in these bits; the size class is above them.
const int F_LOW = 65535;
int hbump; word[32] freel; int gc_runs, gc_freed, gc_auto = 1;
// block walks and new chunks stop here.
int hstop;
// while nonzero, balloc will not return a block overlapping this range.
int hold_lo, hold_hi;
// words of memory the host has (0: the heap cannot grow); hcut: the heap was cut, so it must not grow.
int hmax, hcut;
// memdebug bits, and the line the compiler stamps before new.
int dbg, alloc_line;

// the size of the top-level chunk holding heap offset off, within [0, hstop)
int topsize(int off) {
	int h = hstop - HEAP_LO, base = 0, sz;
	while (h) {
		sz = 1;
		while (sz + sz <= h) sz = sz + sz;
		if (off < base + sz) return sz;
		base = base + sz; h = h - sz;
	}
	return 0;
}
// the free lists. freel[k] heads a doubly linked list of free blocks of
// 2^k words; the links live in the block's first payload words (b[5], b[6]
// here, since b is the header address). fpush places a block on the front of its
// class list, funlink takes one out of the middle, mkblock stamps a fresh
// header, and bclass reads the size class back out of the flags word.
int fpush(word b, int k) {
	b[1] = k * pow2[16];
	b[5] = freel[k];
	b[6] = 0;
	if (freel[k]) freel[k][6] = b;
	freel[k] = b;
	return 0;
}
// remove block b from its size-class free list.
int funlink(word b, int k) {
	if (b[6]) b[6][5] = b[5]; else freel[k] = b[5];
	if (b[5]) b[5][6] = b[6];
	return 0;
}
// turn the memory at b into a free block of size class k.
word mkblock(word b, int k) {
	b[0] = pow2[k];
	b[1] = k * pow2[16];
	b[2] = 0;
	b[3] = 0;
	b[4] = 0;
	return b;
}
// the size class of a heap block.
word bclass(word b) { return (b[1] >> 16) & 31; }
// rebuild the free lists for [HEAP_LO, hstop). returns 0 if that span is not
// a whole number of top-level chunks (nothing is left half-built: the caller
// restores the full heap).
int fill_free() {
	int b = HEAP_LO, sz, k;
	fill_w(freel, 0, 32);
	while (b < hstop) {
		sz = topsize(b - HEAP_LO);
		if (sz <= 0 || b + sz > hstop) return 0;
		k = 0;
		while (k < 31 && pow2[k] < sz) k++;
		if (pow2[k] != sz) return 0;
		fpush(mkblock(b, k), k);
		b = b + sz;
	}
	return 1;
}
// start-up: build the power-of-two table and hand the whole heap range to
// the free lists as a few big blocks
int heap_init() {
	int i = 1;
	if (frame_guard > 1024) frame_guard = 1024;
	pow2[0] = 1;
	while (i < 64) { pow2[i] = pow2[i - 1] + pow2[i - 1]; i++; }
	hstop = HEAP_HI;
	hbump = HEAP_HI;
	hold_lo = 0;
	hold_hi = 0;
	hcut = 0;
	hmax = 0;
	// a map with a growing heap queries the host for available memory. a host
	// that does not answer (-1) or has no more than the initial heap gets a
	// fixed heap
	if (HEAP_GROW) { hmax = syscall(9, 0, 0, 0); if (hmax <= HEAP_LO) hmax = 0; }
	fill_free();
	frame_control[0] = &frame_floor; frame_control[1] = &frame_top; frame_control[2] = &frame_guard;
	frame_control[3] = &data_low; frame_control[4] = &data_top; frame_control[5] = &data_node;
	frame_control[6] = &return_low; frame_control[7] = &return_top; frame_control[8] = &return_node;
	frame_control[9] = freel; frame_control[10] = &hstop; frame_control[11] = &hbump;
	frame_control[12] = &hmax; frame_control[13] = &hold_lo; frame_control[14] = &hold_hi; frame_control[15] = &hcut;
	frame_control[16] = &gc_active;
	syscall(9, 6, frame_control, 0);
	return 0;
}
// drop [lim, HEAP_HI) out of the allocator. the compiler reserves this range
// for type records when it overlaps the heap; the type list is at its start, so
// it cannot also be a buddy header. returns 1 if the cut landed on chunk
// boundaries. allocations that would still overlap [lim, HEAP_HI) are refused.
int heap_reset(int lim) {
	int ok;
	if (lim <= HEAP_LO || lim > HEAP_HI) return 0;
	hstop = lim;
	hbump = lim;
	hold_lo = 0;
	hold_hi = 0;
	if (lim < HEAP_HI) { hold_lo = lim; hold_hi = HEAP_HI; hcut = 1; }
	ok = fill_free();
	if (!ok) {
		hstop = HEAP_HI;
		hbump = HEAP_HI;
		hold_lo = 0;
		hold_hi = 0;
		hcut = 0;
		fill_free();
	}
	return ok;
}
// put a power-of-two tail back. addr is the cut point heap_reset was given.
int heap_uncut(int addr, int k) {
	hstop = HEAP_HI;
	hbump = HEAP_HI;
	hold_lo = 0;
	hold_hi = 0;
	hcut = 0;
	if (addr < HEAP_LO || addr + pow2[k] > HEAP_HI) return 0;
	fpush(mkblock(addr, k), k);
	return 0;
}
// take a block of 2^k words. find the smallest non-empty class at or above k,
// unlink its first block and split it down: each half that is not kept goes
// back on its own list. a block that overlaps the held range is marked
// "releasing" and dropped from the lists permanently (the loop retries),
// so the compiler's type area is never handed out as heap.
word balloc(int k) {
	int j; word b; int h, ok;
	while (1) {
		j = k;
		while (j < 32 && !freel[j]) j++;
		if (j >= 32) return 0;
		b = freel[j];
		funlink(b, j);
		while (j > k) { j--; h = b + pow2[j]; fpush(mkblock(h, j), j); }
		mkblock(b, k);
		ok = 1;
		if (hold_hi && b < hold_hi && b + pow2[k] > hold_lo) {
			b[1] = (k * pow2[16]) | 2;
			b[5] = 0;
			b[6] = 0;
			ok = 0;
		}
		if (ok) return b;
	}
	return 0;
}
// ---- a heap that grows ----

// the heap is [HEAP_LO, hstop). on a map with HEAP_GROW the memory above
// HEAP_HI belongs to the host (a big zeroed array nobody has touched yet), and
// when the free lists cannot satisfy a request the heap takes more of it. the
// buddy allocator does not care where the top is, as long as the top-level
// chunks (topsize) are right: extending hstop re-cuts them, and every new
// piece goes through bfree, which merges it with a free buddy below it. a
// block that is in use stays where it is, so no pointer moves.

// grow so that a block of 2^k words fits: double the heap, or less when the
// host runs out. returns 0 when it cannot.
int heap_grow(int k) {
	int h = hstop - HEAP_LO, h2, need, o, sz, c, room;
	if (!hmax || hcut || hold_hi) return 0;
	room = hmax - HEAP_LO;
	need = (h + pow2[k] - 1) / pow2[k] * pow2[k] + pow2[k];
	h2 = h + h;
	if (h2 < need) h2 = need;
	if (h2 > room) {	// the machine is smaller than the requested heap: the host grows it (syscall 9, 4)
		hmax = syscall(9, 4, HEAP_LO + h2, 0);
		if (hmax <= HEAP_LO) hmax = 0;
		room = hmax - HEAP_LO;
	}
	if (h2 > room) h2 = room;
	if (h2 < need) return 0;
	hstop = HEAP_LO + h2;
	hbump = hstop;
	o = h;
	while (o < h2) {
		// the biggest aligned power of two that starts at o and ends by h2
		sz = 8; c = 3;
		while (sz + sz <= h2 - o && o % (sz + sz) == 0) { sz = sz + sz; c++; }
		bfree(mkblock(HEAP_LO + o, c));
		o = o + sz;
	}
	return 1;
}
// words the heap spans right now (it only ever grows)
int heap_size() { return hstop - HEAP_LO; }
// words on the free lists
int hfree() {
	int k = 3, n = 0; word b;
	while (k < 32) {
		b = freel[k];
		while (b) { n = n + pow2[k]; b = b[5]; }
		k++;
	}
	return n;
}
// end of the block bfree last made, for the sweep.
int fend;
// put block b back, merging it with its buddy as long as it can
int bfree(word b) {
	int k = bclass(b), sz = pow2[k], off; word bud;
	while (1) {
		off = b - HEAP_LO;
		if (sz >= topsize(off)) break;
		bud = HEAP_LO + (off ^ sz);
		// a quarantined buddy still has its check word, and isn't on a free list
		if ((bud[1] & F_LOW) != 0 || bclass(bud) != k || bud[0] != sz || bud[2]) break;
		funlink(bud, k);
		// the upper header is inside the merged block now
		if (bud < b) {
			b[0] = 0;
			b[2] = 0;
			b = bud;
		}
		else { bud[0] = 0; bud[2] = 0; }
		k++; sz = sz + sz;
		mkblock(b, k);
	}
	fpush(mkblock(b, k), k);
	fend = b + sz;
	return 0;
}
// back onto the size-class list, with no buddy walk and no heap scan
int bdrop(word b) {
	int k = bclass(b);
	b[2] = 0;
	fpush(b, k);
	return 0;
}
// is x the payload address of a block that has been allocated (live or
// quarantined)? the check word p[-3] == p ^ MAGIC validates the pointer before
// checking it against block metadata; a random value would have to match by chance.
word isobj(word x) { return x >= HEAP_LO + HDR && x < hbump && x[-3] == (x ^ MAGIC) && (x[-4] & 1); }
// the number of words to skip in p[0..n) before one that could be a pointer
// to a block (see op 20 in core.c); n when none can be. a long payload of
// plain numbers costs one host call instead of an isobj per word. a host that
// does not have the op (-1) is asked once and then never again.
const int SYS_SCAN = 20;
int scan_off;
// walk the n words at p and mark every heap object they point to.
int scan_ptr(int p, int n) {
	word g = ZFP + 2; int r;
	if (n < 8 || scan_off) return 0;
	g[1] = p; g[2] = n; g[3] = hbump; g[0] = SYS_SCAN;
	r = g[0];
	if (r < 0) { scan_off = 1; return 0; }
	return r;
}

// every prologue checks the frame stack; on overflow it resets the frame
// pointer (so this can run at all) and stops
int frame_overflow() {
	put_s("zy: frame stack overflow\n");
	trace_at(1);
	halt();
	return 0;
}
// choose the minimum size of subsequent frame segments, in words.
int reserve_frames(int words) {
	if (words > frame_chunk) frame_chunk = words;
	return frame_chunk;
}
// reserve stack words without invalidating locals or their borrowed addresses.
int reserve_data(int words) { return syscall(9, 7, words, 0); }
// grow the return-address stack to hold at least words entries.
int reserve_returns(int words) { return syscall(9, 8, words, 0); }
// the prologue restores oldfp before calling this helper. its own calls use
// the guard space below oldfp; they must not try to grow another segment.
word frame_grow(int oldfp, int attempted) {
	int size = frame_chunk, slots = oldfp - attempted; word p;
	frame_busy = 1;
	if (!hstop || slots < 0 || slots > 0x7FFFFFFF - frame_guard - 4) {
		*ZFP = FTOP; frame_overflow(); return 0;
	}
	if (size < slots + frame_guard + 4) size = slots + frame_guard + 4;
	p = new_oz(size);
	p[-4] = p[-4] | F_INTERNAL | F_STACK;
	if (gc_active) p[-4] = p[-4] | 2;
	p[0] = oldfp; p[1] = frame_floor; p[2] = frame_top; p[3] = frame_node;
	frame_floor = p + 4; frame_top = p + p[-5] - HDR; frame_node = p;
	frame_chunk = size;
	frame_busy = 0;
	return frame_top - slots;
}
// only the final frame in a segment calls this helper. the helper's own
// epilogue still uses that segment; the caller stores the restored pointer.
word frame_leave() {
	word p = frame_node; int oldfp = p[0];
	frame_busy = 1;
	frame_floor = p[1]; frame_top = p[2]; frame_node = p[3];
	bdrop(p - HDR);
	frame_busy = 0;
	return oldfp;
}
// report that the heap is out of memory, and stop.
int oom() {
	outmode = 0; outgrow = 0;
	put_s("zc: out of heap memory\n");
	trace_at(1);
	halt();
	return 0;
}
// n words, untyped and not zeroed. the type word keeps -(n + 1), so fatten
// can type it later. typed new goes through new_t. o3 new(n) goes through
// new_oz, which zeroes the words that were asked for.
int .u new_raw(int n) {
	int need = n + HDR, k = 3; word b; int p;
	if (n > 0x7FFFFFFF - HDR) { oom(); return 0; }
	if (n < 0) need = HDR;
	while (pow2[k] < need) k++;
	b = balloc(k);
	if (!b) {
		// collect first; if that leaves the heap more than three quarters full (or
		// still short), take more memory from the host
		if (gc_auto) {
			gc();
			b = balloc(k);
			if (HEAP_GROW && hfree() < (hstop - HEAP_LO) / 4) heap_grow(k);
		}
		if (!b) { heap_grow(k); b = balloc(k); }
		if (!b) oom();
	}
	p = b + HDR;
	b[1] = (k * pow2[16]) | 1; b[2] = p ^ MAGIC; b[3] = 0; b[4] = 0 - n - 1;
	// the words past n are not the object's. zero them so a later walk
	// doesn't follow garbage. the n words themselves stay uninitialized.
	if (n > 0 && b[0] - HDR > n) fill_w(p + n, 0, b[0] - HDR - n);
	else if (n <= 0) fill_w(p, 0, b[0] - HDR);
	return p;
}
// n words, untyped, zeroed. the type word stays -(n + 1). new_raw does not
// zero the words that were asked for, so typed new does not zero them twice.
int .u new_oz(int n) {
	int p = new_raw(n);
	if (n > 0) fill_w(p, 0, n);
	return p;
}
// n words typed t, zeroed. memdebug records the line the compiler stored in alloc_line
word .u new_t(int n, int t) {
	word p = new_raw(n);
	p[-1] = t;
	fill_w(p, 0, p[-5] - HDR);
	if (dbg & 1) note_alloc(p, alloc_line);
	return p;
}
// new(n) allocates n zeroed words without a type stamp. new(T) and new(T, n) allocate
// a fresh heap object of type T (n of them for the second form) and stamp T in its
// header; the compiler rewrites those forms to new_t or new_k. the caller owns it,
// and the analyzer frees it when its owner's block ends.
word .u new(int n) { return new_t(n, 0); }
// the compiler works out the size class of a constant-size new at compile
// time (k is the class of n + HDR words), so a repeated allocation of the same
// shape pays for no class search. when the class list has a block, pop it
// directly; a free block already has the right size and an empty payload to
// refill. in a loop that frees its object every pass (an m local) this is the
// recycled block, so the pair costs about a dozen steps.
// memdebug, an empty list, or a block inside the held range (balloc's rule
// for the compiler's type area) fall back to the general path.
word .u new_k(int n, int t, int k) {
	word b = freel[k], p, nx;
	if (!b || dbg || (hold_hi && b < hold_hi && b + pow2[k] > hold_lo)) return new_t(n, t);
	nx = b[5];
	freel[k] = nx;
	if (nx) nx[6] = 0;
	p = b + HDR;
	b[1] = (k * pow2[16]) | 1; b[2] = p ^ MAGIC; b[3] = 0; b[4] = t;
	if (k == 3) { p[0] = 0; p[1] = 0; p[2] = 0; }	// the smallest block: three payload words
	else fill_w(p, 0, pow2[k] - HDR);
	return p;
}
// the size in words of the heap object p, as new asked for it.
int osize(word p) {
	if (!isobj(p)) return 0;
	return p[-5] - HDR;
}
// the type record stamped on the heap object p by new(T), or 0 when there is none.
int typeof_obj(word p) {
	if (!isobj(p) || p[-1] < 0) return 0;
	return p[-1];
}

// how many payload words a free walk should follow. a raw object only owns
// the words new asked for; the slack past that was never zeroed.
int paylen(word p) {
	int n = p[-5] - HDR, req;
	if (p[-1] < 0) { req = 0 - p[-1] - 1; if (req < n) n = req; }
	return n;
}
// frees p and, recursively, every object p owns. the block stays quarantined.
int release(word p) {
	word b = p - HDR; int n = paylen(p), i = 0; word w;
	b[1] = (b[1] & ~7) | 2;	// going: not live, and not free yet either, so a child's buddy check can't merge into it
	while (i < n) {
		i = i + scan_ptr(p + i, n - i);
		if (i >= n) break;
		w = p[i]; if (isobj(w) && !(w[-4] & F_SHARE) && w[-2] == p) release(w);
		i++;
	}
	b[1] = b[1] & ~7;	// quarantined. the check word and the bytes stay; the next sweep reclaims it
	return 0;
}
// releases a heap object and consumes an owned object automatically. an explicit
// d* recast is also accepted; a borrowed reference cannot be consumed.
// storage remains quarantined until collection finds no references to it.
// releasing an already released or shared object has no effect.
unchecked int free(.d p) {
	int n;
	if (isobj(p) && (p[-4] & F_SHARE)) return 0;
	if ((dbg & 1) && quar(p)) {
		put_s("zy: double free from line "); put_n(site_line_of(p)); put_c(10);
		trace_at(1);
		return 0;
	}
	if (isobj(p)) {
		n = paylen(p);
		release(p);
		if (dbg & 2) fill_w(p, 57005, n);	// 0xDEAD, so a stale read is obvious
	}
	return 0;
}
// the pointer is the last one. children go first, then the block returns to
// its size-class list. no sweep, no buddy walk.
unchecked int recycle(.d p) {
	word b; int n, i = 0; word w;
	if ((dbg & 1) && quar(p)) {
		put_s("zy: double free from line "); put_n(site_line_of(p)); put_c(10);
		trace_at(1);
		return 0;
	}
	if (!isobj(p) || (p[-4] & F_SHARE)) return 0;
	b = p - HDR;
	n = paylen(p);
	b[1] = (b[1] & ~7) | 2;
	while (i < n) {
		i = i + scan_ptr(p + i, n - i);
		if (i >= n) break;
		w = p[i]; if (isobj(w) && !(w[-4] & F_SHARE) && w[-2] == p) recycle(w);
		i++;
	}
	if (dbg & 2) fill_w(p, 57005, n);
	bdrop(b);
	return 0;
}
// the matching free for an object whose type has no pointer fields
// (a typed new of a struct of numbers). it checks the type word and the size
// class still match what the compiler assumed, since the variable may have been
// reassigned; if not, or under memdebug, it takes the general route.
unchecked word recycle_leaf(.d p, int t, int k) {
	word b = p - HDR; int f; word h;
	if (dbg || p < HEAP_LO + HDR || p >= hbump) return recycle(p);
	f = b[1];
	if (b[2] != (p ^ MAGIC) || (f & F_LOW) != 1 || p[-1] != t || ((f >> 16) & 31) != k) {
		return recycle(p);
	}
	h = freel[k];	// the block goes on the head of its class list, ready for the next new_k
	b[2] = 0; b[1] = k * pow2[16]; b[5] = h; b[6] = 0;
	if (h) h[6] = b;
	freel[k] = b;
	return 0;
}
// make p the owner of c, so that freeing p also frees c. it returns c, so the call
// composes: h[0] = own(b, h). a shared object has no owner and is left alone.
word own(word c, int p) {
	if (isobj(c) && !(c[-4] & F_SHARE)) c[-2] = p;
	return c;
}
// an opt-in bump arena of n words, made as one block. the handle owns that block.
// arena_alloc returns interior pointers into it and does not use the buddy lists,
// and arena_reset gives all of it back at once.
word .u arena_new(int n) {
	word h = new(3), b; int cap = n;
	if (cap < 1) cap = 1;
	b = new(cap);
	h[0] = own(b, h);
	h[1] = cap;
	h[2] = 0;
	return h;
}
// take n zeroed words from arena a. it returns the address, or 0 when the arena
// does not have n words left.
int arena_alloc(word a, int n) {
	int p, at;
	if (!a || n < 0) return 0;
	at = a[2];
	if (at + n > a[1]) return 0;
	p = a[0] + at;
	if (n) fill_w(p, 0, n);
	a[2] = at + n;
	return p;
}
// give back every block of arena a at once. the words it held are reused by the next
// arena_alloc calls, so pointers into the arena from before are no longer valid.
int arena_reset(word a) {
	if (a) a[2] = 0;
	return 0;
}
// publish p. a shared object has no owner: free does nothing to it, copies of its
// pointer are ordinary words, and the collector reclaims it once every copy is gone.
// returns p.
word share(word p) {
	if (!isobj(p)) return p;
	p[-4] = (p[-4] & ~7) | 1 | F_SHARE;
	p[-2] = 0;
	return p;
}
// true when p is a shared object, which free leaves alone.
int is_shared(word p) {
	if (!isobj(p)) return 0;
	if (p[-4] & F_SHARE) return 1;
	return 0;
}
// make an immutable pair of a and b. a heap object that is stored in either side is
// published too, so a later free from its old owner cannot clear a cell that still
// points at it. read with car and cdr.
unchecked word cons(int a, int b) {
	word p = new(2);
	share(a); share(b);
	p[0] = a; p[1] = b;
	return share(p);
}
// make an immutable record of three words, a, b and c. read the words with tget.
unchecked word triple(int a, int b, int c) {
	word p = new(3);
	share(a); share(b); share(c);
	p[0] = a; p[1] = b; p[2] = c;
	return share(p);
}
// the first word of a pair made by cons.
word car(word p) {
	if (dbg & 1) checkptr(p);
	return p[0];
}
// the second word of a pair made by cons.
word cdr(word p) {
	if (dbg & 1) checkptr(p);
	return p[1];
}
// word i (0, 1 or 2) of a triple made by triple.
word tget(word p, int i) {
	if (dbg & 1) checkptr(p);
	return p[i];
}

// ---- growable arrays ----

// a T[?] is a handle: [len, cap, items, element size]. items is an object the
// handle owns; growing swaps it for a bigger one and moves its children over.

unchecked word .u dnew(int es, int n, int t) {
	word h = new_t(4, t); int c = n; word it;
	if (c < 4) c = 4;
	if (es < 0) it = new((c * (0 - es) + 7) >> 3); else it = new(c * es);	// a negative size is a packed element of that many bytes
	h[0] = n; h[1] = c; h[2] = own(it, h); h[3] = es;
	return h;
}
// grow the growable array h so that it can hold need elements.
unchecked int dgrow(word h, int need) {
	int c = h[1]; word it; int old = h[2], i = 0; word w; int n, es = h[3];
	if (need <= c) return 0;
	while (c < need) c = c + c;
	if (es < 0) { it = new((c * (0 - es) + 7) >> 3); n = (h[0] * (0 - es) + 7) >> 3; es = 0; }
	else { it = new(c * es); n = h[0] * es; }
	copy_w(it, old, n);
	// the children move with the elements (packed bytes have none)
	while (es && i < n) {
		w = it[i];
		if (isobj(w) && w[-2] == old) w[-2] = it;
		i++;
	}
	h[2] = own(it, h); h[1] = c;
	free(old);
	return 0;
}
// ---- line tables and backtraces ----

// with lines on (the default for a program) the compiler records, for every
// function it compiles, a line block among the code: [next, entry, end, name,
// file, count, then count words of offset << 32 | line]. name and file are
// packed byte strings (length word, then the bytes). each word after the
// count says that the code from entry + offset up to the next word's offset
// came from that source line. blocks are chained through line_blocks, newest
// first. a function nested in another (a closure) has its own block and the
// innermost block holding an address is the one that names it. the compiler
// fills line_blocks when it compiles in the same memory as the program; the
// compiler of an image writes the head into the image's own line_blocks.
// frame_namer, when the compiler is resident, is a function that returns the
// name (a zero-terminated character string) of the function holding an
// address, for frames in code without lines.
word line_blocks, frame_namer;
// op 56 of the syscall gate: the return stack pointer, the word after the top return address.
const int SYS_RSP = 56;
// a trace shows this many of the innermost frames, then skips to the last few
const int TRACE_HEAD = 24, TRACE_TAIL = 4;
// the line block of the innermost function whose code holds address a, or 0
word line_block_of(int a) {
	word b = line_blocks, best = 0;
	while (b) {
		if (b[1] <= a && a < b[2] && (!best || b[1] > best[1])) best = b;
		b = b[0];
	}
	return best;
}
// the source line of address a within its line block b: the last recorded line at or before it
int line_of(word b, int a) {
	int i = 0, off = a - b[1], n = b[5], line = 0; word w;
	while (i < n) {
		w = b[6 + i];
		if ((w >> 32) > off) break;
		line = w & 0xFFFFFFFF;
		i++;
	}
	return line;
}
// write the hexadecimal form of a number
int put_hex(int n) {
	char[20] b; int i = 0, d;
	put_s("0x");
	if (!n) { put_c('0'); return 0; }
	while (n && i < 16) { d = n & 15; if (d < 10) b[i++] = '0' + d; else b[i++] = 'a' + d - 10; n = n >> 4; }
	while (i) put_c(b[--i]);
	return 0;
}
// write the line for one frame, given the return address a that is on the
// return stack: its function, file and line when the compiler recorded them,
// else the address and the nearest name. code of the runtime and the compiler
// that has no lines is left out, as are words that are not return addresses.
// returns 1 when a line was written.
int trace_frame(int a) {
	word b; char* name = 0;
	if (a <= 0) return 0;
	b = line_block_of(a - 1);
	if (b) {
		put_s("  at "); put_bs(b[4]); put_c(':'); put_n(line_of(b, a - 1)); put_s(" in "); put_bs(b[3]); put_c(10);
		return 1;
	}
	if (a >= GORG && a < GORG[6]) return 0;
	if (!callable_code(a)) return 0;
	if (frame_namer) name = frame_namer(a);
	put_s("  at "); put_hex(a);
	if (name) { put_s(" in "); put_s(name); }
	put_c(10);
	return 1;
}
// print the call stack, innermost call first, one line per frame, from the
// return stack. skip is how many words at the top of the stack belong to the
// runtime's own calls and are left out: a function that calls trace_at passes 1
// to leave out the return into itself. this reads the pointer with the gate
// store inline, since a call to syscall would add a frame of its own.
int trace_at(int skip) {
	word g = ZFP + 2; int r, lo, shown = 0, left; word rs;
	g[1] = 0; g[2] = 0; g[3] = 0; g[0] = SYS_RSP;
	r = g[0];
	lo = return_low;
	if (r <= lo || r - lo > 0x7FFFFFF) return 0;
	r = r - skip;
	while (r > lo && shown < TRACE_HEAD) { r--; rs = r; if (trace_frame(rs[0])) shown++; }
	left = r - lo;
	if (left > TRACE_TAIL + 8) {
		put_s("  ... "); put_n(left - TRACE_TAIL); put_s(" more frames\n");
		r = lo + TRACE_TAIL;
	}
	while (r > lo) { r--; rs = r; trace_frame(rs[0]); }
	return 0;
}
// print the current call stack without stopping
int trace() { trace_at(1); return 0; }
// the out-of-range report for T[?] indexing (dat, dpop)
int oob(int i, int n) {
	put_s("zy: index ");
	put_n(i);
	put_s(" out of range (length ");
	put_n(n);
	put_s(")\n");
	trace_at(1);
	halt();
	return 0;
}
// element i of a growable array h. indexing with [] does the same, with the bounds
// check. the bounds check is what oob reports when i is outside the array.
word dat(word h, int i) {
	if (i < 0 || i >= h[0]) oob(i, h[0]);
	return h[2] + i * h[3];
}
// the bounds check of p[i] on a pointer (or an untyped word), emitted by the compiler
// in front of the access. a pointer has no length, but a pointer to the start of
// a heap block does have one: the words the block holds (paylen). for any
// other pointer (the middle of a block, a frame, a global, memory managed by hand)
// nothing is known and this returns at once. sz is the element size in words, or
// minus the element size in bytes for packed elements. the length is the block's
// payload, which a buddy block rounds up to a power of two; an o3 raw block is exact.
int bchk(word p, int i, int sz) {
	int n;
	if (p < HEAP_LO + HDR || p >= hbump || p[-3] != (p ^ MAGIC)) return 0;
	n = paylen(p);
	if (sz > 0) {
		if (i >= 0 && i < n && i * sz < n) return 0;
		oob(i, (n + sz - 1) / sz);
		return 0;
	}
	sz = 0 - sz; n = n * 8;
	if (i >= 0 && i < n && i * sz < n) return 0;
	oob(i, (n + sz - 1) / sz);
	return 0;
}
// add x to the end of a growable array h, growing its items when they are full. the
// array owns the items, so x is handed to it (tagged d).
unchecked int dpush(word h, .d x) {
	dgrow(h, h[0] + 1);
	h[2][h[0]] = x;
	own(x, h[2]);
	h[0] = h[0] + 1;
	return 0;
}
// remove the last element of a growable array h and give it back. the array
// must not be empty.
word dpop(word h) {
	word value;
	if (!h[0]) oob(-1, 0);
	h[0] = h[0] - 1;
	value = h[2][h[0]]; h[2][h[0]] = 0;
	if (isobj(value) && value[-2] == h[2]) own(value, 0);
	return value;
}
// set the length of a growable array h to n. growing it fills the new elements with
// zero, and shrinking it drops the elements past n.
int dresize(word h, int n) {
	int old = h[0] * h[3], end, i; word value;
	if (n < 0) n = 0;
	dgrow(h, n);
	end = n * h[3];
	if (end > old) fill_w(h[2] + old, 0, end - old);
	else {
		i = end;
		while (i < old) {
			value = h[2][i]; h[2][i] = 0;
			if (isobj(value) && value[-2] == h[2]) free(value);
			i++;
		}
	}
	h[0] = n;
	return 0;
}
// packed elements (h[3] is minus their size in bytes): the address is a byte address
word datb(word h, int i) {
	if (i < 0 || i >= h[0]) oob(i, h[0]);
	return addr_b(h[2]) + i * (0 - h[3]);
}
// add the byte x to the end of a growable byte array h.
int dpushb(word h, int x) {
	int b = 0 - h[3], a;
	dgrow(h, h[0] + 1);
	a = addr_b(h[2]) + h[0] * b;
	if (b == 1) st8(a, x); else if (b == 2) st16(a, x); else st32(a, x);
	h[0] = h[0] + 1;
	return 0;
}
// remove and return the last byte of a growable byte array h.
int dpopb(word h) {
	int b = 0 - h[3], a;
	if (!h[0]) oob(-1, 0);
	h[0] = h[0] - 1;
	a = addr_b(h[2]) + h[0] * b;
	if (b == 1) return ld8(a);
	if (b == 2) return ld16(a);
	return ld32(a);
}
// growing zeroes the new elements, including the unused tail of the last word
int dresizeb(word h, int n) {
	int b = 0 - h[3], a, e, old = (h[0] * b + 7) >> 3, nw;
	if (n < 0) n = 0;
	if (n > h[0]) {
		dgrow(h, n);
		a = addr_b(h[2]) + h[0] * b;
		e = addr_b(h[2]) + old * 8;
		if (e > addr_b(h[2]) + n * b) e = addr_b(h[2]) + n * b;
		while (a < e) { st8(a, 0); a++; }
		nw = (n * b + 7) >> 3;
		if (nw > old) fill_w(h[2] + old, 0, nw - old);
	}
	h[0] = n;
	return 0;
}
// the length of a growable array, the number of elements it holds.
int dlen(word h) { return h[0]; }
// the capacity of a growable array: how many elements it can hold before it grows.
int dcap(word h) { return h[1]; }

// ---- mark-sweep ----

// conservative and non-moving. roots: the program area (globals live
// between functions), the genome's globals, the compiler's input stack,
// the live part of the frame stack and the live part of the data stack.
// opcode 619 pushes that index. a word below it is not a root.

int ms_top, ms_over, gc_lo, gc_hi;
word ms_buf = MARK0; int markcap = MARKN;
// mark work must grow without starting another collection inside this one.
int reserve_mark(int need) {
	int cap = markcap, auto = gc_auto; word p;
	if (need <= cap) return cap;
	while (cap < need) cap = cap * 2;
	gc_auto = 0; p = new_oz(cap); gc_auto = auto;
	copy_w(p, ms_buf, ms_top);
	p[-4] = p[-4] | F_INTERNAL;
	if (gc_active) p[-4] = p[-4] | 2;
	ms_buf = p; markcap = cap; return cap;
}
// mark one word. a word that is not the payload address of a block is not a
// pointer and is ignored (conservative). a live block gets its mark bit and
// goes on the mark stack to have its payload scanned. a quarantined block that
// something still points at is flagged 4 so the sweep keeps it quarantined
// instead of reusing it. the work stack grows before appending another block.
int mark(word w) {
	int p = 0;
	if (w < HEAP_LO + HDR || w >= hbump || w[-3] != (w ^ MAGIC)) {
		if (dbg & 4) { p = obj_base(w); if (p) return mark(p); }
		return 0;
	}
	if (w[-4] & 1) { if (w[-4] & 2) return 0; w[-4] = w[-4] | 2; }	// live
	else if ((w[-4] & F_LOW) == 0) w[-4] = w[-4] | 4;		// quarantined, but still pointed at
	else return 0;
	if (w == ms_buf || (w[-4] & F_STACK)) return 0;
	if (ms_top >= markcap) reserve_mark(markcap * 2);
	ms_buf[ms_top] = w; ms_top++;
	return 0;
}
// mark every word in [a, b). note *a is a plain load of the word at a.
int markrange(word a, int b) {
	if (dbg & 4) { while (a < b) { mark(*a); a++; } return 0; }	// interior pointers: every word counts
	while (a < b) {
		a = a + scan_ptr(a, b - a);
		if (a >= b) break;
		mark(*a);
		a++;
	}
	return 0;
}
// empty the mark stack: scan the payload of each marked block
int drain() {
	int p = 0;
	while (ms_top) { ms_top--; p = ms_buf[ms_top]; ms_buf[ms_top] = 0; markrange(p, p + p[-5] - HDR); }
	return 0;
}
// stack blocks are marked without scanning their unused payload. each saved
// segment records the caller's live range and the previous segment's node.
int gc_frames() {
	word p = frame_node;
	markrange(*ZFP, frame_top);
	while (p) { mark(p); markrange(p[0], p[2]); p = p[3]; }
	return 0;
}
// gc_roots is defined in the compiler half (it identifies the compiler's
// own tables live); it calls markrange over every root range
int run.gc_roots();
// runs a collection: the blocks nothing points at are reclaimed, quarantined blocks
// included, and the number of blocks freed is returned. cycles are reclaimed too.
unchecked int gc() {
	word b = 0; int sz = 0, n = 0;	// a leftover pointer here would be a root and pin a block
	ms_top = 0; ms_over = 0; gc_active = 1;
	run.gc_roots();
	drain();
	while (ms_over) {	// the mark stack overflowed: rescan marked objects
		ms_over = 0;
		b = HEAP_LO;
		while (b < hstop) {
			if ((b[1] & 7) == 3 || (b[1] & 7) == 4) markrange(b + HDR, b + b[0]);
			b = b + b[0];
			drain();
		}
	}
	b = HEAP_LO;
	while (b < hstop) {
		sz = b[0];
		if ((b[1] & 7) == 1) { bfree(b); n++; b = fend; }	// unmarked live object, shared or not
		else if ((b[1] & 7) == 3) { b[1] = (b[1] & ~7) | 1; b = b + sz; }
		else if ((b[1] & 7) == 4) { b[1] = b[1] & ~7; b = b + sz; }	// still pointed at: stays quarantined
		else if (!(b[1] & 7) && b[2] == ((b + HDR) ^ MAGIC)) { bfree(b); n++; b = fend; }
		else b = b + sz;
	}
	gc_runs++;
	gc_active = 0;
	gc_freed = gc_freed + n;
	return n;
}
// the number of live heap objects, for tests and leak checks.
int live_objects() {
	word b = HEAP_LO; int n = 0;
	while (b < hstop) {
		if ((b[1] & 1) && !(b[1] & F_INTERNAL)) n++;
		b = b + b[0];
	}
	return n;
}
// the size, in words, of the biggest block that is free right now.
int largest_free() {
	int k = 31;
	while (k > 0 && !freel[k]) k--;
	if (!freel[k]) return 0;
	return pow2[k];
}
// the data-stack index: the first live word. opcode 619, word 1238.
int dsp() { return asm { #1238 }; }
// zero the unused data stack, from the bottom up to the live top. the last
// 16 words are the ones this loop is using, so they are pushed as zeros.
int scrub() {
	int top; word p;
	top = dsp();
	p = data_low;
	if (top < data_low + 16) return 0;
	while (p + 16 < top) { *p = 0; p++; }
	asm { 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 };
	asm { _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ };
	return 0;
}

// ---- memory debug ----

// dbg bits: 1 header checks and allocation sites, 2 poison the payload on free
// (the word 57005, which is 0xDEAD), 4 interior pointers keep a quarantined
// block (obj_base finds its header from the size classes). off unless
// a program requests. sites are p ^ MAGIC so the collector does not treat them as pointers.

const int NSITE = 64;
const int POISON = 57005;
int site_drop;
word[64] site_p; word[64] site_line;
// true when p is a freed block still held in quarantine.
word quar(word p) { return p >= HEAP_LO + HDR && p < hbump && p[-3] == (p ^ MAGIC) && !(p[-4] & 1); }
// the object whose payload contains w, or 0. exact pointers and interiors, at any
// depth. every block of class k starts at HEAP_LO plus a multiple of 2^k words, so
// the block holding w, if any, starts at w rounded down to one of those. the
// candidates are tried from the largest class down: a header counts only when its
// check word, size and class agree with k, and the first that holds w in its
// payload is the block. a merge clears the upper half's header and a split rewrites
// the header at the same address, so a stale header can only sit inside the
// payload of the real block, which is found first.
word obj_base(int w) {
	int k = 31, off, sz; word b, p;
	if (w < HEAP_LO + HDR || w >= hbump) return 0;
	off = w - HEAP_LO;
	while (k >= 3) {
		sz = pow2[k];
		b = HEAP_LO + off - off % sz;
		p = b + HDR;
		if (sz <= hbump - HEAP_LO && p < hbump && b[0] == sz && p[-3] == (p ^ MAGIC) && bclass(b) == k) {
			if (w >= p && w < b + sz) return p;
		}
		k--;
	}
	return 0;
}
// the source line recorded for the allocation at p.
word site_line_of(int p) {
	int i = 0, k = p ^ MAGIC;
	while (i < NSITE) { if (site_p[i] == k) return site_line[i]; i++; }
	return 0;
}
// record the source line of the allocation of p, for the leak report.
int note_alloc(int p, int line) {
	int i = 0, k, slot = -1, q;
	if (!(dbg & 1) || !p) return 0;
	k = p ^ MAGIC;
	while (i < NSITE) {
		if (site_p[i] == k) { site_line[i] = line; return 0; }
		if (slot < 0 && !site_p[i]) slot = i;
		i++;
	}
	i = 0;
	while (i < NSITE) {
		q = site_p[i] ^ MAGIC;
		if (site_p[i] && !isobj(q) && !quar(q)) { slot = i; i = NSITE; }
		else i++;
	}
	if (slot < 0) { site_drop = 1; return 0; }
	site_p[slot] = k; site_line[slot] = line;
	return 0;
}
// turns memdebug's checks on or off with a bit set: bit 1 checks headers and reports
// use after free, and the other bits add allocation lines and poison. a program
// turns them on with memdebug on; and the runtime calls this with the flags.
int mem_set(int flags) { dbg = flags; return flags; }
// a heap address used while dbg bit 1 is on: a dead header is a use after free.
int checkptr(int w) {
	word p;
	if (!(dbg & 1) || !w) return 0;
	if (w < HEAP_LO || w >= hstop) return 0;
	p = obj_base(w);
	if (!p) { put_s("zy: bad heap pointer\n"); trace_at(1); halt(); return 0; }
	if (!(p[-4] & 1)) {
		put_s("zy: use after free from line "); put_n(site_line_of(p)); put_c(10);
		trace_at(1);
		halt();
	}
	return 0;
}
// prints the live objects and the lines they were allocated on, the leak report that
// memdebug produces at the end of a run.
int memreport() {
	int i = 0, p, n = 0;
	if (site_drop) put_s("mem: site table full\n");
	while (i < NSITE) {
		if (site_p[i]) {
			p = site_p[i] ^ MAGIC;
			if (isobj(p)) {
				put_s("leak: line "); put_n(site_line[i]); put_s(" "); put_n(osize(p)); put_s(" words\n");
				n++;
			}
		}
		i++;
	}
	return n;
}

// ---- host syscalls ----

// a store of the op number to SYSGATE runs it. the three words after the gate
// are the arguments, and the store leaves the result in the gate.
//   1 open(path, 0 read | 1 write-create)   2 close(fd)
//   3 read(fd, buf, n)   4 write(fd, buf, n)   bytes, one per word
//   5 getenv(name, buf, cap)   6 time() unix seconds
//   21 argc()   22 argv(i, buf, cap)   23 envc()   24 envp(i, buf, cap)
//   40 raw(block)   any linux syscall: the block holds the number and six arguments.
//      the result is the kernel's, or -errno. see Host.raw in src/lib/std.zc

const int SYSGATE = ZFP + 2;
const int SYS_OPEN = 1, SYS_CLOSE = 2, SYS_READ = 3, SYS_WRITE = 4, SYS_GETENV = 5, SYS_TIME = 6;
// terminates the host process with the exit status supplied in argument a.
const int SYS_EXIT = 7;
const int SYS_BOPEN = 10, SYS_BREAD = 11, SYS_BWRITE = 12, SYS_BGETENV = 13;
const int SYS_RAW = 40;
// the command line and the environment. argv holds the program path, which is
// <eval> when the source came from stdin, so argc is 1 even with no arguments.
// the string ops take an index and copy one entry across, one character per
// word like SYS_GETENV: a zero buffer requests the length alone, so the caller
// can size the string before it fetches it. src/lib/std.zc builds the arrays.
const int SYS_ARGC = 21, SYS_ARG = 22, SYS_ENVC = 23, SYS_ENV = 24;
// byte-string paths. the address is the first byte (addr_b of the word after
// the length), not the string object. char* string syscalls are unchanged.
int bopen(bstr path, int mode) { return syscall(SYS_BOPEN, addr_b(bstr_storage(path) + 1), mode, 0); }
// read up to n bytes from fd into the packed byte string s.
int bread(int fd, bstr s, int n) { return syscall(SYS_BREAD, fd, addr_b(bstr_storage(s) + 1), n); }
// write the first n bytes of the packed byte string s to fd.
int bwrite(int fd, bstr s, int n) { return syscall(SYS_BWRITE, fd, addr_b(bstr_storage(s) + 1), n); }
// copy the value of the environment variable name into dst, returning its length.
int bgetenv(bstr name, bstr dst, int n) { return syscall(SYS_BGETENV, addr_b(bstr_storage(name) + 1), addr_b(bstr_storage(dst) + 1), n); }
// ---- c abi ----

// ops 14..17 reach native code (see the c abi section of core.c and extern in
// compiler.zc). cfind(name) is 1 if a native symbol resolves (name is a byte
// string), cload(path) opens a library so its symbols resolve, and
// cbmake(entry, sig) is a native function pointer that runs the zc function at
// entry (cfunc(f) in the compiler builds the signature). a native pointer
// from cbmake only works while a native call is in progress, and not on the
// arm64 jit, where it is 0.

const int SYS_CCALL = 14, SYS_CFIND = 15, SYS_CBMAKE = 16, SYS_CLOAD = 17;
// the address of the native symbol name in the loaded libraries, or 0 when it is not
// loaded. see cload.
int cfind(bstr name) { return syscall(SYS_CFIND, addr_b(bstr_storage(name) + 1), 0, 0); }
// loads the shared library at path, so the symbols it defines can be found with cfind.
int cload(bstr path) { return syscall(SYS_CLOAD, addr_b(bstr_storage(path) + 1), 0, 0); }
// makes a native function pointer that runs the vm entry with the signature sig,
// so c code can call a zc function through it.
int cbmake(int entry, int sig) { return syscall(SYS_CBMAKE, entry, sig, 0); }
// calls the host through the gate word, with the op number and up to three arguments.
// the result comes back as the call's return value (negative for an error). prefer the
// named ops (SYS_OPEN and the rest) to the raw numbers.
int syscall(int op, word a, word b, word c) {
	word g = SYSGATE;
	g[1] = a; g[2] = b; g[3] = c; g[0] = op;
	return g[0];
}
// reads a file into an owned character string; returns null if opening fails.
char* .u readfile(char* path) {
	int fd; char* buf; int n = 0, got, cap; char* nb;
	fd = syscall(SYS_OPEN, path, 0, 0);
	if (fd < 0) return 0;
	cap = 256;
	buf = new(cap);
	while (1) {
		if (n + 128 >= cap) {
			nb = new(cap + cap);
			copy_w(nb, buf, n);
			free(buf);
			buf = nb;
			cap = cap + cap;
		}
		got = syscall(SYS_READ, fd, buf + n, 128);
		if (got <= 0) break;
		n = n + got;
	}
	buf[n] = 0;
	syscall(SYS_CLOSE, fd, 0, 0);
	return buf;
}
// reads a file's bytes into an owned block, one byte to a word after a length word:
// [n, b0, b1, ...]. unlike readfile, a 0 byte in the file is kept. returns null if
// opening fails.
word.u readbytes(char* path) {
	int fd; word buf; int n = 0, got, cap; word nb;
	fd = syscall(SYS_OPEN, path, 0, 0);
	if (fd < 0) return 0;
	cap = 256;
	buf = new(cap);
	while (1) {
		if (n + 130 >= cap) {
			nb = new(cap + cap);
			copy_w(nb, buf, n + 1);
			free(buf);
			buf = nb;
			cap = cap + cap;
		}
		got = syscall(SYS_READ, fd, buf + 1 + n, 128);
		if (got <= 0) break;
		n = n + got;
	}
	buf[0] = n;
	syscall(SYS_CLOSE, fd, 0, 0);
	return buf;
}