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

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

;; 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           :offset-assert 4)
   (elt-count uint32           :offset-assert 8)
   (elt-used  uint32           :offset-assert 12)
   (busy      basic            :offset-assert 16)  ;; are we being sent currently?
   (base      pointer          :offset-assert 20)  ;; 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 0)
    )
  :method-count-assert 9
  :size-assert         #x20
  :flag-assert         #x900000020
  )

(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 ((obj (object-new (the int (+ (-> type-to-make size) 63 (* elt-size elt-count))))))
    (set! (-> obj elt-size) elt-size)
    (set! (-> obj elt-count) elt-count)
    (set! (-> obj elt-used) 0)
    (set! (-> obj busy) '#f)
    ;(set! (-> obj base) (logand -64 (+ (the uint obj) 28 63)))
    ;; base is the 64-byte aligned buffer.
    (set! (-> obj base) (the pointer (logand -64 (+ (the uint (-> obj data)) 63))))
    obj
    )
  )

;; 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 :offset-assert 4)   ;; the two buffers
   (current          rpc-buffer   :offset-assert 12)  ;; the buffer being loaded
   (last-recv-buffer pointer   :offset-assert 16)     ;; the last reply
   (rpc-port         int32     :offset-assert 20)     ;; the RPC port number
   )
  :method-count-assert 15
  :size-assert         #x18
  :flag-assert         #xf00000018
  (:methods
    (new (symbol type uint uint int) rpc-buffer-pair 0)
    (call (rpc-buffer-pair uint pointer uint) int 9)
    (add-element (rpc-buffer-pair) pointer 10)
    (decrement-elt-used (rpc-buffer-pair) int 11)
    (sync (rpc-buffer-pair symbol) int 12)
    (check-busy (rpc-buffer-pair) symbol 13)
    (pop-last-received (rpc-buffer-pair) pointer 14)
    )
  )

(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 ((obj (object-new)))
    (set! (-> obj buffer 0) (new 'global 'rpc-buffer elt-size elt-count))
    (set! (-> obj buffer 1) (new 'global 'rpc-buffer elt-size elt-count))
    (set! (-> obj current) (-> obj buffer 0))
    (set! (-> obj last-recv-buffer) (the pointer '#f))
    (set! (-> obj rpc-port) rpc-port)
    obj
    )
  )

;; method 12
(defmethod sync rpc-buffer-pair ((obj rpc-buffer-pair) (print-stall-warning symbol))
  "Wait for the in progress RPC to complete."
  (let ((active-buffer (if (= (-> obj buffer 0) (-> obj current))
                           (-> obj buffer 1)
                           (-> obj buffer 0))
                       )
        )
    
    (when (-> active-buffer busy)
      ;; the flag is set, meaning we should check.
      (cond 
        ((!= 0 (rpc-busy? (-> obj rpc-port)))
         ;; we're busy
         (if print-stall-warning
             (format 0 "STALL: waiting for IOP on RPC port #~D~%" (-> obj rpc-port))
             )
         (while (!= 0 (rpc-busy? (-> obj rpc-port)))
           ;; real game has a bunch of nops
           (+ 1 2 3)
           )
         )
        (else
          ;; not actually busy, clear the flag!
          (set! (-> active-buffer busy) '#f)
          (set! (-> active-buffer elt-used) 0)
          )
        )
      )
      
    )
   0
  )

;; method 13
(defmethod check-busy rpc-buffer-pair ((obj rpc-buffer-pair))
  "Is the currently running RPC still busy?"
  (let ((active-buffer (if (= (-> obj buffer 0) (-> obj current))
                           (-> obj buffer 1)
                           (-> obj buffer 0)
                           )))
    (when (-> active-buffer busy)
      (if (!= 0 (rpc-busy? (-> obj rpc-port)))
          (return-from #f '#t)
          )
      (set! (-> active-buffer busy) '#f)
      (set! (-> active-buffer elt-count) 0)
      )
    )
  '#f
  )


;; method 9
(defmethod call rpc-buffer-pair ((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 (!= 0 (-> obj current elt-used))
    ;; when we have used elements
    (format 0 "call rpc-buffer-pair with ~D elts~%" (-> obj current elt-used))
    
    ;; make sure the previous buffer is done
    (let ((active-buffer (if (= (-> obj buffer 0) (-> obj current))
                             (-> 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
        (cond 
          ((!= 0 (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 (!= 0 (rpc-busy? (-> obj rpc-port)))
             (+ 1 2 3)
             )
           )
          (else
            ;; 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
        (format 0 "recv-size is ~D~%" recv-size)
        (rpc-call (-> obj rpc-port)
                  fno
                  (the uint 1)
                  (the uint (-> current-buffer base))
                  (the int (* (-> current-buffer elt-used) (-> current-buffer elt-size)))
                  (the uint recv-buff)
                  (the int recv-size)
                  )
        (set! (-> current-buffer busy) '#t)
        (set! (-> obj last-recv-buffer) recv-buff)
        (set! (-> obj current) active-buffer)
        )
      )
    )
  0
  )


;; method 14
(defmethod pop-last-received rpc-buffer-pair ((obj rpc-buffer-pair))
  (let ((result (-> obj last-recv-buffer)))
    (set! (-> obj last-recv-buffer) (the pointer '#f))
    result
    )
  )

;; method 10
(defmethod add-element rpc-buffer-pair ((obj 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 (-> obj current)))
    (when (= (-> current-buffer elt-count) (-> current-buffer elt-used))
      ;; oops, we're full.
      (if (= 0 (-> obj rpc-port))
          ;; if we're RPC 0, this is evidently a situation to warn about.
          (format 0 "WARNING: too many sound commands queued~%")
          )
      ;; otherwise we just flush
      ;; seems kinda dangerous. these could be the wrong parameters...
      (call obj (the uint 0) (the pointer 0) (the uint 0))
      ;; update the current-buffer.
      (set! current-buffer (-> obj current))
      )
    (let ((result (&+ (-> current-buffer base) (* (-> current-buffer elt-size) (-> current-buffer elt-used)))))
      (+! (-> current-buffer elt-used) 1)
      result
      )
    )
  )


;; method 11
(defmethod decrement-elt-used rpc-buffer-pair ((obj rpc-buffer-pair))
  "If elt-used > 0, decrease it by one."
  (when (> (-> obj current elt-used) 0)
   	(-! (-> obj current elt-used) 1) 
    )
  0
  )