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

;; this file is debug only
(declare-file (debug))
(when *debug-segment*
;; definition of type gs-store-image-packet
(deftype gs-store-image-packet (structure)
  ((vifcode        vif-tag      4 :offset-assert   0)
   (giftag         gif-tag        :offset-assert  16)
   (bitbltbuf      gs-bitbltbuf   :offset-assert  32)
   (bitbltbuf-addr gs-reg64       :offset-assert  40)
   (trxpos         gs-trxpos      :offset-assert  48)
   (trxpos-addr    gs-reg64       :offset-assert  56)
   (trxreg         gs-trxreg      :offset-assert  64)
   (trxreg-addr    gs-reg64       :offset-assert  72)
   (finish         int64          :offset-assert  80)
   (finish-addr    gs-reg64       :offset-assert  88)
   (trxdir         gs-trxdir      :offset-assert  96)
   (trxdir-addr    gs-reg64       :offset-assert 104)
   )
  :method-count-assert 9
  :size-assert         #x70
  :flag-assert         #x900000070
  )

;; definition for method 3 of type gs-store-image-packet
;; Used lq/sq
(defmethod inspect gs-store-image-packet ((obj gs-store-image-packet))
  (format #t "[~8x] ~A~%" obj 'gs-store-image-packet)
  (format #t "~Tvifcode[4] @ #x~X~%" (-> obj vifcode))
  (format #t "~Tgiftag: ~D~%" (-> obj giftag))
  (format #t "~Tbitbltbuf: ~D~%" (-> obj bitbltbuf))
  (format #t "~Tbitbltbuf-addr: ~D~%" (-> obj bitbltbuf-addr))
  (format #t "~Ttrxpos: ~D~%" (-> obj trxpos))
  (format #t "~Ttrxpos-addr: ~D~%" (-> obj trxpos-addr))
  (format #t "~Ttrxreg: ~D~%" (-> obj trxreg))
  (format #t "~Ttrxreg-addr: ~D~%" (-> obj trxreg-addr))
  (format #t "~Tfinish: ~D~%" (-> obj finish))
  (format #t "~Tfinish-addr: ~D~%" (-> obj finish-addr))
  (format #t "~Ttrxdir: ~D~%" (-> obj trxdir))
  (format #t "~Ttrxdir-addr: ~D~%" (-> obj trxdir-addr))
  obj
  )

;; definition for function gs-set-default-store-image
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
;; Used lq/sq
(defun gs-set-default-store-image ((packet gs-store-image-packet)
                          (src-fbp int)
                          (src-w int)
                          (src-psm int)
                          (ssax int)
                          (ssay int)
                          (rrw int)
                          (rrh int)
                          )
  (set! (-> packet vifcode 0) (new 'static 'vif-tag))
  (set! (-> packet vifcode 1) (new 'static 'vif-tag :imm #x8000 :cmd (vif-cmd mskpath3)))
  (set! (-> packet vifcode 2) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
  (set! (-> packet vifcode 3) (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1))
  (set! (-> packet giftag) (the-as gif-tag (make-u128
                                             (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d))
                                             (new 'static 'gif-tag64 :nloop #x5 :eop #x1 :nreg #x1)
                                             )
                                   )
        )
  (set! (-> packet bitbltbuf) (new 'static 'gs-bitbltbuf :sbp src-fbp :sbw src-w :spsm src-psm))
  (set! (-> packet bitbltbuf-addr) (gs-reg64 bitbltbuf))
  (set! (-> packet trxpos) (new 'static 'gs-trxpos :ssax ssax :ssay ssay))
  (set! (-> packet trxpos-addr) (gs-reg64 trxpos))
  (set! (-> packet trxreg) (new 'static 'gs-trxreg :rrw rrw :rrh rrh))
  (set! (-> packet trxreg-addr) (gs-reg64 trxreg))
  (set! (-> packet finish) 0)
  (set! (-> packet finish-addr) (gs-reg64 finish))
  (set! (-> packet trxdir) (new 'static 'gs-trxdir :xdir #x1))
  (set! (-> packet trxdir-addr) (gs-reg64 trxdir))
  (.sync.l)
  7
  )

;; definition for function store-image
;; Used lq/sq
(defun store-image ((oddeven int))
  (local-vars (ptr-1 (pointer uint8)) (y-idx int) (y-idx-2 int))
  (let ((width 512)
        (height (-> *video-parms* screen-sy))
        (file (new 'debug 'file-stream "image.raw" 'write))
        )
    (let ((buff0 (new 'debug 'boxed-array uint128 (/ (* width height) 4))))
      (let ((buff1 (new 'debug 'boxed-array uint128 (/ (* width height) 4))))
        (let ((packet (new 'static 'gs-store-image-packet)))
          (gs-set-default-store-image packet #x2800 (/ width 64) 0 0 0 width height)
          (flush-cache 0)
          (gs-store-image packet (-> buff0 data))
          (sync-path 0 0)
          (gs-set-default-store-image packet #x3000 (/ width 64) 0 0 0 width height)
          (flush-cache 0)
          (gs-store-image packet (-> buff1 data))
          )
        (sync-path 0 0)
        (let ((ptr-0 (-> buff0 data)))
          (set! ptr-1 (-> buff1 data))
          (cond
            ((zero? oddeven)
             (set! y-idx 0)
             (while (< y-idx height)
               (file-stream-write file (&+ ptr-0 (* y-idx (* width 4))) (the-as uint (* width 4)))
               (file-stream-write file (&+ ptr-1 (* y-idx (* width 4))) (the-as uint (* width 4)))
               (set! y-idx (+ y-idx 1))
               )
             )
            (else
              (set! y-idx-2 0)
              (while (< y-idx-2 height)
                (file-stream-write file (&+ ptr-1 (* y-idx-2 (* width 4))) (the-as uint (* width 4)))
                (file-stream-write file (&+ ptr-0 (* y-idx-2 (* width 4))) (the-as uint (* width 4)))
                (set! y-idx-2 (+ y-idx-2 1))
                )
              )
            )
          )
        (format #t "oddeven = ~d~%" oddeven)
        (delete buff1)
        )
      (delete buff0)
      )
    (file-stream-close file)
    )
  0
  )

)