aboutsummaryrefslogtreecommitdiff
path: root/docs/history/17-o3-boundaries/code/src/rt.zc
diff options
context:
space:
mode:
Diffstat (limited to 'docs/history/17-o3-boundaries/code/src/rt.zc')
-rw-r--r--docs/history/17-o3-boundaries/code/src/rt.zc291
1 files changed, 0 insertions, 291 deletions
diff --git a/docs/history/17-o3-boundaries/code/src/rt.zc b/docs/history/17-o3-boundaries/code/src/rt.zc
deleted file mode 100644
index 63409b3..0000000
--- a/docs/history/17-o3-boundaries/code/src/rt.zc
+++ /dev/null
@@ -1,291 +0,0 @@
-// ============================================================================
-// 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.
-// ============================================================================
-
-// ---- memory map (words) ----
-const MW = 0x100000; // 1m words of memory
-const HEAP_LO = 0x40000; // heap: 0x40000 .. 0xA0000
-const HEAP_HI = 0xA0000;
-const ZFP = 0xA0000; // frame pointer word, used by every prologue
-const GORG = 0xC0000; // the genome (this code) lives here
-const FBOT = 0xE0000; // frame stack: FBOT .. FTOP, grows down
-const FTOP = 0xF0000;
-const RS0 = 0xF0000; // return stack grows up from here
-const MARK0 = 0xF8000; // mark stack for the collector
-const MARKN = 0x4000;
-const DSLO = 0xFC000; // data stack: DSLO .. MW-16, grows down
-const DSHI = 0xFFFF0;
-const MAGIC = 0x2B7E1516;
-
-// ---- virtual enhancements ----
-// install(desc) wires a custom opcode into the cpu (the % opcode). these three
-// give the language native division and left shift (zdiv, zmod and zshl
-// below are the same thing done in software). they come first, since the
-// compiler resolves / % and << to them by name.
-fn install(desc) { return asm { desc @ % }; }
-enhance idiv(a, b) micro "a = sdiv a b";
-enhance imod(a, b) micro "a = srem a b";
-enhance ishl(a, b) micro "a = shl a b";
-// for o3: an o3 variable's address (fp + k), and a bounds check (1 if i isn't in 0..n-1)
-enhance lfa(k) micro "r1 = ld 655360; k = add r1 k";
-enhance outside(i, n) micro "i = ltu i n; i = xor i 1";
-
-// ---- i/o ----
-fn putc(ch) { asm { ch @ . } return 0; }
-fn getc() { return asm { , }; }
-fn eof() { return asm { ? }; }
-fn halt() { asm { q } return 0; }
-fn puts(s) { let i = 0; while (s[i]) { putc(s[i]); i++; } return 0; }
-fn putn(n)
-{
- let b[12], i = 0;
- if (n < 0) { putc('-'); n = 0 - n; }
- if (n < 0) { puts("2147483648"); return 0; }
- while (1) { b[i++] = '0' + n % 10; n = n / 10; if (!n) break; }
- while (i) putc(b[--i]);
- return 0;
-}
-fn strlen(s) { let n = 0; while (s[n]) n++; return n; }
-fn streq(a, b) { let i = 0; while (a[i] && a[i] == b[i]) i++; return a[i] == b[i]; }
-fn wcopy(dst, src, n) { let i = 0; while (i < n) { dst[i] = src[i]; i++; } return 0; }
-fn wfill(dst, v, n) { let i = 0; while (i < n) { dst[i] = v; i++; } return 0; }
-
-// ---- arithmetic the hardware doesn't have ----
-let pow2[32];
-let zrem;
-fn zudiv(n, dv)
-{
- let q = 0, r = 0, i = 30;
- 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;
-}
-fn zdiv(a, b)
-{
- let s = 0, 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;
-}
-fn zmod(a, b) { let neg = a < 0; if (b == 0) return a; zdiv(a, b); if (neg) return 0 - zrem; return zrem; }
-fn zshl(a, b) { return a * pow2[b & 31]; }
-
-// ---- 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 6
-// word header before the pointer the program sees:
-// p[-6] block size p[-5] size class p[-4] flags (0 free, 1 live, 3 marked)
-// 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].
-const HDR = 6;
-let hbump, freel[32], gc_runs, gc_freed, gc_auto = 1;
-
-// the size of the top-level chunk holding heap offset off
-fn topsize(off)
-{
- let h = HEAP_HI - 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;
-}
-fn fpush(b, k) { b[2] = 0; b[6] = freel[k]; b[7] = 0; if (freel[k]) freel[k][7] = b; freel[k] = b; return 0; }
-fn funlink(b, k)
-{
- if (b[7]) b[7][6] = b[6]; else freel[k] = b[6];
- if (b[6]) b[6][7] = b[7];
- return 0;
-}
-fn mkblock(b, k) { b[0] = pow2[k]; b[1] = k; b[2] = 0; b[3] = 0; b[4] = 0; b[5] = 0; return b; }
-fn heap_init()
-{
- let i = 1, b = HEAP_LO, sz, k;
- pow2[0] = 1;
- while (i < 32) { pow2[i] = pow2[i - 1] + pow2[i - 1]; i++; }
- hbump = HEAP_HI;
- wfill(freel, 0, 32);
- while (b < HEAP_HI) {
- sz = topsize(b - HEAP_LO); k = 0;
- while (pow2[k] < sz) k++;
- fpush(mkblock(b, k), k);
- b = b + sz;
- }
- return 0;
-}
-// a free block of class k, split down from a bigger one if needed; 0 if none
-fn balloc(k)
-{
- let j = k, b, h;
- 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);
- return b;
-}
-let 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
-fn bfree(b)
-{
- let k = b[1], sz = pow2[k], off, bud;
- while (1) {
- off = b - HEAP_LO;
- if (sz >= topsize(off)) break;
- bud = HEAP_LO + (off ^ sz);
- if (bud[2] != 0 || bud[1] != k || bud[0] != sz) break;
- funlink(bud, k);
- if (bud < b) { b[0] = 0; b[3] = 0; b = bud; } // the upper header is inside the merged block now
- else { bud[0] = 0; bud[3] = 0; }
- k++; sz = sz + sz;
- mkblock(b, k);
- }
- fpush(mkblock(b, k), k);
- fend = b + sz;
- return 0;
-}
-fn isobj(x) { return x >= HEAP_LO + HDR && x < hbump && x[-3] == (x ^ MAGIC) && (x[-4] & 1); }
-
-// every prologue checks the frame stack; on overflow it resets the frame
-// pointer (so this can run at all) and stops
-fn frame_overflow() { puts("zy: frame stack overflow\n"); halt(); return 0; }
-fn oom() { puts("zc: out of heap memory\n"); halt(); return 0; }
-// n words, untyped and not zeroed: what new gives o3 code. the type word
-// keeps -(n + 1), so fatten (in the compiler) can type it later
-unchecked .u new_raw(n)
-{
- let need = n + HDR, k = 3, b, p;
- if (n < 0) need = HDR;
- while (pow2[k] < need) k++;
- b = balloc(k);
- if (!b && gc_auto) { gc(); b = balloc(k); }
- if (!b) oom();
- p = b + HDR;
- b[2] = 1; b[3] = p ^ MAGIC; b[4] = 0; b[5] = 0 - n - 1;
- return p;
-}
-// n words typed t, zeroed
-unchecked .u new_t(n, t)
-{
- let p = new_raw(n);
- p[-1] = t;
- wfill(p, 0, p[-6] - HDR);
- return p;
-}
-unchecked .u new(n) { return new_t(n, 0); }
-fn osize(p) { if (!isobj(p)) return 0; return p[-6] - HDR; }
-fn typeof_obj(p) { if (!isobj(p) || p[-1] < 0) return 0; return p[-1]; }
-
-// frees p and, recursively, every object p owns
-fn release(p)
-{
- let b = p - HDR, n = b[0] - HDR, i = 0, w;
- b[2] = 2; // going: not live, and not free yet either, so a child's buddy check can't merge into it
- while (i < n) { w = p[i]; if (isobj(w) && w[-2] == p) release(w); i++; }
- bfree(b);
- return 0;
-}
-unchecked fn free(.d p) { if (isobj(p)) release(p); return 0; }
-fn own(c, p) { if (isobj(c)) c[-2] = p; return c; }
-
-// ---- 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 .u dnew(es, n, t)
-{
- let h = new_t(4, t), c = n, it;
- if (c < 4) c = 4;
- it = new(c * es);
- h[0] = n; h[1] = c; h[2] = own(it, h); h[3] = es;
- return h;
-}
-unchecked fn dgrow(h, need)
-{
- let c = h[1], it, old = h[2], i = 0, w, n;
- if (need <= c) return 0;
- while (c < need) c = c + c;
- it = new(c * h[3]);
- n = h[0] * h[3];
- wcopy(it, old, n);
- while (i < n) { w = it[i]; if (isobj(w) && w[-2] == old) w[-2] = it; i++; } // the children move with the elements
- h[2] = own(it, h); h[1] = c;
- free(old);
- return 0;
-}
-fn oob(i, n) { puts("zy: index "); putn(i); puts(" out of range (length "); putn(n); puts(")\n"); halt(); return 0; }
-unchecked fn dat(h, i) { if (i < 0 || i >= h[0]) oob(i, h[0]); return h[2] + i * h[3]; }
-unchecked fn dpush(h, .d x) { dgrow(h, h[0] + 1); h[2][h[0]] = x; own(x, h[2]); h[0] = h[0] + 1; return 0; }
-unchecked fn dpop(h) { if (!h[0]) oob(-1, 0); h[0] = h[0] - 1; return h[2][h[0]]; }
-unchecked fn dresize(h, n)
-{
- let old = h[0] * h[3];
- if (n < 0) n = 0;
- dgrow(h, n);
- if (n * h[3] > old) wfill(h[2] + old, 0, n * h[3] - old);
- h[0] = n;
- return 0;
-}
-fn dlen(h) { return h[0]; }
-fn dcap(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 whole data stack region.
-let ms_top, ms_over, gc_lo, gc_hi;
-fn mark(w)
-{
- if (!isobj(w) || (w[-4] & 2)) return 0;
- w[-4] = w[-4] | 2;
- if (ms_top < MARKN) { MARK0[ms_top] = w; ms_top++; } else ms_over = 1;
- return 0;
-}
-fn markrange(a, b) { while (a < b) { mark(*a); a++; } return 0; }
-fn drain()
-{
- let p;
- while (ms_top) { ms_top--; p = MARK0[ms_top]; markrange(p, p + p[-6] - HDR); }
- return 0;
-}
-fn gc_roots();
-unchecked fn gc()
-{
- let b, sz, n = 0;
- ms_top = 0; ms_over = 0;
- gc_roots();
- drain();
- while (ms_over) { // the mark stack overflowed: rescan marked objects
- ms_over = 0;
- b = HEAP_LO;
- while (b < HEAP_HI) { if (b[2] == 3) markrange(b + HDR, b + b[0]); b = b + b[0]; drain(); }
- }
- b = HEAP_LO;
- while (b < HEAP_HI) {
- sz = b[0];
- if (b[2] == 1) { bfree(b); n++; b = fend; } // merging may swallow what follows
- else { if (b[2] == 3) b[2] = 1; b = b + sz; }
- }
- gc_runs++;
- gc_freed = gc_freed + n;
- return n;
-}
-// number of live objects, for tests
-fn live_objects() { let b = HEAP_LO, n = 0; while (b < HEAP_HI) { if (b[2] & 1) n++; b = b + b[0]; } return n; }
-// the biggest block that's free right now, in words
-fn largest_free() { let k = 31; while (k > 0 && !freel[k]) k--; if (!freel[k]) return 0; return pow2[k]; }