;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel/gcommon.gc")

;; RPC channels.
;; these should match XXX_RPC_CHANNEL in the game/common/xxx_rpc_types.h
(defconstant RPC-SOUND-PLAYER 0) ;; called player in IOP code

(defconstant RPC-SOUND-LOADER 1) ;; called loader in IOP code

(defconstant RPC-RAMDISK 2) ;; called server in IOP code, sometimes

(defconstant RPC-DGO 3)

(defconstant RPC-LOAD-STR 4) ;; called STR in IOP code

(defconstant RPC-PLAY-STR 5) ;; called PLAY in IOP code

(defun-extern sound-buffer-dump int)

;; DECOMP BEGINS

;; an RPC buffer is a container of elements to send to the IOP.
;; each element is size elt-size, and there are maximum of elt-count elements
;; it is possible to use fewer elements than elt-count.
;; the buffer is 64-byte aligned.
(deftype rpc-buffer (basic)
  ((elt-size  uint32)
   (elt-count uint32)
   (elt-used  uint32)
   (busy      basic) ;; are we being sent currently?
   (base      pointer) ;; 64-byte aligned buffer of elts.
   ;; I suspect this was 16-byte aligned for DMA purposes.
   (data      uint8 :dynamic :offset 32))
  (:methods
   (new (symbol type uint uint) rpc-buffer)))

