mirror of
https://github.com/open-goal/jak-project
synced 2026-08-09 10:54:39 -04:00
f3c63f26bb
Fixes https://github.com/open-goal/jak-project/issues/1821 by adding a special case for `new` method calls where the argument with type `symbol` is actually an address to uninitialized structure on the stack. Fixes https://github.com/open-goal/jak-project/issues/1849 (or at least the cause of the issue Vaser gave in chat, and one random one I found in `debug-sphere`) Fixes https://github.com/open-goal/jak-project/issues/1853 Fixes https://github.com/open-goal/jak-project/issues/1857 by moving the cast into the cond if the body is a single form and the destination type is a bitfield/enum which is likely to work well. Seems to work on the examples we could find in jak 1 and jak 2. Also fixes an issue with casts on the result of `handle->process` (a common place to use casts) the output of process->handle is a plain process. Most of the time, you end up casting this to a more specific. If you add a cast on every use of the variable, the decompiler will decide to change the type of that variable to the more specific type, and this breaks the handle cast. so previously it was impossible to get code like ``` (let* ((s2-0 (the-as swingpole (handle->process (-> self control hack)))) (gp-0 (-> s2-0 dir)) ) ``` But now it will work
371 lines
12 KiB
Common Lisp
371 lines
12 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: load-dgo.gc
|
|
;; name in dgo: load-dgo
|
|
;; dgos: ENGINE, GAME
|
|
|
|
;; status flag sent from OVERLORD about a DGO load.
|
|
(defenum load-msg-result
|
|
:type uint16
|
|
:bitfield #f
|
|
(done 0) ;; dgo fully loaded!
|
|
(error 1) ;; loading failed (file not found, etc)
|
|
(more 2) ;; more files exist!
|
|
(aborted 3) ;; status returned after a request to cancel.
|
|
(invalid 666) ;; invalid status indicating a communication error.
|
|
)
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(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)
|
|
(address uint32 :offset 4)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x20
|
|
:flag-assert #x900000020
|
|
)
|
|
|
|
(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)
|
|
(dummy uint32 4 :offset-assert 16)
|
|
(basename sound-stream-name :inline :offset-assert 32)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x50
|
|
:flag-assert #x900000050
|
|
)
|
|
|
|
(deftype play-chunk-msg (structure)
|
|
((rsvd uint16 :offset-assert 0)
|
|
(result uint16 :offset-assert 2)
|
|
(address pointer :offset-assert 4)
|
|
(section uint32 :offset-assert 8)
|
|
(maxlen uint32 :offset-assert 12)
|
|
(id uint32 4 :offset-assert 16)
|
|
(basename sound-stream-name 4 :inline :offset-assert 32)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #xe0
|
|
:flag-assert #x9000000e0
|
|
)
|
|
|
|
(deftype dgo-header (structure)
|
|
((length uint32 :offset-assert 0)
|
|
(rootname uint8 60 :offset-assert 4)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x40
|
|
:flag-assert #x900000040
|
|
)
|
|
|
|
(define-extern *load-dgo-rpc* rpc-buffer-pair)
|
|
(when (zero? *load-dgo-rpc*)
|
|
(define *load-dgo-rpc* (new 'global 'rpc-buffer-pair (the-as uint 32) (the-as uint 1) 3))
|
|
(define *load-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 1) 4))
|
|
(define *play-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 256) (the-as uint 2) 5))
|
|
(define *load-str-lock* #f)
|
|
(define *que-str-lock* #f)
|
|
(define *dgo-name* (new 'global 'string 64 (the-as string #f)))
|
|
)
|
|
|
|
(defun str-load ((arg0 string) (arg1 int) (arg2 pointer) (arg3 int))
|
|
(if (or (check-busy *load-str-rpc*) *load-str-lock*)
|
|
(return #f)
|
|
)
|
|
(let ((s2-0 (the-as load-chunk-msg (add-element *load-str-rpc*))))
|
|
(set! (-> s2-0 result) (load-msg-result invalid))
|
|
(set! (-> s2-0 address) arg2)
|
|
(set! (-> s2-0 section) (the-as uint arg1))
|
|
(set! (-> s2-0 maxlen) (the-as uint arg3))
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename)) arg0 48)
|
|
(call *load-str-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
|
|
)
|
|
(set! *load-str-lock* #t)
|
|
(set! *que-str-lock* #t)
|
|
#t
|
|
)
|
|
|
|
(defun str-load-status ((arg0 (pointer int32)))
|
|
(if (check-busy *load-str-rpc*)
|
|
(return 'busy)
|
|
)
|
|
(set! *load-str-lock* #f)
|
|
(set! *que-str-lock* #t)
|
|
(let ((v1-7 (the-as load-chunk-msg (pop-last-received *load-str-rpc*))))
|
|
(if (= (-> v1-7 result) (load-msg-result error))
|
|
(return 'error)
|
|
)
|
|
(set! (-> arg0 0) (the-as int (-> v1-7 maxlen)))
|
|
)
|
|
'complete
|
|
)
|
|
|
|
(defun str-load-cancel ()
|
|
(set! *load-str-lock* #f)
|
|
(set! *que-str-lock* #t)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun str-play-async ((arg0 string) (arg1 sound-id))
|
|
(set! *que-str-lock* #t)
|
|
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) arg0 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
|
|
(set! (-> s4-0 id 0) (the-as uint arg1))
|
|
(set! (-> s4-0 id 1) (the-as uint 0))
|
|
(set! (-> s4-0 id 2) (the-as uint 0))
|
|
(set! (-> s4-0 id 3) (the-as uint 0))
|
|
(set! (-> s4-0 result) (the-as uint 0))
|
|
)
|
|
0
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun str-play-stop ((arg0 string) (arg1 sound-id))
|
|
(set! *que-str-lock* #t)
|
|
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) arg0 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
|
|
(set! (-> s4-0 id 0) (the-as uint arg1))
|
|
(set! (-> s4-0 id 1) (the-as uint 0))
|
|
(set! (-> s4-0 id 2) (the-as uint 0))
|
|
(set! (-> s4-0 id 3) (the-as uint 0))
|
|
(set! (-> s4-0 result) (the-as uint 1))
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun str-play-queue ((arg0 string) (arg1 string) (arg2 string) (arg3 string) (arg4 (pointer uint32)) (arg5 pointer))
|
|
(when (and (not (check-busy *play-str-rpc*)) (not *load-str-lock*) (not *que-str-lock*))
|
|
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
|
|
(if arg0
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) arg0 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) "" 48)
|
|
)
|
|
(if arg1
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) arg1 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
|
|
)
|
|
(if arg2
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) arg2 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
|
|
)
|
|
(if arg3
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) arg3 48)
|
|
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
|
|
)
|
|
(dotimes (v1-15 4)
|
|
(set! (-> s4-0 id v1-15) (-> arg4 v1-15))
|
|
)
|
|
(set! (-> s4-0 address) arg5)
|
|
(set! (-> s4-0 result) (the-as uint 2))
|
|
)
|
|
)
|
|
(set! *que-str-lock* #f)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun str-ambient-play ((arg0 string))
|
|
(set! *que-str-lock* #t)
|
|
(let ((s5-0 (the-as load-chunk-msg (add-element *play-str-rpc*))))
|
|
(set! (-> s5-0 basename name 0) (the-as uint 36))
|
|
(copyn-charp<-string (&-> s5-0 basename name 1) arg0 48)
|
|
(set! (-> s5-0 result) (load-msg-result done))
|
|
)
|
|
0
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun str-ambient-stop ((arg0 string))
|
|
(set! *que-str-lock* #t)
|
|
(let ((s5-0 (the-as load-chunk-msg (add-element *play-str-rpc*))))
|
|
(set! (-> s5-0 basename name 0) (the-as uint 36))
|
|
(copyn-charp<-string (&-> s5-0 basename name 1) arg0 48)
|
|
(set! (-> s5-0 result) (load-msg-result error))
|
|
)
|
|
0
|
|
(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)
|
|
)
|
|
|
|
(define *dgo-time* (the-as time-frame 0))
|
|
|
|
(defun dgo-load-begin ((arg0 string) (arg1 pointer) (arg2 pointer) (arg3 pointer))
|
|
(set! *dgo-time* (the-as time-frame (-> *display* real-clock integral-frame-counter)))
|
|
(format 0 "Starting level load clock~%")
|
|
(sync *load-dgo-rpc* #t)
|
|
(let ((s2-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
|
|
(set! (-> s2-0 result) (load-msg-result invalid))
|
|
(set! (-> s2-0 b1) arg1)
|
|
(set! (-> s2-0 b2) arg2)
|
|
(set! (-> s2-0 bt) arg3)
|
|
(set! (-> s2-0 name) (string->sound-name arg0))
|
|
(call *load-dgo-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
|
|
s2-0
|
|
)
|
|
)
|
|
|
|
(defun dgo-load-get-next ((arg0 (pointer symbol)))
|
|
(set! (-> arg0 0) #f)
|
|
(let ((gp-0 (the-as pointer #f)))
|
|
(when (not (check-busy *load-dgo-rpc*))
|
|
(let ((v1-4 (the-as load-dgo-msg (pop-last-received *load-dgo-rpc*))))
|
|
(when v1-4
|
|
(when (or (= (-> v1-4 result) (load-msg-result done)) (= (-> v1-4 result) (load-msg-result more)))
|
|
(set! gp-0 (-> v1-4 b1))
|
|
(set! (-> arg0 0) #t)
|
|
)
|
|
(if (= (-> v1-4 result) (load-msg-result more))
|
|
(set! (-> arg0 0) #f)
|
|
)
|
|
(if (= (-> v1-4 result) (load-msg-result done))
|
|
(format
|
|
0
|
|
"Elapsed time for level = ~Fs~%"
|
|
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun dgo-load-continue ((arg0 pointer) (arg1 pointer) (arg2 pointer))
|
|
(let ((gp-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
|
|
(set! (-> gp-0 result) (load-msg-result invalid))
|
|
(set! (-> gp-0 b1) arg0)
|
|
(set! (-> gp-0 b2) arg1)
|
|
(set! (-> gp-0 bt) arg2)
|
|
(set! (-> gp-0 name) (the-as uint128 0))
|
|
(call *load-dgo-rpc* (the-as uint 1) (the-as pointer gp-0) (the-as uint 32))
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun dgo-load-cancel ()
|
|
(sync *load-dgo-rpc* #t)
|
|
(let ((a2-0 (add-element *load-dgo-rpc*)))
|
|
(call *load-dgo-rpc* (the-as uint 2) a2-0 (the-as uint 32))
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun find-temp-buffer ((arg0 int))
|
|
(let ((gp-0 (+ (/ arg0 16) 2)))
|
|
(cond
|
|
((< (the-as uint gp-0)
|
|
(the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
|
|
)
|
|
(logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
|
|
)
|
|
((< (the-as uint gp-0)
|
|
(the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
|
|
)
|
|
(logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun dgo-load-link ((arg0 dgo-header) (arg1 kheap) (arg2 uint) (arg3 symbol) (arg4 symbol))
|
|
(let ((s4-0 (the-as object (&+ arg0 64))))
|
|
(let ((v1-0 arg2))
|
|
(cond
|
|
((>= (the-as int (+ (the-as uint s4-0) (-> arg0 length))) (the-as int (-> arg1 top-base)))
|
|
(format
|
|
0
|
|
"ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
|
|
(-> arg0 rootname)
|
|
arg0
|
|
arg1
|
|
(- (+ (the-as uint s4-0) (-> arg0 length)) (the-as uint (-> arg1 top-base)))
|
|
)
|
|
)
|
|
((and (< (the-as int arg0) (the-as int v1-0))
|
|
(>= (the-as int (+ (the-as uint s4-0) (-> arg0 length))) (the-as int v1-0))
|
|
)
|
|
(format
|
|
0
|
|
"ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
|
|
(-> arg0 rootname)
|
|
arg0
|
|
arg1
|
|
(- (+ (the-as uint s4-0) (-> arg0 length)) v1-0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(if arg4
|
|
(format
|
|
0
|
|
"NOTICE: loaded ~g, ~D bytes (~f K) at top ~D at #x~X~%"
|
|
(-> arg0 rootname)
|
|
(-> arg0 length)
|
|
(* 0.0009765625 (the float (-> arg0 length)))
|
|
(- (+ (the-as uint s4-0) (-> arg0 length)) (the-as uint (-> arg1 base)))
|
|
arg0
|
|
)
|
|
)
|
|
(string<-charp (clear *dgo-name*) (-> arg0 rootname))
|
|
(nonzero? (link-begin
|
|
(the-as pointer s4-0)
|
|
(-> *dgo-name* data)
|
|
(the-as int (-> arg0 length))
|
|
arg1
|
|
(if arg3
|
|
(link-flag output-load-msg output-load-true-msg execute-login print-login fast-link)
|
|
(link-flag output-load-msg output-load-true-msg execute-login fast-link)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(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)
|
|
)
|
|
|
|
|
|
|
|
|