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..61cefd95 --- /dev/null +++ b/core/heap-analysis.stanza @@ -0,0 +1,370 @@ +defpackage core/heap-analysis : + import core + 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 + 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 + +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 + +#if-defined(BOOTSTRAP) : + + public defn heap-dominator-tree (filename:String) : false + +#else : + + ;;; 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?) + 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("") + 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 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 \