mirror of
https://github.com/open-goal/jak-project
synced 2026-08-06 18:03:30 -04:00
ManDude
6884b0f73e
Adds sprite distort, fixes buggy sprite rendering in progress, adds scissoring support (used in various scrolling menus) and a very basic implementation of `blit-displays`. This is enough to make the fade effect in the progress menu work, along with all the menus working properly without needing to use the REPL. This does not make screen flipping and the filter when failing a mission work. Added support in the decompiler for detecting `dma-buffer-add-gs-set` and `dma-buffer-add-gs-set-flusha` and updated all of the Jak 2 code to use it. Readability improved! Fixes decompiler issue with `with-dma-buffer-add-bucket` not inlining forms which broke syntax. Fixes store error warnings showing up for non-existent stores, there is now a dedicated pass for this at the end. I started work on making `BITBLTBUF` stuff work in the DirectRenderer, but stopped for now because it wasn't strictly necessary. It will still assert like before.
816 lines
30 KiB
Common Lisp
816 lines
30 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: profile.gc
|
|
;; name in dgo: profile
|
|
;; dgos: ENGINE, GAME
|
|
(define-extern *dproc* process)
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; DMA templates for profile drawing
|
|
(deftype profile-work (structure)
|
|
((sprite-tmpl dma-gif-packet :inline :offset-assert 0)
|
|
(line-tmpl dma-gif-packet :inline :offset-assert 32)
|
|
(last-index int32 :offset-assert 64)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x44
|
|
:flag-assert #x900000044
|
|
)
|
|
|
|
;; dma templates
|
|
(define *profile-work*
|
|
(new 'static 'profile-work
|
|
:sprite-tmpl (new 'static 'dma-gif-packet
|
|
:dma-vif (new 'static 'dma-packet
|
|
:dma (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt))
|
|
:vif1 (new 'static 'vif-tag :imm #x4 :cmd (vif-cmd direct) :msk #x1)
|
|
)
|
|
:gif0 (new 'static 'gif-tag64
|
|
:nloop #x1
|
|
:eop #x1
|
|
:pre #x1
|
|
:prim (new 'static 'gs-prim :prim (gs-prim-type sprite) :abe #x1)
|
|
:nreg #x3
|
|
)
|
|
:gif1 (new 'static 'gif-tag-regs :regs0 (gif-reg-id rgbaq) :regs1 (gif-reg-id xyz2) :regs2 (gif-reg-id xyz2))
|
|
)
|
|
:line-tmpl (new 'static 'dma-gif-packet
|
|
:dma-vif (new 'static 'dma-packet
|
|
:dma (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt))
|
|
:vif1 (new 'static 'vif-tag :imm #x4 :cmd (vif-cmd direct) :msk #x1)
|
|
)
|
|
:gif0 (new 'static 'gif-tag64
|
|
:nloop #x1
|
|
:eop #x1
|
|
:pre #x1
|
|
:prim (new 'static 'gs-prim :prim (gs-prim-type line) :abe #x1)
|
|
:nreg #x3
|
|
)
|
|
:gif1 (new 'static 'gif-tag-regs :regs0 (gif-reg-id rgbaq) :regs1 (gif-reg-id xyz2) :regs2 (gif-reg-id xyz2))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; profile setting
|
|
(define *profile-x* 1808)
|
|
(define *profile-y* 1848)
|
|
(define *profile-w* 416)
|
|
(define *profile-h* 8)
|
|
(define *profile-ticks* #f)
|
|
|
|
(defmethod start-frame! profile-segment-array ((obj profile-segment-array))
|
|
"Start a frame."
|
|
(set! (-> obj count) 0)
|
|
(set! (-> obj depth) 0)
|
|
(set! (-> obj max-depth) 0)
|
|
(set! (-> obj base-time) (the-as int (timer-count (the-as timer-bank #x10000800))))
|
|
(start-segment! obj 'all *profile-all-color*)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod start-segment! profile-segment-array ((obj profile-segment-array) (arg0 symbol) (arg1 rgba))
|
|
"Push a new segment onto the profiling stack."
|
|
(when (and *dproc* *debug-segment*)
|
|
(let ((s4-0 (-> obj data (-> obj count))))
|
|
(let ((s3-0 (-> obj base-time)))
|
|
(set! (-> s4-0 name) arg0)
|
|
(set! (-> s4-0 start-time) (the-as int (- (timer-count (the-as timer-bank #x10000800)) (the-as uint s3-0))))
|
|
)
|
|
(set! (-> s4-0 depth) (the-as uint (-> obj depth)))
|
|
(set! (-> s4-0 color) arg1)
|
|
(set! (-> obj segment (-> obj depth)) s4-0)
|
|
)
|
|
(+! (-> obj count) 1)
|
|
(+! (-> obj depth) 1)
|
|
(set! (-> obj max-depth) (max (-> obj max-depth) (-> obj depth)))
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod end-segment! profile-segment-array ((obj profile-segment-array))
|
|
"Pop the last pushed segment."
|
|
(when (and *dproc* *debug-segment*)
|
|
(let* ((v1-4 (+ (-> obj depth) -1))
|
|
(s5-0 (-> obj segment v1-4))
|
|
(s4-0 (-> obj base-time))
|
|
)
|
|
(when (>= v1-4 0)
|
|
(set! (-> s5-0 end-time) (the-as int (- (timer-count (the-as timer-bank #x10000800)) (the-as uint s4-0))))
|
|
(+! (-> obj depth) -1)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun profile-texture-test ((arg0 bucket-id))
|
|
"Is this a texture bucket?"
|
|
(or (= arg0 (bucket-id tex-lcom-sky-pre))
|
|
(= arg0 (bucket-id tex-l0-tfrag))
|
|
(= arg0 (bucket-id tex-l1-tfrag))
|
|
(= arg0 (bucket-id tex-l2-tfrag))
|
|
(= arg0 (bucket-id tex-l3-tfrag))
|
|
(= arg0 (bucket-id tex-l4-tfrag))
|
|
(= arg0 (bucket-id tex-l5-tfrag))
|
|
(= arg0 (bucket-id tex-l0-shrub))
|
|
(= arg0 (bucket-id tex-l1-shrub))
|
|
(= arg0 (bucket-id tex-l2-shrub))
|
|
(= arg0 (bucket-id tex-l3-shrub))
|
|
(= arg0 (bucket-id tex-l4-shrub))
|
|
(= arg0 (bucket-id tex-l5-shrub))
|
|
(= arg0 (bucket-id tex-l0-alpha))
|
|
(= arg0 (bucket-id tex-l1-alpha))
|
|
(= arg0 (bucket-id tex-l2-alpha))
|
|
(= arg0 (bucket-id tex-l3-alpha))
|
|
(= arg0 (bucket-id tex-l4-alpha))
|
|
(= arg0 (bucket-id tex-l5-alpha))
|
|
(= arg0 (bucket-id tex-lcom-tfrag))
|
|
(= arg0 (bucket-id tex-l0-pris))
|
|
(= arg0 (bucket-id tex-l1-pris))
|
|
(= arg0 (bucket-id tex-l2-pris))
|
|
(= arg0 (bucket-id tex-l3-pris))
|
|
(= arg0 (bucket-id tex-l4-pris))
|
|
(= arg0 (bucket-id tex-l5-pris))
|
|
(= arg0 (bucket-id tex-lcom-pris))
|
|
(= arg0 (bucket-id tex-l0-water))
|
|
(= arg0 (bucket-id tex-l1-water))
|
|
(= arg0 (bucket-id tex-l2-water))
|
|
(= arg0 (bucket-id tex-l3-water))
|
|
(= arg0 (bucket-id tex-l4-water))
|
|
(= arg0 (bucket-id tex-l5-water))
|
|
(= arg0 (bucket-id tex-lcom-water))
|
|
(= arg0 (bucket-id tex-all-sprite))
|
|
(= arg0 (bucket-id tex-all-warp))
|
|
(= arg0 (bucket-id tex-all-map))
|
|
)
|
|
)
|
|
|
|
(defun profile-tfrag-test ((arg0 bucket-id))
|
|
"Is this a tfrag bucket?"
|
|
(or (= arg0 (bucket-id tfrag-l0-tfrag))
|
|
(= arg0 (bucket-id tfrag-l1-tfrag))
|
|
(= arg0 (bucket-id tfrag-l2-tfrag))
|
|
(= arg0 (bucket-id tfrag-l3-tfrag))
|
|
(= arg0 (bucket-id tfrag-l4-tfrag))
|
|
(= arg0 (bucket-id tfrag-l5-tfrag))
|
|
(= arg0 (bucket-id tfrag-s-l0-tfrag))
|
|
(= arg0 (bucket-id tfrag-s-l1-tfrag))
|
|
(= arg0 (bucket-id tfrag-s-l2-tfrag))
|
|
(= arg0 (bucket-id tfrag-s-l3-tfrag))
|
|
(= arg0 (bucket-id tfrag-s-l4-tfrag))
|
|
(= arg0 (bucket-id tfrag-s-l5-tfrag))
|
|
(= arg0 (bucket-id tfrag-t-l0-alpha))
|
|
(= arg0 (bucket-id tfrag-t-l1-alpha))
|
|
(= arg0 (bucket-id tfrag-t-l2-alpha))
|
|
(= arg0 (bucket-id tfrag-t-l3-alpha))
|
|
(= arg0 (bucket-id tfrag-t-l4-alpha))
|
|
(= arg0 (bucket-id tfrag-t-l5-alpha))
|
|
(= arg0 (bucket-id tfrag-w-l0-water))
|
|
(= arg0 (bucket-id tfrag-w-l1-water))
|
|
(= arg0 (bucket-id tfrag-w-l2-water))
|
|
(= arg0 (bucket-id tfrag-w-l3-water))
|
|
(= arg0 (bucket-id tfrag-w-l4-water))
|
|
(= arg0 (bucket-id tfrag-w-l5-water))
|
|
(= arg0 (bucket-id tfrag-st-l0-alpha))
|
|
(= arg0 (bucket-id tfrag-st-l1-alpha))
|
|
(= arg0 (bucket-id tfrag-st-l2-alpha))
|
|
(= arg0 (bucket-id tfrag-st-l3-alpha))
|
|
(= arg0 (bucket-id tfrag-st-l4-alpha))
|
|
(= arg0 (bucket-id tfrag-st-l5-alpha))
|
|
(= arg0 (bucket-id tfrag-ws-l0-water))
|
|
(= arg0 (bucket-id tfrag-ws-l1-water))
|
|
(= arg0 (bucket-id tfrag-ws-l2-water))
|
|
(= arg0 (bucket-id tfrag-ws-l3-water))
|
|
(= arg0 (bucket-id tfrag-ws-l4-water))
|
|
(= arg0 (bucket-id tfrag-ws-l5-water))
|
|
)
|
|
)
|
|
|
|
(defun profile-tie-test ((arg0 bucket-id))
|
|
(or (= arg0 (bucket-id tie-l0-tfrag))
|
|
(= arg0 (bucket-id tie-l1-tfrag))
|
|
(= arg0 (bucket-id tie-l2-tfrag))
|
|
(= arg0 (bucket-id tie-l3-tfrag))
|
|
(= arg0 (bucket-id tie-l4-tfrag))
|
|
(= arg0 (bucket-id tie-l5-tfrag))
|
|
(= arg0 (bucket-id etie-l0-tfrag))
|
|
(= arg0 (bucket-id etie-l1-tfrag))
|
|
(= arg0 (bucket-id etie-l2-tfrag))
|
|
(= arg0 (bucket-id etie-l3-tfrag))
|
|
(= arg0 (bucket-id etie-l4-tfrag))
|
|
(= arg0 (bucket-id etie-l5-tfrag))
|
|
(= arg0 (bucket-id tie-s-l0-tfrag))
|
|
(= arg0 (bucket-id tie-s-l1-tfrag))
|
|
(= arg0 (bucket-id tie-s-l2-tfrag))
|
|
(= arg0 (bucket-id tie-s-l3-tfrag))
|
|
(= arg0 (bucket-id tie-s-l4-tfrag))
|
|
(= arg0 (bucket-id tie-s-l5-tfrag))
|
|
(= arg0 (bucket-id etie-s-l0-tfrag))
|
|
(= arg0 (bucket-id etie-s-l1-tfrag))
|
|
(= arg0 (bucket-id etie-s-l2-tfrag))
|
|
(= arg0 (bucket-id etie-s-l3-tfrag))
|
|
(= arg0 (bucket-id etie-s-l4-tfrag))
|
|
(= arg0 (bucket-id etie-s-l5-tfrag))
|
|
(= arg0 (bucket-id tie-v-l0-tfrag))
|
|
(= arg0 (bucket-id tie-v-l1-tfrag))
|
|
(= arg0 (bucket-id tie-v-l2-tfrag))
|
|
(= arg0 (bucket-id tie-v-l3-tfrag))
|
|
(= arg0 (bucket-id tie-v-l4-tfrag))
|
|
(= arg0 (bucket-id tie-v-l5-tfrag))
|
|
(= arg0 (bucket-id tie-t-l0-alpha))
|
|
(= arg0 (bucket-id tie-t-l1-alpha))
|
|
(= arg0 (bucket-id tie-t-l2-alpha))
|
|
(= arg0 (bucket-id tie-t-l3-alpha))
|
|
(= arg0 (bucket-id tie-t-l4-alpha))
|
|
(= arg0 (bucket-id tie-t-l5-alpha))
|
|
(= arg0 (bucket-id etie-t-l0-alpha))
|
|
(= arg0 (bucket-id etie-t-l1-alpha))
|
|
(= arg0 (bucket-id etie-t-l2-alpha))
|
|
(= arg0 (bucket-id etie-t-l3-alpha))
|
|
(= arg0 (bucket-id etie-t-l4-alpha))
|
|
(= arg0 (bucket-id etie-t-l5-alpha))
|
|
(= arg0 (bucket-id tie-st-l0-alpha))
|
|
(= arg0 (bucket-id tie-st-l1-alpha))
|
|
(= arg0 (bucket-id tie-st-l2-alpha))
|
|
(= arg0 (bucket-id tie-st-l3-alpha))
|
|
(= arg0 (bucket-id tie-st-l4-alpha))
|
|
(= arg0 (bucket-id tie-st-l5-alpha))
|
|
(= arg0 (bucket-id etie-st-l0-alpha))
|
|
(= arg0 (bucket-id etie-st-l1-alpha))
|
|
(= arg0 (bucket-id etie-st-l2-alpha))
|
|
(= arg0 (bucket-id etie-st-l3-alpha))
|
|
(= arg0 (bucket-id etie-st-l4-alpha))
|
|
(= arg0 (bucket-id etie-st-l5-alpha))
|
|
)
|
|
)
|
|
|
|
(defun profile-merc-test ((arg0 bucket-id))
|
|
"Is this a merc bucket?"
|
|
(or (= arg0 (bucket-id merc-l0-tfrag))
|
|
(= arg0 (bucket-id merc-l1-tfrag))
|
|
(= arg0 (bucket-id merc-l2-tfrag))
|
|
(= arg0 (bucket-id merc-l3-tfrag))
|
|
(= arg0 (bucket-id merc-l4-tfrag))
|
|
(= arg0 (bucket-id merc-l5-tfrag))
|
|
(= arg0 (bucket-id merc-l0-shrub))
|
|
(= arg0 (bucket-id merc-l1-shrub))
|
|
(= arg0 (bucket-id merc-l2-shrub))
|
|
(= arg0 (bucket-id merc-l3-shrub))
|
|
(= arg0 (bucket-id merc-l4-shrub))
|
|
(= arg0 (bucket-id merc-l5-shrub))
|
|
(= arg0 (bucket-id merc-l0-alpha))
|
|
(= arg0 (bucket-id merc-l1-alpha))
|
|
(= arg0 (bucket-id merc-l2-alpha))
|
|
(= arg0 (bucket-id merc-l3-alpha))
|
|
(= arg0 (bucket-id merc-l4-alpha))
|
|
(= arg0 (bucket-id merc-l5-alpha))
|
|
(= arg0 (bucket-id merc-lcom-tfrag))
|
|
(= arg0 (bucket-id merc-lcom-shrub))
|
|
(= arg0 (bucket-id merc-l0-pris))
|
|
(= arg0 (bucket-id merc-l1-pris))
|
|
(= arg0 (bucket-id merc-l2-pris))
|
|
(= arg0 (bucket-id merc-l3-pris))
|
|
(= arg0 (bucket-id merc-l4-pris))
|
|
(= arg0 (bucket-id merc-l5-pris))
|
|
(= arg0 (bucket-id merc-lcom-pris))
|
|
(= arg0 (bucket-id merc-l0-pris2))
|
|
(= arg0 (bucket-id merc-l1-pris2))
|
|
(= arg0 (bucket-id merc-l2-pris2))
|
|
(= arg0 (bucket-id merc-l3-pris2))
|
|
(= arg0 (bucket-id merc-l4-pris2))
|
|
(= arg0 (bucket-id merc-l5-pris2))
|
|
(= arg0 (bucket-id merc-lcom-pris2))
|
|
(= arg0 (bucket-id merc-l0-water))
|
|
(= arg0 (bucket-id merc-l1-water))
|
|
(= arg0 (bucket-id merc-l2-water))
|
|
(= arg0 (bucket-id merc-l3-water))
|
|
(= arg0 (bucket-id merc-l4-water))
|
|
(= arg0 (bucket-id merc-l5-water))
|
|
(= arg0 (bucket-id merc-lcom-water))
|
|
)
|
|
)
|
|
|
|
(defun profile-emerc-test ((arg0 bucket-id))
|
|
"Is this an emerc bucket?"
|
|
(or (= arg0 (bucket-id emerc-l0-tfrag))
|
|
(= arg0 (bucket-id emerc-l1-tfrag))
|
|
(= arg0 (bucket-id emerc-l2-tfrag))
|
|
(= arg0 (bucket-id emerc-l3-tfrag))
|
|
(= arg0 (bucket-id emerc-l4-tfrag))
|
|
(= arg0 (bucket-id emerc-l5-tfrag))
|
|
(= arg0 (bucket-id emerc-l0-shrub))
|
|
(= arg0 (bucket-id emerc-l1-shrub))
|
|
(= arg0 (bucket-id emerc-l2-shrub))
|
|
(= arg0 (bucket-id emerc-l3-shrub))
|
|
(= arg0 (bucket-id emerc-l4-shrub))
|
|
(= arg0 (bucket-id emerc-l5-shrub))
|
|
(= arg0 (bucket-id emerc-l0-alpha))
|
|
(= arg0 (bucket-id emerc-l1-alpha))
|
|
(= arg0 (bucket-id emerc-l2-alpha))
|
|
(= arg0 (bucket-id emerc-l3-alpha))
|
|
(= arg0 (bucket-id emerc-l4-alpha))
|
|
(= arg0 (bucket-id emerc-l5-alpha))
|
|
(= arg0 (bucket-id emerc-lcom-tfrag))
|
|
(= arg0 (bucket-id emerc-lcom-shrub))
|
|
(= arg0 (bucket-id emerc-l0-pris))
|
|
(= arg0 (bucket-id emerc-l1-pris))
|
|
(= arg0 (bucket-id emerc-l2-pris))
|
|
(= arg0 (bucket-id emerc-l3-pris))
|
|
(= arg0 (bucket-id emerc-l4-pris))
|
|
(= arg0 (bucket-id emerc-l5-pris))
|
|
(= arg0 (bucket-id emerc-lcom-pris))
|
|
(= arg0 (bucket-id emerc-l0-pris2))
|
|
(= arg0 (bucket-id emerc-l1-pris2))
|
|
(= arg0 (bucket-id emerc-l2-pris2))
|
|
(= arg0 (bucket-id emerc-l3-pris2))
|
|
(= arg0 (bucket-id emerc-l4-pris2))
|
|
(= arg0 (bucket-id emerc-l5-pris2))
|
|
(= arg0 (bucket-id emerc-lcom-pris2))
|
|
)
|
|
)
|
|
|
|
(defun profile-mercneric-test ((arg0 bucket-id))
|
|
"Is this a mercneric bucket?"
|
|
(or (= arg0 (bucket-id gmerc-l0-tfrag))
|
|
(= arg0 (bucket-id gmerc-l1-tfrag))
|
|
(= arg0 (bucket-id gmerc-l2-tfrag))
|
|
(= arg0 (bucket-id gmerc-l3-tfrag))
|
|
(= arg0 (bucket-id gmerc-l4-tfrag))
|
|
(= arg0 (bucket-id gmerc-l5-tfrag))
|
|
(= arg0 (bucket-id gmerc-l0-shrub))
|
|
(= arg0 (bucket-id gmerc-l1-shrub))
|
|
(= arg0 (bucket-id gmerc-l2-shrub))
|
|
(= arg0 (bucket-id gmerc-l3-shrub))
|
|
(= arg0 (bucket-id gmerc-l4-shrub))
|
|
(= arg0 (bucket-id gmerc-l5-shrub))
|
|
(= arg0 (bucket-id gmerc-l0-alpha))
|
|
(= arg0 (bucket-id gmerc-l1-alpha))
|
|
(= arg0 (bucket-id gmerc-l2-alpha))
|
|
(= arg0 (bucket-id gmerc-l3-alpha))
|
|
(= arg0 (bucket-id gmerc-l4-alpha))
|
|
(= arg0 (bucket-id gmerc-l5-alpha))
|
|
(= arg0 (bucket-id gmerc-lcom-tfrag))
|
|
(= arg0 (bucket-id gmerc-lcom-shrub))
|
|
(= arg0 (bucket-id gmerc-l0-pris))
|
|
(= arg0 (bucket-id gmerc-l1-pris))
|
|
(= arg0 (bucket-id gmerc-l2-pris))
|
|
(= arg0 (bucket-id gmerc-l3-pris))
|
|
(= arg0 (bucket-id gmerc-l4-pris))
|
|
(= arg0 (bucket-id gmerc-l5-pris))
|
|
(= arg0 (bucket-id gmerc-lcom-pris))
|
|
(= arg0 (bucket-id gmerc-l0-pris2))
|
|
(= arg0 (bucket-id gmerc-l1-pris2))
|
|
(= arg0 (bucket-id gmerc-l2-pris2))
|
|
(= arg0 (bucket-id gmerc-l3-pris2))
|
|
(= arg0 (bucket-id gmerc-l4-pris2))
|
|
(= arg0 (bucket-id gmerc-l5-pris2))
|
|
(= arg0 (bucket-id gmerc-lcom-pris2))
|
|
(= arg0 (bucket-id gmerc-l0-water))
|
|
(= arg0 (bucket-id gmerc-l1-water))
|
|
(= arg0 (bucket-id gmerc-l2-water))
|
|
(= arg0 (bucket-id gmerc-l3-water))
|
|
(= arg0 (bucket-id gmerc-l4-water))
|
|
(= arg0 (bucket-id gmerc-l5-water))
|
|
(= arg0 (bucket-id gmerc-lcom-water))
|
|
(= arg0 (bucket-id gmerc-warp))
|
|
)
|
|
)
|
|
|
|
(defmethod setup-categories! profile-array ((obj profile-array))
|
|
"Summarize data collected."
|
|
|
|
;; loop over both EE and VU profilers
|
|
(dotimes (s5-0 2)
|
|
;; each of the two display-frames has its own profile-array
|
|
;; assume this is called on a display-frame's profile-array and copy us to the
|
|
;; global one.
|
|
(let ((s3-0 (-> *profile-array* data s5-0))
|
|
(s4-0 *profile-collapse*)
|
|
)
|
|
(mem-copy! (&-> s3-0 type) (&-> (-> obj data s5-0) type) 8240)
|
|
|
|
(cond
|
|
((zero? s5-0)
|
|
;; we're the EE profiler.
|
|
((lambda ((arg0 profile-segment-array) (arg1 profile-collapse))
|
|
(let ((v0-0 0))
|
|
;; loop over categories in summary and set to defaults
|
|
(dotimes (v1-0 48)
|
|
(set! (-> arg1 data v1-0 name) #f)
|
|
(set! (-> arg1 data v1-0 count) (the-as uint 0))
|
|
(set! (-> arg1 data v1-0 vu-count) (the-as uint 0))
|
|
(set! (-> arg1 data v1-0 depth) (the-as uint 0))
|
|
(set! (-> arg1 data v1-0 start-time) 0)
|
|
(set! (-> arg1 data v1-0 end-time) 0)
|
|
)
|
|
;; loop over events we got
|
|
(dotimes (v1-3 (-> arg0 count))
|
|
(let ((a2-15 (- (-> arg0 data v1-3 end-time) (-> arg0 data v1-3 start-time))))
|
|
(let ((t0-0 (-> arg0 data v1-3 name)))
|
|
;; search for category that matches
|
|
(dotimes (a3-5 v0-0)
|
|
(when (= (-> arg1 data a3-5 name) t0-0) ;; got it!
|
|
(+! (-> arg1 data a3-5 count) 1)
|
|
(set! (-> arg1 data a3-5 start-time) (the-as int (+ (-> arg1 data a3-5 code-time) a2-15)))
|
|
(goto cfg-11)
|
|
)
|
|
)
|
|
(set! (-> arg1 data v0-0 name) t0-0)
|
|
)
|
|
(set! (-> arg1 data v0-0 count) (the-as uint 1))
|
|
(set! (-> arg1 data v0-0 depth) (-> arg0 data v1-3 depth))
|
|
(set! (-> arg1 data v0-0 start-time) a2-15)
|
|
)
|
|
(set! (-> arg1 data v0-0 color) (-> arg0 data v1-3 color))
|
|
(set! v0-0 (min 47 (+ v0-0 1)))
|
|
(label cfg-11)
|
|
)
|
|
(set! (-> arg1 count) v0-0)
|
|
)
|
|
(none)
|
|
)
|
|
s3-0
|
|
s4-0
|
|
)
|
|
)
|
|
(else
|
|
;; VU
|
|
(let ((s2-0 3)
|
|
(s1-0 (+ (-> s3-0 count) -1))
|
|
)
|
|
(while (>= s1-0 s2-0)
|
|
(let ((s0-0 (-> s3-0 data s2-0)))
|
|
(cond
|
|
((= s2-0 3)
|
|
(set! (-> s0-0 name) 'blit-displays)
|
|
(set! (-> s0-0 color) *profile-blit-color*)
|
|
)
|
|
((= s2-0 5)
|
|
(set! (-> s0-0 name) 'sky)
|
|
(set! (-> s0-0 color) *profile-sky-color*)
|
|
)
|
|
((or (= s2-0 6) (= s2-0 310))
|
|
(set! (-> s0-0 name) 'ocean)
|
|
(set! (-> s0-0 color) *profile-ocean-color*)
|
|
)
|
|
((profile-texture-test (the-as bucket-id s2-0))
|
|
(set! (-> s0-0 name) 'texture)
|
|
(set! (-> s0-0 color) *profile-texture-color*)
|
|
)
|
|
((profile-tfrag-test (the-as bucket-id s2-0))
|
|
(set! (-> s0-0 name) 'tfrag)
|
|
(set! (-> s0-0 color) *profile-tfrag-color*)
|
|
)
|
|
((profile-tie-test (the-as bucket-id s2-0))
|
|
(set! (-> s0-0 name) 'instance-tie)
|
|
(set! (-> s0-0 color) *profile-instance-tie-color*)
|
|
)
|
|
((profile-merc-test (the-as bucket-id s2-0))
|
|
(set! (-> s0-0 name) 'merc)
|
|
(set! (-> s0-0 color) *profile-merc-color*)
|
|
)
|
|
((profile-emerc-test (the-as bucket-id s2-0))
|
|
(set! (-> s0-0 name) 'emerc)
|
|
(set! (-> s0-0 color) *profile-emerc-color*)
|
|
)
|
|
((profile-mercneric-test (the-as bucket-id s2-0))
|
|
(set! (-> s0-0 name) 'generic-merc)
|
|
(set! (-> s0-0 color) *profile-generic-merc-color*)
|
|
)
|
|
((or (and (>= s2-0 74) (>= 78 s2-0))
|
|
(and (>= s2-0 83) (>= 87 s2-0))
|
|
(and (>= s2-0 92) (>= 96 s2-0))
|
|
(and (>= s2-0 101) (>= 105 s2-0))
|
|
(and (>= s2-0 110) (>= 114 s2-0))
|
|
(and (>= s2-0 119) (>= 123 s2-0))
|
|
)
|
|
(set! (-> s0-0 name) 'instance-shrubbery)
|
|
(set! (-> s0-0 color) *profile-instance-shrubbery-color*)
|
|
)
|
|
((or (= s2-0 195) (= s2-0 314))
|
|
(set! (-> s0-0 name) 'shadow)
|
|
(set! (-> s0-0 color) *profile-shadow-color*)
|
|
)
|
|
((= s2-0 313)
|
|
(set! (-> s0-0 name) 'particles)
|
|
(set! (-> s0-0 color) *profile-particles-color*)
|
|
)
|
|
((or (= s2-0 324) (= s2-0 325) (= s2-0 318) (= s2-0 326))
|
|
(set! (-> s0-0 name) 'debug)
|
|
(set! (-> s0-0 color) *profile-debug-color*)
|
|
)
|
|
((= s2-0 311)
|
|
(set! (-> s0-0 name) 'depth-cue)
|
|
(set! (-> s0-0 color) *profile-blit-color*)
|
|
)
|
|
((= s2-0 315)
|
|
(set! (-> s0-0 name) 'effects)
|
|
(set! (-> s0-0 color) *profile-effects-color*)
|
|
)
|
|
((or (= s2-0 320) (= s2-0 321) (= s2-0 322) (= s2-0 323))
|
|
(set! (-> s0-0 name) 'hud)
|
|
(set! (-> s0-0 color) *profile-hud-color*)
|
|
)
|
|
)
|
|
(let ((v1-87 (- (-> s0-0 end-time) (-> s0-0 start-time)))
|
|
(a1-2 (-> s0-0 name))
|
|
)
|
|
;; (format 0 "vu ~D elapsed ~D (~D ~D) ~%" s2-0 v1-87 (-> s0-0 end-time) (-> s0-0 start-time))
|
|
(dotimes (a0-29 (-> s4-0 count))
|
|
(when (= (-> s4-0 data a0-29 name) a1-2)
|
|
(+! (-> s4-0 data a0-29 vu-count) 1)
|
|
(set! (-> s4-0 data a0-29 end-time) (the-as int (+ (-> s4-0 data a0-29 vu-time) v1-87)))
|
|
(goto cfg-91)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(label cfg-91)
|
|
(+! s2-0 1)
|
|
)
|
|
)
|
|
(countdown (v1-94 (-> s3-0 count))
|
|
(when (nonzero? (-> s3-0 data v1-94 end-time))
|
|
(set! (-> s4-0 data 0 vu-count) (the-as uint 1))
|
|
(set! (-> s4-0 data 0 end-time) (- (-> s3-0 data v1-94 end-time) (-> s3-0 data 0 start-time)))
|
|
(goto cfg-99)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(label cfg-99)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod draw-bars! profile-array ((obj profile-array) (arg0 dma-buffer) (arg1 int))
|
|
"Draw the two bars at the top."
|
|
(local-vars (sv-16 (function _varargs_ object)) (sv-32 (function _varargs_ object)))
|
|
(dma-buffer-add-gs-set arg0
|
|
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1))
|
|
(zbuf-1 (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
|
|
(test-1 (new 'static 'gs-test :zte #x1 :ztst (gs-ztest always)))
|
|
(pabe 0)
|
|
(clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
|
|
(tex1-1 (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
|
|
(texa (new 'static 'gs-texa :ta1 #x80))
|
|
(texclut (new 'static 'gs-texclut :cbw #x4))
|
|
(fogcol *fog-color*)
|
|
)
|
|
(let ((v1-5 (* (+ *profile-x* (/ *profile-w* 2)) 16))
|
|
(a0-9 (-> arg0 base))
|
|
)
|
|
(set! (-> (the-as (pointer uint128) a0-9) 0) (-> *profile-work* line-tmpl dma-vif quad))
|
|
(set! (-> (the-as (pointer uint128) a0-9) 1) (-> *profile-work* line-tmpl quad 1))
|
|
(set-vector! (the-as vector4w (&+ a0-9 32)) 64 64 64 64)
|
|
(set-vector! (the-as vector4w (&+ a0-9 48)) v1-5 #x7340 #xffffff 0)
|
|
(set-vector! (the-as vector4w (&+ a0-9 64)) v1-5 #x7580 #xffffff 0)
|
|
)
|
|
(&+! (-> arg0 base) 80)
|
|
(dotimes (s3-0 2)
|
|
(let* ((v1-12 (-> obj data s3-0))
|
|
(a0-11 (-> v1-12 max-depth))
|
|
(s2-1 (max 14 (* a0-11 2)))
|
|
)
|
|
(set! *profile-y* (+ arg1 1840))
|
|
(let ((a1-32 (-> arg0 base)))
|
|
(set! (-> (the-as (pointer uint128) a1-32) 0) (-> *profile-work* sprite-tmpl dma-vif quad))
|
|
(set! (-> (the-as (pointer uint128) a1-32) 1) (-> *profile-work* sprite-tmpl quad 1))
|
|
(set-vector! (the-as vector4w (&+ a1-32 32)) 64 64 64 64)
|
|
(set-vector! (the-as vector4w (&+ a1-32 48)) (* *profile-x* 16) (* *profile-y* 16) #xffffff 0)
|
|
(set-vector!
|
|
(the-as vector4w (&+ a1-32 64))
|
|
(* (+ *profile-x* *profile-w*) 16)
|
|
(* (+ *profile-y* s2-1) 16)
|
|
#xffffff
|
|
0
|
|
)
|
|
)
|
|
(&+! (-> arg0 base) 80)
|
|
(let ((a0-12 (/ s2-1 a0-11)))
|
|
(dotimes (a1-36 (+ (-> v1-12 count) -1))
|
|
(let ((a2-22 (-> v1-12 data a1-36)))
|
|
(when (< (-> a2-22 start-time) (-> a2-22 end-time))
|
|
(let* ((t0-1 (* *ticks-per-frame* 2))
|
|
(a3-15 (* (+ *profile-x* (/ (* (-> a2-22 start-time) *profile-w*) t0-1)) 16))
|
|
(t0-4 (* (+ *profile-x* (/ (* (-> a2-22 end-time) *profile-w*) t0-1)) 16))
|
|
(t3-1 (* (+ arg1 1840 (* (-> a2-22 depth) (the-as uint a0-12))) 16))
|
|
(t1-7 (+ t3-1 (* a0-12 16)))
|
|
(t2-5 (-> arg0 base))
|
|
)
|
|
(set! (-> (the-as (pointer int128) t2-5) 0) (the-as int128 (-> *profile-work* sprite-tmpl dma-vif quad)))
|
|
(set! (-> (the-as (pointer int128) t2-5) 1) (the-as int128 (-> *profile-work* sprite-tmpl quad 1)))
|
|
(set-vector!
|
|
(the-as vector4w (&+ t2-5 32))
|
|
(the int (* 1.9921875 (the float (-> a2-22 color r))))
|
|
(the int (* 1.9921875 (the float (-> a2-22 color g))))
|
|
(the int (* 1.9921875 (the float (-> a2-22 color b))))
|
|
(the-as int (-> a2-22 color a))
|
|
)
|
|
(set-vector! (the-as vector4w (&+ t2-5 48)) a3-15 t3-1 #xffffff 0)
|
|
(set-vector! (the-as vector4w (&+ t2-5 64)) t0-4 t1-7 #xffffff 0)
|
|
)
|
|
(&+! (-> arg0 base) 80)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(cond
|
|
((zero? s3-0)
|
|
(let* ((s1-0 (-> v1-12 data 0 end-time))
|
|
(f30-0 (* 100.0 (/ (the float s1-0) (the float *ticks-per-frame*))))
|
|
)
|
|
(cond
|
|
(*profile-ticks*
|
|
(let ((s0-0 draw-string-xy))
|
|
(set! sv-16 format)
|
|
(let ((a0-16 (clear *temp-string*))
|
|
(a1-37 "~5D")
|
|
)
|
|
(sv-16 a0-16 a1-37 s1-0)
|
|
)
|
|
(s0-0
|
|
*temp-string*
|
|
arg0
|
|
488
|
|
arg1
|
|
(if (>= f30-0 100.0)
|
|
(font-color red)
|
|
(font-color default)
|
|
)
|
|
(font-flags shadow right)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(let ((s1-1 draw-string-xy))
|
|
(format (clear *temp-string*) "~5,,2f" f30-0)
|
|
(s1-1
|
|
*temp-string*
|
|
arg0
|
|
488
|
|
arg1
|
|
(if (>= f30-0 100.0)
|
|
(font-color red)
|
|
(font-color default)
|
|
)
|
|
(font-flags shadow right)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(let ((s1-2 0))
|
|
(countdown (a0-21 (-> v1-12 count))
|
|
(when (nonzero? (-> v1-12 data a0-21 end-time))
|
|
(set! s1-2 (- (-> v1-12 data a0-21 end-time) (-> v1-12 data 0 start-time)))
|
|
(goto cfg-23)
|
|
)
|
|
)
|
|
(label cfg-23)
|
|
(let ((f30-1 (* 100.0 (/ (the float s1-2) (the float *ticks-per-frame*)))))
|
|
(cond
|
|
(*profile-ticks*
|
|
(let ((s0-2 draw-string-xy))
|
|
(set! sv-32 format)
|
|
(let ((a0-26 (clear *temp-string*))
|
|
(a1-45 "~5D")
|
|
)
|
|
(sv-32 a0-26 a1-45 s1-2)
|
|
)
|
|
(s0-2
|
|
*temp-string*
|
|
arg0
|
|
488
|
|
arg1
|
|
(if (>= f30-1 100.0)
|
|
(font-color red)
|
|
(font-color default)
|
|
)
|
|
(font-flags shadow right)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(let ((s1-3 draw-string-xy))
|
|
(format (clear *temp-string*) "~5,,2f" f30-1)
|
|
(s1-3
|
|
*temp-string*
|
|
arg0
|
|
488
|
|
arg1
|
|
(if (>= f30-1 100.0)
|
|
(font-color red)
|
|
(font-color default)
|
|
)
|
|
(font-flags shadow right)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! arg1 (+ s2-1 2 arg1))
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
|
|
|
|
(defmethod draw-text! profile-array ((obj profile-array))
|
|
"Draw the table of times."
|
|
(let ((gp-0 *profile-collapse*))
|
|
(dotimes (s5-0 (-> gp-0 count))
|
|
(when (or (nonzero? (-> gp-0 data s5-0 count)) (nonzero? (-> gp-0 data s5-0 vu-count)))
|
|
(dotimes (s4-0 (the-as int (-> gp-0 data s5-0 depth)))
|
|
(format *stdcon* " ")
|
|
)
|
|
(format *stdcon* "~o~s~0k" (-> gp-0 data s5-0 color) (symbol->string (-> gp-0 data s5-0 name)))
|
|
(if (nonzero? (-> gp-0 data s5-0 count))
|
|
(format
|
|
*stdcon*
|
|
"~170h~5d~220h~5d~280h~5,,2f"
|
|
(-> gp-0 data s5-0 count)
|
|
(-> gp-0 data s5-0 code-time)
|
|
(* 100.0 (/ (the float (-> gp-0 data s5-0 code-time)) (the float *ticks-per-frame*)))
|
|
)
|
|
)
|
|
(if (nonzero? (-> gp-0 data s5-0 vu-count))
|
|
(format
|
|
*stdcon*
|
|
"~338h~5d~388h~5d~448h~5,,2f"
|
|
(-> gp-0 data s5-0 vu-count)
|
|
(-> gp-0 data s5-0 vu-time)
|
|
(* 100.0 (/ (the float (-> gp-0 data s5-0 vu-time)) (the float *ticks-per-frame*)))
|
|
)
|
|
)
|
|
(format *stdcon* "~1k~%")
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
|
|
|
|
|
|
;; DECOMP ENDS
|
|
|
|
(defmacro end-profiler ()
|
|
`(when *debug-segment*
|
|
(let ((prof (-> *display* frames (-> *display* on-screen) profile-array data 0)))
|
|
(when (and *dproc* *debug-segment*)
|
|
(let* ((after-depth (+ (-> prof depth) -1))
|
|
(segment (-> prof segment after-depth))
|
|
(base-time (-> prof base-time))
|
|
)
|
|
(when (>= after-depth 0)
|
|
(set! (-> segment end-time) (the-as int (- (timer-count TIMER1_BANK) base-time)))
|
|
(+! (-> prof depth) -1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro with-profiler (category profile-color &rest body)
|
|
`(begin
|
|
(when *debug-segment*
|
|
(let ((prof (-> *display* frames (-> *display* on-screen) profile-array data 0))
|
|
(name ,category)
|
|
(color ,profile-color)
|
|
)
|
|
(when (and *dproc* *debug-segment*)
|
|
(let ((segment (-> prof data (-> prof count))))
|
|
(let ((base-time (-> prof base-time)))
|
|
(set! (-> segment name) name)
|
|
(set! (-> segment start-time) (the-as int (- (timer-count TIMER1_BANK) base-time)))
|
|
)
|
|
(set! (-> segment depth) (-> prof depth))
|
|
(set! (-> segment color) color)
|
|
(set! (-> prof segment (-> prof depth)) segment)
|
|
)
|
|
(+! (-> prof count) 1)
|
|
(+! (-> prof depth) 1)
|
|
(set! (-> prof max-depth) (max (-> prof max-depth) (-> prof depth)))
|
|
)
|
|
)
|
|
)
|
|
,@body
|
|
(end-profiler)
|
|
)
|
|
)
|