Files
jak-project/test/decompiler/reference/engine/load/load-dgo_REF.gc
T
ManDude 1e11a588f5 [decomp] loader prelim work + some cleanup (#697)
* [decomp] `loader` prelim work + some cleanup

* more things

* more

* even more

* yet even more

* minor fixes

* decompiler fix + use behaviors for two funcs

* last functions

* Create loader_REF.gc

* more work

* change vag tool config format + unrelated farmer and yakow stuff

* update some things

* fix some decomp

* cleanup things i came across + make dgo compileable

* fix consistency test

* update refs

* offline test: skip buggy `external-art-buffer` method

* fix test
2021-07-23 18:30:49 -04:00

408 lines
11 KiB
Common Lisp
Vendored

;;-*-Lisp-*-
(in-package goal)
;; definition of type load-dgo-msg
(deftype load-dgo-msg (structure)
((rsvd uint16 :offset-assert 0)
(result load-msg-result :offset-assert 2)
(b1 pointer :offset-assert 4)
(b2 pointer :offset-assert 8)
(bt pointer :offset-assert 12)
(name uint128 :offset-assert 16)
(name-chars uint8 16 :offset 16)
(address uint32 :offset 4)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
;; definition for method 3 of type load-dgo-msg
;; Used lq/sq
(defmethod inspect load-dgo-msg ((obj load-dgo-msg))
(format #t "[~8x] ~A~%" obj 'load-dgo-msg)
(format #t "~Trsvd: ~D~%" (-> obj rsvd))
(format #t "~Tresult: ~D~%" (-> obj result))
(format #t "~Tb1: #x~X~%" (-> obj b1))
(format #t "~Tb2: #x~X~%" (-> obj b2))
(format #t "~Tbt: #x~X~%" (-> obj bt))
(format #t "~Tname: ~D~%" (-> obj name))
(format #t "~Taddress: ~D~%" (-> obj b1))
obj
)
;; definition of type load-chunk-msg
(deftype load-chunk-msg (structure)
((rsvd uint16 :offset-assert 0)
(result load-msg-result :offset-assert 2)
(address pointer :offset-assert 4)
(section uint32 :offset-assert 8)
(maxlen uint32 :offset-assert 12)
(id uint32 :offset 4)
(basename uint8 48 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
;; definition for method 3 of type load-chunk-msg
(defmethod inspect load-chunk-msg ((obj load-chunk-msg))
(format #t "[~8x] ~A~%" obj 'load-chunk-msg)
(format #t "~Trsvd: ~D~%" (-> obj rsvd))
(format #t "~Tresult: ~D~%" (-> obj result))
(format #t "~Taddress: ~D~%" (-> obj address))
(format #t "~Tsection: ~D~%" (-> obj section))
(format #t "~Tmaxlen: ~D~%" (-> obj maxlen))
(format #t "~Tid: ~D~%" (-> obj address))
(format #t "~Tbasename[48] @ #x~X~%" (-> obj basename))
obj
)
;; definition of type dgo-header
(deftype dgo-header (structure)
((length uint32 :offset-assert 0)
(rootname uint8 60 :offset-assert 4)
(data uint8 :dynamic :offset-assert 64)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
;; definition for method 3 of type dgo-header
(defmethod inspect dgo-header ((obj dgo-header))
(format #t "[~8x] ~A~%" obj 'dgo-header)
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Trootname[60] @ #x~X~%" (-> obj rootname))
obj
)
;; failed to figure out what this is:
(when (zero? *load-dgo-rpc*)
(set!
*load-dgo-rpc*
(new 'global 'rpc-buffer-pair (the-as uint 32) (the-as uint 1) 3)
)
(set!
*load-str-rpc*
(new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 1) 4)
)
(set!
*play-str-rpc*
(new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 2) 5)
)
(set! *load-str-lock* #f)
(set! *que-str-lock* #f)
(set! *dgo-name* (new 'global 'string 64 (the-as string #f)))
)
;; definition for function str-load
(defun str-load ((name string) (chunk-id int) (address pointer) (len int))
(if (or (check-busy *load-str-rpc*) *load-str-lock*)
(return #f)
)
(let ((cmd (the-as load-chunk-msg (add-element *load-str-rpc*))))
(set! (-> cmd result) (load-msg-result invalid))
(set! (-> cmd address) address)
(set! (-> cmd section) (the-as uint chunk-id))
(set! (-> cmd maxlen) (the-as uint len))
(charp<-string (-> cmd basename) name)
(call *load-str-rpc* (the-as uint 0) (the-as pointer cmd) (the-as uint 32))
)
(set! *load-str-lock* #t)
(set! *que-str-lock* #t)
#t
)
;; definition for function str-load-status
(defun str-load-status ((length-out (pointer int32)))
(if (check-busy *load-str-rpc*)
(return 'busy)
)
(set! *load-str-lock* #f)
(set! *que-str-lock* #t)
(let ((response (the-as load-chunk-msg (pop-last-received *load-str-rpc*))))
(if (= (-> response result) (load-msg-result error))
(return 'error)
)
(set! (-> length-out 0) (the-as int (-> response maxlen)))
)
'complete
)
;; definition for function str-load-cancel
;; INFO: Return type mismatch int vs none.
(defun str-load-cancel ()
(set! *load-str-lock* #f)
(set! *que-str-lock* #t)
0
(none)
)
;; definition for function str-play-async
;; INFO: Return type mismatch int vs none.
(defun str-play-async ((name string) (addr sound-id))
(set! *que-str-lock* #t)
(let ((cmd (the-as load-chunk-msg (add-element *play-str-rpc*))))
(charp<-string (-> cmd basename) name)
(set! (-> cmd address) (the-as pointer addr))
(set! (-> cmd result) (load-msg-result done))
)
0
0
(none)
)
;; definition for function str-play-stop
;; INFO: Return type mismatch int vs none.
(defun str-play-stop ((name string))
(set! *que-str-lock* #t)
(let ((cmd (the-as load-chunk-msg (add-element *play-str-rpc*))))
(charp<-string (-> cmd basename) name)
(set! (-> cmd result) (load-msg-result error))
)
0
(none)
)
;; definition for function str-play-queue
;; INFO: Return type mismatch int vs none.
(defun str-play-queue ((name string))
(when
(and
(not (check-busy *play-str-rpc*))
(not *load-str-lock*)
(not *que-str-lock*)
)
(let ((cmd (the-as load-chunk-msg (add-element *play-str-rpc*))))
(charp<-string (-> cmd basename) name)
(set! (-> cmd result) (load-msg-result more))
)
)
(set! *que-str-lock* #f)
0
(none)
)
;; definition for function str-ambient-play
;; INFO: Return type mismatch int vs none.
(defun str-ambient-play ((name string))
(set! *que-str-lock* #t)
(let ((cmd (the-as load-chunk-msg (add-element *play-str-rpc*))))
(set! (-> cmd basename 0) (the-as uint 36))
(charp<-string (&-> cmd basename 1) name)
(set! (-> cmd result) (load-msg-result done))
)
0
0
(none)
)
;; definition for function str-ambient-stop
;; INFO: Return type mismatch int vs none.
(defun str-ambient-stop ((name string))
(set! *que-str-lock* #t)
(let ((cmd (the-as load-chunk-msg (add-element *play-str-rpc*))))
(set! (-> cmd basename 0) (the-as uint 36))
(charp<-string (&-> cmd basename 1) name)
(set! (-> cmd result) (load-msg-result error))
)
0
(none)
)
;; definition for function str-play-kick
;; INFO: Return type mismatch int vs none.
(defun str-play-kick ()
(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)
)
;; definition for symbol *dgo-time*, type uint
(define *dgo-time* (the-as uint 0))
;; definition for function dgo-load-begin
;; Used lq/sq
(defun
dgo-load-begin
((name string) (buffer1 pointer) (buffer2 pointer) (current-heap pointer))
(set! *dgo-time* (-> *display* real-integral-frame-counter))
(format 0 "Starting level load clock~%")
(sync *load-dgo-rpc* #t)
(let ((cmd (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
(set! (-> cmd result) (load-msg-result invalid))
(set! (-> cmd b1) buffer1)
(set! (-> cmd b2) buffer2)
(set! (-> cmd bt) current-heap)
(set! (-> cmd name) (string->sound-name name))
(call *load-dgo-rpc* (the-as uint 0) (the-as pointer cmd) (the-as uint 32))
cmd
)
)
;; definition for function dgo-load-get-next
(defun dgo-load-get-next ((last-object (pointer symbol)))
(set! (-> last-object 0) #t)
(let ((load-location (the-as pointer #f)))
(when (not (check-busy *load-dgo-rpc*))
(let ((response (the-as load-dgo-msg (pop-last-received *load-dgo-rpc*))))
(when response
(if
(or
(= (-> response result) (load-msg-result done))
(= (-> response result) (load-msg-result more))
)
(set! load-location (-> response b1))
)
(if (= (-> response result) (load-msg-result more))
(set! (-> last-object 0) #f)
)
(if (= (-> response result) (load-msg-result done))
(format
0
"Elapsed time for level = ~Fs~%"
(*
0.016666668
(the float (- (-> *display* real-integral-frame-counter) *dgo-time*))
)
)
)
)
)
)
load-location
)
)
;; definition for function dgo-load-continue
;; INFO: Return type mismatch load-dgo-msg vs int.
;; Used lq/sq
(defun dgo-load-continue ((current-heap pointer))
(let ((cmd (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
(set! (-> cmd result) (load-msg-result invalid))
(set! (-> cmd b1) (the-as pointer 0))
(set! (-> cmd b2) (the-as pointer 0))
(set! (-> cmd bt) current-heap)
(set! (-> cmd name) (the-as uint128 0))
(call *load-dgo-rpc* (the-as uint 1) (the-as pointer cmd) (the-as uint 32))
(the-as int cmd)
)
)
;; definition for function dgo-load-cancel
;; INFO: Return type mismatch int vs none.
(defun dgo-load-cancel ()
(sync *load-dgo-rpc* #t)
(let ((cmd (add-element *load-dgo-rpc*)))
(call *load-dgo-rpc* (the-as uint 2) cmd (the-as uint 32))
)
0
(none)
)
;; definition for function find-temp-buffer
(defun find-temp-buffer ((size int))
(let ((qwc (+ (/ size 16) 2)))
(cond
((<
(the-as uint qwc)
(the-as
uint
(dma-buffer-free
(-> *display* frames (-> *display* on-screen) frame global-buf)
)
)
)
(logand
-16
(&+
(-> *display* frames (-> *display* on-screen) frame global-buf base)
15
)
)
)
((<
(the-as uint qwc)
(the-as
uint
(dma-buffer-free
(-> *display* frames (-> *display* on-screen) frame global-buf)
)
)
)
(logand
-16
(&+
(-> *display* frames (-> *display* on-screen) frame global-buf base)
15
)
)
)
)
)
)
;; definition for function dgo-load-link
(defun
dgo-load-link
((obj-file dgo-header) (heap kheap) (print-login symbol) (last-object symbol))
(let ((obj-data (-> obj-file data)))
(if
(>=
(the-as int (&+ obj-data (-> obj-file length)))
(the-as int (-> heap top-base))
)
(format
0
"ERROR: -----> dgo file header #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
obj-file
heap
(&- (&+ obj-data (-> obj-file length)) (the-as uint (-> heap top-base)))
)
)
(if last-object
(format
0
"NOTICE: loaded ~g, ~D bytes (~f K) at top ~D~%"
(-> obj-file rootname)
(-> obj-file length)
(* 0.0009765625 (the float (-> obj-file length)))
(&- (&+ obj-data (-> obj-file length)) (the-as uint (-> heap base)))
)
)
(string<-charp (clear *dgo-name*) (-> obj-file rootname))
(nonzero?
(link-begin
obj-data
(-> *dgo-name* data)
(the-as int (-> obj-file length))
heap
(the-as link-flag (if print-login
47
39
)
)
)
)
)
)
;; definition for function destroy-mem
;; INFO: Return type mismatch int vs none.
(defun destroy-mem ((arg0 (pointer uint32)) (arg1 (pointer uint32)))
(while (< (the-as int arg0) (the-as int arg1))
(set! (-> arg0 0) (the-as uint #xffffffff))
(set! arg0 (&-> arg0 1))
)
0
(none)
)