mirror of
https://github.com/open-goal/jak-project
synced 2026-05-31 17:32:51 -04:00
3d2ca71fe3
* update stuff * gs reference added * update config
918 lines
26 KiB
Common Lisp
918 lines
26 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; this file is debug only
|
|
(when *debug-segment*
|
|
;; definition of type vif-disasm-element
|
|
(deftype vif-disasm-element (structure)
|
|
((mask uint32 :offset-assert 0)
|
|
(tag vif-cmd-32 :offset-assert 4)
|
|
(val uint32 :offset-assert 8)
|
|
(print uint32 :offset-assert 12)
|
|
(string1 string :offset-assert 16)
|
|
(string2 string :offset-assert 20)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x18
|
|
:flag-assert #x900000018
|
|
)
|
|
|
|
;; definition for method 3 of type vif-disasm-element
|
|
(defmethod inspect vif-disasm-element ((obj vif-disasm-element))
|
|
(format #t "[~8x] ~A~%" obj 'vif-disasm-element)
|
|
(format #t "~Tmask: ~D~%" (-> obj mask))
|
|
(format #t "~Ttag: ~D~%" (-> obj tag))
|
|
(format #t "~Tval: ~D~%" (-> obj val))
|
|
(format #t "~Tprint: ~D~%" (-> obj print))
|
|
(format #t "~Tstring1: ~A~%" (-> obj string1))
|
|
(format #t "~Tstring2: ~A~%" (-> obj string2))
|
|
obj
|
|
)
|
|
|
|
;; definition for symbol *vif-disasm-table*, type (array vif-disasm-element)
|
|
(define
|
|
*vif-disasm-table*
|
|
(the-as (array vif-disasm-element)
|
|
(new
|
|
'static
|
|
'boxed-array
|
|
vif-disasm-element
|
|
34
|
|
(new 'static 'vif-disasm-element :mask #x7f :string1 "nop")
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 stcycl)
|
|
:print #x2
|
|
:string1 "stcycl"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 offset)
|
|
:print #x1
|
|
:string1 "offset"
|
|
:string2 "offset"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 base)
|
|
:print #x1
|
|
:string1 "base"
|
|
:string2 "base"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 itop)
|
|
:print #x1
|
|
:string1 "itop"
|
|
:string2 "addr"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 stmod)
|
|
:print #x1
|
|
:string1 "stmod"
|
|
:string2 "mode"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 mskpath3)
|
|
:print #x1
|
|
:string1 "mskpath3"
|
|
:string2 "mask"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 mark)
|
|
:print #x1
|
|
:string1 "mark"
|
|
:string2 "mark"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 flushe)
|
|
:string1 "flushe"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 flush)
|
|
:string1 "flush"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 flusha)
|
|
:string1 "flusha"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 mscal)
|
|
:print #x1
|
|
:string1 "mscal"
|
|
:string2 "addr"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 mscnt)
|
|
:string1 "mscnt"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 mscalf)
|
|
:print #x1
|
|
:string1 "mscalf"
|
|
:string2 "addr"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 stmask)
|
|
:print #x3
|
|
:string1 "stmask"
|
|
:string2 "mask"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 strow)
|
|
:print #x4
|
|
:string1 "strow"
|
|
:string2 "row"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 stcol)
|
|
:print #x4
|
|
:string1 "stcol"
|
|
:string2 "col"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 mpg)
|
|
:print #x5
|
|
:string1 "mpg"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 direct)
|
|
:print #x6
|
|
:string1 "direct"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x7f
|
|
:tag (vif-cmd-32 directhl)
|
|
:print #x6
|
|
:string1 "directhl"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-s-32)
|
|
:val #x10
|
|
:print #x7
|
|
:string1 "unpack-s-32"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-s-16)
|
|
:val #x8
|
|
:print #x7
|
|
:string1 "unpack-s-16"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-s-8)
|
|
:val #x4
|
|
:print #x7
|
|
:string1 "unpack-s-8"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v2-32)
|
|
:val #x8
|
|
:print #x7
|
|
:string1 "unpack-v2-32"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v2-16)
|
|
:val #x4
|
|
:print #x7
|
|
:string1 "unpack-v2-16"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v2-8)
|
|
:val #x2
|
|
:print #x7
|
|
:string1 "unpack-v2-8"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v3-32)
|
|
:val #xc
|
|
:print #x7
|
|
:string1 "unpack-v3-32"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v3-16)
|
|
:val #x6
|
|
:print #x7
|
|
:string1 "unpack-v3-16"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v3-8)
|
|
:val #x3
|
|
:print #x7
|
|
:string1 "unpack-v3-8"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v4-32)
|
|
:val #x10
|
|
:print #x7
|
|
:string1 "unpack-v4-32"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v4-16)
|
|
:val #x8
|
|
:print #x7
|
|
:string1 "unpack-v4-16"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v4-8)
|
|
:val #x4
|
|
:print #x7
|
|
:string1 "unpack-v4-8"
|
|
)
|
|
(new 'static 'vif-disasm-element
|
|
:mask #x6f
|
|
:tag (vif-cmd-32 unpack-v4-5)
|
|
:val #x2
|
|
:print #x7
|
|
:string1 "unpack-v4-5"
|
|
)
|
|
(new 'static 'vif-disasm-element :print #x8)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function disasm-vif-details
|
|
(defun
|
|
disasm-vif-details
|
|
((stream symbol) (data (pointer uint8)) (kind vif-cmd) (count int))
|
|
(let ((count2 count))
|
|
(cond
|
|
((= kind (vif-cmd unpack-v4-8))
|
|
(let ((data-ptr (&-> data 4)))
|
|
(dotimes (i count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~2X #x~2X #x~2X #x~2X~%"
|
|
(+ (+ (shl i 2) 4) (the-as int data))
|
|
(-> data-ptr (shl i 2))
|
|
(-> data-ptr (+ (shl i 2) 1))
|
|
(-> data-ptr (+ (shl i 2) 2))
|
|
(-> data-ptr (+ (shl i 2) 3))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= kind (vif-cmd unpack-s-8))
|
|
(let ((s3-1 (&-> data 4)))
|
|
(dotimes (s2-1 count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~2x~%"
|
|
(+ (+ s2-1 4) (the-as int data))
|
|
count
|
|
)
|
|
(let ((v1-21 (-> s3-1 (* 3 s2-1))))
|
|
)
|
|
(let ((v1-26 (-> s3-1 (+ (* 3 s2-1) 1))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= kind (vif-cmd unpack-v4-32))
|
|
(let ((s3-2 (the-as (pointer uint32) (&-> data 4))))
|
|
(dotimes (s2-2 count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~8x #x~8x #x~8x #x~8x~%"
|
|
(+ (+ (shl s2-2 4) 4) (the-as int data))
|
|
(-> s3-2 (shl s2-2 2))
|
|
(-> s3-2 (+ (shl s2-2 2) 1))
|
|
(-> s3-2 (+ (shl s2-2 2) 2))
|
|
(-> s3-2 (+ (shl s2-2 2) 3))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= kind (vif-cmd unpack-v4-16))
|
|
(let ((s3-3 (the-as (pointer uint16) (&-> data 4))))
|
|
(dotimes (s2-3 count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~4x #x~4x #x~4x #x~4x~%"
|
|
(+ (+ (shl s2-3 3) 4) (the-as int data))
|
|
(-> s3-3 (shl s2-3 2))
|
|
(-> s3-3 (+ (shl s2-3 2) 1))
|
|
(-> s3-3 (+ (shl s2-3 2) 2))
|
|
(-> s3-3 (+ (shl s2-3 2) 3))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= kind (vif-cmd unpack-v3-32))
|
|
(let ((s3-4 (the-as (pointer uint32) (&-> data 4))))
|
|
(dotimes (s2-4 count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~8x #x~8x #x~8x~%"
|
|
(+ (+ (* 12 s2-4) 4) (the-as int data))
|
|
(-> (&+ s3-4 (* 12 s2-4)) 0)
|
|
(-> s3-4 (+ (* 3 s2-4) 1))
|
|
(-> s3-4 (+ (* 3 s2-4) 2))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= kind (vif-cmd unpack-v3-16))
|
|
(let ((s3-5 (the-as (pointer uint16) (&-> data 4))))
|
|
(dotimes (s2-5 count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~4x #x~4x #x~4x~%"
|
|
(+ (+ (* 6 s2-5) 4) (the-as int data))
|
|
(-> (&+ s3-5 (* 6 s2-5)) 0)
|
|
(-> s3-5 (+ (* 3 s2-5) 1))
|
|
(-> s3-5 (+ (* 3 s2-5) 2))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= kind (vif-cmd unpack-v2-16))
|
|
(let ((s3-6 (the-as (pointer uint16) (&-> data 4))))
|
|
(dotimes (s2-6 count2)
|
|
(format
|
|
stream
|
|
" #x~X: #x~4x #x~4x~%"
|
|
(+ (+ (shl s2-6 2) 4) (the-as int data))
|
|
(-> (&+ s3-6 (* 6 s2-6)) 0)
|
|
(-> s3-6 (+ (* 3 s2-6) 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(format
|
|
stream
|
|
" #x~X: Data format #b~b not yet supported, add it for yourself!~%"
|
|
(&-> data 4)
|
|
kind
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for function disasm-vif-tag
|
|
;; Used lq/sq
|
|
(defun
|
|
disasm-vif-tag
|
|
((data (pointer vif-tag)) (words int) (stream symbol) (details symbol))
|
|
(local-vars
|
|
(cmd vif-cmd)
|
|
(data-ptr (pointer vif-tag))
|
|
(data-idx int)
|
|
(unpack-imm vif-unpack-imm)
|
|
)
|
|
(let ((byte-idx 0))
|
|
(while (< byte-idx (shl words 2))
|
|
(let ((packet-size 4))
|
|
(let ((first-tag (-> data 0)))
|
|
(format stream " #x~X:" data)
|
|
(dotimes (cmd-template-idx (-> *vif-disasm-table* length))
|
|
(set! cmd (-> first-tag cmd))
|
|
(when
|
|
(=
|
|
(logand
|
|
cmd
|
|
(the-as uint (-> *vif-disasm-table* cmd-template-idx mask))
|
|
)
|
|
(-> *vif-disasm-table* cmd-template-idx tag)
|
|
)
|
|
(let* ((print-kind (-> *vif-disasm-table* cmd-template-idx print))
|
|
(v0-1 (cond
|
|
((zero? print-kind)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D)~%"
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
)
|
|
)
|
|
((= print-kind 1)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :~s #x~X)~%"
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> *vif-disasm-table* cmd-template-idx string2)
|
|
(-> first-tag imm)
|
|
)
|
|
)
|
|
((= print-kind 2)
|
|
(let
|
|
((stcycl-imm (the-as vif-stcycl-imm (-> first-tag imm)))
|
|
)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :wl ~D :cl ~D)~%"
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> stcycl-imm wl)
|
|
(-> stcycl-imm cl)
|
|
)
|
|
)
|
|
)
|
|
((= print-kind 3)
|
|
(set! packet-size 8)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :~s #x~X)~%"
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> *vif-disasm-table* cmd-template-idx string2)
|
|
(-> data 1)
|
|
)
|
|
)
|
|
((= print-kind 4)
|
|
(set! packet-size 20)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :~s "
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> *vif-disasm-table* cmd-template-idx string2)
|
|
)
|
|
(format
|
|
stream
|
|
"#x~X #x~X #x~X #x~X)~%"
|
|
(-> data 1)
|
|
(-> data 2)
|
|
(-> data 3)
|
|
(-> data 4)
|
|
)
|
|
)
|
|
((= print-kind 5)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :instructions #x~D :addr #x~X)~%"
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> first-tag num)
|
|
(-> first-tag imm)
|
|
)
|
|
)
|
|
((= print-kind 6)
|
|
(if (-> first-tag imm)
|
|
(set! packet-size #x100000)
|
|
(set!
|
|
packet-size
|
|
(the-as int (shl (the-as int (-> first-tag imm)) 4))
|
|
)
|
|
)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :qwc #x~D)~%"
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> first-tag imm)
|
|
)
|
|
(set! data-ptr (&-> data 1))
|
|
(set! data-idx 0)
|
|
(while (< data-idx (the-as int (-> first-tag imm)))
|
|
(format
|
|
stream
|
|
" #x~X: #x~8x #x~8x #x~8x #x~8x~%"
|
|
(+ (+ (shl data-idx 4) 4) (the-as int data))
|
|
(-> data-ptr (shl data-idx 2))
|
|
(-> data-ptr (+ (shl data-idx 2) 1))
|
|
(-> data-ptr (+ (shl data-idx 2) 2))
|
|
(-> data-ptr (+ (shl data-idx 2) 3))
|
|
)
|
|
(set! data-idx (+ data-idx 1))
|
|
)
|
|
#f
|
|
)
|
|
((= print-kind 7)
|
|
(set!
|
|
packet-size
|
|
(the-as
|
|
int
|
|
(+
|
|
(logand
|
|
-4
|
|
(the-as
|
|
int
|
|
(+
|
|
(*
|
|
(-> *vif-disasm-table* cmd-template-idx val)
|
|
(the-as uint (-> first-tag num))
|
|
)
|
|
3
|
|
)
|
|
)
|
|
)
|
|
4
|
|
)
|
|
)
|
|
)
|
|
(set!
|
|
unpack-imm
|
|
(the-as vif-unpack-imm (-> first-tag imm))
|
|
)
|
|
(format
|
|
stream
|
|
" (~s :irq ~D :num ~D :addr #x~X "
|
|
(-> *vif-disasm-table* cmd-template-idx string1)
|
|
(-> first-tag irq)
|
|
(-> first-tag num)
|
|
(-> unpack-imm addr)
|
|
)
|
|
(format
|
|
stream
|
|
":msk ~D :flg ~D :usn ~D [skip ~d])~%"
|
|
(-> first-tag msk)
|
|
(-> unpack-imm flg)
|
|
(-> unpack-imm usn)
|
|
(the-as uint packet-size)
|
|
)
|
|
(if details
|
|
(disasm-vif-details
|
|
stream
|
|
(the-as (pointer uint8) data)
|
|
(logand cmd (vif-cmd cmd-mask))
|
|
(the-as int (-> first-tag num))
|
|
)
|
|
)
|
|
)
|
|
((= print-kind 8)
|
|
(format
|
|
stream
|
|
" (*unknown* vif-tag #x~X)~%"
|
|
(-> first-tag cmd)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! cmd-template-idx (-> *vif-disasm-table* length))
|
|
)
|
|
)
|
|
)
|
|
(+! byte-idx packet-size)
|
|
(&+! data packet-size)
|
|
)
|
|
)
|
|
(- byte-idx (shl words 2))
|
|
)
|
|
)
|
|
|
|
;; definition for function disasm-dma-tag
|
|
;; INFO: Return type mismatch object vs none.
|
|
(defun disasm-dma-tag ((arg0 dma-tag) (arg1 symbol))
|
|
(format arg1 "(dma-tag ")
|
|
(let ((t9-1 format)
|
|
(a0-2 arg1)
|
|
(a1-2 "~s")
|
|
(v1-1 (-> arg0 id))
|
|
)
|
|
(t9-1 a0-2 a1-2 (cond
|
|
((= v1-1 (dma-tag-id end))
|
|
"end"
|
|
)
|
|
((= v1-1 (dma-tag-id ret))
|
|
"ret"
|
|
)
|
|
((= v1-1 (dma-tag-id call))
|
|
"call"
|
|
)
|
|
((= v1-1 (dma-tag-id refs))
|
|
"refs"
|
|
)
|
|
((= v1-1 (dma-tag-id ref))
|
|
"ref"
|
|
)
|
|
((= v1-1 (dma-tag-id next))
|
|
"next"
|
|
)
|
|
((= v1-1 (dma-tag-id cnt))
|
|
"cnt"
|
|
)
|
|
((zero? v1-1)
|
|
"refe"
|
|
)
|
|
(else
|
|
"*unknown*"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(if (> (the-as uint (-> arg0 addr)) 0)
|
|
(format arg1 " :addr #x~8x" (-> arg0 addr))
|
|
)
|
|
(if (> (the-as uint (-> arg0 qwc)) 0)
|
|
(format arg1 " :qwc ~d" (-> arg0 qwc))
|
|
)
|
|
(if (> (the-as uint (-> arg0 spr)) 0)
|
|
(format arg1 " :spr ~d" (-> arg0 spr))
|
|
)
|
|
(if (> (the-as uint (-> arg0 irq)) 0)
|
|
(format arg1 " :irq ~d" (-> arg0 irq))
|
|
)
|
|
(if (> (the-as uint (-> arg0 pce)) 0)
|
|
(format arg1 " :pce ~d" (-> arg0 pce))
|
|
)
|
|
(format arg1 ")~%")
|
|
(none)
|
|
)
|
|
|
|
;; definition for symbol *dma-disasm*, type symbol
|
|
(define *dma-disasm* #t)
|
|
|
|
;; definition for function disasm-dma-list
|
|
;; WARN: Check prologue - tricky store of a0
|
|
;; Used lq/sq
|
|
(defun
|
|
disasm-dma-list
|
|
((data dma-packet)
|
|
(mode symbol)
|
|
(verbose symbol)
|
|
(stream symbol)
|
|
(expected-size int)
|
|
)
|
|
(local-vars
|
|
(addr object)
|
|
(data-2 dma-packet)
|
|
(qwc int)
|
|
(ra-1 object)
|
|
(ra-2 object)
|
|
(call-depth int)
|
|
(current-tag dma-tag)
|
|
)
|
|
(set! data-2 data)
|
|
(let ((mode-2 mode)
|
|
(verbose-2 verbose)
|
|
(stream-2 stream)
|
|
(expected-size-2 expected-size)
|
|
)
|
|
(if verbose-2
|
|
(format stream-2 "~%--- ~X -----------------------------~%" data-2)
|
|
)
|
|
(let ((end-condition #f))
|
|
(let ((total-qwc 0)
|
|
(total-tags 0)
|
|
)
|
|
(set! addr 0)
|
|
(set! qwc 0)
|
|
(set! ra-1 0)
|
|
(set! ra-2 1)
|
|
(set! call-depth -1)
|
|
(set! current-tag (new 'static 'dma-tag))
|
|
(while (not end-condition)
|
|
(cond
|
|
((not
|
|
(valid? data-2 (the-as type #f) "dma-list tag pointer" #t stream-2)
|
|
)
|
|
(format stream-2 "ERROR: dma-list tag pointer invalid~%")
|
|
(set! end-condition 'error)
|
|
)
|
|
(else
|
|
(set! current-tag (-> data-2 dma))
|
|
(when
|
|
(not
|
|
(or
|
|
(zero? total-tags)
|
|
(valid? addr (the-as type #f) "dma-list data pointer" #t stream-2)
|
|
)
|
|
)
|
|
(format stream-2 "ERROR: dma-list data pointer invalid~%")
|
|
(set! end-condition 'error)
|
|
)
|
|
(when (nonzero? (logand #x3ff0000 (the-as int current-tag)))
|
|
(format stream-2 "ERROR: dma tag has data in reserved bits ~X~%")
|
|
(set! end-condition 'error)
|
|
)
|
|
)
|
|
)
|
|
(when (or verbose-2 (= end-condition 'error))
|
|
(format stream-2 "#x~8x: " data-2)
|
|
(cond
|
|
((zero? call-depth)
|
|
(format stream-2 " ")
|
|
)
|
|
((= call-depth 1)
|
|
(format stream-2 " ")
|
|
)
|
|
)
|
|
(disasm-dma-tag current-tag stream-2)
|
|
)
|
|
(if end-condition
|
|
(empty-form)
|
|
(cond
|
|
((or
|
|
(= (-> current-tag id) (dma-tag-id ref))
|
|
(= (-> current-tag id) (dma-tag-id refs))
|
|
(zero? (-> current-tag id))
|
|
)
|
|
(set! addr (-> current-tag addr))
|
|
(set! qwc (the-as int (-> current-tag qwc)))
|
|
(if mode-2
|
|
(let
|
|
((v0-9
|
|
(disasm-vif-tag (&-> data-2 vif0) 2 stream-2 (= mode-2 'details))
|
|
)
|
|
)
|
|
(disasm-vif-tag
|
|
(the-as (pointer vif-tag) (+ (the-as uint addr) (the-as uint v0-9)))
|
|
(the-as int (- (shl (the-as int qwc) 2) (the-as uint (sar v0-9 2))))
|
|
stream-2
|
|
(= mode-2 'details)
|
|
)
|
|
)
|
|
)
|
|
(set!
|
|
data-2
|
|
(the-as dma-packet (&-> (the-as (pointer uint64) data-2) 2))
|
|
)
|
|
(if (zero? (-> current-tag id))
|
|
(set! end-condition #t)
|
|
)
|
|
)
|
|
(else
|
|
(cond
|
|
((= (-> current-tag id) (dma-tag-id cnt))
|
|
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
|
|
(set! qwc (the-as int (-> current-tag qwc)))
|
|
(if mode-2
|
|
(disasm-vif-tag
|
|
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) data-2) 1))
|
|
(the-as int (+ (shl (the-as int qwc) 2) 2))
|
|
stream-2
|
|
(= mode-2 'details)
|
|
)
|
|
)
|
|
(set!
|
|
data-2
|
|
(the-as
|
|
dma-packet
|
|
(+
|
|
(the-as uint data-2)
|
|
(the-as
|
|
uint
|
|
(shl (the-as int (+ (the-as uint qwc) (the-as uint 1))) 4)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(let ((v1-68 data-2))
|
|
)
|
|
)
|
|
((= (-> current-tag id) (dma-tag-id next))
|
|
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
|
|
(set! qwc (the-as int (-> current-tag qwc)))
|
|
(if mode-2
|
|
(disasm-vif-tag
|
|
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) data-2) 1))
|
|
(the-as int (+ (shl (the-as int qwc) 2) 2))
|
|
stream-2
|
|
(= mode-2 'details)
|
|
)
|
|
)
|
|
(when (= data-2 (-> current-tag addr))
|
|
(format stream-2 "ERROR: next tag creates infinite loop.~%")
|
|
(set! end-condition 'error)
|
|
)
|
|
(set! data-2 (the-as dma-packet (-> current-tag addr)))
|
|
(let ((v1-88 data-2))
|
|
)
|
|
)
|
|
(else
|
|
(cond
|
|
((= (-> current-tag id) (dma-tag-id call))
|
|
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
|
|
(set! qwc (the-as int (-> current-tag qwc)))
|
|
(if mode-2
|
|
(disasm-vif-tag
|
|
(the-as
|
|
(pointer vif-tag)
|
|
(&-> (the-as (pointer uint64) data-2) 1)
|
|
)
|
|
(the-as int (+ (shl (the-as int qwc) 2) 2))
|
|
stream-2
|
|
(= mode-2 'details)
|
|
)
|
|
)
|
|
(set! data-2 (the-as dma-packet (-> current-tag addr)))
|
|
(set! call-depth (+ call-depth 1))
|
|
(cond
|
|
((zero? call-depth)
|
|
(set! ra-1 (&+ addr qwc))
|
|
(let ((v1-108 (the-as (pointer uint64) ra-1)))
|
|
)
|
|
)
|
|
(else
|
|
(set! ra-2 (&+ addr qwc))
|
|
(let ((v1-111 (the-as (pointer uint64) ra-2)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= (-> current-tag id) (dma-tag-id ret))
|
|
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
|
|
(set! qwc (the-as int (-> current-tag qwc)))
|
|
(if mode-2
|
|
(disasm-vif-tag
|
|
(the-as
|
|
(pointer vif-tag)
|
|
(&-> (the-as (pointer uint64) data-2) 1)
|
|
)
|
|
(the-as int (+ (shl (the-as int qwc) 2) 2))
|
|
stream-2
|
|
(= mode-2 'details)
|
|
)
|
|
)
|
|
(let ((v1-123 call-depth))
|
|
(cond
|
|
((zero? v1-123)
|
|
(set! data-2 (the-as dma-packet ra-1))
|
|
(let ((v1-125 data-2))
|
|
)
|
|
)
|
|
((= v1-123 1)
|
|
(set! data-2 (the-as dma-packet ra-2))
|
|
(let ((v1-127 data-2))
|
|
)
|
|
)
|
|
(else
|
|
(set! end-condition #t)
|
|
)
|
|
)
|
|
)
|
|
(set! call-depth (+ call-depth -1))
|
|
(let ((v1-131 call-depth))
|
|
)
|
|
)
|
|
((= (-> current-tag id) (dma-tag-id end))
|
|
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
|
|
(set! qwc (the-as int (-> current-tag qwc)))
|
|
(set! end-condition #t)
|
|
(let ((v0-16 (if mode-2
|
|
(disasm-vif-tag
|
|
(the-as
|
|
(pointer vif-tag)
|
|
(&-> (the-as (pointer uint64) data-2) 1)
|
|
)
|
|
(the-as int (+ (shl (the-as int qwc) 2) 2))
|
|
stream-2
|
|
(= mode-2 'details)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(format stream-2 "ERROR: Unknown DMA TAG command.~%")
|
|
(set! end-condition 'error)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(+! total-qwc qwc)
|
|
(+! total-tags 1)
|
|
(if (and (>= expected-size-2 0) (>= total-tags expected-size-2))
|
|
(set! end-condition #t)
|
|
)
|
|
)
|
|
(when (or verbose-2 (= end-condition 'error))
|
|
(format stream-2 "NOTICE: Total tags: ~d~%" total-tags)
|
|
(format stream-2 "NOTICE: Total QWC: ~d~%" total-qwc)
|
|
(format stream-2 "--------------------------------~%~%")
|
|
)
|
|
)
|
|
(!= end-condition 'error)
|
|
)
|
|
)
|
|
)
|
|
|
|
)
|
|
|