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

;; name: decomp.gc
;; name in dgo: decomp
;; dgos: ENGINE, GAME

;; This file has compression/decompression functions used for compressed visibility data, bigmap data, and
;; joint animations (not the joint-anim-compressed stuff, an outer layer of lzo compression of those)
;; It also has the update-vis! method of level, which handles the details of decompression.
;; Luckily for us, the IOP ramdisk vis stuff from Jak 1 is gone!
;; It's not super clear to me why they ditched this system. Maybe the visibility data is a lot smaller in jak 2.

;; DECOMP BEGINS

;; definition for function unpack-comp-rle
;; WARN: Return type mismatch (pointer int8) vs none.
(defun unpack-comp-rle ((arg0 (pointer int8)) (arg1 (pointer int8)))
  (local-vars (v1-2 int) (v1-3 uint))
  (nop!)
  (loop
    (loop
      (set! v1-2 (-> arg1 0))
      (set! arg1 (&-> arg1 1))
      (b! (<= v1-2 0) cfg-5 :delay (nop!))
      (let ((a2-0 (-> arg1 0)))
        (set! arg1 (&-> arg1 1))
        (label cfg-3)
        (nop!)
        (nop!)
        (nop!)
        (nop!)
        (set! (-> arg0 0) a2-0)
        )
      (set! arg0 (&-> arg0 1))
      (b! (> v1-2 0) cfg-3 :delay (set! v1-2 (+ v1-2 -1)))
      )
    (label cfg-5)
    (b! (zero? v1-2) cfg-8 :delay (set! v1-3 (the-as uint (- v1-2))))
    (label cfg-6)
    (let ((a2-1 (-> arg1 0)))
      (set! arg1 (&-> arg1 1))
      (nop!)
      (nop!)
      (set! (-> arg0 0) a2-1)
      )
    (+! v1-3 -1)
    (b! (> (the-as int v1-3) 0) cfg-6 :delay (set! arg0 (&-> arg0 1)))
    )
  (label cfg-8)
  (none)
  )

;; definition of type huf-dictionary-node
(deftype huf-dictionary-node (structure)
  ((zero uint16  :offset-assert   0)
   (one  uint16  :offset-assert   2)
   )
  :method-count-assert 9
  :size-assert         #x4
  :flag-assert         #x900000004
  )

