;;-*-Lisp-*- (in-package goal) (bundles "ENGINE.CGO" "GAME.CGO") (require "engine/level/level.gc") ;; DECOMP BEGINS ;; this file is debug only (declare-file (debug)) (defmethod inspect ((this memory-usage-block)) "Print every active category with its object count, requested bytes, aligned bytes, and totals." (format #t "-------------------------------------------------------------~%") (format #t " # name count bytes used aligned bytes~%") (format #t "-------------------------------------------------------------~%") (let ((used-total 0) (aligned-total 0)) (dotimes (i (-> this length)) (let ((info (-> this data i))) (+! used-total (-> info used)) (+! aligned-total (-> info total)) (format #t "~3D: ~20S ~7D ~8D ~8D~%" i (-> info name) (-> info count) (-> info used) (-> info total)))) (format #t "total: ~8D ~8D~%" used-total aligned-total)) (format #t "-------------------------------------------------------------~%") this) (defmethod mem-usage ((this object) (usage memory-usage-block) (flags int)) "Warn when a nonfalse object reaches this generic fallback. Leave usage unchanged and return the object." (if this (format #t "WARNING: mem-usage called on object, probably not what was wanted for ~A~%" this)) this) (defmethod calculate-total ((this memory-usage-block)) "Return the sum of the aligned total bytes in every active category." (let ((total 0)) (dotimes (i (-> this length)) (+! total (-> this data i total))) total)) (defmethod reset! ((this memory-usage-block)) "Clear all 109 category counters and mark the block empty." (set! (-> this length) 0) (dotimes (i 109) (set! (-> this data i used) 0) (set! (-> this data i total) 0) (set! (-> this data i count) 0)) this) (defun mem-size ((value basic) (print? symbol) (flags int)) "Collect value's memory categories using flags, optionally print the complete category table, and return the sum of aligned total bytes." (let ((usage (new 'stack 'memory-usage-block))) (mem-usage value usage flags) (if print? (inspect usage)) (calculate-total usage))) (defmethod compute-memory-usage ((this level) (force? object)) "Return this level's cached category breakdown. Allocate it when needed and recalculate both the categories and cached total when force? is true or the block is empty." (if (zero? (-> this mem-usage-block)) (set! (-> this mem-usage-block) (new 'debug 'memory-usage-block))) (set! force? (or (zero? (-> this mem-usage-block length)) force?)) (when force? (mem-usage this (reset! (-> this mem-usage-block)) 0) (set! (-> this mem-usage) (calculate-total (-> this mem-usage-block)))) (-> this mem-usage-block)) (defmethod mem-usage ((this process-tree) (usage memory-usage-block) (flags int)) "Name and optionally count the process dead pools, then account for every active process and its heap header, thread, drawable controllers, and other major heap-owned allocations. flags bit #x20 also counts objects currently resident in the dead pools." (let ((name-category 87)) (let* ((name-pool-list *dead-pool-list*) (name-pool-symbol (car name-pool-list))) (while (not (null? name-pool-list)) (set! (-> usage data name-category name) (symbol->string (the-as symbol name-pool-symbol))) (+! name-category 1) (set! name-pool-list (cdr name-pool-list)) (set! name-pool-symbol (car name-pool-list)))) (set! (-> usage length) (max (-> usage length) name-category))) (set! (-> usage data 93 name) "*debug-dead-pool*") (set! *temp-mem-usage* usage) (when (logtest? flags 32) (let* ((dead-category 87) (dead-pool-list *dead-pool-list*) (dead-pool-symbol (car dead-pool-list))) (while (not (null? dead-pool-list)) (let ((pool-root (-> (the-as symbol dead-pool-symbol) value))) (set! *global-search-count* dead-category) (iterate-process-tree (the-as process-tree pool-root) (lambda ((pool-object basic)) (let ((usage *temp-mem-usage*) (category *global-search-count*)) (+! (-> usage data category used) 1) (+! (-> usage data category total) (logand -16 (+ (asize-of pool-object) 15)))) #t) *null-kernel-context*)) (+! dead-category 1) (set! dead-pool-list (cdr dead-pool-list)) (set! dead-pool-symbol (car dead-pool-list))))) (iterate-process-tree this (lambda ((proc process)) (let ((usage *temp-mem-usage*)) (let ((pool-category (cond ((= (-> proc pool) *8k-dead-pool*) 88) ((= (-> proc pool) *16k-dead-pool*) 89) ((= (-> proc pool) *nk-dead-pool*) 90) ((= (-> proc pool) *target-dead-pool*) 91) ((= (-> proc pool) *camera-dead-pool*) 92) ((= (-> proc pool) *debug-dead-pool*) 93) (else 87)))) (+! (-> usage data pool-category count) 1) (+! (-> usage data pool-category total) (logand -16 (+ (asize-of proc) 15)))) (set! (-> usage length) (max 95 (-> usage length))) (set! (-> usage data 94 name) "process-active") (+! (-> usage data 94 count) 1) (let ((process-size (asize-of proc))) (+! (-> usage data 94 used) process-size) (+! (-> usage data 94 total) (logand -16 (+ process-size 15)))) (set! (-> usage length) (max 96 (-> usage length))) (set! (-> usage data 95 name) "heap-total") (+! (-> usage data 95 count) 1) (let ((heap-used (+ (the-as uint (- -4 (the-as int proc))) (the-as uint (-> proc heap-cur))))) (+! (-> usage data 95 used) heap-used) (+! (-> usage data 95 total) (logand -16 (+ heap-used 15)))) (set! (-> usage length) (max 97 (-> usage length))) (set! (-> usage data 96 name) "heap-process") (+! (-> usage data 96 count) 1) (let ((process-data-size (- (-> proc type size) (-> proc type heap-base)))) (+! (-> usage data 96 used) process-data-size) (+! (-> usage data 96 total) (logand -16 (+ process-data-size 15)))) (set! (-> usage length) (max 98 (-> usage length))) (set! (-> usage data 97 name) "heap-header") (+! (-> usage data 97 count) 1) (let ((heap-header-size (-> proc type heap-base))) (+! (-> usage data 97 used) heap-header-size) (+! (-> usage data 97 total) (logand -16 (+ heap-header-size 15)))) (set! (-> usage length) (max 99 (-> usage length))) (set! (-> usage data 98 name) "heap-thread") (+! (-> usage data 98 count) 1) (let ((thread-size (asize-of (-> proc main-thread)))) (+! (-> usage data 98 used) thread-size) (+! (-> usage data 98 total) (logand -16 (+ thread-size 15)))) (when (type-type? (-> proc type) process-drawable) (when (nonzero? (-> (the-as process-drawable proc) root)) (set! (-> usage length) (max 100 (-> usage length))) (set! (-> usage data 99 name) "heap-root") (+! (-> usage data 99 count) 1) (let ((root-size (asize-of (-> (the-as process-drawable proc) root)))) (+! (-> usage data 99 used) root-size) (+! (-> usage data 99 total) (logand -16 (+ root-size 15)))) (when (type-type? (-> (the-as process-drawable proc) root type) collide-shape) (set! (-> usage length) (max 106 (-> usage length))) (set! (-> usage data 105 name) "heap-collide-prim") (+! (-> usage data 105 count) 1) (let ((root-prim-size (asize-of (-> (the-as collide-shape (-> (the-as process-drawable proc) root)) root-prim)))) (+! (-> usage data 105 used) root-prim-size) (+! (-> usage data 105 total) (logand -16 (+ root-prim-size 15)))))) (when (nonzero? (-> (the-as process-drawable proc) node-list)) (set! (-> usage length) (max 103 (-> usage length))) (set! (-> usage data 102 name) "heap-cspace") (+! (-> usage data 102 count) 1) (let ((cspace-size (asize-of (-> (the-as process-drawable proc) node-list)))) (+! (-> usage data 102 used) cspace-size) (+! (-> usage data 102 total) (logand -16 (+ cspace-size 15))))) (when (nonzero? (-> (the-as process-drawable proc) draw)) (set! (-> usage length) (max 101 (-> usage length))) (set! (-> usage data 100 name) "heap-draw-control") (+! (-> usage data 100 count) 1) (let ((draw-control-size (asize-of (-> (the-as process-drawable proc) draw)))) (+! (-> usage data 100 used) draw-control-size) (+! (-> usage data 100 total) (logand -16 (+ draw-control-size 15)))) (when (nonzero? (-> (the-as process-drawable proc) draw skeleton)) (set! (-> usage length) (max 104 (-> usage length))) (set! (-> usage data 103 name) "heap-bone") (+! (-> usage data 103 count) 1) (let ((skeleton-size (asize-of (-> (the-as process-drawable proc) draw skeleton)))) (+! (-> usage data 103 used) skeleton-size) (+! (-> usage data 103 total) (logand -16 (+ skeleton-size 15)))))) (when (nonzero? (-> (the-as process-drawable proc) skel)) (set! (-> usage length) (max 102 (-> usage length))) (set! (-> usage data 101 name) "heap-joint-control") (+! (-> usage data 101 count) 1) (let ((joint-control-size (asize-of (-> (the-as process-drawable proc) skel)))) (+! (-> usage data 101 used) joint-control-size) (+! (-> usage data 101 total) (logand -16 (+ joint-control-size 15))))) (when (nonzero? (-> (the-as process-drawable proc) part)) (set! (-> usage length) (max 105 (-> usage length))) (set! (-> usage data 104 name) "heap-part") (+! (-> usage data 104 count) 1) (let ((particle-control-size (asize-of (-> (the-as process-drawable proc) part)))) (+! (-> usage data 104 used) particle-control-size) (+! (-> usage data 104 total) (logand -16 (+ particle-control-size 15))))) (when (nonzero? (-> (the-as process-drawable proc) nav)) (set! (-> usage length) (max 107 (-> usage length))) (set! (-> usage data 106 name) "heap-misc") (+! (-> usage data 106 count) 1) (let ((nav-size (asize-of (-> (the-as process-drawable proc) nav)))) (+! (-> usage data 106 used) nav-size) (+! (-> usage data 106 total) (logand -16 (+ nav-size 15))))) (when (nonzero? (-> (the-as process-drawable proc) path)) (set! (-> usage length) (max 107 (-> usage length))) (set! (-> usage data 106 name) "heap-misc") (+! (-> usage data 106 count) 1) (let ((path-size (asize-of (-> (the-as process-drawable proc) path)))) (+! (-> usage data 106 used) path-size) (+! (-> usage data 106 total) (logand -16 (+ path-size 15))))) (when (nonzero? (-> (the-as process-drawable proc) vol)) (set! (-> usage length) (max 107 (-> usage length))) (set! (-> usage data 106 name) "heap-misc") (+! (-> usage data 106 count) 1) (let ((volume-size (asize-of (-> (the-as process-drawable proc) vol)))) (+! (-> usage data 106 used) volume-size) (+! (-> usage data 106 total) (logand -16 (+ volume-size 15))))))) #t) *null-kernel-context*) this) ;; Maximum non-debug DMA bytes observed in one frame. (define *max-dma* 0) (defmethod print-mem-usage ((this memory-usage-block) (lev level) (destination object)) "Print a compact level-heap, actor-heap, and current/peak DMA line to destination. In short mode also print actor-heap compaction statistics; otherwise print grouped level-memory and DMA categories, the IOP visibility allocation, and level code, all in KiB." ;; The compact header is common to both display modes. (let ((level-heap-used (&- (-> lev heap current) (the-as uint (-> lev heap base))))) (let ((adjacent-vis-bytes (+ (-> this data 59 total) (-> this data 60 total)))) (< #x10000 adjacent-vis-bytes)) ;; This conservative budget is slightly below the actual level heap capacity, so a small ;; reported overage can still fit in memory. (let ((level-heap-budget #xa1a333) (frame-dma-bytes (* (dma-buffer-length (-> *display* frames (-> *display* last-screen) frame global-buf)) 16))) (set! *max-dma* (max frame-dma-bytes *max-dma*)) ;; The category sum is an estimate: texture adjustments may be negative and are not mirrored ;; by a corresponding positive category elsewhere. (if (< level-heap-budget (-> lev mem-usage)) (format destination "~3L")) ;; Level name and heap use, actor heap use, then current and peak non-debug DMA. (format destination "~0K~10,'-S--~5,'-DK-of-~5,'-DK--~5,'-DK-of-~5,'-DK--" (-> lev name) (sar level-heap-used 10) (sar level-heap-budget 10) (sar (memory-used *nk-dead-pool*) 10) (sar (memory-total *nk-dead-pool*) 10)) (format destination "~5,'-DK/~5,'-DK--~%" (shr frame-dma-bytes 10) (sar *max-dma* 10)))) (when *stats-memory-short* ;; Holding L3 mirrors the actor-heap compaction line to the console. (let ((heap-stats-destination (if (cpad-hold? 1 l3) #t destination))) (format heap-stats-destination "heap-~5,'-DK/~5,'-DK----~D---~D/~D~%" (sar (memory-used *nk-dead-pool*) 10) (sar (memory-total *nk-dead-pool*) 10) (compact-time *nk-dead-pool*) (-> *nk-dead-pool* compact-count) (-> *nk-dead-pool* compact-count-targ)))) (when (not *stats-memory-short*) ;; The detailed table's left column is level RAM and its right column is DMA memory. ;; Debug DMA is sampled here because it is excluded from *max-dma*. (set! (-> *dma-mem-usage* data 84 total) (* (dma-buffer-length (-> *display* frames (-> *display* last-screen) frame debug-buf)) 16)) (format destination " bsp ~192H~5DK ~280Hdebug~456H~5DK~%" (sar (+ (-> this data 56 total) (-> this data 57 total) (-> this data 58 total)) 10) (sar (-> *dma-mem-usage* data 84 total) 10)) (format destination " bsp-leaf-vis-iop ~192H~5DK~%" (sar (if (-> lev vis-info (-> lev vis-self-index)) (the-as int (-> lev vis-info (-> lev vis-self-index) allocated-length)) 0) 10)) (format destination " bsp-leaf-vis-adj ~192H~5DK~%" (sar (+ (-> this data 59 total) (-> this data 60 total)) 10)) (format destination " level-code ~192H~5DK~%" (sar (-> this data 63 total) 10)) (format destination " tfrag ~192H~5DK ~280Htfragment~456H~5DK~%" (sar (+ (-> this data 1 total) (-> this data 2 total) (-> this data 3 total) (-> this data 4 total) (-> this data 5 total) (-> this data 6 total) (-> this data 7 total) (-> this data 8 total)) 10) (sar (-> *dma-mem-usage* data 1 total) 10)) (format destination " tie-proto ~192H~5DK ~280Hsky~456H~5DK~%" (sar (+ (-> this data 9 total) (-> this data 10 total) (-> this data 11 total) (-> this data 12 total) (-> this data 13 total) (-> this data 14 total) (-> this data 16 total) (-> this data 17 total)) 10) (sar (-> *dma-mem-usage* data 85 total) 10)) (format destination " tie-instance ~192H~5DK ~280Htie-fragment~456H~5DK~%" (sar (+ (-> this data 18 total) (-> this data 20 total) (-> this data 21 total) (-> this data 22 total)) 10) (sar (-> *dma-mem-usage* data 9 total) 10)) (format destination " shrub-proto ~192H~5DK ~280Htie-near~456H~5DK~%" (sar (+ (-> this data 25 total) (-> this data 26 total) (-> this data 27 total) (-> this data 28 total) (-> this data 29 total) (-> this data 30 total) (-> this data 31 total) (-> this data 32 total) (-> this data 33 total)) 10) (sar (-> *dma-mem-usage* data 15 total) 10)) (format destination " shrub-instance ~192H~5DK ~280Hshrubbery~456H~5DK~%" (sar (-> this data 34 total) 10) (sar (-> *dma-mem-usage* data 27 total) 10)) (format destination " collision ~192H~5DK ~280Htie-generic~456H~5DK~%" (sar (+ (-> this data 50 total) (-> this data 51 total) (-> this data 52 total) (-> this data 53 total) (-> this data 54 total) (-> this data 55 total)) 10) (sar (-> *dma-mem-usage* data 17 total) 10)) (format destination " pris-geo ~192H~5DK ~280Hpris-fragment~456H~5DK~%" (sar (+ (-> this data 35 total) (-> this data 36 total) (-> this data 37 total) (-> this data 38 total) (-> this data 39 total) (-> this data 40 total) (-> this data 41 total) (-> this data 42 total) (-> this data 70 total) (-> this data 71 total) (-> this data 72 total) (-> this data 73 total) (-> this data 75 total) (-> this data 78 total) (-> this data 77 total) (-> this data 108 total)) 10) (sar (-> *dma-mem-usage* data 35 total) 10)) (format destination " pris-anim ~192H~5DK ~280Hpris-generic~456H~5DK~%" (sar (+ (-> this data 65 total) (-> this data 66 total) (-> this data 67 total) (-> this data 68 total) (-> this data 69 total) (-> this data 74 total) (-> this data 76 total)) 10) (sar (-> *dma-mem-usage* data 86 total) 10)) (format destination " textures ~192H~5DK ~280Htextures~456H~5DK~%" (sar (-> this data 79 total) 10) (sar (-> *dma-mem-usage* data 79 total) 10)) (format destination " entity ~192H~5DK~%" (sar (+ (-> this data 64 total) (-> this data 43 total) (-> this data 44 total) (-> this data 45 total) (-> this data 49 total) (-> this data 48 total) (-> this data 46 total) (-> this data 47 total)) 10)) (format destination " misc ~192H~5DK ~280Hsprite~456H~5DK~%" (sar (+ (-> this data 0 total) (-> this data 61 total) (-> this data 62 total) (-> this data 80 total) (-> this data 81 total)) 10) (sar (-> *dma-mem-usage* data 82 total) 10)) (format destination "~1K~0L")) (none))