mirror of
https://github.com/open-goal/jak-project
synced 2026-06-17 07:08:17 -04:00
water111
6227c6d6a8
also make jak 1 and jak 2 behave the same way, to reduce confusion. It wasn't too bad to update jak 1.
134 lines
5.4 KiB
Common Lisp
Vendored
Generated
134 lines
5.4 KiB
Common Lisp
Vendored
Generated
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; this file is debug only
|
|
(declare-file (debug))
|
|
(when *debug-segment*
|
|
;; definition of type gs-store-image-packet
|
|
(deftype gs-store-image-packet (structure)
|
|
((vifcode vif-tag 4 :offset-assert 0)
|
|
(giftag gif-tag :offset-assert 16)
|
|
(bitbltbuf gs-bitbltbuf :offset-assert 32)
|
|
(bitbltbuf-addr gs-reg64 :offset-assert 40)
|
|
(trxpos gs-trxpos :offset-assert 48)
|
|
(trxpos-addr gs-reg64 :offset-assert 56)
|
|
(trxreg gs-trxreg :offset-assert 64)
|
|
(trxreg-addr gs-reg64 :offset-assert 72)
|
|
(finish int64 :offset-assert 80)
|
|
(finish-addr gs-reg64 :offset-assert 88)
|
|
(trxdir gs-trxdir :offset-assert 96)
|
|
(trxdir-addr gs-reg64 :offset-assert 104)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x70
|
|
:flag-assert #x900000070
|
|
)
|
|
|
|
;; definition for method 3 of type gs-store-image-packet
|
|
;; INFO: Used lq/sq
|
|
(defmethod inspect gs-store-image-packet ((obj gs-store-image-packet))
|
|
(format #t "[~8x] ~A~%" obj 'gs-store-image-packet)
|
|
(format #t "~Tvifcode[4] @ #x~X~%" (-> obj vifcode))
|
|
(format #t "~Tgiftag: ~D~%" (-> obj giftag))
|
|
(format #t "~Tbitbltbuf: ~D~%" (-> obj bitbltbuf))
|
|
(format #t "~Tbitbltbuf-addr: ~D~%" (-> obj bitbltbuf-addr))
|
|
(format #t "~Ttrxpos: ~D~%" (-> obj trxpos))
|
|
(format #t "~Ttrxpos-addr: ~D~%" (-> obj trxpos-addr))
|
|
(format #t "~Ttrxreg: ~D~%" (-> obj trxreg))
|
|
(format #t "~Ttrxreg-addr: ~D~%" (-> obj trxreg-addr))
|
|
(format #t "~Tfinish: ~D~%" (-> obj finish))
|
|
(format #t "~Tfinish-addr: ~D~%" (-> obj finish-addr))
|
|
(format #t "~Ttrxdir: ~D~%" (-> obj trxdir))
|
|
(format #t "~Ttrxdir-addr: ~D~%" (-> obj trxdir-addr))
|
|
obj
|
|
)
|
|
|
|
;; definition for function gs-set-default-store-image
|
|
;; INFO: Used lq/sq
|
|
;; ERROR: Unsupported inline assembly instruction kind - [sync.l]
|
|
(defun gs-set-default-store-image ((packet gs-store-image-packet)
|
|
(src-fbp int)
|
|
(src-w int)
|
|
(src-psm int)
|
|
(ssax int)
|
|
(ssay int)
|
|
(rrw int)
|
|
(rrh int)
|
|
)
|
|
(set! (-> packet vifcode 0) (new 'static 'vif-tag))
|
|
(set! (-> packet vifcode 1) (new 'static 'vif-tag :imm #x8000 :cmd (vif-cmd mskpath3)))
|
|
(set! (-> packet vifcode 2) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
|
|
(set! (-> packet vifcode 3) (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1))
|
|
(set! (-> packet giftag) (the-as gif-tag (make-u128
|
|
(new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d))
|
|
(new 'static 'gif-tag64 :nloop #x5 :eop #x1 :nreg #x1)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> packet bitbltbuf) (new 'static 'gs-bitbltbuf :sbp src-fbp :sbw src-w :spsm src-psm))
|
|
(set! (-> packet bitbltbuf-addr) (gs-reg64 bitbltbuf))
|
|
(set! (-> packet trxpos) (new 'static 'gs-trxpos :ssax ssax :ssay ssay))
|
|
(set! (-> packet trxpos-addr) (gs-reg64 trxpos))
|
|
(set! (-> packet trxreg) (new 'static 'gs-trxreg :rrw rrw :rrh rrh))
|
|
(set! (-> packet trxreg-addr) (gs-reg64 trxreg))
|
|
(set! (-> packet finish) 0)
|
|
(set! (-> packet finish-addr) (gs-reg64 finish))
|
|
(set! (-> packet trxdir) (new 'static 'gs-trxdir :xdir #x1))
|
|
(set! (-> packet trxdir-addr) (gs-reg64 trxdir))
|
|
(.sync.l)
|
|
7
|
|
)
|
|
|
|
;; definition for function store-image
|
|
;; INFO: Used lq/sq
|
|
(defun store-image ((oddeven int))
|
|
(local-vars (ptr-1 (pointer uint128)) (y-idx int) (y-idx-2 int))
|
|
(let ((width 512)
|
|
(height (-> *video-parms* screen-sy))
|
|
(file (new 'debug 'file-stream "image.raw" 'write))
|
|
)
|
|
(let ((buff0 (the-as (array uint128) (new 'debug 'boxed-array uint128 (/ (* width height) 4)))))
|
|
(let ((buff1 (the-as (array uint128) (new 'debug 'boxed-array uint128 (/ (* width height) 4)))))
|
|
(let ((packet (new 'static 'gs-store-image-packet)))
|
|
(gs-set-default-store-image packet #x2800 (/ width 64) 0 0 0 width height)
|
|
(flush-cache 0)
|
|
(gs-store-image packet (-> buff0 data))
|
|
(sync-path 0 0)
|
|
(gs-set-default-store-image packet #x3000 (/ width 64) 0 0 0 width height)
|
|
(flush-cache 0)
|
|
(gs-store-image packet (-> buff1 data))
|
|
)
|
|
(sync-path 0 0)
|
|
(let ((ptr-0 (-> buff0 data)))
|
|
(set! ptr-1 (-> buff1 data))
|
|
(cond
|
|
((zero? oddeven)
|
|
(set! y-idx 0)
|
|
(while (< y-idx height)
|
|
(file-stream-write file (&+ ptr-0 (* y-idx (* width 4))) (the-as uint (* width 4)))
|
|
(file-stream-write file (&+ ptr-1 (* y-idx (* width 4))) (the-as uint (* width 4)))
|
|
(set! y-idx (+ y-idx 1))
|
|
)
|
|
)
|
|
(else
|
|
(set! y-idx-2 0)
|
|
(while (< y-idx-2 height)
|
|
(file-stream-write file (&+ ptr-1 (* y-idx-2 (* width 4))) (the-as uint (* width 4)))
|
|
(file-stream-write file (&+ ptr-0 (* y-idx-2 (* width 4))) (the-as uint (* width 4)))
|
|
(set! y-idx-2 (+ y-idx-2 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(format #t "oddeven = ~d~%" oddeven)
|
|
(delete buff1)
|
|
)
|
|
(delete buff0)
|
|
)
|
|
(file-stream-close file)
|
|
)
|
|
0
|
|
)
|
|
|
|
)
|