Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 21:27:52 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity
jak-project/goal_src/jak2/engine/util/profile.gc
ManDude cd68cb671e
deftype and defmethod syntax major changes (#3094) 
Major change to how `deftype` shows up in our code:
- the decompiler will no longer emit the `offset-assert`,
`method-count-assert`, `size-assert` and `flag-assert` parameters. There
are extremely few cases where having this in the decompiled code is
helpful, as the types there come from `all-types` which already has
those parameters. This also doesn't break type consistency because:
  - the asserts aren't compared.
- the first step of the test uses `all-types`, which has the asserts,
which will throw an error if they're bad.
- the decompiler won't emit the `heap-base` parameter unless necessary
now.
- the decompiler will try its hardest to turn a fixed-offset field into
an `overlay-at` field. It falls back to the old offset if all else
fails.
- `overlay-at` now supports field "dereferencing" to specify the offset
that's within a field that's a structure, e.g.:
```lisp
(deftype foobar (structure)
  ((vec    vector  :inline)
   (flags  int32   :overlay-at (-> vec w))
   )
  )
```
in this structure, the offset of `flags` will be 12 because that is the
final offset of `vec`'s `w` field within this structure.
- **removed ID from all method declarations.** IDs are only ever
automatically assigned now. Fixes #3068.
- added an `:overlay` parameter to method declarations, in order to
declare a new method that goes on top of a previously-defined method.
Syntax is `:overlay <method-name>`. Please do not ever use this.
- added `state-methods` list parameter. This lets you quickly specify a
list of states to be put in the method table. Same syntax as the
`states` list parameter. The decompiler will try to put as many states
in this as it can without messing with the method ID order.

Also changes `defmethod` to make the first type definition (before the
arguments) optional. The type can now be inferred from the first
argument. Fixes #3093.

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2023-10-30 03:20:02 +00:00

817 lines
30 KiB
Common Lisp
Raw Blame History

;;-*-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)
(line-tmpl dma-gif-packet :inline)
(last-index int32)
)
)
;; 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! ((this profile-segment-array))
"Start a frame."
(set! (-> this count) 0)
(set! (-> this depth) 0)
(set! (-> this max-depth) 0)
(set! (-> this base-time) (the-as int (timer-count (the-as timer-bank #x10000800))))
(start-segment! this 'all *profile-all-color*)
0
(none)
)
(defmethod start-segment! ((this profile-segment-array) (arg0 symbol) (arg1 rgba))
"Push a new segment onto the profiling stack."
(when (and *dproc* *debug-segment*)
(let ((s4-0 (-> this data (-> this count))))
(let ((s3-0 (-> this 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 (-> this depth)))
(set! (-> s4-0 color) arg1)
(set! (-> this segment (-> this depth)) s4-0)
)
(+! (-> this count) 1)
(+! (-> this depth) 1)
(set! (-> this max-depth) (max (-> this max-depth) (-> this depth)))
)
0
(none)
)
(defmethod end-segment! ((this profile-segment-array))
"Pop the last pushed segment."
(when (and *dproc* *debug-segment*)
(let* ((v1-4 (+ (-> this depth) -1))
(s5-0 (-> this segment v1-4))
(s4-0 (-> this 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))))
(+! (-> this 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! ((this 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) (&-> (-> this 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! ((this 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 (-> this 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! ((this 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)
)
)
Reference in a new issue View git blame Copy permalink