diff options
Diffstat (limited to 'src/runtime/rt.zc')
| -rw-r--r-- | src/runtime/rt.zc | 1326 |
1 files changed, 1326 insertions, 0 deletions
diff --git a/src/runtime/rt.zc b/src/runtime/rt.zc new file mode 100644 index 0000000..3badcc2 --- /dev/null +++ b/src/runtime/rt.zc @@ -0,0 +1,1326 @@ +// ============================================================================ +// 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 (word 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 word MW = 0x1C5000; +const word CODE_END = 0x80000; +const word HEAP_LO = 0x1C5000; +const word HEAP_HI = 0x225000; +const int HEAP_GROW = 0x1; +const word ZFP = 0x90000; +const word GORG = 0x114100; +const word FBOT = 0x164100; +const word FTOP = 0x1A4100; +const word RS0 = 0x1A4100; +const word MARK0 = 0x1B4100; +const int MARKN = 0x8000; +const word DSLO = 0x1BC100; +const word DSHI = 0x1C4FF0; +const int 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; +[17]word 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) hands the core a descriptor through the % opcode. the core reads +// it and wires the region it describes into 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"; +// ---- 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; word 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) { + [24]word 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 word string, not counting its 0. +int len_w(char* s) { + int n = 0; + while (s[n]) n++; + return n; +} +// true when two word 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 +// safe 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, /* wowie! */ SYS_COPY = 19; +// copy n words from src to dst. +int copy_w(word* dst, word* 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. +int fill_w(word* 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. word strings +// (one character per word) are unchanged. +int len_s(word s) { return s[0]; } +// byte i of a packed byte string. +int at_s(word s, int i) { + if (i < 0 || i >= s[0]) return 0; + return ld8(addr_b(s + 1) + i); +} +// a new packed byte string of n bytes, owned by the caller. +unchecked word new_s(int n) { + word p = new(1 + ((n + 8) >> 3)); + p[0] = n; + return share(p); +} +// store byte v at position i of a word string. +int sput(word s, int i, int v) { st8(addr_b(s + 1) + i, v); return 0; } +// a new string with a followed by b, owned by the caller. +unchecked word cat_s(word a, word b) { + int n = a[0] + b[0]; word p = new_s(n); int i = 0; + while (i < a[0]) { sput(p, i, at_s(a, i)); i++; } + i = 0; + while (i < b[0]) { sput(p, a[0] + i, at_s(b, i)); i++; } + sput(p, n, 0); + return p; +} +// a new string with the characters from i to j of s, owned by the caller. +unchecked word slice_s(word s, int i, int j) { + int n; word p; int k = 0; + if (i < 0) i = 0; + if (j > s[0]) j = s[0]; + 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 word strings: negative, 0 or positive, like strcmp. +int cmp_s(word a, word b) { + int i = 0, n = a[0], ca, cb; + if (b[0] < n) n = b[0]; + 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 (a[0] == b[0]) return 0; + if (a[0] < b[0]) return 0 - 1; + return 1; +} +// true when two word strings are equal. +int eq_s(word a, word b) { return cmp_s(a, b) == 0; } +// true when word string a sorts before b. +int lt_s(word a, word b) { return cmp_s(a, b) < 0; } +// true when word string a sorts before b or equals it. +int le_s(word a, word b) { return cmp_s(a, b) <= 0; } +// write a packed byte string. +int put_bs(word s) { + int i = 0; + while (i < s[0]) { put_c(at_s(s, i)); i++; } + return 0; +} +// the decimal number at the start of a packed byte string. +int s_to_n(word s) { + int n = 0, i = 0, sign = 1; word c; + if (s[0] && at_s(s, 0) == '-') { sign = 0 - 1; i = 1; } + while (i < s[0]) { + 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. +unchecked word n_to_s(int n) { + [24]word b; int i = 0, j = 0, neg = 0; word p, 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 ---- +[64]word 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; +const int F_SHARE = 8; // p[-4] bit, orthogonal to live / mark / releasing +const int F_LOW = 65535; // flags live in these bits; the size class is above them +int hbump; [32]word freel; int gc_runs, gc_freed, gc_auto = 1; +int hstop; // block walks and new chunks stop here +int hold_lo, hold_hi; // while nonzero, balloc will not return a block overlapping this range +int hmax, hcut; // words of memory the host has (0: the heap cannot grow); hcut: the heap was cut, so it must not grow +int dbg, alloc_line; // memdebug bits, and the line the compiler stamps before new + +// 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 asks the host how much memory there is. 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 for good (the loop then tries again), +// 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 heap wants: 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; +} +int fend; // end of the block bfree last made, for the sweep +// 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 is what makes this safe to +// ask about any integer: 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"); + 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); } +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. +unchecked 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. +unchecked 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"); + 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. +unchecked 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. +unchecked 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 +unchecked 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; +} +unchecked 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 +// block that was just recycled, 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. +unchecked 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; +} +// frees a heap object: p has to be tagged d, so a call is free(d*p). the object is +// not reused at once. it is kept in quarantine (a stale pointer still reads the old +// contents), and the next collection reclaims it when nothing points at it. a second +// free does nothing. a shared object is left alone. +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); + 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); + 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 the compiler knows 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 hands out interior pointers into it and never asks the buddy lists, +// and arena_reset gives all of it back at once. +unchecked 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. +unchecked 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. +unchecked 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. +unchecked word car(word p) { + if (dbg & 1) checkptr(p); + return p[0]; +} +// the second word of a pair made by cons. +unchecked word cdr(word p) { + if (dbg & 1) checkptr(p); + return p[1]; +} +// word i (0, 1 or 2) of a triple made by triple. +unchecked 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; +} +// 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"); + 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. +unchecked word dat(word h, int i) { + if (i < 0 || i >= h[0]) oob(i, h[0]); + return h[2] + i * h[3]; +} +// 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. +unchecked word dpop(word h) { + if (!h[0]) oob(-1, 0); + h[0] = h[0] - 1; + return h[2][h[0]]; +} +// 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. +unchecked int dresize(word h, int n) { + int old = h[0] * h[3]; + if (n < 0) n = 0; + dgrow(h, n); + if (n * h[3] > old) fill_w(h[2] + old, 0, n * h[3] - old); + h[0] = n; + return 0; +} +// packed elements (h[3] is minus their size in bytes): the address is a byte address +unchecked 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. +unchecked 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. +unchecked 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 +unchecked 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. +unchecked 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 knows where the compiler's +// own tables live); it calls markrange over every root range +int 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; + 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 (the mark walks back at most 64 words to a real header). off unless +// a program asks. sites are p ^ MAGIC so the collector doesn't see them. +const int NSITE = 64; +const int POISON = 57005; +int site_drop; +[64]word site_p; [64]word 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. +word obj_base(int w) { + int i = 0; word p; int n; + if (w < HEAP_LO + HDR || w >= hbump) return 0; + while (i <= 64) { + p = w - i; + if (p >= HEAP_LO + HDR && p < hbump && p[-3] == (p ^ MAGIC)) { + n = p[-5] - HDR; + if (w >= p && w < p + n) return p; + } + i++; + } + 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"); halt(); return 0; } + if (!(p[-4] & 1)) { + put_s("zy: use after free from line "); put_n(site_line_of(p)); put_c(10); + 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; +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 asks for 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. word-string syscalls are unchanged. +int bopen(word path, int mode) { return syscall(SYS_BOPEN, addr_b(path + 1), mode, 0); } +// read up to n bytes from fd into the packed byte string s. +int bread(int fd, word s, int n) { return syscall(SYS_BREAD, fd, addr_b(s + 1), n); } +// write the first n bytes of the packed byte string s to fd. +int bwrite(int fd, word s, int n) { return syscall(SYS_BWRITE, fd, addr_b(s + 1), n); } +// copy the value of the environment variable name into dst, returning its length. +int bgetenv(word name, word dst, int n) { return syscall(SYS_BGETENV, addr_b(name + 1), addr_b(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(word name) { return syscall(SYS_CFIND, addr_b(name + 1), 0, 0); } +// loads the shared library at path, so the symbols it defines can be found with cfind. +int cload(word path) { return syscall(SYS_CLOAD, addr_b(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]; +} +// the whole file as a fresh string, or 0 if it can't be opened +unchecked word .u readfile(int 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 + 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; +} |