jak-project/goal_src/jakx/engine/load/load-dgo.gc

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

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

;; +++load-msg-result
(defenum load-msg-result
  :type uint16
  :bitfield #f
  (done 0)
  (error 1)
  (more 2)
  (aborted 3)
  (invalid 666)
  )
;; ---load-msg-result

(define-extern *load-dgo-rpc* rpc-buffer-pair)
(define-extern *load-str-rpc* rpc-buffer-pair)
(define-extern *play-str-rpc* rpc-buffer-pair)
(define-extern *load-str-lock* symbol)
(define-extern *que-str-lock* symbol)
(define-extern *dgo-name* string)

(define-extern dynamic-patch-hook (function dgo-header kheap uint none))

;; DECOMP BEGINS

(deftype load-dgo-msg (structure)
  "IOP RPC message for loading a dgo."
  ((rsvd     uint16)
   (result   load-msg-result)
   (b1       pointer)
   (b2       pointer)
   (bt       pointer)
   (name     uint128)
   (address  uint32  :overlay-at b1)
   (id       uint128)
   (pad      uint32  7)
   )
  )


(deftype load-chunk-msg (structure)
  "IOP RPC message for loading a chunk of a chunked animation"
  ((rsvd      uint16)
   (result    load-msg-result)
   (address   pointer)
   (section   uint32)
   (maxlen    uint32)
   (dummy     uint32             4)
   (basename  sound-stream-name  :inline)
   )
  )


(deftype play-chunk-msg (structure)
  "IOP RPC message for playing some streamed audio."
  ((rsvd      uint16)
   (result    uint16)
   (address   pointer)
   (section   uint32)
   (volume    int32              :overlay-at section)
   (maxlen    uint32)
   (group     uint8              :overlay-at maxlen)
   (id        uint32             4)
   (basename  sound-stream-name  4 :inline)
   )
  )


