Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 11:26:18 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity

fix decomp bugs and add ref tests (#930)

Browse source
This commit is contained in:
water111 2021-10-23 10:41:11 -04:00 committed by GitHub
parent 55a3d3f503
commit 49e3fa2963
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
23 changed files with 11819 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
decompiler/IR2/AtomicOpTypeAnalysis.cpp
View file

@ -594,12 +594,18 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input,
return TP_Type::make_from_ts(arg0_type.typespec());
}
if ((m_kind == Kind::ADD || m_kind == Kind::SUB) &&
arg1_type.typespec().base_type() == "pointer" && tc(dts, TypeSpec("integer"), arg0_type)) {
if (m_kind == Kind::ADD && arg1_type.typespec().base_type() == "pointer" &&
tc(dts, TypeSpec("integer"), arg0_type)) {
// plain pointer plus integer = plain pointer
return TP_Type::make_from_ts(arg1_type.typespec());
}
if (m_kind == Kind::SUB && arg1_type.typespec().base_type() == "pointer" &&
tc(dts, TypeSpec("integer"), arg0_type)) {
// plain pointer plus integer = plain pointer
return TP_Type::make_from_ts(arg0_type.typespec());
}
if (m_kind == Kind::ADD && tc(dts, TypeSpec("structure"), arg0_type) &&
arg1_type.is_integer_constant()) {
auto type_info = dts.ts.lookup_type(arg0_type.typespec());

2
decompiler/config/all-types.gc
View file

@ -1596,7 +1596,7 @@
(define-extern enter-state (function object object object object object object object))
(define-extern inherit-state (function state state state))
(define-extern send-event-function (function process event-message-block object))
(define-extern send-event-function (function process-tree event-message-block object))
(define-extern looping-code (function symbol))

2
decompiler/config/jak1_ntsc_black_label/hacks.jsonc
View file

@ -501,7 +501,7 @@
21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33
],
"(method 11 fact-info-target)": [42],
"(anon-function 9 game-save)": [3, 4, 5, 6, 7, 8],
"(anon-function 9 game-save)": [3, 4, 5, 6, 7, 8, 10],
//"(anon-function 9 game-save)":[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14],
"particle-adgif": [0, 1, 2, 3, 4, 5, 7],
"sp-launch-particles-var": [

10
decompiler/config/jak1_ntsc_black_label/type_casts.jsonc
View file

@ -80,6 +80,10 @@
[101, "t9", "(function object object object object object object none)"]
],
"send-event-function": [
[[7,12], "a0", "process"]
],
// MATH
"log2": [[3, "v1", "int"]],
@ -2044,11 +2048,11 @@
[[113, 165], "a0", "game-save-tag"],
[[148, 166], "s2", "game-save-tag"],
[[148, 168], "s4", "game-save-tag"],
[[171, 222], "a0", "game-save-tag"],
[[234, 241], "a0", "game-save-tag"],
[[171, 221], "a0", "game-save-tag"],
[[234, 240], "a0", "game-save-tag"],
[[253, 276], "a0", "game-save-tag"],
[[283, 302], "a0", "game-save-tag"],
[[319, 325], "a1", "game-save-tag"],
[[319, 324], "a1", "game-save-tag"],
[[342, 348], "a1", "game-save-tag"],
[[395, 468], "a0", "game-save-tag"],
[[480, 488], "a0", "game-save-tag"],

30
goal_src/engine/game/game-save.gc
View file

@ -1799,15 +1799,7 @@
(format 0 "auto-save-init!~%")
;; trying to create multiple auto save procs, bad idea.
(when (handle->process (-> *game-info* auto-save-proc))
(let ((a1-2 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-2 from) self)
(set! (-> a1-2 num-params) 2)
(set! (-> a1-2 message) 'notify)
(set! (-> a1-2 param 0) (the-as uint 'error))
(set! (-> a1-2 param 1) (the-as uint 16))
(format 0 "auto save proc error~%")
(send-event-function (the-as process notify-proc) a1-2)
)
(send-event notify-proc 'notify 'error 16)
(return #f)
)
@ -2243,15 +2235,7 @@
(set! (-> self result) arg0)
(let ((s5-0 *auto-save-info*))
(mem-copy! (the-as pointer s5-0) (the-as pointer (-> self info)) 300)
(let ((a1-2 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-2 from) self)
(set! (-> a1-2 num-params) 3)
(set! (-> a1-2 message) 'notify)
(set! (-> a1-2 param 0) (the-as uint 'error))
(set! (-> a1-2 param 1) (the-as uint (-> self result)))
(set! (-> a1-2 param 2) (the-as uint s5-0))
(send-event-function (handle->process (-> self notify)) a1-2)
)
(send-event (handle->process (-> self notify)) 'notify 'error (-> self result) s5-0)
)
(let ((t9-3 format)
(a0-7 #t)
@ -2362,15 +2346,7 @@
)
(let ((gp-0 *auto-save-info*))
(mem-copy! (the-as pointer gp-0) (the-as pointer (-> self info)) 300)
(let ((a1-5 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-5 from) self)
(set! (-> a1-5 num-params) 3)
(set! (-> a1-5 message) 'notify)
(set! (-> a1-5 param 0) (the-as uint 'done))
(set! (-> a1-5 param 1) (the-as uint 1))
(set! (-> a1-5 param 2) (the-as uint gp-0))
(send-event-function (handle->process (-> self notify)) a1-5)
)
(send-event (handle->process (-> self notify)) 'notify 'done 1 gp-0)
)
(case (-> self mode)
(('auto-save)

1
goal_src/engine/gfx/sky/sky.gc
View file

@ -118,6 +118,7 @@
;; skipping old sky stuff (for now)
(define sky-vu1-block (new 'static 'vu-function))
;; this stuff seems to only be used by the "old" sky renderer, which is never used.
;; TODO sky-init-upload-data
;; sky-add-frame-data
;; sky-upload

2
goal_src/kernel/gkernel-h.gc
View file

@ -429,7 +429,7 @@
;; perhaps when deleting a process you could have it set self to #f?
;; I don't see this happen anywhere though, so it's not clear.
`(let ((the-pp ,ppointer))
(the process (if the-pp (-> the-pp 0 self)))
(the process-tree (if the-pp (-> the-pp 0 self)))
)
)

8
goal_src/kernel/gstate.gc
View file

@ -428,14 +428,14 @@ It type checks the arguments for the entry function.
)
)
(defun send-event-function ((proc process) (msg event-message-block))
(defun send-event-function ((proc process-tree) (msg event-message-block))
"Function to send an event to a process. Please use the send-event macros when possible"
(with-pp
(when (and proc (!= (-> proc type) process-tree) (-> proc event-hook))
(when (and proc (!= (-> proc type) process-tree) (-> (the process proc) event-hook))
(let ((pp-backup pp))
(set! pp proc)
(let ((result ((-> proc event-hook) (-> msg from) (-> msg num-params) (-> msg message) msg)))
(set! pp (the process proc))
(let ((result ((-> (the process proc) event-hook) (-> msg from) (-> msg num-params) (-> msg message) msg)))
(set! pp pp-backup)
result
)

2
test/decompiler/reference/decompiler-macros.gc vendored
View file

@ -111,7 +111,7 @@
;; perhaps when deleting a process you could have it set self to #f?
;; I don't see this happen anywhere though, so it's not clear.
`(let ((the-pp ,ppointer))
(the process (if the-pp (-> the-pp 0 self)))
(the process-tree (if the-pp (-> the-pp 0 self)))
)
)

2697
test/decompiler/reference/engine/game/game-save_REF.gc vendored Normal file
View file

File diff suppressed because it is too large Load diff

18
test/decompiler/reference/engine/gfx/hw/display_REF.gc vendored
View file

@ -591,7 +591,14 @@
)
(set! (-> a2-4 base) (&+ gif-buf 32))
)
(let ((total-qwc (/ (&+ (- -16 (the-as int end-dma)) (-> buf base)) 16)))
(let
((total-qwc
(/
(the-as int (+ (- -16 (the-as int end-dma)) (the-as int (-> buf base))))
16
)
)
)
(cond
((nonzero? total-qwc)
(logior!
@ -715,7 +722,14 @@
(set! (-> (the-as (pointer uint64) gif-buf) 9) (the-as uint 0))
(set! (-> t0-2 base) (&+ gif-buf 80))
)
(let ((total-qwc (/ (&+ (- -16 (the-as int end-dma)) (-> buf base)) 16)))
(let
((total-qwc
(/
(the-as int (+ (- -16 (the-as int end-dma)) (the-as int (-> buf base))))
16
)
)
)
(cond
((nonzero? total-qwc)
(logior!

1
test/decompiler/reference/engine/gfx/sky/sky-h_REF.gc vendored
View file

@ -294,6 +294,7 @@
)
;; definition for method 3 of type sky-vertex
;; INFO: this function exists in multiple non-identical object files
(defmethod inspect sky-vertex ((obj sky-vertex))
(format #t "[~8x] ~A~%" obj 'sky-vertex)
(format #t "~Tpos: #<vector @ #x~X>~%" (-> obj pos))

1333
test/decompiler/reference/engine/gfx/sky/sky-tng_REF.gc vendored Normal file
View file

File diff suppressed because it is too large Load diff

2
test/decompiler/reference/engine/gfx/texture_REF.gc vendored
View file

@ -3036,7 +3036,7 @@
unlink-textures-in-heap!
texture-page-dir
((obj texture-page-dir) (heap kheap))
(local-vars (dist-past-end pointer))
(local-vars (dist-past-end uint))
(let ((mem-start (-> heap base))
(mem-end (-> heap top-base))
)

804
test/decompiler/reference/engine/gfx/time-of-day_REF.gc vendored Normal file
View file

@ -0,0 +1,804 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for method 5 of type time-of-day-palette
;; INFO: Return type mismatch uint vs int.
(defmethod asize-of time-of-day-palette ((obj time-of-day-palette))
(the-as int (+ (-> obj type size) (* (* (-> obj height) (-> obj width)) 4)))
)
;; failed to figure out what this is:
(if (zero? time-of-day-effect)
(set! time-of-day-effect nothing)
)
;; definition for function time-of-day-update
;; INFO: Return type mismatch int vs none.
(defbehavior time-of-day-update time-of-day-proc ()
(time-of-day-effect)
(cond
((and
(or (>= (-> self hour) 19) (>= 5 (-> self hour)))
(and
(< 45.0 (-> *time-of-day-context* num-stars))
(-> *time-of-day-context* sky)
)
)
(when
(and
*dproc*
(< (-> self star-count) (the int (-> *time-of-day-context* num-stars)))
)
(spawn (-> self stars) (math-camera-pos))
(+! (-> self star-count) 1)
)
)
((> (-> self star-count) 0)
(forall-particles-with-key
(-> self stars)
(lambda ((arg0 sparticle-system) (arg1 sparticle-cpuinfo))
(if (< (the-as uint #x493e0) (-> arg1 next-time))
(set! (-> arg1 next-time) (the-as uint 5))
(sparticle-kill-it arg0 arg1)
)
(none)
)
#t
#t
)
(set! (-> self star-count) 0)
0
)
)
(cond
((and
(>= (-> self time-of-day) 6.25)
(< (-> self time-of-day) 18.75)
(!= (-> *time-of-day-context* sun-fade) 0.0)
)
(when (and *dproc* (zero? (-> self sun-count)))
(spawn (-> self sun) (math-camera-pos))
(+! (-> self sun-count) 1)
)
)
((> (-> self sun-count) 0)
(kill-and-free-particles (-> self sun))
(set! (-> self sun-count) 0)
0
)
)
(cond
((and
(or (>= (-> self time-of-day) 21.75) (>= 10.25 (-> self time-of-day)))
(!= (-> *time-of-day-context* sun-fade) 0.0)
)
(when (and *dproc* (zero? (-> self green-sun-count)))
(spawn (-> self green-sun) (math-camera-pos))
(+! (-> self green-sun-count) 1)
)
)
((> (-> self green-sun-count) 0)
(kill-and-free-particles (-> self green-sun))
(set! (-> self green-sun-count) 0)
0
)
)
(update-sky-tng-data (-> self time-of-day))
0
(none)
)
;; failed to figure out what this is:
(defstate time-of-day-tick (time-of-day-proc)
:code
(behavior ()
(while #t
(+!
(-> self frame)
(the int (* (-> self time-ratio) (-> *display* time-adjust-ratio)))
)
(when (>= (-> self frame) 300)
(while (>= (-> self frame) 300)
(+! (-> self frame) -300)
(+! (-> self second) 1)
)
(when (>= (-> self second) 60)
(while (>= (-> self second) 60)
(+! (-> self second) -60)
(+! (-> self minute) 1)
)
(when (>= (-> self minute) 60)
(while (>= (-> self minute) 60)
(+! (-> self minute) -60)
(+! (-> self hour) 1)
)
(when (>= (-> self hour) 24)
(while (>= (-> self hour) 24)
(+! (-> self hour) -24)
(+! (-> self day) 1)
)
(when (>= (-> self day) 7)
(while (>= (-> self day) 7)
(+! (-> self day) -7)
(+! (-> self week) 1)
)
(when (>= (-> self week) 4)
(while (>= (-> self week) 4)
(+! (-> self week) -4)
(+! (-> self month) 1)
)
(when (>= (-> self month) 12)
(while (>= (-> self month) 12)
(+! (-> self month) -12)
(+! (-> self year) 1)
)
)
)
)
)
)
)
)
(let* ((f0-4 (the float (-> self frame)))
(f0-6 (+ (* 0.0033333334 f0-4) (the float (-> self second))))
(f0-8 (+ (* 0.016666668 f0-6) (the float (-> self minute))))
(f0-10 (+ (* 0.016666668 f0-8) (the float (-> self hour))))
)
(set! (-> self time-of-day) f0-10)
(set! (-> *time-of-day-context* time) f0-10)
)
(suspend)
)
(none)
)
:post
time-of-day-update
)
;; definition for function init-time-of-day
;; INFO: Return type mismatch object vs none.
(defbehavior init-time-of-day time-of-day-proc ()
(stack-size-set! (-> self main-thread) 128)
(set! (-> self year) 0)
(set! (-> self month) 0)
(set! (-> self week) 0)
(set! (-> self day) 0)
(set! (-> self hour) 0)
(set! (-> self minute) 0)
(set! (-> self second) 0)
(set! (-> self frame) 0)
(set! (-> self time-of-day) 0.0)
(if *time-of-day-fast*
(set! (-> self time-ratio) 18000.0)
(set! (-> self time-ratio) 300.0)
)
(set! (-> self star-count) 0)
(set!
(-> self stars)
(create-launch-control (-> *part-group-id-table* 34) self)
)
(set!
(-> self sun)
(create-launch-control (-> *part-group-id-table* 35) self)
)
(set!
(-> self green-sun)
(create-launch-control (-> *part-group-id-table* 36) self)
)
(go time-of-day-tick)
(none)
)
;; definition for function start-time-of-day
;; INFO: Return type mismatch (pointer process) vs none.
(defun start-time-of-day ()
(kill-by-name 'time-of-day-proc *active-pool*)
(let ((gp-0 (get-process *default-dead-pool* time-of-day-proc #x4000)))
(set! *time-of-day-proc* (the-as (pointer time-of-day-proc) (when gp-0
(let
((t9-2
(method-of-type
time-of-day-proc
activate
)
)
)
(t9-2
(the-as
time-of-day-proc
gp-0
)
*default-pool*
'time-of-day-proc
(the-as
pointer
#x70004000
)
)
)
(run-now-in-process
gp-0
init-time-of-day
)
(->
gp-0
ppointer
)
)
)
)
)
(none)
)
;; definition for function time-of-day-setup
(defun time-of-day-setup ((arg0 symbol))
(when arg0
(cond
((= (-> *time-of-day-proc* 0 time-ratio) 0.0)
(if *time-of-day-fast*
(set! (-> *time-of-day-proc* 0 time-ratio) 18000.0)
(set! (-> *time-of-day-proc* 0 time-ratio) 300.0)
)
(set! *time-of-day-mode* 8)
)
(else
(set! (-> *time-of-day-proc* 0 time-ratio) 0.0)
(set! *time-of-day-mode* 4)
(set! (-> *time-of-day-proc* 0 hour) 12)
(set! (-> *time-of-day-proc* 0 minute) 0)
0
)
)
)
(if (= (-> *time-of-day-proc* 0 time-ratio) 0.0)
#f
#t
)
)
;; definition for function set-time-of-day
;; INFO: Return type mismatch int vs none.
(defun set-time-of-day ((arg0 float))
(let ((v1-0 *time-of-day-proc*))
(set! (-> v1-0 0 hour) (the int arg0))
(let ((a0-1 (* 60.0 (- arg0 (the float (the int arg0))))))
(set! (-> v1-0 0 minute) (the int a0-1))
(set!
(-> v1-0 0 second)
(the int (* 60.0 (- a0-1 (the float (the int a0-1)))))
)
)
)
0
(none)
)
;; definition for function time-of-day-interp-colors
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function time-of-day-interp-colors-scratch
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function init-time-of-day-context
(defun init-time-of-day-context ((arg0 time-of-day-context))
(set-vector! (-> arg0 title-light-group dir0 color) 0.82 0.82 0.82 1.0)
(set-vector! (-> arg0 title-light-group dir1 color) 2.0 2.0 2.0 1.0)
(set-vector! (-> arg0 title-light-group ambi color) 0.5 0.5 0.5 1.0)
(set! (-> arg0 title-light-group dir0 levels x) 1.0)
(set! (-> arg0 title-light-group dir1 levels x) 1.0)
(let ((f0-14 1.0))
(set! (-> arg0 title-light-group ambi levels x) f0-14)
f0-14
)
)
;; definition for function update-time-of-day
;; INFO: Return type mismatch int vs none.
;; Used lq/sq
(defun update-time-of-day ((arg0 time-of-day-context))
(set! (-> arg0 sky) #f)
(set! (-> arg0 target-interp) 0.0)
(when *target*
(set! (-> *target* draw light-index) (the-as uint 0))
(when (-> *target* sidekick)
(set! (-> *target* sidekick 0 draw light-index) (the-as uint 0))
0
)
)
(dotimes (v1-12 (-> *level* length))
(let ((a0-4 (-> *level* level v1-12)))
(when (= (-> a0-4 status) 'active)
(if (-> a0-4 info sky)
(set! (-> arg0 sky) #t)
)
)
)
)
(let ((s4-0 (the-as (array float) (new 'stack 'array float 2))))
0.0
(let ((s5-0 0)
(f30-0 (-> arg0 current-interp))
)
(set! *lightning-frame-done* #f)
(set! *lightning-realtime-done* #f)
(dotimes (s3-0 2)
(let ((s2-0 (-> *level* level s3-0)))
(cond
((!= (-> s2-0 status) 'inactive)
(set! (-> s4-0 s3-0) (-> s2-0 level-distance))
(set! (-> arg0 moods s3-0) (-> s2-0 mood))
((-> s2-0 mood-func) (-> s2-0 mood) (-> arg0 time) s3-0)
(if (and (= (-> s2-0 status) 'active) (-> s2-0 info sky))
(+! s5-0 1)
)
)
(else
(set! (-> s4-0 s3-0) 4095996000.0)
(set! (-> arg0 moods s3-0) *default-mood*)
(update-mood-default *default-mood* (-> arg0 time) 0)
)
)
)
)
(let* ((f0-6 (-> s4-0 0))
(f1-0 (-> s4-0 1))
(f28-0 (cond
((= f1-0 4095996000.0)
0.0
)
((= f0-6 4095996000.0)
1.0
)
((= f0-6 f1-0)
0.5
)
((and
(< 0.0 (-> *math-camera* trans y))
(= (-> *level* level0 name) 'village2)
(= (-> *level* level1 name) 'sunken)
)
0.0
)
((and
(< 0.0 (-> *math-camera* trans y))
(= (-> *level* level0 name) 'sunken)
(= (-> *level* level1 name) 'village2)
)
1.0
)
(else
(/ f0-6 (+ f0-6 f1-0))
)
)
)
)
(if *teleport*
(set! f30-0 f28-0)
)
(when (not (or (paused?) (= f28-0 f30-0)))
(let ((f0-7 (- f30-0 f28-0)))
(set! f30-0 (cond
((= (-> *setting-control* current video-mode) 'pal)
(cond
((< (fabs f0-7) 0.00396)
f28-0
)
((< f0-7 0.0)
(+ 0.00396 f30-0)
)
(else
(+ -0.00396 f30-0)
)
)
)
((< (fabs f0-7) 0.0033)
f28-0
)
((< f0-7 0.0)
(+ 0.0033 f30-0)
)
(else
(+ -0.0033 f30-0)
)
)
)
)
)
(set! (-> arg0 active-count) (the-as uint s5-0))
(set! (-> arg0 interp) f28-0)
)
(set! (-> arg0 current-interp) f30-0)
(set! *sky-drawn* #f)
(set! *cloud-drawn* #f)
(let ((s5-1 (-> arg0 current-fog)))
(cond
((= f30-0 0.0)
(let ((v1-67 (-> arg0 moods 0 current-fog)))
(set! (-> s5-1 fog-color quad) (-> v1-67 fog-color quad))
(set! (-> s5-1 fog-dists quad) (-> v1-67 fog-dists quad))
(set! (-> s5-1 erase-color quad) (-> v1-67 erase-color quad))
)
(set!
(-> arg0 current-prt-color quad)
(-> arg0 moods 0 current-prt-color quad)
)
(set!
(-> arg0 current-sun sun-color quad)
(-> arg0 moods 0 current-sun sun-color quad)
)
(set!
(-> arg0 current-sun env-color quad)
(-> arg0 moods 0 current-sun env-color quad)
)
(set!
(-> arg0 current-shadow quad)
(-> arg0 moods 0 current-shadow quad)
)
(set!
(-> arg0 current-shadow-color quad)
(-> arg0 moods 0 current-shadow-color quad)
)
(dotimes (s4-1 8)
(quad-copy!
(the-as pointer (-> arg0 light-group s4-1))
(the-as pointer (-> arg0 moods 0 light-group s4-1))
12
)
)
(set! (-> arg0 num-stars) (-> arg0 moods 0 num-stars))
(set! (-> arg0 sun-fade) (-> *level* level0 info sun-fade))
)
((= f30-0 1.0)
(let ((v1-88 (-> arg0 moods 1 current-fog)))
(set! (-> s5-1 fog-color quad) (-> v1-88 fog-color quad))
(set! (-> s5-1 fog-dists quad) (-> v1-88 fog-dists quad))
(set! (-> s5-1 erase-color quad) (-> v1-88 erase-color quad))
)
(set!
(-> arg0 current-prt-color quad)
(-> arg0 moods 1 current-prt-color quad)
)
(set!
(-> arg0 current-sun sun-color quad)
(-> arg0 moods 1 current-sun sun-color quad)
)
(set!
(-> arg0 current-sun env-color quad)
(-> arg0 moods 1 current-sun env-color quad)
)
(set!
(-> arg0 current-shadow quad)
(-> arg0 moods 1 current-shadow quad)
)
(set!
(-> arg0 current-shadow-color quad)
(-> arg0 moods 1 current-shadow-color quad)
)
(dotimes (s4-2 8)
(quad-copy!
(the-as pointer (-> arg0 light-group s4-2))
(the-as pointer (-> arg0 moods 1 light-group s4-2))
12
)
)
(set! (-> arg0 num-stars) (-> arg0 moods 1 num-stars))
(set! (-> arg0 sun-fade) (-> *level* level1 info sun-fade))
)
(else
(let ((s4-3 (-> arg0 moods 0 current-fog))
(s3-1 (-> arg0 moods 1 current-fog))
)
(vector4-lerp!
(-> s5-1 fog-color)
(-> s4-3 fog-color)
(-> s3-1 fog-color)
f30-0
)
(vector4-lerp!
(-> s5-1 fog-dists)
(-> s4-3 fog-dists)
(-> s3-1 fog-dists)
f30-0
)
(vector4-lerp!
(-> s5-1 erase-color)
(-> s4-3 erase-color)
(-> s3-1 erase-color)
f30-0
)
)
(vector4-lerp!
(-> arg0 current-prt-color)
(-> arg0 moods 0 current-prt-color)
(-> arg0 moods 1 current-prt-color)
f30-0
)
(vector4-lerp!
(the-as vector (-> arg0 current-sun))
(the-as vector (-> arg0 moods 0 current-sun))
(the-as vector (-> arg0 moods 1 current-sun))
f30-0
)
(vector4-lerp!
(-> arg0 current-sun env-color)
(-> arg0 moods 0 current-sun env-color)
(-> arg0 moods 1 current-sun env-color)
f30-0
)
(vector4-lerp!
(-> arg0 current-shadow)
(-> arg0 moods 0 current-shadow)
(-> arg0 moods 1 current-shadow)
f30-0
)
(vector4-lerp!
(-> arg0 current-shadow-color)
(-> arg0 moods 0 current-shadow-color)
(-> arg0 moods 1 current-shadow-color)
f30-0
)
(dotimes (s4-4 8)
(dotimes (s3-2 3)
(let ((s2-1 (+ (+ (* 48 s3-2) 156 (* 192 s4-4)) (the-as int arg0))))
(let
((s1-0
(+ (+ (* 48 s3-2) 156 (* 192 s4-4)) (the-as int (-> arg0 moods 0)))
)
(s0-0
(+ (+ (* 48 s3-2) 156 (* 192 s4-4)) (the-as int (-> arg0 moods 1)))
)
)
(vector4-lerp!
(the-as vector (+ s2-1 0))
(the-as vector (+ s1-0 0))
(the-as vector (+ s0-0 0))
f30-0
)
(vector4-lerp!
(the-as vector (+ s2-1 16))
(the-as vector (+ s1-0 16))
(the-as vector (+ s0-0 16))
f30-0
)
(vector4-lerp!
(the-as vector (+ s2-1 32))
(the-as vector (+ s1-0 32))
(the-as vector (+ s0-0 32))
f30-0
)
)
(vector-normalize! (the-as vector (+ s2-1 0)) 1.0)
)
)
(let ((s3-3 (+ (the-as uint (-> arg0 light-group 0 ambi)) (* 192 s4-4)))
(s2-2
(+
(the-as uint (-> arg0 moods 0 light-group 0 ambi))
(* 192 s4-4)
)
)
(s1-1
(+
(the-as uint (-> arg0 moods 1 light-group 0 ambi))
(* 192 s4-4)
)
)
)
(vector4-lerp!
(the-as vector (+ s3-3 0))
(the-as vector (+ s2-2 0))
(the-as vector (+ s1-1 0))
f30-0
)
(vector4-lerp!
(the-as vector (+ s3-3 16))
(the-as vector (+ s2-2 16))
(the-as vector (+ s1-1 16))
f30-0
)
(vector4-lerp!
(the-as vector (+ s3-3 32))
(the-as vector (+ s2-2 32))
(the-as vector (+ s1-1 32))
f30-0
)
)
)
(set!
(-> arg0 num-stars)
(+
(-> arg0 moods 0 num-stars)
(* (- (-> arg0 moods 1 num-stars) (-> arg0 moods 0 num-stars)) f30-0)
)
)
(let ((f0-20 (-> *level* level0 info sun-fade)))
(set!
(-> arg0 sun-fade)
(+ f0-20 (* f30-0 (- (-> *level* level1 info sun-fade) f0-20)))
)
)
)
)
(dotimes (s4-5 2)
(make-sky-textures arg0 s4-5)
)
(set! (-> sky-base-polygons 0 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 1 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 2 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 3 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 4 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 5 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 6 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 7 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 8 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 9 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 10 col quad) (-> s5-1 erase-color quad))
(set! (-> sky-base-polygons 11 col quad) (-> s5-1 erase-color quad))
)
)
)
(set!
(-> arg0 current-sun env-color x)
(* 0.5019608 (-> arg0 current-sun env-color x))
)
(set!
(-> arg0 current-sun env-color y)
(* 0.5019608 (-> arg0 current-sun env-color y))
)
(set!
(-> arg0 current-sun env-color z)
(* 0.5019608 (-> arg0 current-sun env-color z))
)
(set!
(-> arg0 current-sun env-color w)
(* 0.5019608 (-> arg0 current-sun env-color w))
)
(let ((v1-179 (-> arg0 current-fog)))
(set!
*fog-color*
(new 'static 'rgba
:r (the int (-> v1-179 fog-color x))
:g (the int (-> v1-179 fog-color y))
:b (the int (-> v1-179 fog-color z))
)
)
)
(let ((v1-184 (-> arg0 current-fog erase-color)))
(set!
(-> arg0 erase-color)
(new 'static 'rgba
:a #x80
:b (the int (-> v1-184 z))
:g (the int (-> v1-184 y))
:r (the int (-> v1-184 x))
)
)
)
(set! (-> *math-camera* fog-start) (-> arg0 current-fog fog-dists x))
(set! (-> *math-camera* fog-end) (-> arg0 current-fog fog-dists y))
(set! (-> *math-camera* fog-max) (-> arg0 current-fog fog-dists z))
(set! (-> *math-camera* fog-min) (-> arg0 current-fog fog-dists w))
(let* ((v1-195 (-> *target* draw light-index))
(f30-1 (-> arg0 target-interp))
(s4-6 (-> arg0 light-group))
(s5-2 (-> arg0 light-group v1-195))
)
(when (nonzero? v1-195)
(cond
((= f30-1 1.0)
)
((= f30-1 0.0)
(quad-copy!
(the-as pointer (-> arg0 light-group v1-195))
(the-as pointer (-> arg0 light-group))
12
)
)
(else
(dotimes (s3-4 4)
(vector4-lerp!
(the-as vector (+ (the-as uint (-> s5-2 dir0)) (* 48 s3-4)))
(the-as vector (+ (the-as uint (-> s4-6 0)) (* 48 s3-4)))
(the-as vector (+ (the-as uint (-> s5-2 dir0)) (* 48 s3-4)))
f30-1
)
(vector4-lerp!
(the-as vector (+ (the-as uint (-> s5-2 dir0 color)) (* 48 s3-4)))
(the-as vector (+ (the-as uint (-> s4-6 0 dir0 color)) (* 48 s3-4)))
(the-as vector (+ (the-as uint (-> s5-2 dir0 color)) (* 48 s3-4)))
f30-1
)
(vector4-lerp!
(the-as vector (+ (the-as uint (-> s5-2 dir0 levels)) (* 48 s3-4)))
(the-as vector (+ (the-as uint (-> s4-6 0 dir0 levels)) (* 48 s3-4)))
(the-as vector (+ (the-as uint (-> s5-2 dir0 levels)) (* 48 s3-4)))
f30-1
)
(vector-normalize!
(the-as vector (+ (the-as uint (-> s5-2 dir0)) (* 48 s3-4)))
1.0
)
)
)
)
(let ((a2-30 (new 'stack-no-clear 'vector)))
(set! (-> a2-30 x) (- (-> s5-2 dir0 direction x)))
(set! (-> a2-30 y) (- (-> s5-2 dir0 direction y)))
(set! (-> a2-30 z) (- (-> s5-2 dir0 direction z)))
(when (< (-> s5-2 dir0 direction y) 0.9063)
(let* ((f0-56 0.4226)
(f1-17 (-> a2-30 x))
(f1-19 (* f1-17 f1-17))
(f2-7 (-> a2-30 z))
(f0-57 (/ f0-56 (sqrtf (+ f1-19 (* f2-7 f2-7)))))
)
(set! (-> a2-30 x) (* (-> a2-30 x) f0-57))
(set! (-> a2-30 y) -0.9063)
(set! (-> a2-30 z) (* (-> a2-30 z) f0-57))
)
)
(vector4-lerp!
(-> arg0 current-shadow)
(-> arg0 current-shadow)
a2-30
f30-1
)
)
(vector-normalize! (-> arg0 current-shadow) 1.0)
)
)
(reset! *palette-fade-controls*)
0
(none)
)
;; definition for method 10 of type palette-fade-controls
;; Used lq/sq
(defmethod
set-fade!
palette-fade-controls
((obj palette-fade-controls)
(arg0 int)
(arg1 float)
(arg2 float)
(arg3 vector)
)
(cond
((and (>= arg0 0) (< arg0 8))
(let ((v1-3 (-> obj control arg0)))
(when (< arg2 (-> v1-3 actor-dist))
(if arg3
(set! (-> v1-3 trans quad) (-> arg3 quad))
)
(set! (-> v1-3 fade) (fmax 0.0 (fmin 1.993 arg1)))
(let ((f0-3 arg2))
(set! (-> v1-3 actor-dist) f0-3)
f0-3
)
)
)
)
(else
(format 0 "ERROR: Bogus palette-fade-control index!~%")
)
)
)
;; definition for method 9 of type palette-fade-controls
(defmethod reset! palette-fade-controls ((obj palette-fade-controls))
(countdown (v1-0 8)
(let ((a1-2 (-> obj control v1-0)))
(set! (-> a1-2 fade) 0.0)
(set! (-> a1-2 actor-dist) 4096000000.0)
)
)
#f
)
;; failed to figure out what this is:
(start-time-of-day)

4172
test/decompiler/reference/engine/level/load-boundary-data_REF.gc vendored Normal file
View file

File diff suppressed because it is too large Load diff

185
test/decompiler/reference/engine/level/load-boundary-h_REF.gc vendored Normal file
View file

@ -0,0 +1,185 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type lbvtx
(deftype lbvtx (structure)
((x float :offset-assert 0)
(y float :offset-assert 4)
(z float :offset-assert 8)
(v0 uint8 :offset-assert 12)
(v1 uint8 :offset-assert 13)
(v2 uint8 :offset-assert 14)
(ix uint8 :offset-assert 15)
(quad uint128 :offset 0)
(v vector :inline :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition for method 3 of type lbvtx
;; Used lq/sq
(defmethod inspect lbvtx ((obj lbvtx))
(format #t "[~8x] ~A~%" obj 'lbvtx)
(format #t "~Tx: ~f~%" (-> obj x))
(format #t "~Ty: ~f~%" (-> obj y))
(format #t "~Tz: ~f~%" (-> obj z))
(format #t "~Tv0: ~D~%" (-> obj v0))
(format #t "~Tv1: ~D~%" (-> obj v1))
(format #t "~Tv2: ~D~%" (-> obj v2))
(format #t "~Tix: ~D~%" (-> obj ix))
(format #t "~Tquad: ~D~%" (-> obj quad))
(format #t "~Tv: #<vector @ #x~X>~%" (&-> obj x))
obj
)
;; definition of type load-boundary-crossing-command
(deftype load-boundary-crossing-command (structure)
((cmd load-boundary-cmd :offset-assert 0)
(bparm uint8 3 :offset-assert 1)
(parm uint32 2 :offset-assert 4)
(lev0 basic :offset 4)
(lev1 basic :offset 8)
(displev basic :offset 4)
(dispcmd basic :offset 8)
(nick basic :offset 4)
(forcelev basic :offset 4)
(forceonoff basic :offset 8)
(checkname basic :offset 4)
)
:pack-me
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
;; definition for method 3 of type load-boundary-crossing-command
(defmethod
inspect
load-boundary-crossing-command
((obj load-boundary-crossing-command))
(format #t "[~8x] ~A~%" obj 'load-boundary-crossing-command)
(format #t "~Tcmd: ~D~%" (-> obj cmd))
(format #t "~Tbparm[3] @ #x~X~%" (-> obj bparm))
(format #t "~Tparm[2] @ #x~X~%" (-> obj parm))
(format #t "~Tlev0: ~A~%" (-> obj lev0))
(format #t "~Tlev1: ~A~%" (-> obj lev1))
(format #t "~Tdisplev: ~A~%" (-> obj lev0))
(format #t "~Tdispcmd: ~A~%" (-> obj lev1))
(format #t "~Tnick: ~A~%" (-> obj lev0))
(format #t "~Tforcelev: ~A~%" (-> obj lev0))
(format #t "~Tforceonoff: ~A~%" (-> obj lev1))
(format #t "~Tcheckname: ~A~%" (-> obj lev0))
obj
)
;; definition of type load-boundary
(deftype load-boundary (basic)
((num-points uint16 :offset-assert 4)
(flags load-boundary-flags :offset-assert 6)
(top-plane float :offset-assert 8)
(bot-plane float :offset-assert 12)
(tri-cnt int32 :offset-assert 16)
(next load-boundary :offset-assert 20)
(cmd-fwd load-boundary-crossing-command :inline :offset-assert 24)
(cmd-bwd load-boundary-crossing-command :inline :offset-assert 36)
(rejector vector :inline :offset-assert 48)
(data lbvtx 1 :inline :offset-assert 64)
(data2 lbvtx :inline :dynamic :offset 64)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
(:methods
(new (symbol type int symbol symbol) _type_ 0)
)
)
;; definition for method 3 of type load-boundary
(defmethod inspect load-boundary ((obj load-boundary))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tnum-points: ~D~%" (-> obj num-points))
(format #t "~Tflags: ~D~%" (-> obj flags))
(format #t "~Ttop-plane: ~f~%" (-> obj top-plane))
(format #t "~Tbot-plane: ~f~%" (-> obj bot-plane))
(format #t "~Ttri-cnt: ~D~%" (-> obj tri-cnt))
(format #t "~Tnext: ~A~%" (-> obj next))
(format
#t
"~Tcmd-fwd: #<load-boundary-crossing-command @ #x~X>~%"
(-> obj cmd-fwd)
)
(format
#t
"~Tcmd-bwd: #<load-boundary-crossing-command @ #x~X>~%"
(-> obj cmd-bwd)
)
(format #t "~Trejector: #<vector @ #x~X>~%" (-> obj rejector))
(format #t "~Tdata[1] @ #x~X~%" (-> obj data))
obj
)
;; definition for symbol *load-boundary-list*, type load-boundary
(define *load-boundary-list* (the-as load-boundary #f))
;; definition for symbol *load-boundary-target*, type (inline-array lbvtx)
(define *load-boundary-target* (the-as (inline-array lbvtx) (malloc 'global 64)))
;; definition for method 0 of type load-boundary
;; Used lq/sq
(defmethod
new
load-boundary
((allocation symbol)
(type-to-make type)
(arg0 int)
(arg1 symbol)
(arg2 symbol)
)
(let
((v0-0
(object-new
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 16)))
)
)
)
(set! (-> v0-0 num-points) (the-as uint arg0))
(cond
(arg1
(set! (-> v0-0 flags) (load-boundary-flags closed))
)
(else
(set! (-> v0-0 flags) (load-boundary-flags))
0
)
)
(set! (-> v0-0 top-plane) 524288.0)
(set! (-> v0-0 bot-plane) -524288.0)
(dotimes (v1-4 arg0)
(set! (-> v0-0 data v1-4 quad) (the-as uint128 0))
(set! (-> v0-0 data v1-4 ix) (the-as uint v1-4))
)
(set! (-> v0-0 tri-cnt) 0)
(set-vector! (-> v0-0 rejector) 0.0 0.0 0.0 268435460.0)
(set! (-> v0-0 cmd-fwd cmd) (load-boundary-cmd invalid))
(set! (-> v0-0 cmd-bwd cmd) (load-boundary-cmd invalid))
(when arg2
(set! (-> v0-0 next) *load-boundary-list*)
(set! *load-boundary-list* v0-0)
)
(if (not arg2)
(set! (-> v0-0 next) #f)
)
v0-0
)
)
;; failed to figure out what this is:
0

2560
test/decompiler/reference/engine/level/load-boundary_REF.gc vendored Normal file
View file

File diff suppressed because it is too large Load diff

13
test/decompiler/reference/kernel/gstate_REF.gc vendored
View file

@ -145,15 +145,20 @@
)
;; definition for function send-event-function
(defun send-event-function ((arg0 process) (arg1 event-message-block))
(defun send-event-function ((arg0 process-tree) (arg1 event-message-block))
(with-pp
(when (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
(when
(and
arg0
(!= (-> arg0 type) process-tree)
(-> (the-as process arg0) event-hook)
)
(let ((gp-0 pp))
(let ((s6-1 arg0))
(let ((s6-1 (the-as process arg0)))
)
(let
((v0-0
((-> arg0 event-hook)
((-> (the-as process arg0) event-hook)
(-> arg1 from)
(-> arg1 num-params)
(-> arg1 message)

6
test/decompiler/reference/levels/misty/misty-conveyor_REF.gc vendored
View file

@ -910,9 +910,9 @@
(let ((t9-8 send-event-function)
(v1-42 (-> self object-on-paddle))
)
(t9-8 (the-as process (if v1-42
(-> v1-42 0 max-value)
)
(t9-8 (the-as process-tree (if v1-42
(-> v1-42 0 max-value)
)
)
a1-2
)

2
test/decompiler/reference/levels/swamp/swamp-rat-nest_REF.gc vendored
View file

@ -1633,7 +1633,7 @@ swamp-rat-nest-default-event-handler
)
)
(if a0-1
(send-event (the-as process a0-1) 'victory)
(send-event a0-1 'victory)
)
)
(set! gp-0 (-> gp-0 0 brother))

2
test/decompiler/reference/levels/swamp/swamp-rat_REF.gc vendored
View file

@ -88,7 +88,7 @@
)
)
(if a0-4
(send-event (the-as process a0-4) 'victory)
(send-event (the-as process-tree a0-4) 'victory)
(go (method-of-object obj nav-enemy-victory))
)
)

9
test/offline/config.jsonc
View file

@ -89,6 +89,15 @@
// stat collection
"start-perf-stat-collection", "end-perf-stat-collection",
// double definition
"(method 3 game-save)",
// new stack boxed array
"update-time-of-day",
// weird asm, was rewritten
"close-sky-buffer",
// float to int
"(method 10 bsp-header)",