mirror of
https://github.com/open-goal/jak-project
synced 2026-08-20 14:24:45 -04:00
water111
259 lines
13 KiB
Common Lisp
259 lines
13 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/dma/dma.gc")
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; DMA buffers are linear write cursors over storage that will be submitted to a DMA channel.
|
|
;; Graphics buffers contain linked dma-buckets rather than one plain transfer.
|
|
|
|
;; The main display list uses a "chain transfer". In this mode, the DMA system reads dma-tags which
|
|
;; tell it what to transfer next. This can be used to construct linked lists of DMA data.
|
|
|
|
;; With tag transfer enabled, the first quadword can contain both a dma-tag and two peripheral
|
|
;; commands. A dma-packet overlays those views on the same 128 bits:
|
|
|
|
;; Ex:
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 32-bit vifcode ;; 32-bit vifcode ;; 64-bit dma-tag ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; The VIF commands are sent only when CHCR.TTE is enabled. Some packet modes use the second command
|
|
;; word for other data.
|
|
|
|
;; A dma-tag plus two vif-tags in a single quadword.
|
|
;; Most DMA stuff goes directly to the VIF, so this is the
|
|
;; most common.
|
|
(deftype dma-packet (structure)
|
|
((dma dma-tag)
|
|
(vif0 vif-tag)
|
|
(vif1 vif-tag)
|
|
(quad uint128 :overlay-at dma)))
|
|
|
|
;; Unused inline-array type for 16-byte packets.
|
|
(deftype dma-packet-array (inline-array-class) ())
|
|
|
|
;; Inline-array element stride.
|
|
(set! (-> dma-packet-array heap-base) (the-as uint 16))
|
|
|
|
;; For doing a dma -> vif -> gif (path 2) transfer.
|
|
(deftype dma-gif-packet (structure)
|
|
((dma-vif dma-packet :inline)
|
|
(gif uint64 2)
|
|
;; Named overlays make the two GIF-tag words directly addressable.
|
|
(gif0 uint64 :overlay-at (-> gif 0))
|
|
(gif1 uint64 :overlay-at (-> gif 1))
|
|
(quad uint128 2 :overlay-at (-> dma-vif dma))))
|
|
|
|
;; A dma-buffer owns a variable-sized payload. base is the next write location and end is the limit
|
|
;; used by callers that track remaining space. The byte overlay provides convenient dynamic access
|
|
;; to the payload beginning at data.
|
|
(deftype dma-buffer (basic)
|
|
((allocated-length int32) ;; payload capacity in bytes
|
|
(base pointer) ;; next unused payload byte
|
|
(end pointer) ;; caller-managed payload limit
|
|
(data uint64 1) ;; first payload storage
|
|
(data-buffer uint8 :dynamic :overlay-at (-> data 0)))
|
|
(:methods
|
|
(new (symbol type int) _type_)))
|
|
|
|
(defmethod new dma-buffer ((allocation symbol) (type-to-make type) (byte-capacity int))
|
|
"Allocate a dma-buffer with byte-capacity bytes of payload storage."
|
|
(let ((buffer (object-new allocation type-to-make (+ byte-capacity -4 (-> type-to-make size)))))
|
|
(set! (-> buffer base) (-> buffer data))
|
|
(set! (-> buffer allocated-length) byte-capacity)
|
|
buffer))
|
|
|
|
(defun dma-buffer-inplace-new ((buffer dma-buffer) (byte-capacity int))
|
|
"Initialize dma-buffer storage in place with byte-capacity bytes. The caller is responsible for
|
|
the object's type and end pointer."
|
|
(set! (-> buffer base) (-> buffer data))
|
|
(set! (-> buffer allocated-length) byte-capacity)
|
|
buffer)
|
|
|
|
(defmethod length ((this dma-buffer))
|
|
"Return the payload capacity in bytes."
|
|
(-> this allocated-length))
|
|
|
|
(defmethod asize-of ((this dma-buffer))
|
|
"Return the complete allocation size, including the dma-buffer header and payload."
|
|
(+ (-> this allocated-length) -4 (-> dma-buffer size)))
|
|
|
|
(defun dma-buffer-length ((buffer dma-buffer))
|
|
"Return the number of occupied quadwords, rounding a partial final quadword up."
|
|
(shr (+ (&- (-> buffer base) (the-as uint (-> buffer data))) 15) 4))
|
|
|
|
(defun dma-buffer-free ((buffer dma-buffer))
|
|
"Return the number of quadwords between the write cursor and end pointer, rounding a partial final
|
|
quadword up."
|
|
(shr (+ (&- (-> buffer end) (the-as uint (-> buffer base))) 15) 4))
|
|
|
|
(defmacro dma-buffer-add-base-type (buf pkt dma-type &rest body)
|
|
"Construct one fixed-size value at the write cursor, evaluate body, and advance past it."
|
|
(with-gensyms (dma-buf)
|
|
`(let* ((,dma-buf ,buf)
|
|
(,pkt (the-as ,dma-type (-> ,dma-buf base))))
|
|
,@body
|
|
(set! (-> ,dma-buf base) (&+ (the-as pointer ,pkt) (size-of ,dma-type))))))
|
|
|
|
(defmacro dma-buffer-add-base-data (buf data-type forms)
|
|
"Append forms as consecutive data-type values and advance the write cursor. Values are coerced
|
|
without runtime type checks."
|
|
(with-gensyms (dma-buf ptr)
|
|
`(let* ((,dma-buf ,buf)
|
|
(,ptr (the-as (pointer ,data-type) (-> ,dma-buf base))))
|
|
,@(apply-i (lambda (x i) `(set! (-> ,ptr ,i) (the-as ,data-type ,x))) forms)
|
|
(set! (-> ,dma-buf base) (&+ (the-as pointer ,ptr) (* ,(length forms) (size-of ,data-type)))))))
|
|
|
|
(defmacro dma-buffer-add-cnt-vif2 (buf qwc vif0 vif1)
|
|
"Append a CNT dma-packet. It transfers qwc quadwords following the tag, then continues after that
|
|
data; vif0 and vif1 occupy the tag-transfer command words."
|
|
(with-gensyms (pkt)
|
|
`(dma-buffer-add-base-type ,buf
|
|
,pkt
|
|
dma-packet
|
|
(set! (-> ,pkt dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc ,qwc))
|
|
(set! (-> ,pkt vif0) ,vif0)
|
|
(set! (-> ,pkt vif1) ,vif1))))
|
|
|
|
(defmacro dma-buffer-add-ref-vif2 (buf qwc addr vif0 vif1)
|
|
"Append a REF dma-packet. It transfers qwc quadwords from addr, then continues after the tag;
|
|
vif0 and vif1 occupy the tag-transfer command words."
|
|
(with-gensyms (pkt)
|
|
`(dma-buffer-add-base-type ,buf
|
|
,pkt
|
|
dma-packet
|
|
(set! (-> ,pkt dma) (new 'static 'dma-tag :id (dma-tag-id ref) :qwc ,qwc :addr (the-as int ,addr)))
|
|
(set! (-> ,pkt vif0) ,vif0)
|
|
(set! (-> ,pkt vif1) ,vif1))))
|
|
|
|
(defmacro dma-buffer-add-ret (buf)
|
|
"Append a RET dma-packet with two VIF no-ops."
|
|
(with-gensyms (pkt)
|
|
`(dma-buffer-add-base-type ,buf
|
|
,pkt
|
|
dma-packet
|
|
(set! (-> ,pkt dma) (new 'static 'dma-tag :id (dma-tag-id ret) :qwc 0))
|
|
(set! (-> ,pkt vif0) (new 'static 'vif-tag :cmd (vif-cmd nop)))
|
|
(set! (-> ,pkt vif1) (new 'static 'vif-tag :cmd (vif-cmd nop))))))
|
|
|
|
(defmacro dma-buffer-add-gif-tag (buf giftag gifregs)
|
|
"Append one GS GIF tag and its register descriptor."
|
|
(with-gensyms (pkt)
|
|
`(dma-buffer-add-base-type ,buf ,pkt gs-gif-tag (set! (-> ,pkt tag) ,giftag) (set! (-> ,pkt regs) ,gifregs))))
|
|
|
|
(defmacro dma-buffer-add-uint64 (buf &rest body)
|
|
"Append 64-bit words to a dma-buffer."
|
|
`(dma-buffer-add-base-data ,buf uint64 ,body))
|
|
|
|
(defmacro dma-buffer-add-uint128 (buf &rest body)
|
|
"Append 128-bit words to a dma-buffer."
|
|
`(dma-buffer-add-base-data ,buf uint128 ,body))
|
|
|
|
(defun dma-buffer-add-vu-function ((buffer dma-buffer) (vu-program vu-function) (flush-path-3 int))
|
|
"Append reference packets that upload a VU microprogram in chunks of at most 127 quadwords. The
|
|
packets refer to the program's existing storage rather than copying its instructions."
|
|
;; The first 4 bytes of a vu-function object's data are discarded because they aren't aligned.
|
|
(let ((function-data (the-as pointer (&-> vu-program data 4)))
|
|
;; og:preserve-this we rely on the vu functions being empty on pc
|
|
(quadwords-remaining (#if PC_PORT 0 (-> vu-program qlength)))
|
|
(instruction-origin (-> vu-program origin)))
|
|
(while (> quadwords-remaining 0)
|
|
;; VIF MPG's NUM field limits each packet to 255 instructions, or 127 whole quadwords.
|
|
(let ((transfer-quadwords (min 127 quadwords-remaining)))
|
|
(dma-buffer-add-ref-vif2 buffer
|
|
transfer-quadwords
|
|
function-data
|
|
(new 'static 'vif-tag :cmd (if (zero? flush-path-3) (vif-cmd flushe) (vif-cmd flusha)))
|
|
;; MPG counts 64-bit VU instructions, while the transfer is in 128-bit quadwords.
|
|
(new 'static 'vif-tag :cmd (vif-cmd mpg) :num (shl transfer-quadwords 1) :imm instruction-origin))
|
|
(&+! function-data (* transfer-quadwords 16))
|
|
(set! quadwords-remaining (- quadwords-remaining transfer-quadwords))
|
|
(+! instruction-origin (* transfer-quadwords 2)))))
|
|
#f)
|
|
|
|
(defun dma-buffer-send ((bank dma-bank) (buffer dma-buffer))
|
|
"Validate and send the occupied buffer as a normal DMA transfer without interpreting tags."
|
|
(when (< (-> buffer allocated-length) (&- (-> buffer base) (-> buffer data)))
|
|
(segfault))
|
|
(dma-send bank (the-as uint (-> buffer data)) (the-as uint (dma-buffer-length buffer))))
|
|
|
|
(defun dma-buffer-send-chain ((bank dma-bank-source) (buffer dma-buffer))
|
|
"Validate and send the buffer as a DMA source chain."
|
|
(when (< (-> buffer allocated-length) (&- (-> buffer base) (-> buffer data)))
|
|
(segfault))
|
|
(dma-send-chain bank (the-as uint (-> buffer data))))
|
|
|
|
(defmacro with-cnt-vif-block (bindings &rest body)
|
|
"Start a cnt w/ vif direct to gif dma packet setup for the dma-buffer in bindings.
|
|
With this, you can transfer data through PATH2 without having to setup the tag yourself.
|
|
The qwc of the transfer is determined at runtime at the end of this block."
|
|
(let ((buf (first bindings)))
|
|
(with-gensyms (buf-start buf-qwc)
|
|
`(let ((,buf-start (-> ,buf base)))
|
|
;; setup the dmatag for PATH2 transfer, qwc is 0 (patched later)
|
|
(dma-buffer-add-cnt-vif2 ,buf 0 (new 'static 'vif-tag :cmd (vif-cmd nop)) (new 'static 'vif-tag :cmd (vif-cmd direct)))
|
|
;; things with this buffer!
|
|
,@body
|
|
;; patch qwc! just do the difference between the current ptr and the old one and turn it into qwords.
|
|
;; we take one qword out because it's the initial dmatag which isnt part of the count.
|
|
;; this rounds *down*, so make sure to fill the buffer in 128-bit boundaries.
|
|
(let ((,buf-qwc (/ (+ (&- -16 ,buf-start) (the int (-> ,buf base))) 16)))
|
|
(cond
|
|
((nonzero? ,buf-qwc) ;; stuff was added to the buffer
|
|
;; patch the DMA tag
|
|
(logior! (-> (the-as (pointer dma-tag) ,buf-start) 0) (the-as uint (new 'static 'dma-tag :qwc ,buf-qwc)))
|
|
;; patch the 2nd vifcode's imm field (qwc)
|
|
(logior! (-> (the-as (pointer dma-tag) ,buf-start) 1) (the-as uint (shl (shr (shl ,buf-qwc 48) 48) 32))))
|
|
(else ;; nothing was added to the buffer. delete the dmatag, you cannot transfer 0 qwords.
|
|
(set! (-> ,buf base) ,buf-start))))))))
|
|
|
|
(defmacro with-cnt-vif-block-qwc (bindings &rest body)
|
|
"Start a cnt w/ vif direct to gif dma packet setup for the dma-buffer in bindings.
|
|
With this, you can transfer data through PATH2 without having to setup the tag yourself.
|
|
The qwc of the transfer is determined at runtime at the end of this block.
|
|
WARNING: You MUST guarantee that the resulting qwc is NOT zero!"
|
|
(let ((buf (first bindings)))
|
|
(with-gensyms (buf-start buf-qwc)
|
|
`(let ((,buf-start (the-as dma-packet (-> ,buf base))))
|
|
;; dmatag will be added at the end so we reserve
|
|
(&+! (-> ,buf base) 16)
|
|
;; setup the dmatag for PATH2 transfer, qwc is 0 (patched later)
|
|
(dma-buffer-add-cnt-vif2 ,buf 0 (new 'static 'vif-tag :cmd (vif-cmd nop)) (new 'static 'vif-tag :cmd (vif-cmd direct)))
|
|
;; things with this buffer!
|
|
,@body
|
|
;; we make the dmatag now! its at the start.
|
|
(let ((,buf-qwc (/ (+ (- -16 (the-as int ,buf-start)) (the-as int (-> ,buf base))) 16)))
|
|
(set! (-> ,buf-start dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc ,buf-qwc))
|
|
(set! (-> ,buf-start vif0) (new 'static 'vif-tag))
|
|
(set! (-> ,buf-start vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1 :imm ,buf-qwc)))))))
|
|
|
|
(defmacro with-dma-bucket (bindings &rest body)
|
|
"Start a new dma-bucket in body that will be finished at the end.
|
|
The bindings are the dma-buffer, dma-bucket and bucket-id respectively."
|
|
(let ((buf (first bindings))
|
|
(bucket (second bindings))
|
|
(bucket-id (third bindings)))
|
|
(with-gensyms (buf-start bucket-edge pkt)
|
|
`(let ((,buf-start (-> ,buf base)))
|
|
,@body
|
|
;; we end the chain with a next. The bucket system will patch the next chain to this,
|
|
;; and then patch all the buckets togehter before sending the DMA.
|
|
(let ((,bucket-edge (the (pointer dma-tag) (-> ,buf base))))
|
|
(let ((,pkt (the-as dma-packet (-> ,buf base))))
|
|
(set! (-> ,pkt dma) (new 'static 'dma-tag :id (dma-tag-id next)))
|
|
(set! (-> ,pkt vif0) (new 'static 'vif-tag :cmd (vif-cmd nop)))
|
|
(set! (-> ,pkt vif1) (new 'static 'vif-tag :cmd (vif-cmd nop)))
|
|
(set! (-> ,buf base) (&+ (the-as pointer ,pkt) (size-of dma-packet))))
|
|
(dma-bucket-insert-tag ,bucket
|
|
,bucket-id
|
|
,buf-start ;; the first thing in this chain, bucket will patch previous to this
|
|
,bucket-edge ;; end of this chain (ptr to next tag)
|
|
))))))
|
|
|
|
(defmacro with-dma-buffer-add-bucket (bindings &key (bucket-group (-> (current-frame) bucket-group)) &rest body)
|
|
"Bind a dma-buffer to a variable and use it on a block to allow adding things to a new bucket.
|
|
usage: (with-dma-buffer-add-bucket ((buffer-name buffer) bucket-id) &rest body)
|
|
example: (with-dma-buffer-add-bucket ((buf (-> (current-frame) debug-buf)) (bucket-id debug-no-zbuf)) ...)"
|
|
`(let ((,(caar bindings) ,(cadar bindings))) (with-dma-bucket (,(caar bindings) ,bucket-group ,(cadr bindings)) ,@body)))
|