mirror of
https://github.com/open-goal/jak-project
synced 2026-08-06 09:54:10 -04:00
water111
303 lines
16 KiB
Common Lisp
303 lines
16 KiB
Common Lisp
;;-*-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 mem-usage-flags))
|
|
"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 mem-usage-flags))
|
|
"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)) (mem-usage-flags))
|
|
(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 mem-usage-flags))
|
|
"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 (mem-usage-flags include-dead-pools))
|
|
(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))))
|
|
(mem-usage-add! usage process-active 1 (asize-of proc))
|
|
(mem-usage-add! usage heap-total 1 (+ (the-as uint (- -4 (the-as int proc))) (the-as uint (-> proc heap-cur))))
|
|
(mem-usage-add! usage heap-process 1 (- (-> proc type size) (-> proc type heap-base)))
|
|
(mem-usage-add! usage heap-header 1 (-> proc type heap-base))
|
|
(mem-usage-add! usage heap-thread 1 (asize-of (-> proc main-thread)))
|
|
(when (type-type? (-> proc type) process-drawable)
|
|
(when (nonzero? (-> (the-as process-drawable proc) root))
|
|
(mem-usage-add! usage heap-root 1 (asize-of (-> (the-as process-drawable proc) root)))
|
|
(when (type-type? (-> (the-as process-drawable proc) root type) collide-shape)
|
|
(mem-usage-add! usage heap-collide-prim 1 (asize-of (-> (the-as collide-shape (-> (the-as process-drawable proc) root)) root-prim)))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) node-list))
|
|
(mem-usage-add! usage heap-cspace 1 (asize-of (-> (the-as process-drawable proc) node-list))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) draw))
|
|
(mem-usage-add! usage heap-draw-control 1 (asize-of (-> (the-as process-drawable proc) draw)))
|
|
(when (nonzero? (-> (the-as process-drawable proc) draw skeleton))
|
|
(mem-usage-add! usage heap-bone 1 (asize-of (-> (the-as process-drawable proc) draw skeleton)))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) skel))
|
|
(mem-usage-add! usage heap-joint-control 1 (asize-of (-> (the-as process-drawable proc) skel))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) part))
|
|
(mem-usage-add! usage heap-part 1 (asize-of (-> (the-as process-drawable proc) part))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) nav))
|
|
(mem-usage-add! usage heap-misc 1 (asize-of (-> (the-as process-drawable proc) nav))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) path))
|
|
(mem-usage-add! usage heap-misc 1 (asize-of (-> (the-as process-drawable proc) path))))
|
|
(when (nonzero? (-> (the-as process-drawable proc) vol))
|
|
(mem-usage-add! usage heap-misc 1 (asize-of (-> (the-as process-drawable proc) vol))))))
|
|
#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))
|