mirror of
https://github.com/open-goal/jak-project
synced 2026-08-15 12:59:39 -04:00
water111
f3c63f26bb
Fixes https://github.com/open-goal/jak-project/issues/1821 by adding a special case for `new` method calls where the argument with type `symbol` is actually an address to uninitialized structure on the stack. Fixes https://github.com/open-goal/jak-project/issues/1849 (or at least the cause of the issue Vaser gave in chat, and one random one I found in `debug-sphere`) Fixes https://github.com/open-goal/jak-project/issues/1853 Fixes https://github.com/open-goal/jak-project/issues/1857 by moving the cast into the cond if the body is a single form and the destination type is a bitfield/enum which is likely to work well. Seems to work on the examples we could find in jak 1 and jak 2. Also fixes an issue with casts on the result of `handle->process` (a common place to use casts) the output of process->handle is a plain process. Most of the time, you end up casting this to a more specific. If you add a cast on every use of the variable, the decompiler will decide to change the type of that variable to the more specific type, and this breaks the handle cast. so previously it was impossible to get code like ``` (let* ((s2-0 (the-as swingpole (handle->process (-> self control hack)))) (gp-0 (-> s2-0 dir)) ) ``` But now it will work
862 lines
32 KiB
Common Lisp
862 lines
32 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 bucket-4))
|
|
(= arg0 (bucket-id bucket-7))
|
|
(= arg0 (bucket-id bucket-18))
|
|
(= arg0 (bucket-id bucket-29))
|
|
(= arg0 (bucket-id bucket-40))
|
|
(= arg0 (bucket-id bucket-51))
|
|
(= arg0 (bucket-id bucket-62))
|
|
(= arg0 (bucket-id bucket-73))
|
|
(= arg0 (bucket-id bucket-82))
|
|
(= arg0 (bucket-id bucket-91))
|
|
(= arg0 (bucket-id bucket-100))
|
|
(= arg0 (bucket-id bucket-109))
|
|
(= arg0 (bucket-id bucket-118))
|
|
(= arg0 (bucket-id bucket-127))
|
|
(= arg0 (bucket-id bucket-137))
|
|
(= arg0 (bucket-id bucket-147))
|
|
(= arg0 (bucket-id bucket-157))
|
|
(= arg0 (bucket-id bucket-167))
|
|
(= arg0 (bucket-id bucket-177))
|
|
(= arg0 (bucket-id bucket-187))
|
|
(= arg0 (bucket-id bucket-196))
|
|
(= arg0 (bucket-id bucket-200))
|
|
(= arg0 (bucket-id bucket-204))
|
|
(= arg0 (bucket-id bucket-208))
|
|
(= arg0 (bucket-id bucket-212))
|
|
(= arg0 (bucket-id bucket-216))
|
|
(= arg0 (bucket-id bucket-220))
|
|
(= arg0 (bucket-id bucket-252))
|
|
(= arg0 (bucket-id bucket-261))
|
|
(= arg0 (bucket-id bucket-270))
|
|
(= arg0 (bucket-id bucket-279))
|
|
(= arg0 (bucket-id bucket-288))
|
|
(= arg0 (bucket-id bucket-297))
|
|
(= arg0 (bucket-id bucket-306))
|
|
(= arg0 (bucket-id bucket-312))
|
|
(= arg0 (bucket-id bucket-316))
|
|
(= arg0 (bucket-id bucket-319))
|
|
)
|
|
)
|
|
|
|
(defun profile-tfrag-test ((arg0 bucket-id))
|
|
"Is this a tfrag bucket?"
|
|
(or (= arg0 (bucket-id bucket-8))
|
|
(= arg0 (bucket-id bucket-19))
|
|
(= arg0 (bucket-id bucket-30))
|
|
(= arg0 (bucket-id bucket-41))
|
|
(= arg0 (bucket-id bucket-52))
|
|
(= arg0 (bucket-id bucket-63))
|
|
(= arg0 (bucket-id bucket-11))
|
|
(= arg0 (bucket-id bucket-22))
|
|
(= arg0 (bucket-id bucket-33))
|
|
(= arg0 (bucket-id bucket-44))
|
|
(= arg0 (bucket-id bucket-55))
|
|
(= arg0 (bucket-id bucket-66))
|
|
(= arg0 (bucket-id bucket-128))
|
|
(= arg0 (bucket-id bucket-138))
|
|
(= arg0 (bucket-id bucket-148))
|
|
(= arg0 (bucket-id bucket-158))
|
|
(= arg0 (bucket-id bucket-168))
|
|
(= arg0 (bucket-id bucket-178))
|
|
(= arg0 (bucket-id bucket-255))
|
|
(= arg0 (bucket-id bucket-264))
|
|
(= arg0 (bucket-id bucket-273))
|
|
(= arg0 (bucket-id bucket-282))
|
|
(= arg0 (bucket-id bucket-291))
|
|
(= arg0 (bucket-id bucket-300))
|
|
(= arg0 (bucket-id bucket-134))
|
|
(= arg0 (bucket-id bucket-144))
|
|
(= arg0 (bucket-id bucket-154))
|
|
(= arg0 (bucket-id bucket-164))
|
|
(= arg0 (bucket-id bucket-174))
|
|
(= arg0 (bucket-id bucket-184))
|
|
(= arg0 (bucket-id bucket-259))
|
|
(= arg0 (bucket-id bucket-268))
|
|
(= arg0 (bucket-id bucket-277))
|
|
(= arg0 (bucket-id bucket-286))
|
|
(= arg0 (bucket-id bucket-295))
|
|
(= arg0 (bucket-id bucket-304))
|
|
)
|
|
)
|
|
|
|
(defun profile-tie-test ((arg0 bucket-id))
|
|
"Is this a tie bucket?"
|
|
(or (= arg0 (bucket-id bucket-9))
|
|
(= arg0 (bucket-id bucket-20))
|
|
(= arg0 (bucket-id bucket-31))
|
|
(= arg0 (bucket-id bucket-42))
|
|
(= arg0 (bucket-id bucket-53))
|
|
(= arg0 (bucket-id bucket-64))
|
|
(= arg0 (bucket-id bucket-10))
|
|
(= arg0 (bucket-id bucket-21))
|
|
(= arg0 (bucket-id bucket-32))
|
|
(= arg0 (bucket-id bucket-43))
|
|
(= arg0 (bucket-id bucket-54))
|
|
(= arg0 (bucket-id bucket-65))
|
|
(= arg0 (bucket-id bucket-12))
|
|
(= arg0 (bucket-id bucket-23))
|
|
(= arg0 (bucket-id bucket-34))
|
|
(= arg0 (bucket-id bucket-45))
|
|
(= arg0 (bucket-id bucket-56))
|
|
(= arg0 (bucket-id bucket-67))
|
|
(= arg0 (bucket-id bucket-13))
|
|
(= arg0 (bucket-id bucket-24))
|
|
(= arg0 (bucket-id bucket-35))
|
|
(= arg0 (bucket-id bucket-46))
|
|
(= arg0 (bucket-id bucket-57))
|
|
(= arg0 (bucket-id bucket-68))
|
|
(= arg0 (bucket-id bucket-17))
|
|
(= arg0 (bucket-id bucket-28))
|
|
(= arg0 (bucket-id bucket-39))
|
|
(= arg0 (bucket-id bucket-50))
|
|
(= arg0 (bucket-id bucket-61))
|
|
(= arg0 (bucket-id bucket-72))
|
|
(= arg0 (bucket-id bucket-129))
|
|
(= arg0 (bucket-id bucket-139))
|
|
(= arg0 (bucket-id bucket-149))
|
|
(= arg0 (bucket-id bucket-159))
|
|
(= arg0 (bucket-id bucket-169))
|
|
(= arg0 (bucket-id bucket-179))
|
|
(= arg0 (bucket-id bucket-130))
|
|
(= arg0 (bucket-id bucket-140))
|
|
(= arg0 (bucket-id bucket-150))
|
|
(= arg0 (bucket-id bucket-160))
|
|
(= arg0 (bucket-id bucket-170))
|
|
(= arg0 (bucket-id bucket-180))
|
|
(= arg0 (bucket-id bucket-135))
|
|
(= arg0 (bucket-id bucket-145))
|
|
(= arg0 (bucket-id bucket-155))
|
|
(= arg0 (bucket-id bucket-165))
|
|
(= arg0 (bucket-id bucket-175))
|
|
(= arg0 (bucket-id bucket-185))
|
|
(= arg0 (bucket-id bucket-136))
|
|
(= arg0 (bucket-id bucket-146))
|
|
(= arg0 (bucket-id bucket-156))
|
|
(= arg0 (bucket-id bucket-166))
|
|
(= arg0 (bucket-id bucket-176))
|
|
(= arg0 (bucket-id bucket-186))
|
|
)
|
|
)
|
|
|
|
(defun profile-merc-test ((arg0 bucket-id))
|
|
"Is this a merc bucket?"
|
|
(or (= arg0 (bucket-id bucket-14))
|
|
(= arg0 (bucket-id bucket-25))
|
|
(= arg0 (bucket-id bucket-36))
|
|
(= arg0 (bucket-id bucket-47))
|
|
(= arg0 (bucket-id bucket-58))
|
|
(= arg0 (bucket-id bucket-69))
|
|
(= arg0 (bucket-id bucket-79))
|
|
(= arg0 (bucket-id bucket-88))
|
|
(= arg0 (bucket-id bucket-97))
|
|
(= arg0 (bucket-id bucket-106))
|
|
(= arg0 (bucket-id bucket-115))
|
|
(= arg0 (bucket-id bucket-124))
|
|
(= arg0 (bucket-id bucket-131))
|
|
(= arg0 (bucket-id bucket-141))
|
|
(= arg0 (bucket-id bucket-151))
|
|
(= arg0 (bucket-id bucket-161))
|
|
(= arg0 (bucket-id bucket-171))
|
|
(= arg0 (bucket-id bucket-181))
|
|
(= arg0 (bucket-id bucket-188))
|
|
(= arg0 (bucket-id bucket-192))
|
|
(= arg0 (bucket-id bucket-197))
|
|
(= arg0 (bucket-id bucket-201))
|
|
(= arg0 (bucket-id bucket-205))
|
|
(= arg0 (bucket-id bucket-209))
|
|
(= arg0 (bucket-id bucket-213))
|
|
(= arg0 (bucket-id bucket-217))
|
|
(= arg0 (bucket-id bucket-221))
|
|
(= arg0 (bucket-id bucket-225))
|
|
(= arg0 (bucket-id bucket-229))
|
|
(= arg0 (bucket-id bucket-233))
|
|
(= arg0 (bucket-id bucket-237))
|
|
(= arg0 (bucket-id bucket-241))
|
|
(= arg0 (bucket-id bucket-245))
|
|
(= arg0 (bucket-id bucket-249))
|
|
(= arg0 (bucket-id bucket-253))
|
|
(= arg0 (bucket-id bucket-262))
|
|
(= arg0 (bucket-id bucket-271))
|
|
(= arg0 (bucket-id bucket-280))
|
|
(= arg0 (bucket-id bucket-289))
|
|
(= arg0 (bucket-id bucket-298))
|
|
(= arg0 (bucket-id bucket-307))
|
|
)
|
|
)
|
|
|
|
(defun profile-emerc-test ((arg0 bucket-id))
|
|
"Is this an emerc bucket?"
|
|
(or (= arg0 (bucket-id bucket-15))
|
|
(= arg0 (bucket-id bucket-26))
|
|
(= arg0 (bucket-id bucket-37))
|
|
(= arg0 (bucket-id bucket-48))
|
|
(= arg0 (bucket-id bucket-59))
|
|
(= arg0 (bucket-id bucket-70))
|
|
(= arg0 (bucket-id bucket-80))
|
|
(= arg0 (bucket-id bucket-89))
|
|
(= arg0 (bucket-id bucket-98))
|
|
(= arg0 (bucket-id bucket-107))
|
|
(= arg0 (bucket-id bucket-116))
|
|
(= arg0 (bucket-id bucket-125))
|
|
(= arg0 (bucket-id bucket-132))
|
|
(= arg0 (bucket-id bucket-142))
|
|
(= arg0 (bucket-id bucket-152))
|
|
(= arg0 (bucket-id bucket-162))
|
|
(= arg0 (bucket-id bucket-172))
|
|
(= arg0 (bucket-id bucket-182))
|
|
(= arg0 (bucket-id bucket-189))
|
|
(= arg0 (bucket-id bucket-193))
|
|
(= arg0 (bucket-id bucket-198))
|
|
(= arg0 (bucket-id bucket-202))
|
|
(= arg0 (bucket-id bucket-206))
|
|
(= arg0 (bucket-id bucket-210))
|
|
(= arg0 (bucket-id bucket-214))
|
|
(= arg0 (bucket-id bucket-218))
|
|
(= arg0 (bucket-id bucket-222))
|
|
(= arg0 (bucket-id bucket-226))
|
|
(= arg0 (bucket-id bucket-230))
|
|
(= arg0 (bucket-id bucket-234))
|
|
(= arg0 (bucket-id bucket-238))
|
|
(= arg0 (bucket-id bucket-242))
|
|
(= arg0 (bucket-id bucket-246))
|
|
(= arg0 (bucket-id bucket-250))
|
|
)
|
|
)
|
|
|
|
(defun profile-mercneric-test ((arg0 bucket-id))
|
|
"Is this a mercneric bucket?"
|
|
(or (= arg0 (bucket-id bucket-16))
|
|
(= arg0 (bucket-id bucket-27))
|
|
(= arg0 (bucket-id bucket-38))
|
|
(= arg0 (bucket-id bucket-49))
|
|
(= arg0 (bucket-id bucket-60))
|
|
(= arg0 (bucket-id bucket-71))
|
|
(= arg0 (bucket-id bucket-81))
|
|
(= arg0 (bucket-id bucket-90))
|
|
(= arg0 (bucket-id bucket-99))
|
|
(= arg0 (bucket-id bucket-108))
|
|
(= arg0 (bucket-id bucket-117))
|
|
(= arg0 (bucket-id bucket-126))
|
|
(= arg0 (bucket-id bucket-133))
|
|
(= arg0 (bucket-id bucket-143))
|
|
(= arg0 (bucket-id bucket-153))
|
|
(= arg0 (bucket-id bucket-163))
|
|
(= arg0 (bucket-id bucket-173))
|
|
(= arg0 (bucket-id bucket-183))
|
|
(= arg0 (bucket-id bucket-190))
|
|
(= arg0 (bucket-id bucket-194))
|
|
(= arg0 (bucket-id bucket-199))
|
|
(= arg0 (bucket-id bucket-203))
|
|
(= arg0 (bucket-id bucket-207))
|
|
(= arg0 (bucket-id bucket-211))
|
|
(= arg0 (bucket-id bucket-215))
|
|
(= arg0 (bucket-id bucket-219))
|
|
(= arg0 (bucket-id bucket-223))
|
|
(= arg0 (bucket-id bucket-227))
|
|
(= arg0 (bucket-id bucket-231))
|
|
(= arg0 (bucket-id bucket-235))
|
|
(= arg0 (bucket-id bucket-239))
|
|
(= arg0 (bucket-id bucket-243))
|
|
(= arg0 (bucket-id bucket-247))
|
|
(= arg0 (bucket-id bucket-251))
|
|
(= arg0 (bucket-id bucket-254))
|
|
(= arg0 (bucket-id bucket-263))
|
|
(= arg0 (bucket-id bucket-272))
|
|
(= arg0 (bucket-id bucket-281))
|
|
(= arg0 (bucket-id bucket-290))
|
|
(= arg0 (bucket-id bucket-299))
|
|
(= arg0 (bucket-id bucket-308))
|
|
(= arg0 (bucket-id bucket-317))
|
|
)
|
|
)
|
|
|
|
(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))
|
|
)
|
|
(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)))
|
|
(let* ((v1-0 arg0)
|
|
(a0-1 (the-as object (-> v1-0 base)))
|
|
)
|
|
(set! (-> (the-as dma-packet a0-1) dma) (new 'static 'dma-tag :qwc #xa :id (dma-tag-id cnt)))
|
|
(set! (-> (the-as dma-packet a0-1) vif0) (new 'static 'vif-tag))
|
|
(set! (-> (the-as dma-packet a0-1) vif1) (new 'static 'vif-tag :imm #xa :cmd (vif-cmd direct) :msk #x1))
|
|
(set! (-> v1-0 base) (&+ (the-as pointer a0-1) 16))
|
|
)
|
|
(let* ((v1-1 arg0)
|
|
(a0-3 (the-as object (-> v1-1 base)))
|
|
)
|
|
(set! (-> (the-as gs-gif-tag a0-3) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x9))
|
|
(set! (-> (the-as gs-gif-tag a0-3) regs) (new 'static 'gif-tag-regs
|
|
:regs0 (gif-reg-id a+d)
|
|
:regs1 (gif-reg-id a+d)
|
|
:regs2 (gif-reg-id a+d)
|
|
:regs3 (gif-reg-id a+d)
|
|
:regs4 (gif-reg-id a+d)
|
|
:regs5 (gif-reg-id a+d)
|
|
:regs6 (gif-reg-id a+d)
|
|
:regs7 (gif-reg-id a+d)
|
|
:regs8 (gif-reg-id a+d)
|
|
:regs9 (gif-reg-id a+d)
|
|
:regs10 (gif-reg-id a+d)
|
|
:regs11 (gif-reg-id a+d)
|
|
:regs12 (gif-reg-id a+d)
|
|
:regs13 (gif-reg-id a+d)
|
|
:regs14 (gif-reg-id a+d)
|
|
:regs15 (gif-reg-id a+d)
|
|
)
|
|
)
|
|
(set! (-> v1-1 base) (&+ (the-as pointer a0-3) 16))
|
|
)
|
|
(let* ((v1-2 arg0)
|
|
(a0-5 (-> v1-2 base))
|
|
)
|
|
(set! (-> (the-as (pointer gs-alpha) a0-5) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 1) (gs-reg64 alpha-1))
|
|
(set! (-> (the-as (pointer gs-zbuf) a0-5) 2) (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 3) (gs-reg64 zbuf-1))
|
|
(set! (-> (the-as (pointer gs-test) a0-5) 4) (new 'static 'gs-test :zte #x1 :ztst (gs-ztest always)))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 5) (gs-reg64 test-1))
|
|
(set! (-> (the-as (pointer uint64) a0-5) 6) (the-as uint 0))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 7) (gs-reg64 pabe))
|
|
(set! (-> (the-as (pointer gs-clamp) a0-5) 8)
|
|
(new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp))
|
|
)
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 9) (gs-reg64 clamp-1))
|
|
(set! (-> (the-as (pointer gs-tex1) a0-5) 10) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 11) (gs-reg64 tex1-1))
|
|
(set! (-> (the-as (pointer gs-texa) a0-5) 12) (new 'static 'gs-texa :ta1 #x80))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 13) (gs-reg64 texa))
|
|
(set! (-> (the-as (pointer gs-texclut) a0-5) 14) (new 'static 'gs-texclut :cbw #x4))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 15) (gs-reg64 texclut))
|
|
(set! (-> (the-as (pointer uint64) a0-5) 16) (the-as uint *fog-color*))
|
|
(set! (-> (the-as (pointer gs-reg64) a0-5) 17) (gs-reg64 fogcol))
|
|
(set! (-> v1-2 base) (&+ a0-5 144))
|
|
)
|
|
(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 orange-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 orange-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 orange-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 orange-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)
|
|
)
|
|
) |