mirror of
https://github.com/open-goal/jak-project
synced 2026-07-05 05:40:00 -04:00
ManDude
821 lines
35 KiB
Common Lisp
821 lines
35 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: shadow-cpu.gc
|
|
;; name in dgo: shadow-cpu
|
|
;; dgos: ENGINE, GAME
|
|
|
|
(define-extern shadow-vu1-patch-consts (function symbol int none))
|
|
(define-extern shadow-vu1-init-buffer (function dma-buffer int none))
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; WARN: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this shadow-geo))
|
|
(the-as int (* (-> this total-qwc) 16))
|
|
)
|
|
|
|
(defmethod mem-usage ((this 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 (* (-> this total-qwc) 16)))
|
|
(+! (-> arg0 data 110 used) v1-6)
|
|
(+! (-> arg0 data 110 total) (logand -16 (+ v1-6 15)))
|
|
)
|
|
this
|
|
)
|
|
|
|
(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))
|
|
)
|
|
)
|
|
|
|
(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)
|
|
)
|
|
|
|
;; 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)
|
|
)
|
|
|
|
(shadow-make-invert-buf)
|
|
|
|
(define *shadow-dma-invert-call* (the-as pointer #f))
|
|
|
|
;; 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)
|
|
)
|
|
|
|
;; 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)
|
|
)
|
|
|
|
(deftype shadow-stats (structure)
|
|
((num-single-tris uint32)
|
|
(num-double-tris uint32)
|
|
(num-single-edges uint32)
|
|
(num-double-edges uint32)
|
|
(num-fragments uint16)
|
|
(num-objects uint16)
|
|
)
|
|
)
|
|
|
|
|
|
(deftype shadow-dcache (structure)
|
|
((vtx-table uint32)
|
|
(single-edge-table uint32)
|
|
(double-edge-table uint32)
|
|
(double-tri-table uint32)
|
|
(dcache-top uint32)
|
|
(num-facing-single-tris uint32)
|
|
(num-single-edges uint32)
|
|
(num-double-edges uint32)
|
|
(single-tri-list uint32)
|
|
(single-edge-list uint32)
|
|
(double-edge-list uint32)
|
|
(ptr-dual-verts uint32)
|
|
(stats shadow-stats :inline)
|
|
(frag-qwc uint32)
|
|
(center vector :inline)
|
|
(plane vector :inline)
|
|
(top-plane vector :inline)
|
|
(near-plane vector :inline)
|
|
(light-dir vector :inline)
|
|
(vtx-min vector :inline)
|
|
(data uint8 :dynamic)
|
|
)
|
|
)
|
|
|
|
|
|
(define shadow-vu0-block (new 'static 'vu-function :length 88 :qlength 44))
|
|
|
|
(def-mips2c shadow-xform-verts function)
|
|
|
|
(def-mips2c shadow-calc-dual-verts function)
|
|
|
|
(def-mips2c shadow-scissor-edges function)
|
|
|
|
(def-mips2c shadow-scissor-top function)
|
|
|
|
(def-mips2c shadow-init-vars function)
|
|
|
|
(def-mips2c shadow-find-facing-single-tris function)
|
|
|
|
(def-mips2c shadow-find-single-edges function)
|
|
|
|
(def-mips2c shadow-find-facing-double-tris function)
|
|
|
|
(def-mips2c shadow-find-double-edges function)
|
|
|
|
(def-mips2c shadow-add-verts function)
|
|
|
|
(def-mips2c shadow-add-facing-single-tris function)
|
|
|
|
(def-mips2c shadow-add-single-edges function)
|
|
|
|
(def-mips2c shadow-add-single-tris function)
|
|
|
|
(def-mips2c shadow-add-double-tris function)
|
|
|
|
(def-mips2c shadow-add-double-edges function)
|
|
|
|
(defmethod shadow-control-method-14 ((this shadow-control) (arg0 vector) (arg1 vector) (arg2 float) (arg3 float) (arg4 float))
|
|
(let ((gp-0 (-> this 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)
|
|
)
|
|
|
|
;; WARN: Return type mismatch symbol vs none.
|
|
(defun debug-draw-settings ((arg0 shadow-settings))
|
|
(let ((v1-0 (-> arg0 shadow-dir))
|
|
(a2-0 (-> arg0 center))
|
|
(s5-0 (-> arg0 top-plane))
|
|
(s4-0 (-> arg0 bot-plane))
|
|
(s3-0 (new 'stack-no-clear 'vector))
|
|
(s2-0 (new 'stack-no-clear 'vector))
|
|
)
|
|
(cond
|
|
((logtest? (-> arg0 flags) (shadow-flags shdf02))
|
|
(vector+float*! s3-0 a2-0 v1-0 (- (vector-dot (the-as vector s5-0) a2-0) (-> s5-0 w)))
|
|
(vector+float*! s2-0 a2-0 v1-0 (- (vector-dot (the-as vector s4-0) a2-0) (-> s4-0 w)))
|
|
)
|
|
(else
|
|
(let ((a0-8 (vector+float*! (new 'stack-no-clear 'vector) a2-0 v1-0 (-> v1-0 w))))
|
|
(vector+float*! s3-0 a0-8 v1-0 (- (vector-dot (the-as vector s5-0) a0-8) (-> s5-0 w)))
|
|
(vector+float*! s2-0 a0-8 v1-0 (- (vector-dot (the-as vector s4-0) a0-8) (-> s4-0 w)))
|
|
)
|
|
)
|
|
)
|
|
(add-debug-sphere #t (bucket-id debug-no-zbuf1) 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) (-> arg0 center) 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))
|
|
)
|
|
)
|
|
|
|
(def-mips2c shadow-execute (function shadow-dma-packet pointer pointer))
|
|
|
|
;; ERROR: Failed store: (s.d! (+ (the-as dma-packet a0-5) 8) 0) at op 17
|
|
(defun shadow-vu0-upload ()
|
|
(#unless PC_PORT
|
|
(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)
|
|
)
|
|
|
|
;; 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)
|
|
(set! (-> v1-24 dcache-top) (the-as uint 0))
|
|
)
|
|
0
|
|
(let ((v1-26 #f))
|
|
(dotimes (a0-10 2)
|
|
(if (nonzero? (-> gp-1 bucket a0-10 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! (-> (scratchpad-object shadow-dcache) 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? (-> (scratchpad-object shadow-dcache) ptr-dual-verts))))
|
|
(let ((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)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
;; modified in pc port so we don't have to do the crazy z buffer flipping stuff.
|
|
(shadow-dma-end s3-1 (the-as gs-rgbaq a1-9) #f #|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) ;; manually patched
|
|
(+ (* (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)
|
|
)
|
|
|
|
(defmethod probe-line-for-shadow ((this 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))
|
|
(+! (-> s4-0 start-pos y) 4096.0)
|
|
(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 this))
|
|
(logclear! (-> v1-5 settings flags) (shadow-flags disable-draw))
|
|
)
|
|
0
|
|
(let ((v1-7 this))
|
|
(set! (-> v1-7 settings bot-plane w) (- (+ (-> s4-0 best-other-tri intersect y) arg1)))
|
|
)
|
|
0
|
|
(set! (-> this settings top-plane w) (- (+ (-> s4-0 best-other-tri intersect y) arg2)))
|
|
0
|
|
)
|
|
(else
|
|
(let ((v1-10 this))
|
|
(logior! (-> v1-10 settings flags) (shadow-flags disable-draw))
|
|
)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
)
|