[jak2] combined shadow work PR (#2632)

This PR is a combination of
https://github.com/open-goal/jak-project/pull/2507 and some additional
changes to port Shadow VU1 to OpenGL. As far as I can tell, it's
working.

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
This commit is contained in:
water111
2023-05-07 12:12:21 -04:00
committed by GitHub
parent 40b2e93be7
commit b79f28fe07
39 changed files with 9659 additions and 111 deletions
+7 -3
View File
@@ -1330,14 +1330,14 @@
(let ((v1-0 *shadow-globals*))
(dotimes (a0-0 2)
(let ((a1-2 (-> v1-0 bucket a0-0)))
(set! (-> a1-2 first) (the-as uint 0))
(set! (-> a1-2 next) (the-as uint 0))
(set! (-> a1-2 first) (the-as pointer 0))
(set! (-> a1-2 next) (the-as pointer 0))
(set! (-> a1-2 shadow-color) (if (zero? a0-0)
(new 'static 'rgba :r #xf0 :g #xf0 :b #xf0 :a #x80)
(the-as rgba (-> *setting-control* user-current spotlight-color))
)
)
(set! (-> a1-2 constants) (the-as basic 0))
(set! (-> a1-2 constants) (the-as shadow-vu1-constants 0))
)
)
)
@@ -2176,3 +2176,7 @@
(display-sync arg0)
(none)
)
+923
View File
@@ -0,0 +1,923 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for method 5 of type shadow-geo
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of shadow-geo ((obj shadow-geo))
(the-as int (* (-> obj total-qwc) 16))
)
;; definition for method 8 of type shadow-geo
(defmethod mem-usage shadow-geo ((obj shadow-geo) (arg0 memory-usage-block) (arg1 int))
(set! (-> arg0 length) (max 111 (-> arg0 length)))
(set! (-> arg0 data 110 name) "shadow-geo")
(+! (-> arg0 data 110 count) 1)
(let ((v1-6 (* (-> obj total-qwc) 16)))
(+! (-> arg0 data 110 used) v1-6)
(+! (-> arg0 data 110 total) (logand -16 (+ v1-6 15)))
)
obj
)
;; definition for symbol *shadow-data*, type shadow-data
(define *shadow-data* (new 'static 'shadow-data
:dma-unpack-template (new 'static 'dma-packet
:dma (new 'static 'dma-tag :id (dma-tag-id cnt))
:vif0 (new 'static 'vif-tag :cmd (vif-cmd flush) :msk #x1)
:vif1 (new 'static 'vif-tag :cmd (vif-cmd unpack-v4-32))
)
:dma-cnt (new 'static 'dma-tag :id (dma-tag-id cnt))
:vif-unpack-v4-8 (new 'static 'vif-tag :cmd (vif-cmd unpack-v4-8))
)
)
;; definition for function shadow-invert-z-buf
;; WARN: Return type mismatch int vs none.
(defun shadow-invert-z-buf ((arg0 dma-buffer))
(let ((v1-0 (-> arg0 base)))
(let* ((a1-0 arg0)
(a2-0 (the-as object (-> a1-0 base)))
)
(set! (-> (the-as dma-packet a2-0) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a2-0) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet a2-0) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1))
(set! (-> a1-0 base) (&+ (the-as pointer a2-0) 16))
)
(let* ((a1-1 arg0)
(a2-2 (the-as object (-> a1-1 base)))
)
(set! (-> (the-as gs-gif-tag a2-2) tag) (new 'static 'gif-tag64 :nloop #x7 :eop #x1 :nreg #x1))
(set! (-> (the-as gs-gif-tag a2-2) regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
(set! (-> a1-1 base) (&+ (the-as pointer a2-2) 16))
)
(let ((t1-0 (-> arg0 base))
(t0-0 512)
)
416
(let ((a1-3 1792)
(a2-4 1840)
)
2304
(let ((a3-5 2256)
(t0-1 (/ t0-0 32))
)
(set! (-> (the-as (pointer gs-reg) t1-0) 8) (gs-reg texflush))
(set! (-> (the-as (pointer gs-reg64) t1-0) 0) (gs-reg64 prim))
(set! (-> (the-as (pointer gs-reg) t1-0) 24) (gs-reg frame-1))
(set! (-> (the-as (pointer gs-frame) t1-0) 2) (new 'static 'gs-frame :fbp #x130 :fbw #x8 :fbmsk #xff000000))
(set! (-> (the-as (pointer gs-reg) t1-0) 40) (gs-reg zbuf-1))
(set! (-> (the-as (pointer gs-zbuf) t1-0) 4) (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
(set! (-> (the-as (pointer gs-reg) t1-0) 56) (gs-reg test-1))
(set! (-> (the-as (pointer gs-test) t1-0) 6)
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always))
)
(set! (-> (the-as (pointer gs-reg) t1-0) 72) (gs-reg alpha-1))
(set! (-> (the-as (pointer gs-alpha) t1-0) 8) (new 'static 'gs-alpha :b #x1 :c #x2 :d #x2 :fix #x80))
(set! (-> (the-as (pointer gs-reg) t1-0) 88) (gs-reg prim))
(set! (-> (the-as (pointer gs-reg64) t1-0) 10) (gs-reg64 colclamp))
(set! (-> (the-as (pointer gs-reg) t1-0) 104) (gs-reg rgbaq))
(set! (-> (the-as (pointer gs-rgbaq) t1-0) 12) (new 'static 'gs-rgbaq :r #xff :g #xff :b #xff :q 1.0))
(&+! (-> arg0 base) 112)
(let* ((t1-3 arg0)
(t2-12 (the-as object (-> t1-3 base)))
)
(set! (-> (the-as gs-gif-tag t2-12) tag)
(new 'static 'gif-tag64 :eop #x1 :flg (gif-flag reg-list) :nreg #x2 :nloop t0-1)
)
(set! (-> (the-as gs-gif-tag t2-12) regs)
(new 'static 'gif-tag-regs :regs0 (gif-reg-id xyz2) :regs1 (gif-reg-id xyz2))
)
(set! (-> t1-3 base) (&+ (the-as pointer t2-12) 16))
)
(let ((t1-4 0))
(dotimes (t2-14 t0-1)
(let* ((t3-3 arg0)
(t4-2 (-> t3-3 base))
)
(set! (-> (the-as (pointer gs-xyzf) t4-2) 0) (new 'static 'gs-xyzf :y (* a2-4 16) :x (* (+ t1-4 a1-3) 16)))
(set! (-> (the-as (pointer gs-xyzf) t4-2) 1) (new 'static 'gs-xyzf :y (* a3-5 16) :x (* (+ t1-4 32 a1-3) 16)))
(set! (-> t3-3 base) (&+ t4-2 16))
)
(+! t1-4 32)
)
)
)
)
)
(nop!)
(nop!)
0
(let ((a1-9 (/ (the-as int (+ (- -16 (the-as int v1-0)) (the-as int (-> arg0 base)))) 16)))
(cond
((nonzero? a1-9)
(logior! (-> (the-as (pointer uint64) v1-0) 0) (shr (shl a1-9 48) 48))
(logior! (-> (the-as (pointer uint64) v1-0) 1) (shl (shr (shl a1-9 48) 48) 32))
)
(else
(set! (-> arg0 base) v1-0)
)
)
)
)
(none)
)
;; definition for function shadow-make-invert-buf
;; WARN: Return type mismatch pointer vs none.
(defun shadow-make-invert-buf ()
(let ((gp-0 *shadow-dma-buf*))
(let ((v1-0 gp-0))
(set! (-> v1-0 base) (-> v1-0 data))
(set! (-> v1-0 end) (&-> v1-0 data-buffer (-> v1-0 allocated-length)))
)
(shadow-invert-z-buf gp-0)
(let ((v1-1 (the-as object (-> gp-0 base))))
(set! (-> (the-as dma-packet v1-1) dma) (new 'static 'dma-tag :id (dma-tag-id ret)))
(set! (-> (the-as dma-packet v1-1) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-1) vif1) (new 'static 'vif-tag))
(set! (-> gp-0 base) (&+ (the-as pointer v1-1) 16))
)
)
(none)
)
;; failed to figure out what this is:
(shadow-make-invert-buf)
;; definition for symbol *shadow-dma-invert-call*, type pointer
(define *shadow-dma-invert-call* (the-as pointer #f))
;; definition for function shadow-dma-init
;; WARN: Return type mismatch dma-buffer vs none.
(defun shadow-dma-init ((arg0 dma-buffer))
(-> *display* on-screen)
(let ((a1-0 408))
(* a1-0 32)
(let ((t3-0 512)
(t2-0 416)
(a2-0 1792)
(a3-0 1840)
)
2304
(let ((t0-0 2256)
(t1-0 (/ t3-0 32))
(t5-0 (* a3-0 16))
)
(set! *shadow-dma-invert-call* (-> arg0 base))
(let* ((v1-6 arg0)
(t4-0 (the-as object (-> v1-6 base)))
)
(set! (-> (the-as dma-packet t4-0) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet t4-0) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet t4-0) vif1) (new 'static 'vif-tag))
(set! (-> v1-6 base) (&+ (the-as pointer t4-0) 16))
)
(let ((v1-7 (-> arg0 base)))
(let* ((t4-2 arg0)
(t6-1 (the-as object (-> t4-2 base)))
)
(set! (-> (the-as dma-packet t6-1) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet t6-1) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet t6-1) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1))
(set! (-> t4-2 base) (&+ (the-as pointer t6-1) 16))
)
(let* ((t4-3 arg0)
(t6-3 (the-as object (-> t4-3 base)))
)
(set! (-> (the-as gs-gif-tag t6-3) tag) (new 'static 'gif-tag64 :nloop #xa :eop #x1 :nreg #x1))
(set! (-> (the-as gs-gif-tag t6-3) regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
(set! (-> t4-3 base) (&+ (the-as pointer t6-3) 16))
)
(let ((t4-4 (-> arg0 base)))
(set! (-> (the-as (pointer gs-reg64) t4-4) 1) (gs-reg64 texflush))
(set! (-> (the-as (pointer gs-reg64) t4-4) 3) (gs-reg64 test-1))
(set! (-> (the-as (pointer gs-test) t4-4) 2)
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always))
)
(set! (-> (the-as (pointer gs-reg64) t4-4) 5) (gs-reg64 alpha-1))
(set! (-> (the-as (pointer gs-alpha) t4-4) 4) (new 'static 'gs-alpha :b #x1 :d #x1))
(set! (-> (the-as (pointer gs-reg64) t4-4) 7) (gs-reg64 frame-1))
(set! (-> (the-as (pointer gs-frame) t4-4) 6) (new 'static 'gs-frame :fbw #x8 :fbmsk #xffffff :fbp a1-0))
(set! (-> (the-as (pointer gs-reg64) t4-4) 9) (gs-reg64 zbuf-1))
(set! (-> (the-as (pointer gs-zbuf) t4-4) 8) (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
(set! (-> (the-as (pointer gs-reg64) t4-4) 11) (gs-reg64 xyoffset-1))
(set! (-> (the-as (pointer gs-xy-offset) t4-4) 10) (new 'static 'gs-xy-offset :ofx (* a2-0 16) :ofy t5-0))
(set! (-> (the-as (pointer gs-reg64) t4-4) 13) (gs-reg64 tex0-1))
(set! (-> (the-as (pointer gs-tex0) t4-4) 12)
(new 'static 'gs-tex0 :tbw #x8 :tw #x9 :th #x9 :tcc #x1 :tbp0 (* a1-0 32))
)
(set! (-> (the-as (pointer gs-reg) t4-4) 120) (gs-reg tex1-1))
(set! (-> (the-as (pointer gs-tex1) t4-4) 14) (new 'static 'gs-tex1))
(set! (-> (the-as (pointer gs-reg) t4-4) 136) (gs-reg miptbp1-1))
(set! (-> (the-as (pointer gs-miptbp) t4-4) 16) (new 'static 'gs-miptbp))
(set! (-> (the-as (pointer gs-reg) t4-4) 152) (gs-reg clamp-1))
(set! (-> (the-as (pointer gs-clamp) t4-4) 18) (new 'static 'gs-clamp
:wms (gs-tex-wrap-mode region-clamp)
:wmt (gs-tex-wrap-mode region-clamp)
:maxv (+ t2-0 -1)
:maxu (+ t3-0 -1)
)
)
)
(&+! (-> arg0 base) 160)
(let* ((t2-7 arg0)
(t3-5 (the-as object (-> t2-7 base)))
)
(set! (-> (the-as gs-gif-tag t3-5) tag)
(new 'static 'gif-tag64 :nloop #x1 :eop #x1 :flg (gif-flag reg-list) :nreg #x2)
)
(set! (-> (the-as gs-gif-tag t3-5) regs) (new 'static 'gif-tag-regs :regs1 (gif-reg-id rgbaq)))
(set! (-> t2-7 base) (&+ (the-as pointer t3-5) 16))
)
(let* ((t2-8 arg0)
(t3-7 (-> t2-8 base))
)
(set! (-> (the-as (pointer gs-prim) t3-7) 0) (new 'static 'gs-prim :prim (gs-prim-type sprite)))
(set! (-> (the-as (pointer gs-rgbaq) t3-7) 1) (new 'static 'gs-rgbaq :a #x60))
(set! (-> t2-8 base) (&+ t3-7 16))
)
(let* ((t2-9 arg0)
(t3-9 (the-as object (-> t2-9 base)))
)
(set! (-> (the-as gs-gif-tag t3-9) tag)
(new 'static 'gif-tag64 :eop #x1 :flg (gif-flag reg-list) :nreg #x2 :nloop t1-0)
)
(set! (-> (the-as gs-gif-tag t3-9) regs)
(new 'static 'gif-tag-regs :regs0 (gif-reg-id xyz2) :regs1 (gif-reg-id xyz2))
)
(set! (-> t2-9 base) (&+ (the-as pointer t3-9) 16))
)
(let ((t2-10 0))
(dotimes (t3-11 t1-0)
(let* ((t4-12 arg0)
(t5-12 (-> t4-12 base))
)
(set! (-> (the-as (pointer gs-xyzf) t5-12) 0)
(new 'static 'gs-xyzf :z #x1ffff :y (* a3-0 16) :x (* (+ a2-0 t2-10) 16))
)
(set! (-> (the-as (pointer gs-xyzf) t5-12) 1)
(new 'static 'gs-xyzf :z #x1ffff :y (* t0-0 16) :x (* (+ t2-10 32 a2-0) 16))
)
(set! (-> t4-12 base) (&+ t5-12 16))
)
(+! t2-10 32)
)
)
(let* ((a2-3 arg0)
(a3-1 (the-as object (-> a2-3 base)))
)
(set! (-> (the-as gs-gif-tag a3-1) tag) (new 'static 'gif-tag64 :nloop #x4 :eop #x1 :nreg #x1))
(set! (-> (the-as gs-gif-tag a3-1) regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
(set! (-> a2-3 base) (&+ (the-as pointer a3-1) 16))
)
(cond
(*shadow-debug*
(let* ((a2-5 arg0)
(a3-3 (-> a2-5 base))
)
(set! (-> (the-as (pointer gs-test) a3-3) 0)
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest greater-equal))
)
(set! (-> (the-as (pointer gs-reg64) a3-3) 1) (gs-reg64 test-1))
(set! (-> (the-as (pointer gs-zbuf) a3-3) 2) (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24)))
(set! (-> (the-as (pointer gs-reg64) a3-3) 3) (gs-reg64 zbuf-1))
(set! (-> (the-as (pointer gs-frame) a3-3) 4) (new 'static 'gs-frame :fbw #x8 :fbp a1-0))
(set! (-> (the-as (pointer gs-reg64) a3-3) 5) (gs-reg64 frame-1))
(set! (-> (the-as (pointer uint64) a3-3) 6) (the-as uint 0))
(set! (-> (the-as (pointer gs-reg64) a3-3) 7) (gs-reg64 texflush))
(set! (-> a2-5 base) (&+ a3-3 64))
)
)
(else
(let* ((a2-6 arg0)
(a3-4 (-> a2-6 base))
)
(set! (-> (the-as (pointer gs-test) a3-4) 0)
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest greater-equal))
)
(set! (-> (the-as (pointer gs-reg64) a3-4) 1) (gs-reg64 test-1))
(set! (-> (the-as (pointer gs-zbuf) a3-4) 2) (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
(set! (-> (the-as (pointer gs-reg64) a3-4) 3) (gs-reg64 zbuf-1))
(set! (-> (the-as (pointer gs-frame) a3-4) 4) (new 'static 'gs-frame :fbw #x8 :fbmsk #xffffff :fbp a1-0))
(set! (-> (the-as (pointer gs-reg64) a3-4) 5) (gs-reg64 frame-1))
(set! (-> (the-as (pointer uint64) a3-4) 6) (the-as uint 0))
(set! (-> (the-as (pointer gs-reg64) a3-4) 7) (gs-reg64 texflush))
(set! (-> a2-6 base) (&+ a3-4 64))
)
)
)
(let ((a2-10 (/ (the-as int (+ (- -16 (the-as int v1-7)) (the-as int (-> arg0 base)))) 16)))
(cond
((nonzero? a2-10)
(logior! (-> (the-as (pointer uint64) v1-7) 0) (shr (shl a2-10 48) 48))
(logior! (-> (the-as (pointer uint64) v1-7) 1) (shl (shr (shl a2-10 48) 48) 32))
)
(else
(set! (-> arg0 base) v1-7)
)
)
)
)
)
)
)
(none)
)
;; definition for function shadow-dma-end
;; WARN: Return type mismatch dma-buffer vs none.
(defun shadow-dma-end ((arg0 dma-buffer) (arg1 gs-rgbaq) (arg2 symbol) (arg3 int))
(-> *display* on-screen)
(let ((s0-0 408))
(* s0-0 32)
(let ((v1-4 512)
(s3-0 416)
(s5-0 1792)
(s4-0 1840)
)
2304
2256
(let ((s2-0 (/ v1-4 32)))
(* s4-0 16)
(let ((v1-6 (the-as object *shadow-dma-invert-call*))
(a0-3 *shadow-dma-buf*)
)
(cond
(arg2
(set! (-> (the-as (pointer uint64) v1-6)) (logior #x50000000 (shr (shl (the-as int (-> a0-3 data)) 33) 1)))
(set! (-> (the-as (pointer uint64) v1-6) 1) (the-as uint 0))
(let* ((v1-7 arg0)
(a1-3 (the-as object (-> v1-7 base)))
)
(set! (-> (the-as dma-packet a1-3) dma)
(new 'static 'dma-tag :id (dma-tag-id call) :addr (the-as int (-> a0-3 data)))
)
(set! (-> (the-as dma-packet a1-3) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet a1-3) vif1) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
(set! (-> v1-7 base) (&+ (the-as pointer a1-3) 16))
)
)
(else
(set! (-> (the-as dma-packet v1-6) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as (pointer uint64) v1-6) 1) (the-as uint 0))
0
)
)
)
(shadow-vu1-patch-consts arg2 arg3)
(let* ((v1-10 arg0)
(a0-12 (the-as object (-> v1-10 base)))
)
(set! (-> (the-as dma-packet a0-12) dma) (new 'static 'dma-tag :qwc #x6 :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a0-12) vif0) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
(set! (-> (the-as dma-packet a0-12) vif1) (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1))
(set! (-> v1-10 base) (&+ (the-as pointer a0-12) 16))
)
(let* ((v1-11 arg0)
(a0-14 (the-as object (-> v1-11 base)))
)
(set! (-> (the-as gs-gif-tag a0-14) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x5))
(set! (-> (the-as gs-gif-tag a0-14) regs) GIF_REGS_ALL_AD)
(set! (-> v1-11 base) (&+ (the-as pointer a0-14) 16))
)
(let* ((v1-12 arg0)
(a0-16 (-> v1-12 base))
)
(set! (-> (the-as (pointer uint64) a0-16) 0) (the-as uint 0))
(set! (-> (the-as (pointer gs-reg64) a0-16) 1) (gs-reg64 texflush))
(set! (-> (the-as (pointer gs-test) a0-16) 2)
(new 'static 'gs-test :ate #x1 :atst (gs-atest not-equal) :aref #x60 :zte #x1 :ztst (gs-ztest always))
)
(set! (-> (the-as (pointer gs-reg64) a0-16) 3) (gs-reg64 test-1))
(set! (-> (the-as (pointer gs-frame) a0-16) 4) (new 'static 'gs-frame :fbw #x8 :fbp s0-0))
(set! (-> (the-as (pointer gs-reg64) a0-16) 5) (gs-reg64 frame-1))
(set! (-> (the-as (pointer uint64) a0-16) 6) (the-as uint 0))
(set! (-> (the-as (pointer gs-reg64) a0-16) 7) (gs-reg64 alpha-1))
(set! (-> (the-as (pointer uint64) a0-16) 8) (the-as uint 0))
(set! (-> (the-as (pointer gs-reg64) a0-16) 9) (gs-reg64 texflush))
(set! (-> v1-12 base) (&+ a0-16 80))
)
(let ((v1-13 (-> arg0 base)))
(let* ((a0-18 arg0)
(a1-19 (the-as object (-> a0-18 base)))
)
(set! (-> (the-as dma-packet a1-19) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a1-19) vif0) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
(set! (-> (the-as dma-packet a1-19) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1))
(set! (-> a0-18 base) (&+ (the-as pointer a1-19) 16))
)
(let* ((a0-19 arg0)
(a1-21 (the-as object (-> a0-19 base)))
)
(set! (-> (the-as gs-gif-tag a1-21) tag)
(new 'static 'gif-tag64 :nloop #x1 :flg (gif-flag reg-list) :nreg #x2)
)
(set! (-> (the-as gs-gif-tag a1-21) regs) (new 'static 'gif-tag-regs :regs1 (gif-reg-id rgbaq)))
(set! (-> (the-as (pointer gs-prim) a1-21) 2)
(new 'static 'gs-prim :prim (gs-prim-type sprite) :tme #x1 :abe #x1)
)
(set! (-> (the-as (pointer gs-rgbaq) a1-21) 3) arg1)
(set! (-> (the-as (inline-array gs-gif-tag) a1-21) 2 tag)
(new 'static 'gif-tag64 :eop #x1 :flg (gif-flag reg-list) :nreg #x4 :nloop s2-0)
)
(set! (-> (the-as (inline-array gs-gif-tag) a1-21) 2 regs) (new 'static 'gif-tag-regs
:regs0 (gif-reg-id st)
:regs1 (gif-reg-id xyz2)
:regs2 (gif-reg-id st)
:regs3 (gif-reg-id xyz2)
)
)
(set! (-> a0-19 base) (&+ (the-as pointer a1-21) 48))
)
(let ((a0-20 0)
(a1-23 0)
)
(dotimes (a2-12 s2-0)
(let ((t1-0 a0-20))
(+! a0-20 32)
(let* ((a3-3 arg0)
(t0-4 (-> a3-3 base))
)
(set! (-> (the-as (pointer uint64) t0-4) 0)
(the-as
uint
(logior (shl (the-as int (* 0.001953125 (+ 0.5 (the float a1-23)))) 32)
(shr (shl (the-as int (* 0.001953125 (+ 0.5 (the float t1-0)))) 32) 32)
)
)
)
(set! (-> (the-as (pointer uint64) t0-4) 1)
(the-as
uint
(logior (logior (shl #x1ffff 32) (shr (shl (* (+ s5-0 t1-0) 16) 48) 48))
(shr (shl (* (+ s4-0 a1-23) 16) 48) 32)
)
)
)
(set! (-> (the-as (pointer uint64) t0-4) 2)
(the-as
uint
(logior (shl (the-as int (* 0.001953125 (+ 0.5 (the float s3-0)))) 32)
(shr (shl (the-as int (* 0.001953125 (+ 0.5 (the float a0-20)))) 32) 32)
)
)
)
(set! (-> (the-as (pointer uint64) t0-4) 3)
(the-as uint (logior (logior (shl #x1ffff 32) (shr (shl (* (+ s5-0 a0-20) 16) 48) 48))
(shr (shl (* (+ s4-0 s3-0) 16) 48) 32)
)
)
)
(set! (-> a3-3 base) (&+ t0-4 32))
)
)
)
)
(let ((a1-27 (/ (the-as int (+ (- -16 (the-as int v1-13)) (the-as int (-> arg0 base)))) 16)))
(cond
((nonzero? a1-27)
(logior! (-> (the-as (pointer uint64) v1-13) 0) (shr (shl a1-27 48) 48))
(logior! (-> (the-as (pointer uint64) v1-13) 1) (shl (shr (shl a1-27 48) 48) 32))
)
(else
(set! (-> arg0 base) v1-13)
)
)
)
)
)
)
)
(reset-display-gs-state *display* arg0)
(none)
)
;; definition of type shadow-stats
(deftype shadow-stats (structure)
((num-single-tris uint32 :offset-assert 0)
(num-double-tris uint32 :offset-assert 4)
(num-single-edges uint32 :offset-assert 8)
(num-double-edges uint32 :offset-assert 12)
(num-fragments uint16 :offset-assert 16)
(num-objects uint16 :offset-assert 18)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
;; definition for method 3 of type shadow-stats
(defmethod inspect shadow-stats ((obj shadow-stats))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'shadow-stats)
(format #t "~1Tnum-single-tris: ~D~%" (-> obj num-single-tris))
(format #t "~1Tnum-double-tris: ~D~%" (-> obj num-double-tris))
(format #t "~1Tnum-single-edges: ~D~%" (-> obj num-single-edges))
(format #t "~1Tnum-double-edges: ~D~%" (-> obj num-double-edges))
(format #t "~1Tnum-fragments: ~D~%" (-> obj num-fragments))
(format #t "~1Tnum-objects: ~D~%" (-> obj num-objects))
(label cfg-4)
obj
)
;; definition of type shadow-dcache
(deftype shadow-dcache (structure)
((vtx-table uint32 :offset-assert 0)
(single-edge-table uint32 :offset-assert 4)
(double-edge-table uint32 :offset-assert 8)
(double-tri-table uint32 :offset-assert 12)
(dcache-top uint32 :offset-assert 16)
(num-facing-single-tris uint32 :offset-assert 20)
(num-single-edges uint32 :offset-assert 24)
(num-double-edges uint32 :offset-assert 28)
(single-tri-list uint32 :offset-assert 32)
(single-edge-list uint32 :offset-assert 36)
(double-edge-list uint32 :offset-assert 40)
(ptr-dual-verts uint32 :offset-assert 44)
(stats shadow-stats :inline :offset-assert 48)
(frag-qwc uint32 :offset-assert 68)
(center vector :inline :offset-assert 80)
(plane vector :inline :offset-assert 96)
(top-plane vector :inline :offset-assert 112)
(near-plane vector :inline :offset-assert 128)
(light-dir vector :inline :offset-assert 144)
(vtx-min vector :inline :offset-assert 160)
(data uint8 :dynamic :offset-assert 176)
)
:method-count-assert 9
:size-assert #xb0
:flag-assert #x9000000b0
)
;; definition for method 3 of type shadow-dcache
(defmethod inspect shadow-dcache ((obj shadow-dcache))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'shadow-dcache)
(format #t "~1Tvtx-table: #x~X~%" (-> obj vtx-table))
(format #t "~1Tsingle-edge-table: #x~X~%" (-> obj single-edge-table))
(format #t "~1Tdouble-edge-table: #x~X~%" (-> obj double-edge-table))
(format #t "~1Tdouble-tri-table: #x~X~%" (-> obj double-tri-table))
(format #t "~1Tdcache-top: #x~X~%" (-> obj dcache-top))
(format #t "~1Tnum-facing-single-tris: ~D~%" (-> obj num-facing-single-tris))
(format #t "~1Tnum-single-edges: ~D~%" (-> obj num-single-edges))
(format #t "~1Tnum-double-edges: ~D~%" (-> obj num-double-edges))
(format #t "~1Tsingle-tri-list: #x~X~%" (-> obj single-tri-list))
(format #t "~1Tsingle-edge-list: #x~X~%" (-> obj single-edge-list))
(format #t "~1Tdouble-edge-list: #x~X~%" (-> obj double-edge-list))
(format #t "~1Tptr-dual-verts: #x~X~%" (-> obj ptr-dual-verts))
(format #t "~1Tstats: #<shadow-stats @ #x~X>~%" (-> obj stats))
(format #t "~1Tfrag-qwc: ~D~%" (-> obj frag-qwc))
(format #t "~1Tcenter: #<vector @ #x~X>~%" (-> obj center))
(format #t "~1Tplane: #<vector @ #x~X>~%" (-> obj plane))
(format #t "~1Ttop-plane: #<vector @ #x~X>~%" (-> obj top-plane))
(format #t "~1Tnear-plane: #<vector @ #x~X>~%" (-> obj near-plane))
(format #t "~1Tlight-dir: #<vector @ #x~X>~%" (-> obj light-dir))
(format #t "~1Tvtx-min: #<vector @ #x~X>~%" (-> obj vtx-min))
(format #t "~1Tdata[0] @ #x~X~%" (-> obj data))
(label cfg-4)
obj
)
;; definition for symbol shadow-vu0-block, type vu-function
(define shadow-vu0-block (new 'static 'vu-function :length 88 :qlength 44))
;; definition for function shadow-xform-verts
;; INFO: function output is handled by mips2c
(def-mips2c shadow-xform-verts function)
;; definition for function shadow-calc-dual-verts
;; INFO: function output is handled by mips2c
(def-mips2c shadow-calc-dual-verts function)
;; definition for function shadow-scissor-edges
;; INFO: function output is handled by mips2c
(def-mips2c shadow-scissor-edges function)
;; definition for function shadow-scissor-top
;; INFO: function output is handled by mips2c
(def-mips2c shadow-scissor-top function)
;; definition for function shadow-init-vars
;; INFO: function output is handled by mips2c
(def-mips2c shadow-init-vars function)
;; definition for function shadow-find-facing-single-tris
;; INFO: function output is handled by mips2c
(def-mips2c shadow-find-facing-single-tris function)
;; definition for function shadow-find-single-edges
;; INFO: function output is handled by mips2c
(def-mips2c shadow-find-single-edges function)
;; definition for function shadow-find-facing-double-tris
;; INFO: function output is handled by mips2c
(def-mips2c shadow-find-facing-double-tris function)
;; definition for function shadow-find-double-edges
;; INFO: function output is handled by mips2c
(def-mips2c shadow-find-double-edges function)
;; definition for function shadow-add-verts
;; INFO: function output is handled by mips2c
(def-mips2c shadow-add-verts function)
;; definition for function shadow-add-facing-single-tris
;; INFO: function output is handled by mips2c
(def-mips2c shadow-add-facing-single-tris function)
;; definition for function shadow-add-single-edges
;; INFO: function output is handled by mips2c
(def-mips2c shadow-add-single-edges function)
;; definition for function shadow-add-single-tris
;; INFO: function output is handled by mips2c
(def-mips2c shadow-add-single-tris function)
;; definition for function shadow-add-double-tris
;; INFO: function output is handled by mips2c
(def-mips2c shadow-add-double-tris function)
;; definition for function shadow-add-double-edges
;; INFO: function output is handled by mips2c
(def-mips2c shadow-add-double-edges function)
;; definition for method 14 of type shadow-control
;; WARN: Return type mismatch int vs none.
(defmethod shadow-control-method-14 shadow-control ((obj shadow-control) (arg0 vector) (arg1 vector) (arg2 float) (arg3 float) (arg4 float))
(let ((gp-0 (-> obj settings)))
(let ((s4-0 (-> gp-0 shadow-dir)))
(vector-normalize-copy! s4-0 arg1 1.0)
(set! (-> gp-0 shadow-dir w) (- arg2))
(when *shadow-debug*
(add-debug-x #t (bucket-id debug-no-zbuf1) arg0 *color-red*)
(add-debug-vector #t (bucket-id debug-no-zbuf1) arg0 s4-0 (meters 3) *color-red*)
)
(let ((s1-2 (vector+float*! (new 'stack-no-clear 'vector) arg0 s4-0 arg3))
(s5-2 (vector+float*! (new 'stack-no-clear 'vector) arg0 s4-0 arg4))
)
(vector-negate! (-> gp-0 top-plane) s4-0)
(vector-negate! (-> gp-0 bot-plane) s4-0)
(set! (-> gp-0 top-plane w) (- (vector-dot s1-2 (the-as vector (-> gp-0 top-plane)))))
(set! (-> gp-0 bot-plane w) (- (vector-dot s5-2 (the-as vector (-> gp-0 bot-plane)))))
)
)
(logior! (-> gp-0 flags) (shadow-flags shdf02 shdf03 shdf04 shdf07))
)
0
(none)
)
;; definition for function debug-draw-settings
;; WARN: Return type mismatch symbol vs none.
(defun debug-draw-settings ((arg0 matrix))
(let ((v1-0 (-> arg0 vector 1))
(a2-0 (-> arg0 vector))
(s5-0 (-> arg0 trans))
(s4-0 (-> arg0 vector 2))
(s3-0 (new 'stack-no-clear 'vector))
(s2-0 (new 'stack-no-clear 'vector))
)
(cond
((logtest? (the-as int (-> arg0 vector 0 w)) 4)
(vector+float*! s3-0 (the-as vector a2-0) v1-0 (- (vector-dot s5-0 (the-as vector a2-0)) (-> s5-0 w)))
(vector+float*! s2-0 (the-as vector a2-0) v1-0 (- (vector-dot s4-0 (the-as vector a2-0)) (-> s4-0 w)))
)
(else
(let ((a0-8 (vector+float*! (new 'stack-no-clear 'vector) (the-as vector a2-0) v1-0 (-> v1-0 w))))
(vector+float*! s3-0 a0-8 v1-0 (- (vector-dot s5-0 a0-8) (-> s5-0 w)))
(vector+float*! s2-0 a0-8 v1-0 (- (vector-dot s4-0 a0-8) (-> s4-0 w)))
)
)
)
(add-debug-sphere #t (bucket-id debug-no-zbuf1) (the-as vector a2-0) (meters 0.8) *color-magenta*)
(add-debug-x #t (bucket-id debug-no-zbuf1) s3-0 *color-blue*)
(add-debug-vector #t (bucket-id debug-no-zbuf1) s3-0 s5-0 (meters 2) *color-blue*)
(add-debug-line
#t
(bucket-id debug-no-zbuf1)
(the-as vector (-> arg0 vector))
s3-0
*color-magenta*
#f
(the-as rgba -1)
)
(add-debug-x #t (bucket-id debug-no-zbuf1) s2-0 *color-green*)
(add-debug-vector #t (bucket-id debug-no-zbuf1) s2-0 s4-0 (meters 2) *color-green*)
(add-debug-line #t (bucket-id debug-no-zbuf1) s3-0 s2-0 *color-green* #f (the-as rgba -1))
)
(none)
)
;; definition for function shadow-execute
;; INFO: function output is handled by mips2c
(def-mips2c shadow-execute (function shadow-dma-packet pointer pointer))
;; definition for function shadow-vu0-upload
;; WARN: Return type mismatch int vs none.
;; ERROR: Failed store: (s.d! (+ (the-as dma-packet a0-5) 8) 0) at op 17
(defun shadow-vu0-upload ()
(let ((gp-0 *vu0-dma-list*))
(let ((v1-0 gp-0))
(set! (-> v1-0 base) (-> v1-0 data))
(set! (-> v1-0 end) (&-> v1-0 data-buffer (-> v1-0 allocated-length)))
)
(dma-buffer-add-vu-function gp-0 shadow-vu0-block 0)
(let* ((v1-1 gp-0)
(a0-5 (the-as object (-> v1-1 base)))
)
(set! (-> (the-as dma-packet a0-5) dma) (new 'static 'dma-tag :id (dma-tag-id end)))
(s.d! (+ (the-as dma-packet a0-5) 8) 0)
(set! (-> v1-1 base) (&+ (the-as pointer a0-5) 16))
)
(.sync.l)
(dma-buffer-send-chain (the-as dma-bank-source #x10008000) gp-0)
)
0
(none)
)
;; definition for function shadow-execute-all
;; WARN: Return type mismatch int vs none.
;; ERROR: Failed store: (s.h! (+ v1-24 18) 0) at op 58
;; ERROR: Failed store: (s.h! (+ v1-24 16) 0) at op 59
(defun shadow-execute-all ((arg0 dma-buffer))
(when *debug-segment*
(let ((gp-0 (-> *display* frames (-> *display* on-screen) profile-array data 0))
(v1-7 'shadow)
(s5-0 *profile-shadow-color*)
)
(when (and *dproc* *debug-segment*)
(let ((s4-0 (-> gp-0 data (-> gp-0 count))))
(let ((s3-0 (-> gp-0 base-time)))
(set! (-> s4-0 name) v1-7)
(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 (-> gp-0 depth)))
(set! (-> s4-0 color) s5-0)
(set! (-> gp-0 segment (-> gp-0 depth)) s4-0)
)
(+! (-> gp-0 count) 1)
(+! (-> gp-0 depth) 1)
(set! (-> gp-0 max-depth) (max (-> gp-0 max-depth) (-> gp-0 depth)))
)
)
0
)
(when (logtest? (vu1-renderer-mask shadow) (-> *display* vu1-enable-user))
(let ((gp-1 *shadow-globals*))
(let ((v1-24 (the-as shadow-dcache (-> (the-as shadow-dcache *gsf-buffer*) stats))))
(set! (-> v1-24 vtx-table) (the-as uint 0))
(set! (-> v1-24 single-edge-table) (the-as uint 0))
(set! (-> v1-24 double-edge-table) (the-as uint 0))
(set! (-> v1-24 double-tri-table) (the-as uint 0))
(s.h! (+ v1-24 18) 0)
(s.h! (+ v1-24 16) 0)
)
0
(let ((v1-26 #f))
(dotimes (a0-11 2)
(if (nonzero? (-> gp-1 bucket a0-11 first))
(set! v1-26 #t)
)
)
(when v1-26
(shadow-vu0-upload)
(dotimes (s5-1 2)
(let* ((s2-0 (-> gp-1 bucket s5-1))
(s1-0 (-> s2-0 first))
)
(when (nonzero? s1-0)
(with-dma-buffer-add-bucket ((s3-1 (-> *display* frames (-> *display* on-screen) global-buf))
(if (zero? s5-1)
(bucket-id shadow)
(bucket-id shadow2)
)
)
(set! (-> (the-as shadow-dcache #x70000000) ptr-dual-verts) (the-as uint 0))
(shadow-vu1-init-buffer s3-1 s5-1)
(flush-cache 0)
(shadow-dma-init s3-1)
(set! (-> s3-1 base) (shadow-execute (the-as shadow-dma-packet s1-0) (-> s3-1 base)))
(let ((a2-1 (nonzero? (-> (the-as shadow-dcache #x70000000) ptr-dual-verts)))
(a1-9 (logior (shl #x3f800000 32) (shr (shl (the-as int (the-as uint32 (-> s2-0 shadow-color))) 32) 32)))
)
(let ((v1-42 (-> *time-of-day-context* current-shadow-color)))
(if (zero? s5-1)
(set! a1-9
(logior (logand (logior (logand (logior (logand a1-9 -256) (shr (shl (the int (* 128.0 (-> v1-42 x))) 56) 56)) -65281)
(shr (shl (the int (* 128.0 (-> v1-42 y))) 56) 48)
)
-16711681
)
(shr (shl (the int (* 128.0 (-> v1-42 z))) 56) 40)
)
)
)
)
(shadow-dma-end s3-1 (the-as gs-rgbaq a1-9) a2-1 s5-1)
)
)
)
)
)
)
)
)
(let ((gp-2 (the-as shadow-dcache *gsf-buffer*)))
(let ((v1-59 (-> *terrain-stats* shadow)))
(+! (-> v1-59 groups) (-> gp-2 stats num-objects))
(+! (-> v1-59 fragments) (-> gp-2 stats num-objects))
(+! (-> v1-59 tris)
(* (+ (-> gp-2 stats num-single-tris)
(-> gp-2 stats num-double-tris)
(-> gp-2 stats num-single-edges)
(-> gp-2 stats num-double-edges)
)
2
)
)
(+! (-> v1-59 dverts)
(* (the-as uint 6) (-> gp-2 stats num-single-tris))
(* (the-as uint 6) (-> gp-2 stats num-double-tris))
(* (-> gp-2 stats num-single-edges) 4)
(* (-> gp-2 stats num-double-edges) 4)
)
)
(when #f
(format *stdcon* "~%~%~%~%#single tris : ~4d~%" (-> gp-2 stats num-single-tris))
(format *stdcon* "#double tris : ~4d~%" (-> gp-2 stats num-double-tris))
(format *stdcon* "#single edges: ~4d~%" (-> gp-2 stats num-single-edges))
(format *stdcon* "#double edges: ~4d~%" (-> gp-2 stats num-double-edges))
)
)
)
(when *debug-segment*
(let ((gp-3 (-> *display* frames (-> *display* on-screen) profile-array data 0)))
(when (and *dproc* *debug-segment*)
(let* ((v1-73 (+ (-> gp-3 depth) -1))
(s5-2 (-> gp-3 segment v1-73))
(s4-2 (-> gp-3 base-time))
)
(when (>= v1-73 0)
(set! (-> s5-2 end-time) (the-as int (- (timer-count (the-as timer-bank #x10000800)) (the-as uint s4-2))))
(+! (-> gp-3 depth) -1)
)
)
)
)
0
)
0
(none)
)
;; definition for method 13 of type shadow-control
;; INFO: Used lq/sq
;; WARN: Return type mismatch int vs none.
(defmethod shadow-control-method-13 shadow-control ((obj shadow-control) (arg0 vector) (arg1 float) (arg2 float) (arg3 float))
(with-pp
(let ((s4-0 (new 'stack-no-clear 'collide-query)))
(let ((v1-0 pp))
(set! (-> s4-0 start-pos quad) (-> arg0 quad))
(set! (-> s4-0 start-pos y) (+ 4096.0 (-> s4-0 start-pos y)))
(set-vector! (-> s4-0 move-dist) 0.0 (- arg3) 0.0 1.0)
(let ((a0-4 s4-0))
(set! (-> a0-4 radius) 8192.0)
(set! (-> a0-4 collide-with) (collide-spec backgnd))
(set! (-> a0-4 ignore-process0) v1-0)
(set! (-> a0-4 ignore-process1) #f)
(set! (-> a0-4 ignore-pat) (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :noendlessfall #x1))
(set! (-> a0-4 action-mask) (collide-action solid))
)
)
(cond
((>= (fill-and-probe-using-line-sphere *collide-cache* s4-0) 0.0)
(let ((v1-5 obj))
(logclear! (-> v1-5 settings flags) (shadow-flags disable-draw))
)
0
(let ((v1-7 obj))
(set! (-> v1-7 settings bot-plane w) (- (+ (-> s4-0 best-other-tri intersect y) arg1)))
)
0
(set! (-> obj settings top-plane w) (- (+ (-> s4-0 best-other-tri intersect y) arg2)))
0
)
(else
(let ((v1-10 obj))
(logior! (-> v1-10 settings flags) (shadow-flags disable-draw))
)
0
)
)
)
0
(none)
)
)
+283
View File
@@ -0,0 +1,283 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type shadow-vu1-constants
(deftype shadow-vu1-constants (structure)
((hmgescale vector :inline :offset-assert 0)
(invhscale vector :inline :offset-assert 16)
(texoffset vector :inline :offset-assert 32)
(texscale vector :inline :offset-assert 48)
(hvdfoff vector :inline :offset-assert 64)
(fog vector :inline :offset-assert 80)
(clrs vector 2 :inline :offset-assert 96)
(adgif gs-gif-tag :inline :offset-assert 128)
(texflush gs-adcmd :inline :offset-assert 144)
(flush gs-adcmd :inline :offset-assert 160)
(trigif gs-gif-tag :inline :offset-assert 176)
(quadgif gs-gif-tag :inline :offset-assert 192)
)
:method-count-assert 9
:size-assert #xd0
:flag-assert #x9000000d0
)
;; definition for method 3 of type shadow-vu1-constants
(defmethod inspect shadow-vu1-constants ((obj shadow-vu1-constants))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'shadow-vu1-constants)
(format #t "~1Thmgescale: #<vector @ #x~X>~%" (-> obj hmgescale))
(format #t "~1Tinvhscale: #<vector @ #x~X>~%" (-> obj invhscale))
(format #t "~1Ttexoffset: #<vector @ #x~X>~%" (-> obj texoffset))
(format #t "~1Ttexscale: #<vector @ #x~X>~%" (-> obj texscale))
(format #t "~1Thvdfoff: #<vector @ #x~X>~%" (-> obj hvdfoff))
(format #t "~1Tfog: #<vector @ #x~X>~%" (-> obj fog))
(format #t "~1Tclrs[2] @ #x~X~%" (-> obj clrs))
(format #t "~1Tadgif: #<gs-gif-tag @ #x~X>~%" (-> obj adgif))
(format #t "~1Ttexflush: #<gs-adcmd @ #x~X>~%" (-> obj texflush))
(format #t "~1Tflush: #<gs-adcmd @ #x~X>~%" (-> obj flush))
(format #t "~1Ttrigif: #<gs-gif-tag @ #x~X>~%" (-> obj trigif))
(format #t "~1Tquadgif: #<gs-gif-tag @ #x~X>~%" (-> obj quadgif))
(label cfg-4)
obj
)
;; definition of type shadow-vu1-data
(deftype shadow-vu1-data (structure)
((adgif gs-gif-tag :inline :offset-assert 0)
(ad gs-adcmd :inline :offset-assert 16)
(flush gs-adcmd :inline :offset-assert 32)
(trigif gs-gif-tag :inline :offset-assert 48)
(quadgif gs-gif-tag :inline :offset-assert 64)
(texoffset vector :inline :offset-assert 80)
(texscale vector :inline :offset-assert 96)
(clrs qword 2 :inline :offset-assert 112)
)
:method-count-assert 9
:size-assert #x90
:flag-assert #x900000090
)
;; definition for method 3 of type shadow-vu1-data
(defmethod inspect shadow-vu1-data ((obj shadow-vu1-data))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'shadow-vu1-data)
(format #t "~1Tadgif: #<gs-gif-tag @ #x~X>~%" (-> obj adgif))
(format #t "~1Tad: #<gs-adcmd @ #x~X>~%" (-> obj ad))
(format #t "~1Tflush: #<gs-adcmd @ #x~X>~%" (-> obj flush))
(format #t "~1Ttrigif: #<gs-gif-tag @ #x~X>~%" (-> obj trigif))
(format #t "~1Tquadgif: #<gs-gif-tag @ #x~X>~%" (-> obj quadgif))
(format #t "~1Ttexoffset: #<vector @ #x~X>~%" (-> obj texoffset))
(format #t "~1Ttexscale: #<vector @ #x~X>~%" (-> obj texscale))
(format #t "~1Tclrs[2] @ #x~X~%" (-> obj clrs))
(label cfg-4)
obj
)
;; definition for symbol *shadow-vu1-data*, type shadow-vu1-data
(define *shadow-vu1-data* (new 'static 'shadow-vu1-data
:adgif (new 'static 'gs-gif-tag
:tag (new 'static 'gif-tag64 :nloop #x1 :nreg #x1)
:regs (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d))
)
:ad (new 'static 'gs-adcmd :cmds (gs-reg64 texflush))
:flush (new 'static 'gs-adcmd :cmds (gs-reg64 rgbaq) :y #x3f800000)
:trigif (new 'static 'gs-gif-tag
:tag (new 'static 'gif-tag64
:nloop #x1
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type tri-fan) :tme #x1)
:nreg #x7
)
:regs (new 'static 'gif-tag-regs
:regs0 (gif-reg-id rgbaq)
:regs1 (gif-reg-id st)
:regs2 (gif-reg-id xyzf2)
:regs3 (gif-reg-id st)
:regs4 (gif-reg-id xyzf2)
:regs5 (gif-reg-id st)
:regs6 (gif-reg-id xyzf2)
)
)
:quadgif (new 'static 'gs-gif-tag
:tag (new 'static 'gif-tag64
:nloop #x1
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type tri-fan) :tme #x1)
:nreg #x9
)
:regs (new 'static 'gif-tag-regs
:regs0 (gif-reg-id rgbaq)
:regs1 (gif-reg-id st)
:regs2 (gif-reg-id xyzf2)
:regs3 (gif-reg-id st)
:regs4 (gif-reg-id xyzf2)
:regs5 (gif-reg-id st)
:regs6 (gif-reg-id xyzf2)
:regs7 (gif-reg-id st)
:regs8 (gif-reg-id xyzf2)
)
)
:texoffset (new 'static 'vector :x 256.5 :y 208.5)
:texscale (new 'static 'vector :x 0.001953125 :y 0.001953125)
:clrs (new 'static 'inline-array qword 2
(new 'static 'qword :data (new 'static 'array uint32 4 #x80 #x0 #x0 #x82))
(new 'static 'qword :data (new 'static 'array uint32 4 #x0 #x80 #x0 #x7f))
)
)
)
;; definition for symbol shadow-vu1-block, type vu-function
(define shadow-vu1-block (new 'static 'vu-function :length #x2e9 :qlength #x175))
;; definition for function shadow-vu1-add-constants
;; INFO: Used lq/sq
;; WARN: Return type mismatch dma-buffer vs none.
(defun shadow-vu1-add-constants ((arg0 dma-buffer) (arg1 int))
(let* ((a3-0 13)
(v1-0 arg0)
(a2-0 (the-as object (-> v1-0 base)))
)
(set! (-> (the-as dma-packet a2-0) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc a3-0))
(set! (-> (the-as dma-packet a2-0) vif0) (new 'static 'vif-tag :imm #x404 :cmd (vif-cmd stcycl)))
(set! (-> (the-as dma-packet a2-0) vif1)
(new 'static 'vif-tag :imm #x370 :cmd (vif-cmd unpack-v4-32) :num a3-0)
)
(set! (-> v1-0 base) (the-as pointer (&+ (the-as dma-packet a2-0) 16)))
)
(let ((v1-1 (the-as object (-> arg0 base))))
(let ((a3-4 *math-camera*)
(a2-2 *shadow-vu1-data*)
)
(set! (-> (the-as shadow-vu1-constants v1-1) hmgescale quad) (-> a3-4 hmge-scale quad))
(set! (-> (the-as shadow-vu1-constants v1-1) invhscale quad) (-> a3-4 inv-hmge-scale quad))
(set! (-> (the-as shadow-vu1-constants v1-1) hvdfoff quad) (-> a3-4 hvdf-off quad))
(set! (-> (the-as shadow-vu1-constants v1-1) hvdfoff x) 2048.0)
(set! (-> (the-as shadow-vu1-constants v1-1) hvdfoff y) 2048.0)
(set! (-> (the-as shadow-vu1-constants v1-1) fog x) (-> a3-4 pfog0))
(set! (-> (the-as shadow-vu1-constants v1-1) clrs 0 quad) (-> a2-2 clrs 0 quad))
(set! (-> (the-as shadow-vu1-constants v1-1) clrs 1 quad) (-> a2-2 clrs 1 quad))
(set! (-> (the-as shadow-vu1-constants v1-1) texoffset quad) (-> a2-2 texoffset quad))
(set! (-> (the-as shadow-vu1-constants v1-1) texscale quad) (-> a2-2 texscale quad))
(set! (-> (the-as shadow-vu1-constants v1-1) adgif qword) (-> a2-2 adgif qword))
(set! (-> (the-as shadow-vu1-constants v1-1) texflush quad) (-> a2-2 ad quad))
(set! (-> (the-as shadow-vu1-constants v1-1) flush quad) (-> a2-2 flush quad))
(set! (-> (the-as shadow-vu1-constants v1-1) trigif qword) (-> a2-2 trigif qword))
(set! (-> (the-as shadow-vu1-constants v1-1) quadgif qword) (-> a2-2 quadgif qword))
)
(set! (-> *shadow-globals* bucket arg1 constants) (the-as shadow-vu1-constants v1-1))
)
(&+! (-> arg0 base) 208)
(let* ((v1-4 arg0)
(a1-3 (the-as object (-> v1-4 base)))
)
(set! (-> (the-as dma-packet a1-3) dma) (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a1-3) vif0) (new 'static 'vif-tag :imm #x404 :cmd (vif-cmd stcycl)))
(set! (-> (the-as dma-packet a1-3) vif1)
(new 'static 'vif-tag :imm #x3ac :num #x4 :cmd (vif-cmd unpack-v4-32))
)
(set! (-> v1-4 base) (&+ (the-as pointer a1-3) 16))
)
(let* ((v1-5 arg0)
(a1-5 (the-as object (-> v1-5 base)))
)
(set! (-> (the-as shadow-vu1-data a1-5) adgif tag) (new 'static 'gif-tag64 :nloop #x1 :nreg #x2))
(set! (-> (the-as shadow-vu1-data a1-5) adgif regs)
(new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d) :regs1 (gif-reg-id rgbaq))
)
(set! (-> (the-as shadow-vu1-data a1-5) ad data) (the-as uint 0))
(set! (-> (the-as shadow-vu1-data a1-5) ad cmds) (gs-reg64 texflush))
(set! (-> (the-as shadow-vu1-data a1-5) flush data) (the-as uint 0))
(set! (-> (the-as shadow-vu1-data a1-5) flush cmds) (gs-reg64 prim))
(set! (-> (the-as shadow-vu1-data a1-5) trigif tag)
(new 'static 'gif-tag64
:nloop #x3
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type tri-fan) :tme #x1)
:nreg #x2
)
)
(set! (-> (the-as shadow-vu1-data a1-5) trigif regs)
(new 'static 'gif-tag-regs :regs0 (gif-reg-id st) :regs1 (gif-reg-id xyzf2))
)
(set! (-> v1-5 base) (&+ (the-as pointer a1-5) 64))
)
(none)
)
;; definition for function shadow-vu1-patch-consts
;; WARN: Return type mismatch int vs none.
(defun shadow-vu1-patch-consts ((arg0 symbol) (arg1 int))
(let ((v1-2 (-> *shadow-globals* bucket arg1 constants)))
(cond
(arg0
(set! (-> v1-2 hvdfoff z) (- 1.0 (-> v1-2 hvdfoff z)))
(set! (-> v1-2 fog w) -1.0)
)
(else
(set! (-> v1-2 fog w) 1.0)
)
)
)
0
(none)
)
;; definition for function shadow-vu1-add-matrix
;; INFO: Used lq/sq
;; WARN: Return type mismatch dma-buffer vs none.
(defun shadow-vu1-add-matrix ((arg0 dma-buffer) (arg1 math-camera))
(let ((v1-0 4))
(let* ((a2-4 arg0)
(a3-0 (the-as object (-> a2-4 base)))
)
(set! (-> (the-as dma-packet a3-0) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc v1-0))
(set! (-> (the-as dma-packet a3-0) vif0) (new 'static 'vif-tag :imm #x404 :cmd (vif-cmd stcycl)))
(set! (-> (the-as dma-packet a3-0) vif1) (new 'static 'vif-tag :cmd (vif-cmd unpack-v4-32) :num v1-0))
(set! (-> a2-4 base) (&+ (the-as pointer a3-0) 16))
)
)
(let ((v1-5 (the-as object (-> arg0 base))))
(let ((a2-5 (-> arg1 perspective quad 0))
(a3-1 (-> arg1 perspective quad 1))
(t0-4 (-> arg1 perspective quad 2))
(a1-1 (-> arg1 perspective trans quad))
)
(set! (-> (the-as matrix v1-5) quad 0) a2-5)
(set! (-> (the-as matrix v1-5) quad 1) a3-1)
(set! (-> (the-as matrix v1-5) quad 2) t0-4)
(set! (-> (the-as matrix v1-5) trans quad) a1-1)
)
(set! (-> arg0 base) (&+ (the-as pointer v1-5) 64))
)
(none)
)
;; definition for function shadow-vu1-init-buffer
;; WARN: Return type mismatch dma-buffer vs none.
(defun shadow-vu1-init-buffer ((arg0 dma-buffer) (arg1 int))
(dma-buffer-add-vu-function arg0 shadow-vu1-block 1)
(shadow-vu1-add-constants arg0 arg1)
(shadow-vu1-add-matrix arg0 *math-camera*)
(let* ((v1-0 arg0)
(a0-4 (the-as object (-> v1-0 base)))
)
(set! (-> (the-as dma-packet a0-4) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a0-4) vif0) (new 'static 'vif-tag :cmd (vif-cmd mscalf) :msk #x1 :imm #xa))
(set! (-> (the-as dma-packet a0-4) vif1) (new 'static 'vif-tag :cmd (vif-cmd flushe) :msk #x1))
(set! (-> v1-0 base) (&+ (the-as pointer a0-4) 16))
)
(none)
)