From b259c1c34f6dbe1e591a3542e580a3b6b439b3c3 Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 09:06:35 -0800 Subject: [PATCH 1/7] get initial version of retained heap analysis going --- compiler/codegen.stanza | 1 + compiler/vm-structures.stanza | 1 + core/core.stanza | 113 +++++--- core/heap-analysis.stanza | 476 ++++++++++++++++++++++++++++++++++ core/long-vector.stanza | 3 +- 5 files changed, 562 insertions(+), 32 deletions(-) create mode 100644 core/heap-analysis.stanza diff --git a/compiler/codegen.stanza b/compiler/codegen.stanza index 96c140bc..71f706c8 100644 --- a/compiler/codegen.stanza +++ b/compiler/codegen.stanza @@ -334,6 +334,7 @@ public defn compile-entry-function (emitter:CodeEmitter, stubs:AsmStubs) : #label(safepoint-table) ;safepoint-table:ptr #label(debug-table) ;debug-table:ptr #label(local-var-table) ;local-var-table:ptr + #long() ;heap-dominator-tree:ptr #label(class-table) ;class-table:ptr #label(global-root-table) ;global-root-table:ptr #label(stackmap-table) ;stackmap-table:ptr diff --git a/compiler/vm-structures.stanza b/compiler/vm-structures.stanza index 3bad507f..6fef0c40 100644 --- a/compiler/vm-structures.stanza +++ b/compiler/vm-structures.stanza @@ -31,6 +31,7 @@ public lostanza deftype VMState : var safepoint-table: ptr ;(Permanent State) var debug-table: ptr ;(Permanent State) var local-var-table: ptr ;(Permanent State) + var heap-dominator-tree: ptr ;(Variable State) var class-table: ptr ;(Permanent State) ;Interpreted Mode Tables var instructions: ptr ;(Permanent State) diff --git a/core/core.stanza b/core/core.stanza index a2a602ac..77d487b7 100644 --- a/core/core.stanza +++ b/core/core.stanza @@ -214,31 +214,83 @@ protected lostanza deftype ArrayRecord : ;are used only in compiled mode. ;Permanent state changes in-between each code load. ;Variable state changes in-between each boundary change. -protected lostanza deftype VMState : - ;Compiled and Interpreted Mode - global-offsets: ptr ;(Permanent State) - global-mem: ptr ;(Permanent State) - var sig-handler: long ;(Permanent State) - var current-coroutine-ptr: ptr ;[TODO] Change to long to represent reference. - var stepping-coroutine-ptr: ptr ;[TODO] Change to long to represent reference. - const-table: ptr ;(Permanent State) - const-mem: ptr ;(Permanent State) - data-offsets: ptr ;(Permanent State) - data-mem: ptr ;(Permanent State) - code-offsets: ptr ;(Permanent State) - registers: ptr ;(Permanent State) - system-registers: ptr ;(Permanent State) - var heap: Heap ;(Variable State) - safepoint-table: ptr ;(Variable State) - debug-table: ptr ;(Variable State) - local-var-table: ptr ;(Variable State) - ;Compiled Mode Tables - class-table: ptr - global-root-table: ptr - stackmap-table: ptr> - stack-trace-table: ptr - extern-table: ptr - extern-defn-table: ptr +#if-defined(BOOTSTRAP) : + + protected lostanza deftype VMState : + ;Compiled and Interpreted Mode + global-offsets: ptr ;(Permanent State) + global-mem: ptr ;(Permanent State) + var sig-handler: long ;(Permanent State) + var current-coroutine-ptr: ptr ;[TODO] Change to long to represent reference. + var stepping-coroutine-ptr: ptr ;[TODO] Change to long to represent reference. + const-table: ptr ;(Permanent State) + const-mem: ptr ;(Permanent State) + data-offsets: ptr ;(Permanent State) + data-mem: ptr ;(Permanent State) + code-offsets: ptr ;(Permanent State) + registers: ptr ;(Permanent State) + system-registers: ptr ;(Permanent State) + var heap: Heap ;(Variable State) + safepoint-table: ptr ;(Variable State) + debug-table: ptr ;(Variable State) + local-var-table: ptr ;(Variable State) + ;Compiled Mode Tables + class-table: ptr + global-root-table: ptr + stackmap-table: ptr> + stack-trace-table: ptr + extern-table: ptr + extern-defn-table: ptr + + lostanza defn initialize-dominator-tree () -> ref : + return false + +#else: + + protected lostanza deftype HeapDominator : + var roots : ptr + var sizes : ptr + var addrs : ptr + var offs : ptr + var heap : ptr + + protected lostanza deftype VMState : + ;Compiled and Interpreted Mode + global-offsets: ptr ;(Permanent State) + global-mem: ptr ;(Permanent State) + var sig-handler: long ;(Permanent State) + var current-coroutine-ptr: ptr ;[TODO] Change to long to represent reference. + var stepping-coroutine-ptr: ptr ;[TODO] Change to long to represent reference. + const-table: ptr ;(Permanent State) + const-mem: ptr ;(Permanent State) + data-offsets: ptr ;(Permanent State) + data-mem: ptr ;(Permanent State) + code-offsets: ptr ;(Permanent State) + registers: ptr ;(Permanent State) + system-registers: ptr ;(Permanent State) + var heap: Heap ;(Variable State) + safepoint-table: ptr ;(Variable State) + debug-table: ptr ;(Variable State) + local-var-table: ptr ;(Variable State) + var dom: ptr ;(Variable State) + ;Compiled Mode Tables + class-table: ptr + global-root-table: ptr + stackmap-table: ptr> + stack-trace-table: ptr + extern-table: ptr + extern-defn-table: ptr + + lostanza defn initialize-dominator-tree () -> ref : + val vms:ptr = call-prim flush-vm() + val dom = (call-c clib/malloc(sizeof(HeapDominator))) as ptr + dom.roots = LSLongVector() + dom.sizes = LSLongVector() + dom.addrs = LSLongVector() + dom.offs = LSLongVector() + dom.heap = LSLongVector() + vms.dom = dom + return false lostanza deftype ExternTable : length: long @@ -1614,9 +1666,9 @@ lostanza defn iterate-roots (f:ptr<((ptr, ptr) -> ref)>, return [vms.heap.iterate-roots](f, vms) ;Call f on all references stored in the object pointed to by p. -lostanza defn iterate-references (p:ptr, - f:ptr<((ptr, ptr) -> ref)>, - vms:ptr) -> ref : +protected lostanza defn iterate-references (p:ptr, + f:ptr<((ptr, ptr) -> ref)>, + vms:ptr) -> ref : ;Retrieve the object's tag. val tag = get-tag(p) ;Fast path using fast descriptor table. @@ -2632,8 +2684,8 @@ public lostanza defn clear (start:ptr, size:long) -> ptr : return call-c clib/memset(start, 0, size) ;Call f on all root pointers. -lostanza defn core-iterate-roots (f:ptr<((ptr, ptr) -> ref)>, - vms:ptr) -> ref : +protected lostanza defn core-iterate-roots (f:ptr<((ptr, ptr) -> ref)>, + vms:ptr) -> ref : ;Scan globals val globals = vms.global-mem as ptr val roots = vms.global-root-table @@ -4203,6 +4255,7 @@ initialize-gc-notifiers() initialize-gc-statistics() initialize-liveness-handlers() initialize-symbol-table() +initialize-dominator-tree() ;================================================================================ ;========================== End of Boot Sequence ================================ diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza new file mode 100644 index 00000000..9a222d2f --- /dev/null +++ b/core/heap-analysis.stanza @@ -0,0 +1,476 @@ +defpackage core/heap-analysis : + import core + import collections + import core/long-vector + +; TODO: +; remove unique-id +; flatten prevs/nexts ??? -- perhaps adaptive structure like a list + +defn scatter (src:Seqable, idx:Tuple) -> Tuple : + val dst = Array(length(idx)) + for (x in src, i in 0 to false) do : dst[idx[i]] = x + to-tuple(dst) + +defn gather (src:Tuple, idx:Seqable) -> Seq : + seq({ src[_] }, idx) + +defn gather (src:IndexedCollection, idx:Seqable) -> Seq : + seq({ src[_] }, idx) + +lostanza defn clear (v:ptr) -> ref : + v.length = 0 + return false + +;;; INTERFACE TO STANZA MEMORY SYSTEM + +lostanza defn addrs (dom:ptr) -> ptr : + return dom.addrs as ptr + +lostanza defn heap (dom:ptr) -> ptr : + return dom.heap as ptr + +lostanza defn sizes (dom:ptr) -> ptr : + return dom.sizes as ptr + +lostanza defn roots (dom:ptr) -> ptr : + return dom.roots as ptr + +lostanza defn offs (dom:ptr) -> ptr : + return dom.offs as ptr + +lostanza defn collect-object-address-and-size (p:ptr, tag:int, size:long, vms:ptr) -> ref : + add(addrs(vms.dom), p as long) + ; call-c clib/printf("ADDR %lx\n", p) + add(sizes(vms.dom), size as long) + return false + +lostanza var unique-id:long = 1000L + +lostanza defn collect-object-contents (p:ptr, tag:int, size:long, vms:ptr) -> ref : + add(offs(vms.dom), heap(vms.dom).length) + add(heap(vms.dom), tag as long) + add(heap(vms.dom), unique-id) + unique-id = unique-id + 1L + val idx = heap(vms.dom).length + add(heap(vms.dom), 0L) ; place holder + core/iterate-references(p, addr(do-collect-object-contents), vms) + heap(vms.dom).items[idx] = heap(vms.dom).length - idx - 1 + return false + +lostanza defn do-collect-object-contents (ref:ptr, vms:ptr) -> ref : + ;Retrieve the value at the given heap pointer. + val v = [ref] + ;Is this a reference to a Stanza heap object? + val tagbits = v & 7L + if tagbits == 1L : + ;Remove the tag bits to retrieve the object pointer. + val p = (v - 1) as ptr + add(heap(vms.dom), addr-to-id(addrs(vms.dom), p as long) + 1) + return false + +public lostanza defn register-all-roots (vms:ptr) -> ref : + core/core-iterate-roots(addr(register-root-reference), vms) + register-stack-roots(vms) + return false + +public lostanza defn register-stack-roots (vms:ptr) -> ref : + var stack:ptr = vms.heap.stacks + while stack != null : + iterate-references-in-stack-frames(stack, addr(register-root-reference), vms) + stack = stack.tail + return false + +public lostanza defn register-root-reference (ref:ptr, vms:ptr) -> ref : + val v = [ref] + val tagbits = v & 7L ; heap object? + if tagbits == 1L : + val p = (v - 1) as ptr ; remove tag bits to retrieve object pointer + add(roots(vms.dom), p as long) + return false + +lostanza defn iterate-objects + (pstart:ptr, pend:ptr, vms:ptr, f:ptr<((ptr, int, long, ptr) -> ref)>) -> ref : + var p:ptr = pstart + while p < pend : + val tag = [p] as int + val class = vms.class-table[tag].record + var size:long = 0L + if class.item-size == 0 : + size = object-size-on-heap(class.size) + else : + val class = class as ptr + val array = p as ptr + val len = array.slots[0] + val base-size = class.base-size + val item-size = class.item-size + val my-size = base-size + item-size * len + size = object-size-on-heap(my-size) + [f](p, tag, size, vms) + p = p + size + return false + +lostanza defn addr-to-id (xs:ptr, x:long) -> long : + var res:long = -1L + labels : + begin: goto loop(0L, xs.length) + loop (start:long, end:long) : + if end > start : + val center = (start + end) >> 1 + val xc = xs.items[center] + if x == xc : res = center + else if x < xc : goto loop(start, center) + else : goto loop(center + 1L, end) + return res + +lostanza deftype LowFlatObjects : + var sizes : ptr ; static sizes of objects + var offs : ptr ; offsets to inlined objects in heap + var heap : ptr ; | type | len | ids ... | ... + +lostanza deftype FlatObjects <: IndexedCollection&Lengthable : + value : ptr + +lostanza defn FlatObjects (sizes:ptr, offs:ptr, heap:ptr) -> ref : + val lfo = call-c clib/stz_malloc(sizeof(LowFlatObjects)) as ptr + lfo.sizes = sizes + lfo.offs = offs + lfo.heap = heap + return new FlatObjects{ lfo } + +lostanza defmethod length (xs:ref) -> ref : + return new Int{xs.value.offs.length} + +lostanza defn offset (xs:ref, id:ref) -> ref : + return new Int{xs.value.offs.items[id.value] as int} + +lostanza defmethod get (xs:ref, idx:ref) -> ref : + return new Int{xs.value.heap.items[idx.value] as int} + +defn get-all (xs:FlatObjects, indices:Range) -> Seq : + seq({ xs[_] }, indices) + +defn tag-of (xs:FlatObjects, id:Int) -> Int : + xs[offset(xs, id)] + +defn unique-of (xs:FlatObjects, id:Int) -> Int : + xs[offset(xs, id) + 1] + +lostanza defn size-of (xs:ref, id:ref) -> ref : + return new Int{ xs.value.sizes.items[id.value] as int } + +defn sizes (objs:FlatObjects) -> Seq : + seq(size-of{objs, _}, 0 to length(objs)) + +defn refs (objs:FlatObjects, id:Int) -> Seqable : + val off = offset(objs, id) + val len = objs[off + 2] + val refs-off = off + 3 + get-all(objs, refs-off to (refs-off + len)) + +lostanza defn do-dominator-tree () -> ref : + call-c clib/printf("GC...\n") + run-garbage-collector() + val vms:ptr = call-prim flush-vm() + val dom = vms.dom + clear(offs(dom)) + clear(sizes(dom)) + clear(heap(dom)) + ;; get all roots + call-c clib/printf("REG ROOTS...\n") + register-all-roots(vms) + call-c clib/printf("FOUND %d ROOTS...\n", roots(dom).length) + ;; get sizes and addresses of objects on heap + add(sizes(dom), roots(dom).length as long) ; dummy root object + call-c clib/printf("COLLECT HEAP %lx OBJECT ADDRESSES AND SIZES...\n", vms.heap.start) + iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-address-and-size)) + val nursery = core/nursery-start(addr(vms.heap)) + call-c clib/printf("COLLECT NURSERY %lx OBJECT ADDRESSES AND SIZES...\n", nursery) + iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-address-and-size)) + call-c clib/printf("DONE %d OBJECTS...\n", addrs(dom).length) + ;; build heap data translated to object ids using addresses and binary search + add(offs(dom), 0L) ; first root object + add(heap(dom), -1L) ; dummy root object tag + add(heap(dom), unique-id) + unique-id = unique-id + 1L + add(heap(dom), roots(dom).length as long) + for (var i:int = 0, i < roots(dom).length, i = i + 1) : + add(heap(dom), addr-to-id(addrs(dom), roots(dom).items[i]) + 1) ; point to roots + iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-contents)) + iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-contents)) + clear(addrs(dom)) + clear(roots(dom)) + call-c clib/printf("DONE... %d OFFS\n", offs(dom).length) + return FlatObjects(sizes(dom), offs(dom), heap(dom)) + +;;; FlatIdObjects + +defstruct FlatIdObjects : + order : Tuple + reorder : Tuple + objs : FlatObjects +with: + printer => true + +defn sizes (o:FlatIdObjects) -> Seq : + gather(to-tuple(sizes(objs(o))), order(o)) + +defn length (ios:FlatIdObjects) -> Int : + length(objs(ios)) + +lostanza defn class-name (x:ref) -> ref : + var res:ref + if x.value == -1 : + res = String("root") + else : + res = String(class-name(x.value)) + return res + +defn nexts (fobjs:FlatIdObjects) -> Tuple> : + val objs = objs(fobjs) + to-tuple $ for id in order(fobjs) seq : + to-list $ seq({ reorder(fobjs)[_] }, refs(objs, id)) + +defn prevs (nexts:Tuple>) -> Tuple> : + val prevs = Array>(length(nexts), List()) + for (next in nexts, id in 0 to false) do : + for r in next do : + prevs[r] = cons(id, prevs[r]) + to-tuple $ prevs + +defn id-print-guts (idx:Int, id:Int, unique:Int, tag:Int, refs:Seqable) : + print("%_: %_ = {%_ %_ %_}" % [idx, id, class-name(tag), unique, to-tuple $ refs]) + +defn print-id-object-guts (objs:FlatObjects) -> False : + for id in 0 to length(objs) do : + id-print-guts(id, id, unique-of(objs, id), tag-of(objs, id), refs(objs, id)) + println("") + +defn id-print-stat (idx:Int, id:Int, unique:Int, tag:Int, tot-size:Int, size:Int) : + print("%_: %_ = {%_ %_ %_ %_}" % [idx, id, class-name(tag), unique, size, tot-size]) + +defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : + val ids = reverse $ to-list $ qsort({ tot-sizes[_] }, 0 to length(objs)) + for (id in ids, i in 0 to false) do : + val tot-size = tot-sizes[id] + if tot-size > 0 : + id-print-stat(i, id, unique-of(objs, id), tag-of(objs, id), tot-size, size-of(objs, id)) + println("") + +defn objects-to-id-objects (objs:FlatObjects) -> FlatIdObjects : + ; print-id-object-guts(objs) + FlatIdObjects(to-tuple $ (0 to length(objs)), to-tuple $ (0 to length(objs)), objs) + +;;; DOMINATORS + +;; find depth first order of objects +defn depth-first (ios:FlatIdObjects) -> FlatIdObjects : + val nexts = nexts(ios) + val visited? = Array(length(ios), false) + val order0 = Vector() + let loop (idx:Int = 0) : + if not visited?[idx] : + visited?[idx] = true + for nidx in nexts[idx] do : loop(nidx) + add(order0, idx) + val missing = filter({ not visited?[_] }, 0 to length(visited?)) + val order = to-tuple $ cat(missing, order0) + ; println("DFS %_ %_" % [length(order), order]) + FlatIdObjects(to-tuple $ order, scatter(0 to length(order), to-tuple(order)), objs(ios)) + +; fast dominators algorithm assuming depth-first order +defn idom (num:Int, prevs:Tuple>) -> Tuple : + ; println("IDOM NUM %_ PREVS %_" % [num, prevs]) + val doms = Array(num, -1) + val start-id = num - 1 + doms[start-id] = start-id + defn intersect (b1:Int, b2:Int) -> Int : + let loop (finger1:Int = b1, finger2:Int = b2) : + if finger1 != finger2 : + val finger1 = let iter (finger1:Int = finger1) : + if finger1 < finger2 : iter(doms[finger1]) + else : finger1 + val finger2 = let iter (finger2:Int = finger2) : + if finger2 < finger1 : iter(doms[finger2]) + else : finger2 + loop(finger1, finger2) + else : + finger1 + let loop () : + let iter (b : Int = start-id - 1, changed? : True|False = false) : + if b >= 0 : + val new-idom = let find (idom:Int = -1, ps:List = prevs[b]) : + if empty?(ps) : + idom + else : + val p = head(ps) + val nxt-idom = + if doms[p] != -1 : + if idom == -1 : p + else : intersect(p, idom) + else : idom + find(nxt-idom, tail(ps)) + val changed? = doms[b] != new-idom + doms[b] = new-idom + iter(b - 1, changed?) + else : + loop() when changed? + to-tuple $ doms + +defn calc-sizes (ios:FlatIdObjects, doms:Tuple) -> Array : + val tot-sizes = to-array $ sizes(ios) + ; println("%_: %_" % [0, tot-sizes]) + val len = length(ios) + for i in 0 to (len - 1) do : + if doms[i] >= 0 : + tot-sizes[doms[i]] = tot-sizes[doms[i]] + tot-sizes[i] + ; println("%_: %_" % [i + 1, tot-sizes]) + tot-sizes + +defn print-xml (s:FileOutputStream, id-objs:FlatIdObjects, sizes:Array, nexts:Tuple>, doms:Tuple, threshold:Int = 0) : + val objs = objs(id-objs) + defn children (doms:Tuple) -> Tuple> : + val children = to-tuple $ repeatedly({ Vector() }, length(nexts)) + for (dom in doms, id in 0 to false) do : + add(children[dom], id) when (dom >= 0 and dom != id) + map(to-tuple, children) + defn stringify (s:String) -> String : + replace(s, "&", "A") + defn indent (n:Int) : + for i in 0 to n do : print(s, " ") + val kiddies = children(doms) + let walk (idx:Int = length(doms) - 1, depth:Int = 0) : + val id = order(id-objs)[idx] + val name = stringify(class-name(tag-of(objs, id))) + indent(depth * 2) println(s, "<%_ RETAINED=\"%_\" STATIC=\"%_\">" % [name, sizes[idx], size-of(objs, id)]) + val childs = reverse $ to-list $ qsort({ sizes[_] }, filter({ sizes[_] > threshold }, kiddies[idx])) + for child in childs do : + walk(child, depth + 1) + indent(depth * 2) println(s, "" % [name]) + +public defn heap-dominator-tree (filename:String) -> FlatIdObjects : + val objs = do-dominator-tree() + ; val objs = tst-dominator-tree() + ; dump-heap(objs) + val id-objs0 = objects-to-id-objects(objs) + ; val nxts0 = nexts(id-objs0) + ; val prvs0 = prevs(nxts0) + ; for (id in order(id-objs0), i in 0 to false) do : + ; id-print-guts(i, id, unique-of(objs, id), tag-of(objs, id), refs(objs, id)) + ; print(" NEXTS %_ PREVS %_" % [nxts0[i], prvs0[i]]) + ; println("") + val id-objs = depth-first(id-objs0) + ; val nxts = nexts(id-objs) + ; val prvs = prevs(nxts) + ; for (id in order(id-objs), i in 0 to false) do : + ; id-print-guts(i, id, unique-of(objs, id), tag-of(objs, id), refs(objs, id)) + ; print(" NEXTS %_ PREVS %_" % [nxts[i], prvs[i]]) + ; println("") + val nxts = nexts(id-objs) + val doms = idom(length(id-objs), prevs(nxts)) + ; println("IDOM DONE %_" % [doms]) + val sizes = calc-sizes(id-objs, doms) + ; println("SIZES %_" % [sizes]) + print-id-object-stats(objs, to-tuple $ gather(sizes, reorder(id-objs))) + val s = FileOutputStream(filename) + print-xml(s, id-objs, sizes, nxts, doms) + close(s) + id-objs + +; defstruct Tup : +; value : Tuple +; +; val tup3 = Tup([ 0 1 2 3 4 5 6 7 8 9 ]) +; val tup2 = Tup([ tup3 tup3 ]) +; val tup1 = Tup([ tup2 tup2 ]) +; val tup0 = Tup([ tup1 tup1 ]) + +defstruct BinTree : + left : BinTree|Int + right : BinTree|Int + +defn bin-tree (n:Int) -> BinTree : + if n <= 0 : + BinTree(0, 1) + else : + BinTree(bin-tree(n - 1), bin-tree(n - 1)) + +val tup = bin-tree(6) + +heap-dominator-tree("sizes.xml") + +; val tst-2 = [ 1 ] +; val tst-1 = [ tst-2 ] +; val tst-0 = [ tst-1, tst-2 ] +; +; lostanza defn object-type-id (x:ref) -> int : +; val ref = x as long +; val p = (ref - 1L) as ptr +; return [p] as int +; +; lostanza defn tst-dominator-tree () -> ref : +; val vms:ptr = call-prim flush-vm() +; val dom = vms.dom +; clear(offs(dom)) +; clear(sizes(dom)) +; clear(heap(dom)) +; ;0 +; add(offs(dom), 0L) +; add(heap(dom), -1L) +; add(heap(dom), unique-id) +; unique-id = unique-id + 1L +; add(heap(dom), 1L) +; add(heap(dom), 2L) +; add(sizes(dom), 2L * 8L) +; ;1 +; add(offs(dom), heap(dom).length) +; add(heap(dom), object-type-id(tst-1)) +; add(heap(dom), unique-id) +; unique-id = unique-id + 1L +; add(heap(dom), 1L) +; add(heap(dom), 3L) +; add(sizes(dom), 8L + 1L * 8L) +; ;2 +; add(offs(dom), heap(dom).length) +; add(heap(dom), object-type-id(tst-0)) +; add(heap(dom), unique-id) +; unique-id = unique-id + 1L +; add(heap(dom), 2L) +; add(heap(dom), 1L) +; add(heap(dom), 3L) +; add(sizes(dom), 8L + 2L * 8L) +; ;3 +; add(offs(dom), heap(dom).length) +; add(heap(dom), object-type-id(tst-1)) +; add(heap(dom), unique-id) +; unique-id = unique-id + 1L +; add(heap(dom), 0L) +; add(sizes(dom), 8L) +; return FlatObjects(sizes(dom), offs(dom), heap(dom)) + +lostanza defn dump-heap (objs:ref) -> ref : + call-c clib/printf("OFFS:\n") + for (var i:int = 0, i < objs.value.offs.length, i = i + 1) : + call-c clib/printf("%d : %ld\n", i, objs.value.offs.items[i]) + call-c clib/printf("HEAP:\n") + for (var i:int = 0, i < objs.value.heap.length, i = i + 1) : + call-c clib/printf("%d : %ld\n", i, objs.value.heap.items[i]) + return false + +defstruct IntArrayPow2 : + sizes : IntArray + offs : IntArray + items : IntArray + +defn accum (xs:Seqable, init:Int) -> Seq : + var accum:Int = init + for x in xs seq : (val r = accum, accum = accum + x, r) + +defn IntArrayPow2 (sizes:IntArray) -> IntArrayPow2 : + val len = length(sizes) + val offs = to-intarray $ accum(sizes, 0) + val items = IntArray(offs[len - 1] + sizes[len - 1]) + IntArrayPow2(sizes, offs, items) + +defn get (vv:IntArrayPow2, idx:Int) -> Collection : + items(vv)[offs(vv)[idx] to (offs(vv)[idx] + sizes(vv)[idx])] \ No newline at end of file diff --git a/core/long-vector.stanza b/core/long-vector.stanza index 062c15d4..5b828227 100644 --- a/core/long-vector.stanza +++ b/core/long-vector.stanza @@ -1,6 +1,5 @@ defpackage core/long-vector : import core - import collections public lostanza deftype LSLongVector : var capacity: int @@ -39,4 +38,4 @@ lostanza defn ensure-capacity (v:ptr, new-capacity:int) -> int : while c < new-capacity : c = c << 1 v.capacity = c v.items = realloc(v.items, c * sizeof(long)) - return 0 \ No newline at end of file + return 0 From 6bee7f81c289851aaaea629f93cf8f22c05114f3 Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 09:15:52 -0800 Subject: [PATCH 2/7] remove unique-ids and clean up print outs --- core/heap-analysis.stanza | 43 +++++++++------------------------------ 1 file changed, 10 insertions(+), 33 deletions(-) diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza index 9a222d2f..f354372b 100644 --- a/core/heap-analysis.stanza +++ b/core/heap-analysis.stanza @@ -3,10 +3,6 @@ defpackage core/heap-analysis : import collections import core/long-vector -; TODO: -; remove unique-id -; flatten prevs/nexts ??? -- perhaps adaptive structure like a list - defn scatter (src:Seqable, idx:Tuple) -> Tuple : val dst = Array(length(idx)) for (x in src, i in 0 to false) do : dst[idx[i]] = x @@ -41,17 +37,12 @@ lostanza defn offs (dom:ptr) -> ptr : lostanza defn collect-object-address-and-size (p:ptr, tag:int, size:long, vms:ptr) -> ref : add(addrs(vms.dom), p as long) - ; call-c clib/printf("ADDR %lx\n", p) add(sizes(vms.dom), size as long) return false -lostanza var unique-id:long = 1000L - lostanza defn collect-object-contents (p:ptr, tag:int, size:long, vms:ptr) -> ref : add(offs(vms.dom), heap(vms.dom).length) add(heap(vms.dom), tag as long) - add(heap(vms.dom), unique-id) - unique-id = unique-id + 1L val idx = heap(vms.dom).length add(heap(vms.dom), 0L) ; place holder core/iterate-references(p, addr(do-collect-object-contents), vms) @@ -153,9 +144,6 @@ defn get-all (xs:FlatObjects, indices:Range) -> Seq : defn tag-of (xs:FlatObjects, id:Int) -> Int : xs[offset(xs, id)] -defn unique-of (xs:FlatObjects, id:Int) -> Int : - xs[offset(xs, id) + 1] - lostanza defn size-of (xs:ref, id:ref) -> ref : return new Int{ xs.value.sizes.items[id.value] as int } @@ -164,8 +152,8 @@ defn sizes (objs:FlatObjects) -> Seq : defn refs (objs:FlatObjects, id:Int) -> Seqable : val off = offset(objs, id) - val len = objs[off + 2] - val refs-off = off + 3 + val len = objs[off + 1] + val refs-off = off + 2 get-all(objs, refs-off to (refs-off + len)) lostanza defn do-dominator-tree () -> ref : @@ -177,7 +165,6 @@ lostanza defn do-dominator-tree () -> ref : clear(sizes(dom)) clear(heap(dom)) ;; get all roots - call-c clib/printf("REG ROOTS...\n") register-all-roots(vms) call-c clib/printf("FOUND %d ROOTS...\n", roots(dom).length) ;; get sizes and addresses of objects on heap @@ -191,8 +178,6 @@ lostanza defn do-dominator-tree () -> ref : ;; build heap data translated to object ids using addresses and binary search add(offs(dom), 0L) ; first root object add(heap(dom), -1L) ; dummy root object tag - add(heap(dom), unique-id) - unique-id = unique-id + 1L add(heap(dom), roots(dom).length as long) for (var i:int = 0, i < roots(dom).length, i = i + 1) : add(heap(dom), addr-to-id(addrs(dom), roots(dom).items[i]) + 1) ; point to roots @@ -238,23 +223,23 @@ defn prevs (nexts:Tuple>) -> Tuple> : prevs[r] = cons(id, prevs[r]) to-tuple $ prevs -defn id-print-guts (idx:Int, id:Int, unique:Int, tag:Int, refs:Seqable) : - print("%_: %_ = {%_ %_ %_}" % [idx, id, class-name(tag), unique, to-tuple $ refs]) +defn id-print-guts (id:Int, tag:Int, refs:Seqable) : + print("%_ = {%_ %_}" % [id, class-name(tag), to-tuple $ refs]) defn print-id-object-guts (objs:FlatObjects) -> False : for id in 0 to length(objs) do : - id-print-guts(id, id, unique-of(objs, id), tag-of(objs, id), refs(objs, id)) + id-print-guts(id, tag-of(objs, id), refs(objs, id)) println("") -defn id-print-stat (idx:Int, id:Int, unique:Int, tag:Int, tot-size:Int, size:Int) : - print("%_: %_ = {%_ %_ %_ %_}" % [idx, id, class-name(tag), unique, size, tot-size]) +defn id-print-stat (id:Int, tag:Int, tot-size:Int, size:Int) : + print("%_ = {%_ %_ %_}" % [id, class-name(tag), size, tot-size]) defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : val ids = reverse $ to-list $ qsort({ tot-sizes[_] }, 0 to length(objs)) for (id in ids, i in 0 to false) do : val tot-size = tot-sizes[id] if tot-size > 0 : - id-print-stat(i, id, unique-of(objs, id), tag-of(objs, id), tot-size, size-of(objs, id)) + id-print-stat(id, tag-of(objs, id), tot-size, size-of(objs, id)) println("") defn objects-to-id-objects (objs:FlatObjects) -> FlatIdObjects : @@ -356,14 +341,14 @@ public defn heap-dominator-tree (filename:String) -> FlatIdObjects : ; val nxts0 = nexts(id-objs0) ; val prvs0 = prevs(nxts0) ; for (id in order(id-objs0), i in 0 to false) do : - ; id-print-guts(i, id, unique-of(objs, id), tag-of(objs, id), refs(objs, id)) + ; id-print-guts(i, id, tag-of(objs, id), refs(objs, id)) ; print(" NEXTS %_ PREVS %_" % [nxts0[i], prvs0[i]]) ; println("") val id-objs = depth-first(id-objs0) ; val nxts = nexts(id-objs) ; val prvs = prevs(nxts) ; for (id in order(id-objs), i in 0 to false) do : - ; id-print-guts(i, id, unique-of(objs, id), tag-of(objs, id), refs(objs, id)) + ; id-print-guts(i, id, tag-of(objs, id), refs(objs, id)) ; print(" NEXTS %_ PREVS %_" % [nxts[i], prvs[i]]) ; println("") val nxts = nexts(id-objs) @@ -417,24 +402,18 @@ heap-dominator-tree("sizes.xml") ; ;0 ; add(offs(dom), 0L) ; add(heap(dom), -1L) -; add(heap(dom), unique-id) -; unique-id = unique-id + 1L ; add(heap(dom), 1L) ; add(heap(dom), 2L) ; add(sizes(dom), 2L * 8L) ; ;1 ; add(offs(dom), heap(dom).length) ; add(heap(dom), object-type-id(tst-1)) -; add(heap(dom), unique-id) -; unique-id = unique-id + 1L ; add(heap(dom), 1L) ; add(heap(dom), 3L) ; add(sizes(dom), 8L + 1L * 8L) ; ;2 ; add(offs(dom), heap(dom).length) ; add(heap(dom), object-type-id(tst-0)) -; add(heap(dom), unique-id) -; unique-id = unique-id + 1L ; add(heap(dom), 2L) ; add(heap(dom), 1L) ; add(heap(dom), 3L) @@ -442,8 +421,6 @@ heap-dominator-tree("sizes.xml") ; ;3 ; add(offs(dom), heap(dom).length) ; add(heap(dom), object-type-id(tst-1)) -; add(heap(dom), unique-id) -; unique-id = unique-id + 1L ; add(heap(dom), 0L) ; add(sizes(dom), 8L) ; return FlatObjects(sizes(dom), offs(dom), heap(dom)) From f3e6f8286f4d130ec89b2313d7a57a1e4f07f89c Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 09:27:28 -0800 Subject: [PATCH 3/7] clean up more --- core/heap-analysis.stanza | 136 +++++--------------------------------- 1 file changed, 17 insertions(+), 119 deletions(-) diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza index f354372b..37f757c6 100644 --- a/core/heap-analysis.stanza +++ b/core/heap-analysis.stanza @@ -35,12 +35,14 @@ lostanza defn roots (dom:ptr) -> ptr : lostanza defn offs (dom:ptr) -> ptr : return dom.offs as ptr -lostanza defn collect-object-address-and-size (p:ptr, tag:int, size:long, vms:ptr) -> ref : +lostanza defn collect-object-address-and-size + (p:ptr, tag:int, size:long, vms:ptr) -> ref : add(addrs(vms.dom), p as long) add(sizes(vms.dom), size as long) return false -lostanza defn collect-object-contents (p:ptr, tag:int, size:long, vms:ptr) -> ref : +lostanza defn collect-object-contents + (p:ptr, tag:int, size:long, vms:ptr) -> ref : add(offs(vms.dom), heap(vms.dom).length) add(heap(vms.dom), tag as long) val idx = heap(vms.dom).length @@ -81,7 +83,8 @@ public lostanza defn register-root-reference (ref:ptr, vms:ptr, pend:ptr, vms:ptr, f:ptr<((ptr, int, long, ptr) -> ref)>) -> ref : + (pstart:ptr, pend:ptr, vms:ptr, + f:ptr<((ptr, int, long, ptr) -> ref)>) -> ref : var p:ptr = pstart while p < pend : val tag = [p] as int @@ -122,7 +125,8 @@ lostanza deftype LowFlatObjects : lostanza deftype FlatObjects <: IndexedCollection&Lengthable : value : ptr -lostanza defn FlatObjects (sizes:ptr, offs:ptr, heap:ptr) -> ref : +lostanza defn FlatObjects + (sizes:ptr, offs:ptr, heap:ptr) -> ref : val lfo = call-c clib/stz_malloc(sizeof(LowFlatObjects)) as ptr lfo.sizes = sizes lfo.offs = offs @@ -243,7 +247,6 @@ defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : println("") defn objects-to-id-objects (objs:FlatObjects) -> FlatIdObjects : - ; print-id-object-guts(objs) FlatIdObjects(to-tuple $ (0 to length(objs)), to-tuple $ (0 to length(objs)), objs) ;;; DOMINATORS @@ -260,12 +263,10 @@ defn depth-first (ios:FlatIdObjects) -> FlatIdObjects : add(order0, idx) val missing = filter({ not visited?[_] }, 0 to length(visited?)) val order = to-tuple $ cat(missing, order0) - ; println("DFS %_ %_" % [length(order), order]) FlatIdObjects(to-tuple $ order, scatter(0 to length(order), to-tuple(order)), objs(ios)) ; fast dominators algorithm assuming depth-first order defn idom (num:Int, prevs:Tuple>) -> Tuple : - ; println("IDOM NUM %_ PREVS %_" % [num, prevs]) val doms = Array(num, -1) val start-id = num - 1 doms[start-id] = start-id @@ -304,15 +305,15 @@ defn idom (num:Int, prevs:Tuple>) -> Tuple : defn calc-sizes (ios:FlatIdObjects, doms:Tuple) -> Array : val tot-sizes = to-array $ sizes(ios) - ; println("%_: %_" % [0, tot-sizes]) val len = length(ios) for i in 0 to (len - 1) do : if doms[i] >= 0 : tot-sizes[doms[i]] = tot-sizes[doms[i]] + tot-sizes[i] - ; println("%_: %_" % [i + 1, tot-sizes]) tot-sizes -defn print-xml (s:FileOutputStream, id-objs:FlatIdObjects, sizes:Array, nexts:Tuple>, doms:Tuple, threshold:Int = 0) : +defn print-xml + (s:FileOutputStream, id-objs:FlatIdObjects, sizes:Array, + nexts:Tuple>, doms:Tuple, threshold:Int = 0) : val objs = objs(id-objs) defn children (doms:Tuple) -> Tuple> : val children = to-tuple $ repeatedly({ Vector() }, length(nexts)) @@ -321,133 +322,30 @@ defn print-xml (s:FileOutputStream, id-objs:FlatIdObjects, sizes:Array, nex map(to-tuple, children) defn stringify (s:String) -> String : replace(s, "&", "A") - defn indent (n:Int) : - for i in 0 to n do : print(s, " ") + defn P (n:Int, str:Printable) : + for i in 0 to (n * 2) do : print(s, " ") + println(s, str) val kiddies = children(doms) let walk (idx:Int = length(doms) - 1, depth:Int = 0) : val id = order(id-objs)[idx] val name = stringify(class-name(tag-of(objs, id))) - indent(depth * 2) println(s, "<%_ RETAINED=\"%_\" STATIC=\"%_\">" % [name, sizes[idx], size-of(objs, id)]) + P(depth, "<%_ RETAINED=\"%_\" STATIC=\"%_\">" % [name, sizes[idx], size-of(objs, id)]) val childs = reverse $ to-list $ qsort({ sizes[_] }, filter({ sizes[_] > threshold }, kiddies[idx])) for child in childs do : walk(child, depth + 1) - indent(depth * 2) println(s, "" % [name]) + P(depth, "" % [name]) public defn heap-dominator-tree (filename:String) -> FlatIdObjects : val objs = do-dominator-tree() - ; val objs = tst-dominator-tree() - ; dump-heap(objs) val id-objs0 = objects-to-id-objects(objs) - ; val nxts0 = nexts(id-objs0) - ; val prvs0 = prevs(nxts0) - ; for (id in order(id-objs0), i in 0 to false) do : - ; id-print-guts(i, id, tag-of(objs, id), refs(objs, id)) - ; print(" NEXTS %_ PREVS %_" % [nxts0[i], prvs0[i]]) - ; println("") val id-objs = depth-first(id-objs0) - ; val nxts = nexts(id-objs) - ; val prvs = prevs(nxts) - ; for (id in order(id-objs), i in 0 to false) do : - ; id-print-guts(i, id, tag-of(objs, id), refs(objs, id)) - ; print(" NEXTS %_ PREVS %_" % [nxts[i], prvs[i]]) - ; println("") val nxts = nexts(id-objs) val doms = idom(length(id-objs), prevs(nxts)) - ; println("IDOM DONE %_" % [doms]) val sizes = calc-sizes(id-objs, doms) - ; println("SIZES %_" % [sizes]) print-id-object-stats(objs, to-tuple $ gather(sizes, reorder(id-objs))) val s = FileOutputStream(filename) print-xml(s, id-objs, sizes, nxts, doms) close(s) id-objs -; defstruct Tup : -; value : Tuple -; -; val tup3 = Tup([ 0 1 2 3 4 5 6 7 8 9 ]) -; val tup2 = Tup([ tup3 tup3 ]) -; val tup1 = Tup([ tup2 tup2 ]) -; val tup0 = Tup([ tup1 tup1 ]) - -defstruct BinTree : - left : BinTree|Int - right : BinTree|Int - -defn bin-tree (n:Int) -> BinTree : - if n <= 0 : - BinTree(0, 1) - else : - BinTree(bin-tree(n - 1), bin-tree(n - 1)) - -val tup = bin-tree(6) - -heap-dominator-tree("sizes.xml") - -; val tst-2 = [ 1 ] -; val tst-1 = [ tst-2 ] -; val tst-0 = [ tst-1, tst-2 ] -; -; lostanza defn object-type-id (x:ref) -> int : -; val ref = x as long -; val p = (ref - 1L) as ptr -; return [p] as int -; -; lostanza defn tst-dominator-tree () -> ref : -; val vms:ptr = call-prim flush-vm() -; val dom = vms.dom -; clear(offs(dom)) -; clear(sizes(dom)) -; clear(heap(dom)) -; ;0 -; add(offs(dom), 0L) -; add(heap(dom), -1L) -; add(heap(dom), 1L) -; add(heap(dom), 2L) -; add(sizes(dom), 2L * 8L) -; ;1 -; add(offs(dom), heap(dom).length) -; add(heap(dom), object-type-id(tst-1)) -; add(heap(dom), 1L) -; add(heap(dom), 3L) -; add(sizes(dom), 8L + 1L * 8L) -; ;2 -; add(offs(dom), heap(dom).length) -; add(heap(dom), object-type-id(tst-0)) -; add(heap(dom), 2L) -; add(heap(dom), 1L) -; add(heap(dom), 3L) -; add(sizes(dom), 8L + 2L * 8L) -; ;3 -; add(offs(dom), heap(dom).length) -; add(heap(dom), object-type-id(tst-1)) -; add(heap(dom), 0L) -; add(sizes(dom), 8L) -; return FlatObjects(sizes(dom), offs(dom), heap(dom)) - -lostanza defn dump-heap (objs:ref) -> ref : - call-c clib/printf("OFFS:\n") - for (var i:int = 0, i < objs.value.offs.length, i = i + 1) : - call-c clib/printf("%d : %ld\n", i, objs.value.offs.items[i]) - call-c clib/printf("HEAP:\n") - for (var i:int = 0, i < objs.value.heap.length, i = i + 1) : - call-c clib/printf("%d : %ld\n", i, objs.value.heap.items[i]) - return false - -defstruct IntArrayPow2 : - sizes : IntArray - offs : IntArray - items : IntArray - -defn accum (xs:Seqable, init:Int) -> Seq : - var accum:Int = init - for x in xs seq : (val r = accum, accum = accum + x, r) - -defn IntArrayPow2 (sizes:IntArray) -> IntArrayPow2 : - val len = length(sizes) - val offs = to-intarray $ accum(sizes, 0) - val items = IntArray(offs[len - 1] + sizes[len - 1]) - IntArrayPow2(sizes, offs, items) - -defn get (vv:IntArrayPow2, idx:Int) -> Collection : - items(vv)[offs(vv)[idx] to (offs(vv)[idx] + sizes(vv)[idx])] \ No newline at end of file +; heap-dominator-tree("sizes.xml") \ No newline at end of file From eadcf8ba4b4c85ae90b0c1f2be6bb4aed0e44798 Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 09:46:41 -0800 Subject: [PATCH 4/7] more comments and cleanups --- core/heap-analysis.stanza | 90 ++++++++++++++++++++++----------------- 1 file changed, 52 insertions(+), 38 deletions(-) diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza index 37f757c6..0d49fe6e 100644 --- a/core/heap-analysis.stanza +++ b/core/heap-analysis.stanza @@ -3,6 +3,8 @@ defpackage core/heap-analysis : import collections import core/long-vector +;;; UTILITIES + defn scatter (src:Seqable, idx:Tuple) -> Tuple : val dst = Array(length(idx)) for (x in src, i in 0 to false) do : dst[idx[i]] = x @@ -18,6 +20,14 @@ lostanza defn clear (v:ptr) -> ref : v.length = 0 return false +lostanza defn class-name (x:ref) -> ref : + var res:ref + if x.value == -1 : + res = String("root") + else : + res = String(class-name(x.value)) + return res + ;;; INTERFACE TO STANZA MEMORY SYSTEM lostanza defn addrs (dom:ptr) -> ptr : @@ -104,6 +114,7 @@ lostanza defn iterate-objects p = p + size return false +;; Look up offset into sorted list of object addresses using binary search lostanza defn addr-to-id (xs:ptr, x:long) -> long : var res:long = -1L labels : @@ -117,6 +128,10 @@ lostanza defn addr-to-id (xs:ptr, x:long) -> long : else : goto loop(center + 1L, end) return res +;;; LowFlatObject -- create flat and packed version of roots and objects +;;; -- stores tag, num-refs, refs for each object +;;; -- also has extra root root object with ref per root + lostanza deftype LowFlatObjects : var sizes : ptr ; static sizes of objects var offs : ptr ; offsets to inlined objects in heap @@ -129,8 +144,8 @@ lostanza defn FlatObjects (sizes:ptr, offs:ptr, heap:ptr) -> ref : val lfo = call-c clib/stz_malloc(sizeof(LowFlatObjects)) as ptr lfo.sizes = sizes - lfo.offs = offs - lfo.heap = heap + lfo.offs = offs + lfo.heap = heap return new FlatObjects{ lfo } lostanza defmethod length (xs:ref) -> ref : @@ -142,6 +157,7 @@ lostanza defn offset (xs:ref, id:ref) -> ref : lostanza defmethod get (xs:ref, idx:ref) -> ref : return new Int{xs.value.heap.items[idx.value] as int} +; for some reason can't name this method get like in stanza runtime defn get-all (xs:FlatObjects, indices:Range) -> Seq : seq({ xs[_] }, indices) @@ -155,12 +171,13 @@ defn sizes (objs:FlatObjects) -> Seq : seq(size-of{objs, _}, 0 to length(objs)) defn refs (objs:FlatObjects, id:Int) -> Seqable : - val off = offset(objs, id) - val len = objs[off + 1] + val off = offset(objs, id) ; base + val num-refs = objs[off + 1] val refs-off = off + 2 - get-all(objs, refs-off to (refs-off + len)) + get-all(objs, refs-off to (refs-off + num-refs)) -lostanza defn do-dominator-tree () -> ref : +;; Pack roots / heap into FlatObjects +lostanza defn FlatObjects () -> ref : call-c clib/printf("GC...\n") run-garbage-collector() val vms:ptr = call-prim flush-vm() @@ -178,22 +195,26 @@ lostanza defn do-dominator-tree () -> ref : val nursery = core/nursery-start(addr(vms.heap)) call-c clib/printf("COLLECT NURSERY %lx OBJECT ADDRESSES AND SIZES...\n", nursery) iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-address-and-size)) - call-c clib/printf("DONE %d OBJECTS...\n", addrs(dom).length) + call-c clib/printf("FOUND %d OBJECTS...\n", addrs(dom).length) ;; build heap data translated to object ids using addresses and binary search add(offs(dom), 0L) ; first root object add(heap(dom), -1L) ; dummy root object tag add(heap(dom), roots(dom).length as long) + call-c clib/printf("CONVERTING ROOT ADDRESSES TO IDS...\n") for (var i:int = 0, i < roots(dom).length, i = i + 1) : add(heap(dom), addr-to-id(addrs(dom), roots(dom).items[i]) + 1) ; point to roots + call-c clib/printf("PACKING HEAP DATA...\n") iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-contents)) + call-c clib/printf("PACKING NURSERY DATA...\n") iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-contents)) clear(addrs(dom)) clear(roots(dom)) - call-c clib/printf("DONE... %d OFFS\n", offs(dom).length) + call-c clib/printf("DONE...\n") return FlatObjects(sizes(dom), offs(dom), heap(dom)) ;;; FlatIdObjects +;; Permutation wrapper of flat-objects defstruct FlatIdObjects : order : Tuple reorder : Tuple @@ -207,14 +228,6 @@ defn sizes (o:FlatIdObjects) -> Seq : defn length (ios:FlatIdObjects) -> Int : length(objs(ios)) -lostanza defn class-name (x:ref) -> ref : - var res:ref - if x.value == -1 : - res = String("root") - else : - res = String(class-name(x.value)) - return res - defn nexts (fobjs:FlatIdObjects) -> Tuple> : val objs = objs(fobjs) to-tuple $ for id in order(fobjs) seq : @@ -227,25 +240,6 @@ defn prevs (nexts:Tuple>) -> Tuple> : prevs[r] = cons(id, prevs[r]) to-tuple $ prevs -defn id-print-guts (id:Int, tag:Int, refs:Seqable) : - print("%_ = {%_ %_}" % [id, class-name(tag), to-tuple $ refs]) - -defn print-id-object-guts (objs:FlatObjects) -> False : - for id in 0 to length(objs) do : - id-print-guts(id, tag-of(objs, id), refs(objs, id)) - println("") - -defn id-print-stat (id:Int, tag:Int, tot-size:Int, size:Int) : - print("%_ = {%_ %_ %_}" % [id, class-name(tag), size, tot-size]) - -defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : - val ids = reverse $ to-list $ qsort({ tot-sizes[_] }, 0 to length(objs)) - for (id in ids, i in 0 to false) do : - val tot-size = tot-sizes[id] - if tot-size > 0 : - id-print-stat(id, tag-of(objs, id), tot-size, size-of(objs, id)) - println("") - defn objects-to-id-objects (objs:FlatObjects) -> FlatIdObjects : FlatIdObjects(to-tuple $ (0 to length(objs)), to-tuple $ (0 to length(objs)), objs) @@ -336,16 +330,36 @@ defn print-xml P(depth, "" % [name]) public defn heap-dominator-tree (filename:String) -> FlatIdObjects : - val objs = do-dominator-tree() + val objs = FlatObjects() val id-objs0 = objects-to-id-objects(objs) val id-objs = depth-first(id-objs0) val nxts = nexts(id-objs) val doms = idom(length(id-objs), prevs(nxts)) val sizes = calc-sizes(id-objs, doms) - print-id-object-stats(objs, to-tuple $ gather(sizes, reorder(id-objs))) + ; print-id-object-stats(objs, to-tuple $ gather(sizes, reorder(id-objs))) val s = FileOutputStream(filename) print-xml(s, id-objs, sizes, nxts, doms) close(s) id-objs -; heap-dominator-tree("sizes.xml") \ No newline at end of file +heap-dominator-tree("sizes.xml") + +; defn id-print-guts (id:Int, tag:Int, refs:Seqable) : +; print("%_ = {%_ %_}" % [id, class-name(tag), to-tuple $ refs]) +; +; defn print-id-object-guts (objs:FlatObjects) -> False : +; for id in 0 to length(objs) do : +; id-print-guts(id, tag-of(objs, id), refs(objs, id)) +; println("") +; +; defn id-print-stat (id:Int, tag:Int, tot-size:Int, size:Int) : +; print("%_ = {%_ %_ %_}" % [id, class-name(tag), size, tot-size]) +; +; defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : +; val ids = reverse $ to-list $ qsort({ tot-sizes[_] }, 0 to length(objs)) +; for (id in ids, i in 0 to false) do : +; val tot-size = tot-sizes[id] +; if tot-size > 0 : +; id-print-stat(id, tag-of(objs, id), tot-size, size-of(objs, id)) +; println("") + From e267344e92205179b6943626186e24c7a4934cac Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 09:57:14 -0800 Subject: [PATCH 5/7] remove top-level call to run it --- core/heap-analysis.stanza | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza index 0d49fe6e..34fc1155 100644 --- a/core/heap-analysis.stanza +++ b/core/heap-analysis.stanza @@ -342,7 +342,7 @@ public defn heap-dominator-tree (filename:String) -> FlatIdObjects : close(s) id-objs -heap-dominator-tree("sizes.xml") +; heap-dominator-tree("sizes.xml") ; defn id-print-guts (id:Int, tag:Int, refs:Seqable) : ; print("%_ = {%_ %_}" % [id, class-name(tag), to-tuple $ refs]) From e72f91f773c552842a60e16705d74486e6b9999c Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 11:46:41 -0800 Subject: [PATCH 6/7] prepare for PR --- core/heap-analysis.stanza | 671 +++++++++++++++++++------------------- scripts/make.sh | 1 + 2 files changed, 339 insertions(+), 333 deletions(-) diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza index 34fc1155..a1253107 100644 --- a/core/heap-analysis.stanza +++ b/core/heap-analysis.stanza @@ -28,338 +28,343 @@ lostanza defn class-name (x:ref) -> ref : res = String(class-name(x.value)) return res -;;; INTERFACE TO STANZA MEMORY SYSTEM - -lostanza defn addrs (dom:ptr) -> ptr : - return dom.addrs as ptr - -lostanza defn heap (dom:ptr) -> ptr : - return dom.heap as ptr - -lostanza defn sizes (dom:ptr) -> ptr : - return dom.sizes as ptr - -lostanza defn roots (dom:ptr) -> ptr : - return dom.roots as ptr - -lostanza defn offs (dom:ptr) -> ptr : - return dom.offs as ptr - -lostanza defn collect-object-address-and-size - (p:ptr, tag:int, size:long, vms:ptr) -> ref : - add(addrs(vms.dom), p as long) - add(sizes(vms.dom), size as long) - return false - -lostanza defn collect-object-contents - (p:ptr, tag:int, size:long, vms:ptr) -> ref : - add(offs(vms.dom), heap(vms.dom).length) - add(heap(vms.dom), tag as long) - val idx = heap(vms.dom).length - add(heap(vms.dom), 0L) ; place holder - core/iterate-references(p, addr(do-collect-object-contents), vms) - heap(vms.dom).items[idx] = heap(vms.dom).length - idx - 1 - return false - -lostanza defn do-collect-object-contents (ref:ptr, vms:ptr) -> ref : - ;Retrieve the value at the given heap pointer. - val v = [ref] - ;Is this a reference to a Stanza heap object? - val tagbits = v & 7L - if tagbits == 1L : - ;Remove the tag bits to retrieve the object pointer. - val p = (v - 1) as ptr - add(heap(vms.dom), addr-to-id(addrs(vms.dom), p as long) + 1) - return false - -public lostanza defn register-all-roots (vms:ptr) -> ref : - core/core-iterate-roots(addr(register-root-reference), vms) - register-stack-roots(vms) - return false - -public lostanza defn register-stack-roots (vms:ptr) -> ref : - var stack:ptr = vms.heap.stacks - while stack != null : - iterate-references-in-stack-frames(stack, addr(register-root-reference), vms) - stack = stack.tail - return false - -public lostanza defn register-root-reference (ref:ptr, vms:ptr) -> ref : - val v = [ref] - val tagbits = v & 7L ; heap object? - if tagbits == 1L : - val p = (v - 1) as ptr ; remove tag bits to retrieve object pointer - add(roots(vms.dom), p as long) - return false - -lostanza defn iterate-objects - (pstart:ptr, pend:ptr, vms:ptr, - f:ptr<((ptr, int, long, ptr) -> ref)>) -> ref : - var p:ptr = pstart - while p < pend : - val tag = [p] as int - val class = vms.class-table[tag].record - var size:long = 0L - if class.item-size == 0 : - size = object-size-on-heap(class.size) - else : - val class = class as ptr - val array = p as ptr - val len = array.slots[0] - val base-size = class.base-size - val item-size = class.item-size - val my-size = base-size + item-size * len - size = object-size-on-heap(my-size) - [f](p, tag, size, vms) - p = p + size - return false - -;; Look up offset into sorted list of object addresses using binary search -lostanza defn addr-to-id (xs:ptr, x:long) -> long : - var res:long = -1L - labels : - begin: goto loop(0L, xs.length) - loop (start:long, end:long) : - if end > start : - val center = (start + end) >> 1 - val xc = xs.items[center] - if x == xc : res = center - else if x < xc : goto loop(start, center) - else : goto loop(center + 1L, end) - return res - -;;; LowFlatObject -- create flat and packed version of roots and objects -;;; -- stores tag, num-refs, refs for each object -;;; -- also has extra root root object with ref per root - -lostanza deftype LowFlatObjects : - var sizes : ptr ; static sizes of objects - var offs : ptr ; offsets to inlined objects in heap - var heap : ptr ; | type | len | ids ... | ... - -lostanza deftype FlatObjects <: IndexedCollection&Lengthable : - value : ptr - -lostanza defn FlatObjects - (sizes:ptr, offs:ptr, heap:ptr) -> ref : - val lfo = call-c clib/stz_malloc(sizeof(LowFlatObjects)) as ptr - lfo.sizes = sizes - lfo.offs = offs - lfo.heap = heap - return new FlatObjects{ lfo } - -lostanza defmethod length (xs:ref) -> ref : - return new Int{xs.value.offs.length} - -lostanza defn offset (xs:ref, id:ref) -> ref : - return new Int{xs.value.offs.items[id.value] as int} - -lostanza defmethod get (xs:ref, idx:ref) -> ref : - return new Int{xs.value.heap.items[idx.value] as int} - -; for some reason can't name this method get like in stanza runtime -defn get-all (xs:FlatObjects, indices:Range) -> Seq : - seq({ xs[_] }, indices) - -defn tag-of (xs:FlatObjects, id:Int) -> Int : - xs[offset(xs, id)] - -lostanza defn size-of (xs:ref, id:ref) -> ref : - return new Int{ xs.value.sizes.items[id.value] as int } - -defn sizes (objs:FlatObjects) -> Seq : - seq(size-of{objs, _}, 0 to length(objs)) - -defn refs (objs:FlatObjects, id:Int) -> Seqable : - val off = offset(objs, id) ; base - val num-refs = objs[off + 1] - val refs-off = off + 2 - get-all(objs, refs-off to (refs-off + num-refs)) - -;; Pack roots / heap into FlatObjects -lostanza defn FlatObjects () -> ref : - call-c clib/printf("GC...\n") - run-garbage-collector() - val vms:ptr = call-prim flush-vm() - val dom = vms.dom - clear(offs(dom)) - clear(sizes(dom)) - clear(heap(dom)) - ;; get all roots - register-all-roots(vms) - call-c clib/printf("FOUND %d ROOTS...\n", roots(dom).length) - ;; get sizes and addresses of objects on heap - add(sizes(dom), roots(dom).length as long) ; dummy root object - call-c clib/printf("COLLECT HEAP %lx OBJECT ADDRESSES AND SIZES...\n", vms.heap.start) - iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-address-and-size)) - val nursery = core/nursery-start(addr(vms.heap)) - call-c clib/printf("COLLECT NURSERY %lx OBJECT ADDRESSES AND SIZES...\n", nursery) - iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-address-and-size)) - call-c clib/printf("FOUND %d OBJECTS...\n", addrs(dom).length) - ;; build heap data translated to object ids using addresses and binary search - add(offs(dom), 0L) ; first root object - add(heap(dom), -1L) ; dummy root object tag - add(heap(dom), roots(dom).length as long) - call-c clib/printf("CONVERTING ROOT ADDRESSES TO IDS...\n") - for (var i:int = 0, i < roots(dom).length, i = i + 1) : - add(heap(dom), addr-to-id(addrs(dom), roots(dom).items[i]) + 1) ; point to roots - call-c clib/printf("PACKING HEAP DATA...\n") - iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-contents)) - call-c clib/printf("PACKING NURSERY DATA...\n") - iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-contents)) - clear(addrs(dom)) - clear(roots(dom)) - call-c clib/printf("DONE...\n") - return FlatObjects(sizes(dom), offs(dom), heap(dom)) - -;;; FlatIdObjects - -;; Permutation wrapper of flat-objects -defstruct FlatIdObjects : - order : Tuple - reorder : Tuple - objs : FlatObjects -with: - printer => true - -defn sizes (o:FlatIdObjects) -> Seq : - gather(to-tuple(sizes(objs(o))), order(o)) - -defn length (ios:FlatIdObjects) -> Int : - length(objs(ios)) - -defn nexts (fobjs:FlatIdObjects) -> Tuple> : - val objs = objs(fobjs) - to-tuple $ for id in order(fobjs) seq : - to-list $ seq({ reorder(fobjs)[_] }, refs(objs, id)) - -defn prevs (nexts:Tuple>) -> Tuple> : - val prevs = Array>(length(nexts), List()) - for (next in nexts, id in 0 to false) do : - for r in next do : - prevs[r] = cons(id, prevs[r]) - to-tuple $ prevs - -defn objects-to-id-objects (objs:FlatObjects) -> FlatIdObjects : - FlatIdObjects(to-tuple $ (0 to length(objs)), to-tuple $ (0 to length(objs)), objs) - -;;; DOMINATORS - -;; find depth first order of objects -defn depth-first (ios:FlatIdObjects) -> FlatIdObjects : - val nexts = nexts(ios) - val visited? = Array(length(ios), false) - val order0 = Vector() - let loop (idx:Int = 0) : - if not visited?[idx] : - visited?[idx] = true - for nidx in nexts[idx] do : loop(nidx) - add(order0, idx) - val missing = filter({ not visited?[_] }, 0 to length(visited?)) - val order = to-tuple $ cat(missing, order0) - FlatIdObjects(to-tuple $ order, scatter(0 to length(order), to-tuple(order)), objs(ios)) - -; fast dominators algorithm assuming depth-first order -defn idom (num:Int, prevs:Tuple>) -> Tuple : - val doms = Array(num, -1) - val start-id = num - 1 - doms[start-id] = start-id - defn intersect (b1:Int, b2:Int) -> Int : - let loop (finger1:Int = b1, finger2:Int = b2) : - if finger1 != finger2 : - val finger1 = let iter (finger1:Int = finger1) : - if finger1 < finger2 : iter(doms[finger1]) - else : finger1 - val finger2 = let iter (finger2:Int = finger2) : - if finger2 < finger1 : iter(doms[finger2]) - else : finger2 - loop(finger1, finger2) - else : - finger1 - let loop () : - let iter (b : Int = start-id - 1, changed? : True|False = false) : - if b >= 0 : - val new-idom = let find (idom:Int = -1, ps:List = prevs[b]) : - if empty?(ps) : - idom - else : - val p = head(ps) - val nxt-idom = - if doms[p] != -1 : - if idom == -1 : p - else : intersect(p, idom) - else : idom - find(nxt-idom, tail(ps)) - val changed? = doms[b] != new-idom - doms[b] = new-idom - iter(b - 1, changed?) +#if-defined(BOOTSTRAP) : + + ;;; INTERFACE TO STANZA MEMORY SYSTEM + + lostanza defn addrs (dom:ptr) -> ptr : + return dom.addrs as ptr + + lostanza defn heap (dom:ptr) -> ptr : + return dom.heap as ptr + + lostanza defn sizes (dom:ptr) -> ptr : + return dom.sizes as ptr + + lostanza defn roots (dom:ptr) -> ptr : + return dom.roots as ptr + + lostanza defn offs (dom:ptr) -> ptr : + return dom.offs as ptr + + lostanza defn collect-object-address-and-size + (p:ptr, tag:int, size:long, vms:ptr) -> ref : + add(addrs(vms.dom), p as long) + add(sizes(vms.dom), size as long) + return false + + lostanza defn collect-object-contents + (p:ptr, tag:int, size:long, vms:ptr) -> ref : + add(offs(vms.dom), heap(vms.dom).length) + add(heap(vms.dom), tag as long) + val idx = heap(vms.dom).length + add(heap(vms.dom), 0L) ; place holder + core/iterate-references(p, addr(do-collect-object-contents), vms) + heap(vms.dom).items[idx] = heap(vms.dom).length - idx - 1 + return false + + lostanza defn do-collect-object-contents (ref:ptr, vms:ptr) -> ref : + ;Retrieve the value at the given heap pointer. + val v = [ref] + ;Is this a reference to a Stanza heap object? + val tagbits = v & 7L + if tagbits == 1L : + ;Remove the tag bits to retrieve the object pointer. + val p = (v - 1) as ptr + add(heap(vms.dom), addr-to-id(addrs(vms.dom), p as long) + 1) + return false + + public lostanza defn register-all-roots (vms:ptr) -> ref : + core/core-iterate-roots(addr(register-root-reference), vms) + register-stack-roots(vms) + return false + + public lostanza defn register-stack-roots (vms:ptr) -> ref : + var stack:ptr = vms.heap.stacks + while stack != null : + iterate-references-in-stack-frames(stack, addr(register-root-reference), vms) + stack = stack.tail + return false + + public lostanza defn register-root-reference (ref:ptr, vms:ptr) -> ref : + val v = [ref] + val tagbits = v & 7L ; heap object? + if tagbits == 1L : + val p = (v - 1) as ptr ; remove tag bits to retrieve object pointer + add(roots(vms.dom), p as long) + return false + + lostanza defn iterate-objects + (pstart:ptr, pend:ptr, vms:ptr, + f:ptr<((ptr, int, long, ptr) -> ref)>) -> ref : + var p:ptr = pstart + while p < pend : + val tag = [p] as int + val class = vms.class-table[tag].record + var size:long = 0L + if class.item-size == 0 : + size = object-size-on-heap(class.size) else : - loop() when changed? - to-tuple $ doms - -defn calc-sizes (ios:FlatIdObjects, doms:Tuple) -> Array : - val tot-sizes = to-array $ sizes(ios) - val len = length(ios) - for i in 0 to (len - 1) do : - if doms[i] >= 0 : - tot-sizes[doms[i]] = tot-sizes[doms[i]] + tot-sizes[i] - tot-sizes - -defn print-xml - (s:FileOutputStream, id-objs:FlatIdObjects, sizes:Array, - nexts:Tuple>, doms:Tuple, threshold:Int = 0) : - val objs = objs(id-objs) - defn children (doms:Tuple) -> Tuple> : - val children = to-tuple $ repeatedly({ Vector() }, length(nexts)) - for (dom in doms, id in 0 to false) do : - add(children[dom], id) when (dom >= 0 and dom != id) - map(to-tuple, children) - defn stringify (s:String) -> String : - replace(s, "&", "A") - defn P (n:Int, str:Printable) : - for i in 0 to (n * 2) do : print(s, " ") - println(s, str) - val kiddies = children(doms) - let walk (idx:Int = length(doms) - 1, depth:Int = 0) : - val id = order(id-objs)[idx] - val name = stringify(class-name(tag-of(objs, id))) - P(depth, "<%_ RETAINED=\"%_\" STATIC=\"%_\">" % [name, sizes[idx], size-of(objs, id)]) - val childs = reverse $ to-list $ qsort({ sizes[_] }, filter({ sizes[_] > threshold }, kiddies[idx])) - for child in childs do : - walk(child, depth + 1) - P(depth, "" % [name]) - -public defn heap-dominator-tree (filename:String) -> FlatIdObjects : - val objs = FlatObjects() - val id-objs0 = objects-to-id-objects(objs) - val id-objs = depth-first(id-objs0) - val nxts = nexts(id-objs) - val doms = idom(length(id-objs), prevs(nxts)) - val sizes = calc-sizes(id-objs, doms) - ; print-id-object-stats(objs, to-tuple $ gather(sizes, reorder(id-objs))) - val s = FileOutputStream(filename) - print-xml(s, id-objs, sizes, nxts, doms) - close(s) - id-objs - -; heap-dominator-tree("sizes.xml") - -; defn id-print-guts (id:Int, tag:Int, refs:Seqable) : -; print("%_ = {%_ %_}" % [id, class-name(tag), to-tuple $ refs]) -; -; defn print-id-object-guts (objs:FlatObjects) -> False : -; for id in 0 to length(objs) do : -; id-print-guts(id, tag-of(objs, id), refs(objs, id)) -; println("") -; -; defn id-print-stat (id:Int, tag:Int, tot-size:Int, size:Int) : -; print("%_ = {%_ %_ %_}" % [id, class-name(tag), size, tot-size]) -; -; defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : -; val ids = reverse $ to-list $ qsort({ tot-sizes[_] }, 0 to length(objs)) -; for (id in ids, i in 0 to false) do : -; val tot-size = tot-sizes[id] -; if tot-size > 0 : -; id-print-stat(id, tag-of(objs, id), tot-size, size-of(objs, id)) -; println("") + val class = class as ptr + val array = p as ptr + val len = array.slots[0] + val base-size = class.base-size + val item-size = class.item-size + val my-size = base-size + item-size * len + size = object-size-on-heap(my-size) + [f](p, tag, size, vms) + p = p + size + return false + + ;; Look up offset into sorted list of object addresses using binary search + lostanza defn addr-to-id (xs:ptr, x:long) -> long : + var res:long = -1L + labels : + begin: goto loop(0L, xs.length) + loop (start:long, end:long) : + if end > start : + val center = (start + end) >> 1 + val xc = xs.items[center] + if x == xc : res = center + else if x < xc : goto loop(start, center) + else : goto loop(center + 1L, end) + return res + + ;;; LowFlatObject -- create flat and packed version of roots and objects + ;;; -- stores tag, num-refs, refs for each object + ;;; -- also has extra root root object with ref per root + + lostanza deftype LowFlatObjects : + var sizes : ptr ; static sizes of objects + var offs : ptr ; offsets to inlined objects in heap + var heap : ptr ; | type | len | ids ... | ... + + lostanza deftype FlatObjects <: IndexedCollection&Lengthable : + value : ptr + + lostanza defn FlatObjects + (sizes:ptr, offs:ptr, heap:ptr) -> ref : + val lfo = call-c clib/stz_malloc(sizeof(LowFlatObjects)) as ptr + lfo.sizes = sizes + lfo.offs = offs + lfo.heap = heap + return new FlatObjects{ lfo } + + lostanza defmethod length (xs:ref) -> ref : + return new Int{xs.value.offs.length} + + lostanza defn offset (xs:ref, id:ref) -> ref : + return new Int{xs.value.offs.items[id.value] as int} + + lostanza defmethod get (xs:ref, idx:ref) -> ref : + return new Int{xs.value.heap.items[idx.value] as int} + + ; for some reason can't name this method get like in stanza runtime + defn get-all (xs:FlatObjects, indices:Range) -> Seq : + seq({ xs[_] }, indices) + + defn tag-of (xs:FlatObjects, id:Int) -> Int : + xs[offset(xs, id)] + + lostanza defn size-of (xs:ref, id:ref) -> ref : + return new Int{ xs.value.sizes.items[id.value] as int } + + defn sizes (objs:FlatObjects) -> Seq : + seq(size-of{objs, _}, 0 to length(objs)) + + defn refs (objs:FlatObjects, id:Int) -> Seqable : + val off = offset(objs, id) ; base + val num-refs = objs[off + 1] + val refs-off = off + 2 + get-all(objs, refs-off to (refs-off + num-refs)) + + ;; Pack roots / heap into FlatObjects + lostanza defn FlatObjects () -> ref : + call-c clib/printf("GC...\n") + run-garbage-collector() + val vms:ptr = call-prim flush-vm() + val dom = vms.dom + clear(offs(dom)) + clear(sizes(dom)) + clear(heap(dom)) + ;; get all roots + register-all-roots(vms) + call-c clib/printf("FOUND %d ROOTS...\n", roots(dom).length) + ;; get sizes and addresses of objects on heap + add(sizes(dom), roots(dom).length as long) ; dummy root object + call-c clib/printf("COLLECT HEAP %lx OBJECT ADDRESSES AND SIZES...\n", vms.heap.start) + iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-address-and-size)) + val nursery = core/nursery-start(addr(vms.heap)) + call-c clib/printf("COLLECT NURSERY %lx OBJECT ADDRESSES AND SIZES...\n", nursery) + iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-address-and-size)) + call-c clib/printf("FOUND %d OBJECTS...\n", addrs(dom).length) + ;; build heap data translated to object ids using addresses and binary search + add(offs(dom), 0L) ; first root object + add(heap(dom), -1L) ; dummy root object tag + add(heap(dom), roots(dom).length as long) + call-c clib/printf("CONVERTING ROOT ADDRESSES TO IDS...\n") + for (var i:int = 0, i < roots(dom).length, i = i + 1) : + add(heap(dom), addr-to-id(addrs(dom), roots(dom).items[i]) + 1) ; point to roots + call-c clib/printf("PACKING HEAP DATA...\n") + iterate-objects(vms.heap.start, vms.heap.old-objects-end, vms, addr(collect-object-contents)) + call-c clib/printf("PACKING NURSERY DATA...\n") + iterate-objects(nursery, vms.heap.top, vms, addr(collect-object-contents)) + clear(addrs(dom)) + clear(roots(dom)) + call-c clib/printf("DONE...\n") + return FlatObjects(sizes(dom), offs(dom), heap(dom)) + + ;;; FlatIdObjects + + ;; Permutation wrapper of flat-objects + defstruct FlatIdObjects : + order : Tuple + reorder : Tuple + objs : FlatObjects + with: + printer => true + + defn sizes (o:FlatIdObjects) -> Seq : + gather(to-tuple(sizes(objs(o))), order(o)) + + defn length (ios:FlatIdObjects) -> Int : + length(objs(ios)) + + defn nexts (fobjs:FlatIdObjects) -> Tuple> : + val objs = objs(fobjs) + to-tuple $ for id in order(fobjs) seq : + to-list $ seq({ reorder(fobjs)[_] }, refs(objs, id)) + + defn prevs (nexts:Tuple>) -> Tuple> : + val prevs = Array>(length(nexts), List()) + for (next in nexts, id in 0 to false) do : + for r in next do : + prevs[r] = cons(id, prevs[r]) + to-tuple $ prevs + + defn objects-to-id-objects (objs:FlatObjects) -> FlatIdObjects : + FlatIdObjects(to-tuple $ (0 to length(objs)), to-tuple $ (0 to length(objs)), objs) + + ;;; DOMINATORS + + ;; find depth first order of objects + defn depth-first (ios:FlatIdObjects) -> FlatIdObjects : + val nexts = nexts(ios) + val visited? = Array(length(ios), false) + val order0 = Vector() + let loop (idx:Int = 0) : + if not visited?[idx] : + visited?[idx] = true + for nidx in nexts[idx] do : loop(nidx) + add(order0, idx) + val missing = filter({ not visited?[_] }, 0 to length(visited?)) + val order = to-tuple $ cat(missing, order0) + FlatIdObjects(to-tuple $ order, scatter(0 to length(order), to-tuple(order)), objs(ios)) + + ; fast dominators algorithm assuming depth-first order + defn idom (num:Int, prevs:Tuple>) -> Tuple : + val doms = Array(num, -1) + val start-id = num - 1 + doms[start-id] = start-id + defn intersect (b1:Int, b2:Int) -> Int : + let loop (finger1:Int = b1, finger2:Int = b2) : + if finger1 != finger2 : + val finger1 = let iter (finger1:Int = finger1) : + if finger1 < finger2 : iter(doms[finger1]) + else : finger1 + val finger2 = let iter (finger2:Int = finger2) : + if finger2 < finger1 : iter(doms[finger2]) + else : finger2 + loop(finger1, finger2) + else : + finger1 + let loop () : + let iter (b : Int = start-id - 1, changed? : True|False = false) : + if b >= 0 : + val new-idom = let find (idom:Int = -1, ps:List = prevs[b]) : + if empty?(ps) : + idom + else : + val p = head(ps) + val nxt-idom = + if doms[p] != -1 : + if idom == -1 : p + else : intersect(p, idom) + else : idom + find(nxt-idom, tail(ps)) + val changed? = doms[b] != new-idom + doms[b] = new-idom + iter(b - 1, changed?) + else : + loop() when changed? + to-tuple $ doms + + defn calc-sizes (ios:FlatIdObjects, doms:Tuple) -> Array : + val tot-sizes = to-array $ sizes(ios) + val len = length(ios) + for i in 0 to (len - 1) do : + if doms[i] >= 0 : + tot-sizes[doms[i]] = tot-sizes[doms[i]] + tot-sizes[i] + tot-sizes + + defn print-xml + (s:FileOutputStream, id-objs:FlatIdObjects, sizes:Array, + nexts:Tuple>, doms:Tuple, threshold:Int = 0) : + val objs = objs(id-objs) + defn children (doms:Tuple) -> Tuple> : + val children = to-tuple $ repeatedly({ Vector() }, length(nexts)) + for (dom in doms, id in 0 to false) do : + add(children[dom], id) when (dom >= 0 and dom != id) + map(to-tuple, children) + defn stringify (s:String) -> String : + replace(s, "&", "A") + defn P (n:Int, str:Printable) : + for i in 0 to (n * 2) do : print(s, " ") + println(s, str) + val kiddies = children(doms) + let walk (idx:Int = length(doms) - 1, depth:Int = 0) : + val id = order(id-objs)[idx] + val name = stringify(class-name(tag-of(objs, id))) + P(depth, "<%_ RETAINED=\"%_\" STATIC=\"%_\">" % [name, sizes[idx], size-of(objs, id)]) + val childs = reverse $ to-list $ qsort({ sizes[_] }, filter({ sizes[_] > threshold }, kiddies[idx])) + for child in childs do : + walk(child, depth + 1) + P(depth, "" % [name]) + + public defn heap-dominator-tree (filename:String) : + val objs = FlatObjects() + val id-objs0 = objects-to-id-objects(objs) + val id-objs = depth-first(id-objs0) + val nxts = nexts(id-objs) + val doms = idom(length(id-objs), prevs(nxts)) + val sizes = calc-sizes(id-objs, doms) + ; print-id-object-stats(objs, to-tuple $ gather(sizes, reorder(id-objs))) + val s = FileOutputStream(filename) + print-xml(s, id-objs, sizes, nxts, doms) + close(s) + + ; heap-dominator-tree("sizes.xml") + + ; defn id-print-guts (id:Int, tag:Int, refs:Seqable) : + ; print("%_ = {%_ %_}" % [id, class-name(tag), to-tuple $ refs]) + ; + ; defn print-id-object-guts (objs:FlatObjects) -> False : + ; for id in 0 to length(objs) do : + ; id-print-guts(id, tag-of(objs, id), refs(objs, id)) + ; println("") + ; + ; defn id-print-stat (id:Int, tag:Int, tot-size:Int, size:Int) : + ; print("%_ = {%_ %_ %_}" % [id, class-name(tag), size, tot-size]) + ; + ; defn print-id-object-stats (objs:FlatObjects, tot-sizes:Tuple) -> False : + ; val ids = reverse $ to-list $ qsort({ tot-sizes[_] }, 0 to length(objs)) + ; for (id in ids, i in 0 to false) do : + ; val tot-size = tot-sizes[id] + ; if tot-size > 0 : + ; id-print-stat(id, tag-of(objs, id), tot-size, size-of(objs, id)) + ; println("") + +#else : + + public defn heap-dominator-tree (filename:String) : false diff --git a/scripts/make.sh b/scripts/make.sh index c36c2106..d44e8b34 100755 --- a/scripts/make.sh +++ b/scripts/make.sh @@ -60,6 +60,7 @@ PKGFILES="math \ core/debug-table \ core/sighandler \ core/local-table \ + core/heap-analysis \ arg-parser \ line-wrap \ stz/test-driver \ From ca854d2fd9debc10cd2b986dc1a98ca6f8f75071 Mon Sep 17 00:00:00 2001 From: jackbackrack Date: Tue, 28 Jan 2025 12:10:54 -0800 Subject: [PATCH 7/7] change arms of if bootstrap --- core/heap-analysis.stanza | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/core/heap-analysis.stanza b/core/heap-analysis.stanza index a1253107..61cefd95 100644 --- a/core/heap-analysis.stanza +++ b/core/heap-analysis.stanza @@ -30,6 +30,10 @@ lostanza defn class-name (x:ref) -> ref : #if-defined(BOOTSTRAP) : + public defn heap-dominator-tree (filename:String) : false + +#else : + ;;; INTERFACE TO STANZA MEMORY SYSTEM lostanza defn addrs (dom:ptr) -> ptr : @@ -364,7 +368,3 @@ lostanza defn class-name (x:ref) -> ref : ; id-print-stat(id, tag-of(objs, id), tot-size, size-of(objs, id)) ; println("") -#else : - - public defn heap-dominator-tree (filename:String) : false -