;; definition for method 3 of type huf-dictionary-node
(defmethod inspect huf-dictionary-node ((obj huf-dictionary-node))
  (when (not obj)
    (set! obj obj)
    (goto cfg-4)
    )
  (format #t "[~8x] ~A~%" obj 'huf-dictionary-node)
  (format #t "~1Tzero: ~D~%" (-> obj zero))
  (format #t "~1Tone: ~D~%" (-> obj one))
  (label cfg-4)
  obj
  )

;; definition for function unpack-comp-huf
;; WARN: Return type mismatch int vs none.
(defun unpack-comp-huf ((arg0 (pointer uint8)) (arg1 (pointer uint8)) (arg2 uint) (arg3 huf-dictionary-node))
  (local-vars (t1-1 uint) (t3-2 (pointer uint16)))
  (nop!)
  (let ((t1-0 (-> arg3 zero))
        (a2-1 (+ arg2 -1028))
        (t2-0 (-> arg3 one))
        )
    (nop!)
    (label cfg-1)
    (let ((v1-4 128))
      (nop!)
      (let ((t0-0 (-> arg1 0)))
        (set! arg1 (&-> arg1 1))
        (label cfg-2)
        (let ((t3-0 (logand t0-0 v1-4)))
          (shift-arith-right-32 v1-4 v1-4 1)
          (b! (zero? t3-0) cfg-4 :delay (set! t1-1 t1-0))
          )
        )
      (nop!)
      (set! t1-1 t2-0)
      (label cfg-4)
      (let ((t2-1 (+ t1-1 -256)))
        (let ((t3-1 (* t1-1 4)))
          (b! (< (the-as int t2-1) 0) cfg-8 :delay (set! t3-2 (the-as (pointer uint16) (+ t3-1 a2-1))))
          )
        (b! (zero? t2-1) cfg-10 :delay (set! t1-0 (-> t3-2 0)))
        )
      (b! (nonzero? v1-4) cfg-2 :delay (set! t2-0 (-> t3-2 1)))
      (b! #t cfg-1 :delay (nop!))
      (label cfg-8)
      (set! (-> arg0 0) t1-1)
      (set! arg0 (&-> arg0 1))
      (nop!)
      (set! t1-0 (-> arg3 zero))
      (b! (nonzero? v1-4) cfg-2 :delay (set! t2-0 (-> arg3 one)))
      )
    )
  (b! #t cfg-1 :delay (nop!))
  (label cfg-10)
  (nop!)
  (nop!)
  0
  (none)
  )

;; definition for function unpack-comp-lzo
;; WARN: Return type mismatch int vs none.
(defun unpack-comp-lzo ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
  0
  (let ((v1-1 arg0))
    (b! (>= (the-as uint 17) (-> arg1 0)) cfg-5 :delay #f)
    (let ((a2-4 (the-as int (+ (-> arg1 0) -17))))
      (set! arg1 (&-> arg1 1))
      (b! (< a2-4 4) cfg-41)
      (until (<= a2-4 0)
        (set! (-> arg0 0) (-> arg1 0))
        (set! arg0 (&-> arg0 1))
        (set! arg1 (&-> arg1 1))
        (+! a2-4 -1)
        )
      (b! #t cfg-15 :delay (nop!))
      (label cfg-5)
      (b! #t cfg-45 :delay (nop!))
      (label cfg-6)
      (let ((a2-6 (-> arg1 0)))
        (set! arg1 (&-> arg1 1))
        (b! (>= (the-as int a2-6) 16) cfg-18)
        (b! (nonzero? a2-6) cfg-12 :delay (empty-form))
        (while (zero? (-> arg1 0))
          (+! a2-6 255)
          (set! arg1 (&-> arg1 1))
          )
        (set! a2-6 (+ (-> arg1 0) 15 a2-6))
        (set! arg1 (&-> arg1 1))
        (label cfg-12)
        (set! (-> arg0 0) (-> arg1 0))
        (set! (-> arg0 1) (-> arg1 1))
        (set! (-> arg0 2) (-> arg1 2))
        (set! arg0 (&-> arg0 3))
        (set! arg1 (&-> arg1 3))
        (until (<= (the-as int a2-6) 0)
          (set! (-> arg0 0) (-> arg1 0))
          (set! arg0 (&-> arg0 1))
          (set! arg1 (&-> arg1 1))
          (+! a2-6 -1)
          )
        (label cfg-15)
        (set! a2-6 (-> arg1 0))
        (set! arg1 (&-> arg1 1))
        (b! (>= (the-as int a2-6) 16) cfg-18)
        (let ((a2-10 (the-as (pointer uint8) (&- (&- (&-> arg0 -2049) (the-as uint (/ (the-as int a2-6) 4))) (the-as uint (* (-> arg1 0) 4))))))
          (set! arg1 (&-> arg1 1))
          (set! (-> arg0 0) (-> a2-10 0))
          (set! (-> arg0 1) (-> a2-10 1))
          (set! (-> arg0 2) (-> a2-10 2))
          (set! arg0 (&-> arg0 3))
          (&-> a2-10 2)
          )
        (b! #t cfg-39 :delay (nop!))
        (b! #t cfg-43 :delay (nop!))
        (label cfg-18)
        (b! (< (the-as int a2-6) 64) cfg-20)
        (let ((a3-23
                (the-as (pointer uint8) (&- (&- (&-> arg0 -1) (the-as uint (logand (/ (the-as int a2-6) 4) 7))) (the-as uint (* (-> arg1 0) 8))))
                )
              )
          (set! arg1 (&-> arg1 1))
          (let ((a2-13 (+ (/ (the-as int a2-6) 32) -1)))
            (b! #t cfg-36 :delay (nop!))
            (label cfg-20)
            (b! (< (the-as int a2-6) 32) cfg-27)
            (set! a2-13 (the-as int (logand a2-6 31)))
            (b! (nonzero? a2-13) cfg-26 :delay (empty-form))
            (b! #t cfg-24 :delay (nop!))
            (label cfg-23)
            (+! a2-13 255)
            (set! arg1 (&-> arg1 1))
            (label cfg-24)
            (b! (zero? (-> arg1 0)) cfg-23 :delay (nop!))
            (set! a2-13 (the-as int (+ (-> arg1 0) 31 a2-13)))
            (set! arg1 (&-> arg1 1))
            (label cfg-26)
            (set! a3-23 (the-as (pointer uint8) (&- (&-> arg0 -1) (the-as uint (+ (shr (-> arg1 0) 2) (* (-> arg1 1) 64))))))
            (set! arg1 (&-> arg1 2))
            (b! #t cfg-36 :delay (nop!))
            (label cfg-27)
            (b! (< (the-as int a2-6) 16) cfg-35)
            (let ((a3-32 (the-as (pointer uint8) (&- arg0 (the-as uint (shl (logand a2-6 8) 11))))))
              (set! a2-13 (the-as int (logand a2-6 7)))
              (b! (nonzero? a2-13) cfg-33 :delay (empty-form))
              (b! #t cfg-31 :delay (nop!))
              (label cfg-30)
              (+! a2-13 255)
              (set! arg1 (&-> arg1 1))
              (label cfg-31)
              (b! (zero? (-> arg1 0)) cfg-30 :delay (nop!))
              (set! a2-13 (the-as int (+ (-> arg1 0) 7 a2-13)))
              (set! arg1 (&-> arg1 1))
              (label cfg-33)
              (let ((a3-33 (&- a3-32 (the-as uint (+ (shr (-> arg1 0) 2) (* (-> arg1 1) 64))))))
                (set! arg1 (&-> arg1 2))
                (b! (= a3-33 arg0) cfg-47 :delay (nop!))
                (set! a3-23 (&-> (the-as (pointer uint8) a3-33) -16384))
                )
              )
            (b! #t cfg-36 :delay (nop!))
            (label cfg-35)
            (let ((a2-16 (the-as (pointer uint8) (&- (&- (&-> arg0 -1) (the-as uint (/ (the-as int a2-6) 4))) (the-as uint (* (-> arg1 0) 4))))))
              (set! arg1 (&-> arg1 1))
              (set! (-> arg0 0) (-> a2-16 0))
              (set! (-> arg0 1) (-> a2-16 1))
              (set! arg0 (&-> arg0 2))
              (&-> a2-16 1)
              )
            (b! #t cfg-39 :delay (nop!))
            (label cfg-36)
            (set! (-> arg0 0) (-> a3-23 0))
            (set! (-> arg0 1) (-> a3-23 1))
            (set! arg0 (&-> arg0 2))
            (let ((a3-39 (&-> a3-23 2)))
              (until (<= (the-as int a2-13) 0)
                (set! (-> arg0 0) (-> a3-39 0))
                (set! arg0 (&-> arg0 1))
                (set! a3-39 (&-> a3-39 1))
                (+! a2-13 -1)
                )
              )
            )
          )
        (label cfg-39)
        (set! a2-4 (the-as int (logand (-> arg1 -2) 3)))
        (b! (zero? (the-as uint a2-4)) cfg-45 :delay (nop!))
        (until (<= a2-4 0)
          (label cfg-41)
          (set! (-> arg0 0) (-> arg1 0))
          (set! arg0 (&-> arg0 1))
          (set! arg1 (&-> arg1 1))
          (set! a2-4 (the-as int (+ (the-as uint a2-4) -1)))
          )
        (set! a2-6 (-> arg1 0))
        )
      )
    (set! arg1 (&-> arg1 1))
    (label cfg-43)
    (b! #t cfg-18 :delay (nop!))
    (label cfg-45)
    (b! #t cfg-6 :delay (nop!))
    (label cfg-47)
    (&- arg0 (the-as uint v1-1))
    )
  (none)
  )

;; definition for method 16 of type level
;; INFO: Used lq/sq
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 138]
(defmethod update-vis! level ((obj level) (vis-info level-vis-info) (unused uint) (in-bsp-vis-string (pointer uint8)))
  (local-vars (t0-3 uint128) (extra-vis-length int) (extra-vis-dest (pointer int8)))
  (let* ((cam-leaf-idx (-> vis-info from-bsp current-leaf-idx))
         (curr-vis-string-offset (-> vis-info current-vis-string))
         (desired-vis-string-offset (-> vis-info vis-string cam-leaf-idx))
         )
    0
    (+ #x70000000 0)
    (+ 2048 #x70000000)
    (b! (!= curr-vis-string-offset desired-vis-string-offset) cfg-8 :delay (empty-form))
    (b! (not (logtest? (vis-info-flag loading) (-> vis-info flags))) cfg-6 :delay (empty-form))
    (if (check-busy *ramdisk-rpc*)
        (return #f)
        )
    (logclear! (-> vis-info flags) (vis-info-flag loading))
    (let ((vis-buf (the-as (pointer integer) (-> obj vis-buffer))))
      (b! #t cfg-16 :delay (nop!))
      (label cfg-6)
      (return #t)
      (label cfg-8)
      (when (logtest? (vis-info-flag loading) (-> vis-info flags))
        (if (check-busy *ramdisk-rpc*)
            (return #f)
            )
        (logclear! (-> vis-info flags) (vis-info-flag loading))
        )
      (set! (-> vis-info current-vis-string) desired-vis-string-offset)
      (b! (logtest? (vis-info-flag in-iop) (-> vis-info flags)) cfg-15 :delay (empty-form))
      (set! vis-buf (&+ in-bsp-vis-string desired-vis-string-offset))
      (b! #t cfg-16 :delay (nop!))
      (label cfg-15)
      (format 0 "ERROR: ramdisk vis for level ~A, this is not supported~%" (-> obj name))
      (let ((v0-1 #f))
        (b! #t cfg-49 :delay (nop!))
        (label cfg-16)
        (let ((lower-flag-bits (the-as int (logand (vis-info-flag
                                                     dummy0
                                                     dummy1
                                                     dummy2
                                                     dummy3
                                                     dummy4
                                                     dummy5
                                                     dummy6
                                                     dummy7
                                                     dummy8
                                                     dummy9
                                                     dummy10
                                                     dummy11
                                                     dummy12
                                                     dummy13
                                                     dummy14
                                                     dummy15
                                                     dummy16
                                                     dummy17
                                                     dummy18
                                                     dummy19
                                                     dummy20
                                                     dummy21
                                                     dummy22
                                                     dummy23
                                                     dummy24
                                                     dummy25
                                                     dummy26
                                                     dummy27
                                                     dummy28
                                                     )
                                                   (-> vis-info flags)
                                                   )
                                       )
                               )
              (spad-start (&-> (the-as (pointer int8) *fake-scratchpad-data*) 0))
              (spad-end (the-as (pointer int8) (&+ *fake-scratchpad-data* 2048)))
              (list-len (-> obj bsp visible-list-length))
              )
          (when (zero? (the-as vis-info-flag lower-flag-bits))
            (let ((qwc (/ (+ list-len 15) 16)))
              (dotimes (a0-19 qwc)
                (set! (-> (the-as (pointer int128) (&+ spad-start (* a0-19 16)))) (the int128 0))
                )
              )
            (mem-copy! spad-start (the-as (pointer uint8) vis-buf) list-len)
            )
          (while (nonzero? lower-flag-bits)
            (let ((comp-mode (logand lower-flag-bits 7)))
              (cond
                ((= comp-mode 1)
                 (let ((qwc2 (/ (+ list-len 15) 16)))
                   (dotimes (a0-23 qwc2)
                     (set! (-> (the-as (pointer int128) (&+ spad-start (* a0-23 16)))) (the int128 0))
                     )
                   )
                 (set! extra-vis-length (-> obj bsp extra-vis-list-length))
                 (set! extra-vis-dest (&+ spad-start (- list-len extra-vis-length)))
                 (let ((extra-vis-in (unpack-vis (-> obj bsp drawable-trees) spad-start (the-as (pointer int8) vis-buf))))
                   (dotimes (extra-vis-idx extra-vis-length)
                     (let ((vis-byte (-> extra-vis-in 0)))
                       (set! extra-vis-in (&-> extra-vis-in 1))
                       (set! (-> extra-vis-dest 0) vis-byte)
                       )
                     (set! extra-vis-dest (&-> extra-vis-dest 1))
                     )
                   )
                 #f
                 )
                ((= comp-mode 2)
                 (unpack-comp-rle spad-start (the-as (pointer int8) vis-buf))
                 )
                ((= comp-mode 3)
                 (unpack-comp-huf
                   (the-as (pointer uint8) spad-start)
                   (the-as (pointer uint8) vis-buf)
                   (-> vis-info dictionary)
                   (the-as huf-dictionary-node (+ (-> vis-info dictionary) (-> vis-info dictionary-length) -4))
                   )
                 )
                ((= comp-mode 4)
                 (unpack-comp-lzo (the-as (pointer uint8) spad-start) (the-as (pointer uint8) vis-buf))
                 )
                )
              )
            (set! vis-buf spad-start)
            (set! spad-start spad-end)
            (set! spad-end (the-as (pointer int8) vis-buf))
            (shift-arith-right-32 lower-flag-bits lower-flag-bits 3)
            )
          (let ((vis-ptr (the-as (pointer uint8) vis-buf))
                (all-vis-ptr (the-as (pointer uinteger) (-> obj bsp all-visible-list)))
                (vis-error #f)
                )
            (dotimes (s0-1 list-len)
              (when (!= (logand (-> vis-ptr 0) (-> (the-as (pointer uint8) all-vis-ptr) 0)) (-> vis-ptr 0))
                (format
                  #t
                  "ERROR: illegal vis bits set [byte ~X] ~X -> ~X~%"
                  s0-1
                  (-> vis-ptr 0)
                  (-> (the-as (pointer uint8) all-vis-ptr) 0)
                  )
                (set! vis-error #t)
                )
              (set! vis-ptr (&-> vis-ptr 1))
              (set! all-vis-ptr (&+ (the-as (pointer uint16) all-vis-ptr) 1))
              )
            (when vis-error
              (format
                #t
                "src = #x~x dest = #x~x  ~s  ~s~%"
                vis-buf
                (-> vis-info vis-bits)
                (-> vis-info level)
                (-> vis-info from-level)
                )
              (format #t "leaf-index = ~d~%" (-> vis-info from-bsp current-leaf-idx))
              0
              )
            )
          (let ((unpacked-vis-ptr vis-buf)
                (final-vis-ptr (the-as object (-> vis-info vis-bits)))
                (all-vis (the-as (pointer uinteger) (-> obj bsp all-visible-list)))
                (vis-qwc (/ (+ list-len 15) 16))
                )
            (dotimes (a3-6 vis-qwc)
              (let ((t0-2 (-> (the-as (pointer uint128) unpacked-vis-ptr) 0))
                    (t1-1 (-> (the-as (pointer uint128) all-vis) 0))
                    )
                (.pand t0-3 t0-2 t1-1)
                )
              (set! (-> (the-as (pointer uint128) final-vis-ptr) 0) t0-3)
              (set! final-vis-ptr (+ (the-as uint final-vis-ptr) 16))
              (set! unpacked-vis-ptr (&-> (the-as (pointer uint8) unpacked-vis-ptr) 16))
              (set! all-vis (&-> (the-as (pointer uint16) all-vis) 8))
              )
            )
          )
        (set! v0-1 #t)
        (label cfg-49)
        v0-1
        )
      )
    )
  )

;; definition for function pack-comp-rle
;; WARN: Return type mismatch int vs none.
(defun pack-comp-rle ((arg0 (pointer uint8)) (arg1 (pointer uint8)) (arg2 int) (arg3 int))
  (let ((s4-0 0))
    0
    (while (and (> arg2 0) (< (+ s4-0 131) arg3))
      (cond
        ((= (-> arg1 0) (-> arg1 1))
         (let ((v1-2 (-> arg1 0)))
           (set! arg1 (&-> arg1 2))
           (let ((a0-2 2))
             (+! arg2 -2)
             (while (> arg2 0)
               (cond
                 ((= v1-2 (-> arg1 0))
                  (+! a0-2 1)
                  (set! arg1 (&-> arg1 1))
                  (+! arg2 -1)
                  (if (>= a0-2 128)
                      (goto cfg-12)
                      )
                  )
                 (else
                   (goto cfg-12)
                   )
                 )
               )
             (label cfg-12)
             (set! (-> arg0 0) (the-as uint (+ a0-2 -1)))
             )
           (set! (-> arg0 1) v1-2)
           )
         (set! arg0 (&-> arg0 2))
         (+! s4-0 2)
         )
        (else
          (let ((a0-4 arg1)
                (v1-4 1)
                )
            (set! arg1 (&-> arg1 1))
            (+! arg2 -1)
            (while (< 1 arg2)
              (when (and (= (-> arg1 0) (-> arg1 1)) (< 2 arg2))
                (if (= (-> arg1 0) (-> arg1 2))
                    (goto cfg-26)
                    )
                )
              (+! v1-4 1)
              (set! arg1 (&-> arg1 1))
              (+! arg2 -1)
              (if (>= v1-4 127)
                  (goto cfg-26)
                  )
              )
            (label cfg-26)
            (when (= arg2 1)
              (+! v1-4 1)
              (set! arg1 (&-> arg1 1))
              (+! arg2 -1)
              )
            (set! (-> arg0 0) (the-as uint (- v1-4)))
            (let ((a1-21 (&-> arg0 1))
                  (a2-4 (+ s4-0 1))
                  )
              (dotimes (t0-0 v1-4)
                (set! (-> a1-21 t0-0) (-> a0-4 t0-0))
                )
              (set! arg0 (&+ a1-21 v1-4))
              (set! s4-0 (+ a2-4 v1-4))
              )
            )
          )
        )
      )
    (if (< arg3 (+ s4-0 131))
        (format 0 "(GOMI) Warning: May have run out of bigmap bit mask compression memory~%")
        )
    (when (= arg2 1)
      (set! (-> arg0 0) (the-as uint -1))
      (set! (-> arg0 1) (-> arg1 0))
      (set! arg0 (&-> arg0 2))
      (+! s4-0 2)
      (&-> arg1 1)
      )
    (set! (-> arg0 0) (the-as uint 0))
    (&-> arg0 1)
    (+ s4-0 1)
    )
  (none)
  )