jak-project/test/decompiler/reference/engine/dma/dma-disasm_REF.gc
water111 dbc266c00b
New Pretty Printer (#994)
* begin work on improved pretty printer

* update ref

* finish pretty printer

* force line break for defstate
2021-12-04 16:06:01 -05:00

727 lines
24 KiB
Common Lisp
Vendored
Generated

;;-*-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
:type vif-disasm-element :length 34 :allocated-length 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~%"
(+ (+ (* i 4) 4) (the-as int data))
(-> data-ptr (* i 4))
(-> data-ptr (+ (* i 4) 1))
(-> data-ptr (+ (* i 4) 2))
(-> data-ptr (+ (* i 4) 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)
(-> s3-1 (* 3 s2-1))
(-> 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~%"
(+ (+ (* s2-2 16) 4) (the-as int data))
(-> s3-2 (* s2-2 4))
(-> s3-2 (+ (* s2-2 4) 1))
(-> s3-2 (+ (* s2-2 4) 2))
(-> s3-2 (+ (* s2-2 4) 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~%"
(+ (+ (* s2-3 8) 4) (the-as int data))
(-> s3-3 (* s2-3 4))
(-> s3-3 (+ (* s2-3 4) 1))
(-> s3-3 (+ (* s2-3 4) 2))
(-> s3-3 (+ (* s2-3 4) 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~%"
(+ (+ (* s2-6 4) 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 (* words 4))
(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 (-> *vif-disasm-table* cmd-template-idx mask)) (-> *vif-disasm-table* cmd-template-idx tag))
(let ((print-kind (-> *vif-disasm-table* cmd-template-idx print)))
(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 (* (-> first-tag imm) 16)))
)
(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~%"
(+ (+ (* data-idx 16) 4) (the-as int data))
(-> data-ptr (* data-idx 4))
(-> data-ptr (+ (* data-idx 4) 1))
(-> data-ptr (+ (* data-idx 4) 2))
(-> data-ptr (+ (* data-idx 4) 3))
)
(set! data-idx (+ data-idx 1))
)
#f
)
((= print-kind 7)
(set! packet-size
(the-as int (+ (logand -4 (+ (* (-> *vif-disasm-table* cmd-template-idx val) (-> 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 (* words 4))
)
)
;; 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"
)
((= v1-1 (dma-tag-id refe))
"refe"
)
(else
"*unknown*"
)
)
)
)
(if (> (-> arg0 addr) 0)
(format arg1 " :addr #x~8x" (-> arg0 addr))
)
(if (> (-> arg0 qwc) 0)
(format arg1 " :qwc ~d" (-> arg0 qwc))
)
(if (> (-> arg0 spr) 0)
(format arg1 " :spr ~d" (-> arg0 spr))
)
(if (> (-> arg0 irq) 0)
(format arg1 " :irq ~d" (-> arg0 irq))
)
(if (> (-> 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 (logtest? (the-as dma-tag #x3ff0000) 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)
)
(cond
(end-condition
)
((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)))
(when mode-2
(let ((v0-10 (disasm-vif-tag (&-> data-2 vif0) 2 stream-2 (= mode-2 'details))))
(disasm-vif-tag
(the-as (pointer vif-tag) (+ addr v0-10))
(the-as int (- (* qwc 4) (the-as uint (/ v0-10 4))))
stream-2
(= mode-2 'details)
)
)
)
(set! data-2 (the-as dma-packet (&-> (the-as (pointer uint64) data-2) 2)))
(if (= (-> current-tag id) (dma-tag-id refe))
(set! end-condition #t)
)
)
((= (-> 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 (+ (* qwc 4) 2))
stream-2
(= mode-2 'details)
)
)
(set! data-2 (the-as dma-packet (+ (the-as uint data-2) (* (+ qwc 1) 16))))
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 (+ (* qwc 4) 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)))
data-2
)
((= (-> 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 (+ (* qwc 4) 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))
(the-as (pointer uint64) ra-1)
)
(else
(set! ra-2 (&+ addr qwc))
(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 (+ (* qwc 4) 2))
stream-2
(= mode-2 'details)
)
)
(let ((v1-123 call-depth))
(cond
((zero? v1-123)
(set! data-2 (the-as dma-packet ra-1))
data-2
)
((= v1-123 1)
(set! data-2 (the-as dma-packet ra-2))
data-2
)
(else
(set! end-condition #t)
)
)
)
(set! call-depth (+ call-depth -1))
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)
(if mode-2
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) data-2) 1))
(the-as int (+ (* qwc 4) 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)
)
)
)
)