;;-*-Lisp-*-
(in-package goal)

;; name: dma-buffer.gc
;; name in dgo: dma-buffer
;; dgos: GAME, ENGINE

;; DMA buffers store data to be sent over DMA.
;; They are a very simple wrapper around the data.
;; Typically a dma-buffer will store dma-buckets or other more complicated data structures.

;; 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.

;; If the DMA is configured correctly, it is possible to make the first quadword contain
;; both a dma-tag and a tag for the peripheral. This allows you to have a single quadword
;; tag that controls both the DMA and peripheral. We call these a "dma-packet" for some reason.

;; Ex:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 32-bit vifcode ;; 32-bit vifcode ;; 64-bit dma-tag ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; in this case, the vifcodes will be sent to the vif, if
;; the dma transfer has tte set.
;; note that the second vifcode can also hold other stuff depending on the mode.


;; 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   :offset-assert 0)
   (vif0 vif-tag   :offset-assert 8)
   (vif1 vif-tag   :offset-assert 12) ;; doesn't have to be a vif tag.
   (quad uint128  :offset 0)
   )
  :method-count-assert 9
  :size-assert         #x10
  :flag-assert         #x900000010
  )

;; seems to be unused? Also, it seems to be broken. Do not use this.
(deftype dma-packet-array (inline-array-class)
  ()
  :method-count-assert 9
  :size-assert         #x10
  :flag-assert         #x900000010
  )
(set! (-> dma-packet-array heap-base) 16)

;; For doing a dma -> vif -> gif (path 2) transfer.
(deftype dma-gif-packet (structure)
  ((dma-vif dma-packet :inline :offset-assert 0)
   (gif     uint64    2       :offset-assert 16) ;; guess
   (quad    uint128    2       :offset 0)
   )
  :method-count-assert 9
  :size-assert         #x20
  :flag-assert         #x900000020
  )

;; dma-buffer is a dynamically sized container for storing DMA data.
;; It seems like this was not actually implemented as a proper dynamic type.
;; I added a data-buffer field that overlaps with data to get at the array of
;; bytes more easily.
(deftype dma-buffer (basic)
  ((allocated-length int32    :offset-assert 4)    ;; number of bytes.
   (base             pointer  :offset-assert 8)    ;; first unused memory.
   (end              pointer  :offset-assert 12)   ;; ?? unused ??
   (data             uint64 1 :offset-assert 16)   ;; start of memory.
   (data-buffer      uint8    :dynamic :offset 16) ;; the actual dynamic array backing it.
   )
  (:methods
   (new (symbol type int) _type_  0)
   )
  :method-count-assert 9
  :size-assert         #x18
  :flag-assert         #x900000018
  )

(defmethod new dma-buffer ((allocation symbol) (type-to-make type) (arg0 int))
  "Create a new dma-buffer with enough room to store arg0 bytes.
   Note that this does not set the end field."
  (let ((v0-0 (object-new allocation type-to-make
                          (+ (+ arg0 -4) (the-as int (-> type-to-make size)))
                          )
          )
        )
    (set! (-> v0-0 base) (-> v0-0 data))
    (set! (-> v0-0 allocated-length) arg0)
    v0-0
    )
  )

(defun dma-buffer-inplace-new ((obj dma-buffer) (size int))
  "Create a dma-buffer in-place. Does not set the type of the dma-buffer object."
  (set! (-> obj base) (-> obj data))
  (set! (-> obj allocated-length) size)
  obj
  )

(defmethod length dma-buffer ((obj dma-buffer))
  "Get the amount of data the buffer can hold, in bytes."
  (-> obj allocated-length)
  )

(defmethod asize-of dma-buffer ((obj dma-buffer))
  "Get the size in memory of the object"
  (+ (+ (-> obj allocated-length) -4) (the-as int (-> dma-buffer size)))
  )

(defun dma-buffer-length ((arg0 dma-buffer))
  "Get length used in quadwords, rounded down"
  (shr (+ (&- (-> arg0 base) (-> arg0 data)) 15) 4)
  )

(defun dma-buffer-free ((arg0 dma-buffer))
  "Get the number of free quadwords, rounded down, between base and end pointers."
  (shr (+ (&- (-> arg0 end) (-> arg0 base)) 15) 4)
  )

(defun dma-buffer-add-vu-function ((dma-buf dma-buffer) (vu-func vu-function) (flush-path-3 int))
  "Add DMA tags to load the given VU function. The destination in vu instruction memory
   is specific inside the vu-function. This does NOT copy the vu-function into the buffer,
   but creates a reference to the existing VU function."

  ;; The first 4 bytes of a vu-function object's data are discarded because they aren't aligned.
  (let ((func-ptr (the-as pointer (&-> vu-func data 4)))
        (qlen (-> vu-func qlength)) ;; number of quadwords
        (origin (-> vu-func origin)) ;; destination address in VU instruction memory.
        )
    ;; loop until whole program is transferred.
    (while (> qlen 0)
      ;; transfer up to 127 quadwords at a single time.
      (let ((qwc-now (min 127 qlen)))
        ;; grab the next dma-packet:
        (let* ((dma-buf-2 dma-buf)
               (buf-ptr (the-as dma-packet (-> dma-buf-2 base)))
               )
          ;; Set up DMA to transfer the data from the vu-function
          ;; ref id = reference to data outside of the buffer.
          (set! (-> buf-ptr dma)
                (new 'static 'dma-tag :id (dma-tag-id ref) :addr (the-as int func-ptr) :qwc qwc-now)
                )
          ;; Set up first vifcode as a flush.
          (set! (-> buf-ptr vif0)
                (new 'static 'vif-tag :cmd (if (zero? flush-path-3) (vif-cmd flushe) (vif-cmd flusha)))
                )
          ;; next vifcode, transfer microprogram. This is in 64-bit units (VU instructions)
          (set! (-> buf-ptr vif1)
                (new 'static 'vif-tag :cmd (vif-cmd mpg) :num (shl qwc-now 1) :imm origin)
                )
          (set! (-> dma-buf-2 base) (&+ (the-as pointer buf-ptr) 16))
          )
        ;; increment by qwc-now quadwords.
        (&+! func-ptr (shl qwc-now 4))
        (set! qlen (- qlen qwc-now))
        (+! origin (shl qwc-now 1))
        )
      )
    )
  #f
  )


(defun dma-buffer-send ((chan dma-bank) (buf dma-buffer))
  "Send the DMA buffer! DOES NOT TRANSFER TAG."
  (when (< (-> buf allocated-length)
           (&- (-> buf base) (-> buf data))
           )
    ;; oops. we overflowed the DMA buffer. die.
    (segfault)
    )
  (dma-send chan
   (the-as uint (-> buf data))
   (the-as uint (dma-buffer-length buf))
   )
  )

(defun dma-buffer-send-chain ((chan dma-bank-source) (buf dma-buffer))
  "Send the DMA buffer! Sends the tags"
  (when (< (-> buf allocated-length)
           (&- (-> buf base) (-> buf data))
           )
    ;; oops. we overflowed the DMA buffer. die.
    (segfault)
    )
  (dma-send-chain chan
   (the-as uint (-> buf data))
   )
  )