(defmethod new rpc-buffer ((allocation symbol) (type-to-make type) (elt-size uint) (elt-count uint))
  "Create a new rpc-buffer with room for elt-count elements of elt-size.
   The element array is 64-byte aligned."
  ;; we make room for a buffer of size elt-size * elt-count that is _64 byte_ aligned.
  (let ((this (object-new allocation type-to-make (the int (+ (-> type-to-make size) 63 (* elt-size elt-count))))))
    (set! (-> this elt-size) elt-size)
    (set! (-> this elt-count) elt-count)
    (set! (-> this elt-used) 0)
    (set! (-> this busy) #f)
    ;(set! (-> this base) (logand -64 (+ (the uint this) 28 63)))
    ;; base is the 64-byte aligned buffer.
    (set! (-> this base) (the pointer (logand -64 (+ (the uint (-> this data)) 63))))
    this))

;; An RPC buffer pair is a pair of two buffers that implement double buffering.
;; The "current" buffer is the one being loaded on the EE.
;; The other is referred to as the active buffer.
;; This also supports receiving data, though it just gives you a plain pointer.
(deftype rpc-buffer-pair (basic)
  ((buffer           rpc-buffer 2) ;; the two buffers
   (current          rpc-buffer) ;; the buffer being loaded
   (last-recv-buffer pointer) ;; the last reply
   (rpc-port         int32) ;; the RPC port number
   )
  (:methods
   (new (symbol type uint uint int) rpc-buffer-pair)
   (call (rpc-buffer-pair uint pointer uint) int)
   (add-element (rpc-buffer-pair) pointer)
   (decrement-elt-used (rpc-buffer-pair) int)
   (sync (rpc-buffer-pair symbol) int)
   (check-busy (rpc-buffer-pair) symbol)
   (pop-last-received (rpc-buffer-pair) pointer)))

(defmethod new rpc-buffer-pair ((allocation symbol) (type-to-make type) (elt-size uint) (elt-count uint) (rpc-port int))
  "Create a new rpc-buffer-pair"
  (let ((this (object-new allocation type-to-make)))
    (set! (-> this buffer 0) (new 'global 'rpc-buffer elt-size elt-count))
    (set! (-> this buffer 1) (new 'global 'rpc-buffer elt-size elt-count))
    (set! (-> this current) (-> this buffer 0))
    (set! (-> this last-recv-buffer) (the pointer #f))
    (set! (-> this rpc-port) rpc-port)
    this))

(defmethod sync ((this rpc-buffer-pair) (print-stall-warning symbol))
  "Wait for the in progress RPC to complete."
  (let ((active-buffer (if (= (-> this current) (-> this buffer 0)) (-> this buffer 1) (-> this buffer 0))))
    (when (-> active-buffer busy)
      ;; the flag is set, meaning we should check.
      (when (nonzero? (rpc-busy? (-> this rpc-port)))
        ;; we're busy
        (if print-stall-warning (format 0 "STALL: waiting for IOP on RPC port #~D~%" (-> this rpc-port)))
        (while (nonzero? (rpc-busy? (-> this rpc-port)))
          (nop!)
          (nop!)
          (nop!)
          (nop!)
          (nop!)
          (nop!)
          (nop!)
          (nop!)))
      ;; not longer busy, clear the flag!
      (set! (-> active-buffer busy) #f)
      (set! (-> active-buffer elt-used) (the-as uint 0))
      0))
  0)

(defmethod check-busy ((this rpc-buffer-pair))
  "Is the currently running RPC still busy?"
  (let ((active-buffer (if (= (-> this current) (-> this buffer 0)) (-> this buffer 1) (-> this buffer 0))))
    (when (-> active-buffer busy)
      (if (nonzero? (rpc-busy? (-> this rpc-port))) (return #t))
      (set! (-> active-buffer busy) #f)
      (set! (-> active-buffer elt-used) 0)))
  #f)

(defmethod call ((obj rpc-buffer-pair) (fno uint) (recv-buff pointer) (recv-size uint))
  "Call an RPC. This is an async RPC. Use check-busy or sync to see if it's done."
  (when (nonzero? (-> obj current elt-used))
    ;; when we have used elements
    ;; make sure the previous buffer is done
    (let ((active-buffer (if (= (-> obj current) (-> obj buffer 0)) (-> obj buffer 1) (-> obj buffer 0))))
      (when (-> active-buffer busy)
        ;; we think the active buffer may be busy.
        ;; first lets just do a simple check
        (when (nonzero? (rpc-busy? (-> obj rpc-port)))
          ;; busy! print an error and stall!
          (format 0 "STALL: waiting for IOP on RPC port #~D~%" (-> obj rpc-port))
          (while (nonzero? (rpc-busy? (-> obj rpc-port)))
            (nop!)
            (nop!)
            (nop!)
            (nop!)
            (nop!)
            (nop!)
            (nop!)
            (nop!)))
        ;; not busy.
        (set! (-> active-buffer busy) #f)
        (set! (-> active-buffer elt-used) 0))
      ;; now we've cleared the last RPC call, we can do another
      (let ((current-buffer (-> obj current)))
        ;; rpc_channel, fno, async, send_buff, send_size, recv_buff, recv_size
        (rpc-call (-> obj rpc-port)
                  fno
                  (the-as uint 1)
                  (the-as uint (-> current-buffer base))
                  (the-as int (* (-> current-buffer elt-size) (-> current-buffer elt-used)))
                  (the-as uint recv-buff)
                  (the-as int recv-size))
        (set! (-> current-buffer busy) #t))
      (set! (-> obj last-recv-buffer) recv-buff)
      (set! (-> obj current) active-buffer)))
  0)

(defmethod pop-last-received ((this rpc-buffer-pair))
  (let ((result (-> this last-recv-buffer))) (set! (-> this last-recv-buffer) (the-as pointer #f)) result))

(defmethod add-element ((this rpc-buffer-pair))
  "Add an element, and return a pointer to the element.
   If we are out of elements, flush by doing an RPC call.
   DANGER: this uses all arguments of 0. If you want something else, flush it yourself.
   If we're RPC 0 and we do this auto-flush, print a warning.
   "
  (let ((current-buffer (-> this current)))
    (when (= (-> current-buffer elt-used) (-> current-buffer elt-count))
      ;; oops, we're full.
      (when (zero? (-> this rpc-port))
        ;; if we're RPC 0, this is evidently a situation to warn about.
        (format 0 "WARNING: too many sound commands queued~%")
        (sound-buffer-dump) ;; og:preserve-this added for debugging
        )
      (format 0 "WARNING: flushing RPC port #~D~%" (-> this rpc-port)) ;; og:preserve-this
      ;; otherwise we just flush
      ;; seems kinda dangerous. these could be the wrong parameters...
      (call this (the-as uint 0) (the-as pointer 0) (the-as uint 0))
      ;; update the current-buffer.
      (set! current-buffer (-> this current)))
    (let ((result (&+ (-> current-buffer base) (* (-> current-buffer elt-used) (-> current-buffer elt-size)))))
      (+! (-> current-buffer elt-used) 1)
      result)))

(defmethod decrement-elt-used ((this rpc-buffer-pair))
  "If elt-used > 0, decrease it by one."
  (if (> (-> this current elt-used) 0) (+! (-> this current elt-used) -1))
  0)