(when (zero? *load-dgo-rpc*)
  (set! *load-dgo-rpc* (new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 1) 4))
  (set! *load-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 80) (the-as uint 1) 5))
  (set! *play-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 256) (the-as uint 4) 6))
  (set! *load-str-lock* #f)
  (set! *que-str-lock* #f)
  (set! *dgo-name* (new 'global 'string 64 (the-as string #f)))
  )

(defun str-load ((name string) (chunk-idx int) (dest-addr pointer) (max-len int))
  "Send a message to the IOP to start loading a chunk of a .STR file to the EE."
  (if (or (check-busy *load-str-rpc*) *load-str-lock*)
      (return #f)
      )
  (let ((s2-0 (the-as load-chunk-msg (add-element *load-str-rpc*))))
    (set! (-> s2-0 result) (load-msg-result invalid))
    (set! (-> s2-0 address) dest-addr)
    (set! (-> s2-0 section) (the-as uint chunk-idx))
    (set! (-> s2-0 maxlen) (the-as uint max-len))
    (copyn-charp<-string (-> s2-0 basename name) name 48)
    (call *load-str-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
    )
  (set! *load-str-lock* #t)
  (set! *que-str-lock* #t)
  #t
  )

(defun str-load-status ((maxlen-out (pointer int32)))
  "Get the status of the most recent load.
   Return 'busy if in progress, 'error if failed, or 'complete.
   If 'complete, returns the maxlen value from the IOP."
  (if (check-busy *load-str-rpc*)
      (return 'busy)
      )
  (set! *load-str-lock* #f)
  (set! *que-str-lock* #t)
  (let ((v1-7 (the-as load-chunk-msg (pop-last-received *load-str-rpc*))))
    (if (= (-> v1-7 result) (load-msg-result error))
        (return 'error)
        )
    (set! (-> maxlen-out 0) (the-as int (-> v1-7 maxlen)))
    )
  'complete
  )

(defun str-load-cancel ()
  "Cancel a streaming load. Note that this does not actually stop the transfer, so the IOP may continue writing to the buffer."
  (set! *load-str-lock* #f)
  (set! *que-str-lock* #t)
  0
  (none)
  )

(defun str-play-async ((name string) (id sound-id) (volume int) (group int))
  "Start playing a streaming audio."
  (set! *que-str-lock* #t)
  (let ((s2-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
    (copyn-charp<-string (-> s2-0 basename 0 name) name 48)
    (copyn-charp<-string (-> s2-0 basename 1 name) "" 48)
    (copyn-charp<-string (-> s2-0 basename 2 name) "" 48)
    (copyn-charp<-string (-> s2-0 basename 3 name) "" 48)
    (set! (-> s2-0 id 0) (the-as uint id))
    (set! (-> s2-0 id 1) (the-as uint 0))
    (set! (-> s2-0 id 2) (the-as uint 0))
    (set! (-> s2-0 id 3) (the-as uint 0))
    (set! (-> s2-0 section) (the-as uint volume))
    (set! (-> s2-0 maxlen) (the-as uint 0))
    (set! (-> s2-0 group) (the-as uint group))
    (set! (-> s2-0 result) (the-as uint 0))
    )
  0
  0
  (none)
  )

(defun str-play-stop ((name string) (id sound-id))
  "Stop playing streaming audio."
  (set! *que-str-lock* #t)
  (let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
    (copyn-charp<-string (-> s4-0 basename 0 name) name 48)
    (copyn-charp<-string (-> s4-0 basename 1 name) "" 48)
    (copyn-charp<-string (-> s4-0 basename 2 name) "" 48)
    (copyn-charp<-string (-> s4-0 basename 3 name) "" 48)
    (set! (-> s4-0 id 0) (the-as uint id))
    (set! (-> s4-0 id 1) (the-as uint 0))
    (set! (-> s4-0 id 2) (the-as uint 0))
    (set! (-> s4-0 id 3) (the-as uint 0))
    (set! (-> s4-0 result) (the-as uint 1))
    )
  0
  (none)
  )

(defun str-play-queue ((name0 string) (name1 string) (name2 string) (name3 string) (ids (pointer uint32)) (mask pointer))
  "Queue up streaming data, allowing it to start playing without delay."
  (when (and (not (check-busy *play-str-rpc*)) (not *que-str-lock*))
    (let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
      (if name0
          (copyn-charp<-string (-> s4-0 basename 0 name) name0 48)
          (copyn-charp<-string (-> s4-0 basename 0 name) "" 48)
          )
      (if name1
          (copyn-charp<-string (-> s4-0 basename 1 name) name1 48)
          (copyn-charp<-string (-> s4-0 basename 1 name) "" 48)
          )
      (if name2
          (copyn-charp<-string (-> s4-0 basename 2 name) name2 48)
          (copyn-charp<-string (-> s4-0 basename 2 name) "" 48)
          )
      (if name3
          (copyn-charp<-string (-> s4-0 basename 3 name) name3 48)
          (copyn-charp<-string (-> s4-0 basename 3 name) "" 48)
          )
      (dotimes (v1-14 4)
        (set! (-> s4-0 id v1-14) (-> ids v1-14))
        )
      (set! (-> s4-0 address) mask)
      (set! (-> s4-0 result) (the-as uint 2))
      )
    )
  (set! *que-str-lock* #f)
  0
  (none)
  )

(defun str-ambient-play ((name string))
  "Start playing ambient (unused?)."
  (set! *que-str-lock* #t)
  (let ((s5-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
    (set! (-> s5-0 basename 0 name 0) (the-as uint 36))
    (copyn-charp<-string (&-> s5-0 basename 0 name 1) name 48)
    (set! (-> s5-0 result) (the-as uint 0))
    )
  0
  0
  (none)
  )

(defun str-ambient-stop ((name string))
  "Stop playing ambient (unused?)."
  (set! *que-str-lock* #t)
  (let ((s5-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
    (set! (-> s5-0 basename 0 name 0) (the-as uint 36))
    (copyn-charp<-string (&-> s5-0 basename 0 name 1) name 48)
    (set! (-> s5-0 result) (the-as uint 1))
    )
  0
  (none)
  )

(defun str-play-kick ()
  "Do an empty RPC on play so the IOP code runs and can update buffers."
  (cond
    ((check-busy *play-str-rpc*)
     )
    (else
      (call *play-str-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
      )
    )
  0
  (none)
  )

(define *dgo-time* (the-as time-frame 0))

(defun dgo-load-begin ((name string) (buffer1 uint128) (buffer2 pointer) (buffer-top pointer) (arg4 pointer))
  "Start a DGO load!"
  (set! *dgo-time* (-> *display* real-clock integral-frame-counter))
  (format 0 "Starting level load clock~%")
  (sync *load-dgo-rpc* #t)
  (let ((s1-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
    (set! (-> s1-0 result) (load-msg-result invalid))
    (set! (-> s1-0 b1) buffer2)
    (set! (-> s1-0 b2) buffer-top)
    (set! (-> s1-0 bt) arg4)
    (set! (-> s1-0 name) (string->sound-name name))
    (set! (-> s1-0 id) buffer1)
    (call *load-dgo-rpc* (the-as uint 0) (the-as pointer s1-0) (the-as uint 32))
    s1-0
    )
  )

(defun dgo-load-get-next ((done-out (pointer symbol)))
  "Get the address of the most recently loaded object. #f is there is none. Returns if this is the last by arg0."
  (set! (-> done-out 0) #f)
  (let ((gp-0 (the-as pointer #f)))
    (when (not (check-busy *load-dgo-rpc*))
      (let ((v1-4 (the-as load-dgo-msg (pop-last-received *load-dgo-rpc*))))
        (when v1-4
          (when (or (= (-> v1-4 result) (load-msg-result done)) (= (-> v1-4 result) (load-msg-result more)))
            (set! gp-0 (-> v1-4 b1))
            (set! (-> done-out 0) #t)
            )
          (if (= (-> v1-4 result) (load-msg-result more))
              (set! (-> done-out 0) #f)
              )
          (if (= (-> v1-4 result) (load-msg-result done))
              (format
                0
                "Elapsed time for level = ~Fs~%"
                (* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
                )
              )
          )
        )
      )
    gp-0
    )
  )

(defun dgo-load-continue ((buffer1 pointer) (buffer2 pointer) (buffer-top pointer))
  "Inform the IOP that it is safe to start loading the next object."
  (let ((gp-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
    (set! (-> gp-0 result) (load-msg-result invalid))
    (set! (-> gp-0 b1) buffer1)
    (set! (-> gp-0 b2) buffer2)
    (set! (-> gp-0 bt) buffer-top)
    (set! (-> gp-0 name) (the-as uint128 0))
    (call *load-dgo-rpc* (the-as uint 1) (the-as pointer gp-0) (the-as uint 32))
    gp-0
    )
  )

(defun dgo-load-cancel ((arg0 int))
  "Abort a DGO load."
  (let ((v1-0 (the-as sound-rpc-cancel-dgo (get-sound-buffer-entry))))
    (set! (-> v1-0 command) (the-as uint 20))
    (set! (-> v1-0 id) (the-as uint arg0))
    )
  0
  (none)
  )

(defun find-temp-buffer ((size int))
  "Unused function to find some temporary leftover space in DMA buffer.
   Unused since jak 1, and checks the same buffer twice??"
  (let ((gp-0 (+ (/ size 16) 2)))
    (cond
      ((< (the-as uint gp-0)
          (the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
          )
       (logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
       )
      ((< (the-as uint gp-0)
          (the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
          )
       (logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
       )
      )
    )
  )

(defun dgo-load-link ((arg0 dgo-header) (arg1 kheap) (arg2 uint) (arg3 symbol) (arg4 symbol))
  "Start the async linker on a GOAL object file that was just loaded."
  (dynamic-patch-hook arg0 arg1 arg2)
  (let ((s4-0 (the-as object (&+ arg0 64))))
    (cond
      ((>= (the-as int (+ (the-as uint s4-0) (-> arg0 length))) (the-as int (-> arg1 top-base)))
       (format
         0
         "ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes.  This is very bad!~%"
         (-> arg0 rootname)
         arg0
         arg1
         (- (+ (the-as uint s4-0) (-> arg0 length)) (the-as uint (-> arg1 top-base)))
         )
       )
      ((and (< (the-as int arg0) (the-as int arg2))
            (>= (the-as int (+ (the-as uint s4-0) (-> arg0 length))) (the-as int arg2))
            )
       (format
         0
         "ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes.  This is very bad!~%"
         (-> arg0 rootname)
         arg0
         arg1
         (- (+ (the-as uint s4-0) (-> arg0 length)) arg2)
         )
       )
      )
    (if arg4
        (format
          0
          "NOTICE: loaded ~g, ~D bytes (~f K) at top ~D at #x~X - #x~X~%"
          (-> arg0 rootname)
          (-> arg0 length)
          (* 0.0009765625 (the float (-> arg0 length)))
          (- (+ (the-as uint s4-0) (-> arg0 length)) (the-as uint (-> arg1 base)))
          arg0
          (+ (the-as uint s4-0) (-> arg0 length))
          )
        )
    (string<-charp (clear *dgo-name*) (-> arg0 rootname))
    (nonzero? (link-begin
                (the-as pointer s4-0)
                (-> *dgo-name* data)
                (the-as int (-> arg0 length))
                arg1
                (if arg3
                    (link-flag output-load-msg output-load-true-msg execute-login print-login fast-link)
                    (link-flag output-load-msg output-load-true-msg execute-login fast-link)
                    )
                )
              )
    )
  )

(defun destroy-mem ((start (pointer uint32)) (end (pointer uint32)))
  "Overwrite memory with #xffffffff for debugging."
  (while (< (the-as int start) (the-as int end))
    (set! (-> start 0) (the-as uint #xffffffff))
    (set! start (&-> start 1))
    )
  0
  (none)
  )