mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-08-05 01:30:22 -04:00
Code Issues Packages Projects Releases Wiki Activity

[decomp] finish actor-link-h and a few more (#592)

Browse Source 
* finish actor-link-h

* decompile files

* fix pp issue
This commit is contained in:
water111
2021-06-14 20:46:54 -04:00
committed by GitHub
parent fac4364aa4
commit 0aa474f12b
50 changed files with 3781 additions and 1122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/decompiler/reference/all_forward_declarations.gc
+26
View File
@@ -906,6 +906,7 @@
(defenum entity-perm-status
:bitfield #t
:type uint16
(bit-1 1)
(dead 2)
(complete 6))
@@ -1060,3 +1061,28 @@
)
)
(define-extern *progress-process* (pointer progress))
(define-extern entity-by-name (function string entity))
(define-extern entity-by-aid (function uint entity))
(declare-type nav-mesh basic)
(define-extern *default-nav-mesh* nav-mesh)
(defenum path-control-flag
:bitfield #t
:type uint32
(display 0)
(not-found 4)
)
(defenum nav-control-flags
:bitfield #t
:type uint32
(display-marks 0)
(bit8 8)
(bit13 13)
)
(defmacro with-pp (&rest body)
`(rlet ((pp :reg r13 :reset-here #t :type process))
,@body)
)
test/decompiler/reference/engine/anim/aligner-h_REF.gc
+17 -16
View File
@@ -47,25 +47,26 @@
new
align-control
((allocation symbol) (type-to-make type) (arg0 process))
(local-vars (pp process))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
(with-pp
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
)
(if (zero? obj)
(return (begin
(let ((t9-1 (the-as (function object object) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(t9-1 a0-1)
(if (zero? obj)
(return (begin
(let ((t9-1 (the-as (function object object) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(t9-1 a0-1)
)
(the-as align-control 0)
)
(the-as align-control 0)
)
)
)
(set! (-> obj process) arg0)
obj
)
(set! (-> obj process) arg0)
obj
)
)
test/decompiler/reference/engine/camera/cam-debug-h_REF.gc
+146
View File
@@ -0,0 +1,146 @@
;;-*-Lisp-*-
(in-package goal)
;; this file is debug only
(when *debug-segment*
;; definition for symbol *redline-table*, type (pointer float)
(define *redline-table* (the-as (pointer float) (malloc 'debug 1600)))
;; definition for symbol *redline-index*, type int
(define *redline-index* 0)
;; definition for function float-save-redline
;; INFO: Return type mismatch int vs none.
(defun float-save-redline ((arg0 float))
(set! (-> *redline-table* *redline-index*) arg0)
(set! *redline-index* (+ *redline-index* 1))
(when (>= *redline-index* 400)
(set! *redline-index* 0)
(let ((v0-1 0))
)
)
(none)
)
;; definition for function float-lookup-redline
(defun float-lookup-redline ((arg0 float))
(let ((a0-3 (mod (+ (+ (the int arg0) -1) *redline-index*) 400)))
(-> *redline-table* a0-3)
)
)
;; definition for symbol *blueline-table*, type (pointer float)
(define *blueline-table* (the-as (pointer float) (malloc 'debug 1600)))
;; definition for symbol *blueline-index*, type int
(define *blueline-index* 0)
;; definition for function float-save-blueline
;; INFO: Return type mismatch int vs none.
(defun float-save-blueline ((arg0 float))
(set! (-> *blueline-table* *blueline-index*) arg0)
(set! *blueline-index* (+ *blueline-index* 1))
(when (>= *blueline-index* 400)
(set! *blueline-index* 0)
(let ((v0-1 0))
)
)
(none)
)
;; definition for function float-lookup-blueline
(defun float-lookup-blueline ((arg0 float))
(let ((a0-3 (mod (+ (+ (the int arg0) -1) *blueline-index*) 400)))
(-> *blueline-table* a0-3)
)
)
;; definition for symbol *greenline-table*, type (pointer float)
(define *greenline-table* (the-as (pointer float) (malloc 'debug 1600)))
;; definition for symbol *greenline-index*, type int
(define *greenline-index* 0)
;; definition for function float-save-greenline
;; INFO: Return type mismatch int vs none.
(defun float-save-greenline ((arg0 float))
(set! (-> *greenline-table* *greenline-index*) arg0)
(set! *greenline-index* (+ *greenline-index* 1))
(when (>= *greenline-index* 400)
(set! *greenline-index* 0)
(let ((v0-1 0))
)
)
(none)
)
;; definition for function float-lookup-greenline
(defun float-lookup-greenline ((arg0 float))
(let ((a0-3 (mod (+ (+ (the int arg0) -1) *greenline-index*) 400)))
(-> *greenline-table* a0-3)
)
)
;; definition for symbol *yellowline-table*, type (pointer float)
(define *yellowline-table* (the-as (pointer float) (malloc 'debug 1600)))
;; definition for symbol *yellowline-index*, type int
(define *yellowline-index* 0)
;; definition for function float-save-yellowline
;; INFO: Return type mismatch int vs none.
(defun float-save-yellowline ((arg0 float))
(set! (-> *yellowline-table* *yellowline-index*) arg0)
(set! *yellowline-index* (+ *yellowline-index* 1))
(when (>= *yellowline-index* 400)
(set! *yellowline-index* 0)
(let ((v0-1 0))
)
)
(none)
)
;; definition for function float-lookup-yellowline
(defun float-lookup-yellowline ((arg0 float))
(let ((a0-3 (mod (+ (+ (the int arg0) -1) *yellowline-index*) 400)))
(-> *yellowline-table* a0-3)
)
)
;; definition for symbol *timeplot-table*, type (pointer float)
(define *timeplot-table* (the-as (pointer float) (malloc 'debug 1600)))
;; definition for symbol *timeplot-index*, type int
(define *timeplot-index* 0)
;; definition for function float-save-timeplot
;; INFO: Return type mismatch int vs none.
(defun float-save-timeplot ((arg0 float))
(set! (-> *timeplot-table* *timeplot-index*) arg0)
(set! *timeplot-index* (+ *timeplot-index* 1))
(when (>= *timeplot-index* 400)
(set! *timeplot-index* 0)
(let ((v0-1 0))
)
)
(none)
)
;; definition for function float-lookup-timeplot
(defun float-lookup-timeplot ((arg0 float))
(let ((a0-3 (mod (+ (+ (the int arg0) -1) *timeplot-index*) 400)))
(-> *timeplot-table* a0-3)
)
)
;; definition (perm) for symbol *cam-layout*, type symbol
(define-perm *cam-layout* symbol #f)
;; failed to figure out what this is:
(let ((v0-6 0))
)
)
test/decompiler/reference/engine/camera/cam-interface_REF.gc
+17 -17
View File
@@ -99,25 +99,25 @@
;; INFO: Return type mismatch int vs none.
;; Used lq/sq
(defun camera-teleport-to-entity ((arg0 entity-actor))
(local-vars (pp process))
(let ((gp-0 (new 'stack 'transformq)))
(set!
(-> gp-0 trans quad)
(-> (the-as transform (-> arg0 extra)) scale quad)
)
(quaternion-copy! (the-as quaternion (-> gp-0 rot)) (-> arg0 quat))
(vector-identity! (-> gp-0 scale))
(let ((a1-2 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-2 from) pp)
(set! (-> a1-2 num-params) 1)
(set! (-> a1-2 message) 'teleport-to-transformq)
(set! (-> a1-2 param 0) (the-as uint gp-0))
(send-event-function *camera* a1-2)
(with-pp (let ((gp-0 (new 'stack 'transformq)))
(set!
(-> gp-0 trans quad)
(-> (the-as transform (-> arg0 extra)) scale quad)
)
(quaternion-copy! (the-as quaternion (-> gp-0 rot)) (-> arg0 quat))
(vector-identity! (-> gp-0 scale))
(let ((a1-2 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-2 from) pp)
(set! (-> a1-2 num-params) 1)
(set! (-> a1-2 message) 'teleport-to-transformq)
(set! (-> a1-2 param 0) (the-as uint gp-0))
(send-event-function *camera* a1-2)
)
)
(let ((v0-4 0))
)
(none)
)
(let ((v0-4 0))
)
(none)
)
;; failed to figure out what this is:
test/decompiler/reference/engine/collide/collide-shape-h_REF.gc
+11 -11
View File
@@ -389,17 +389,17 @@
;; definition of type collide-shape
(deftype collide-shape (trsqv)
((process basic :offset-assert 140)
(max-iteration-count uint8 :offset-assert 144)
(nav-flags uint8 :offset-assert 145)
(pad-byte uint8 2 :offset-assert 146)
(pat-ignore-mask uint32 :offset-assert 148)
(event-self basic :offset-assert 152)
(event-other basic :offset-assert 156)
(root-prim basic :offset-assert 160)
(riders basic :offset-assert 164)
(backup-collide-as uint64 :offset-assert 168)
(backup-collide-with uint64 :offset-assert 176)
((process process :offset-assert 140)
(max-iteration-count uint8 :offset-assert 144)
(nav-flags uint8 :offset-assert 145)
(pad-byte uint8 2 :offset-assert 146)
(pat-ignore-mask uint32 :offset-assert 148)
(event-self basic :offset-assert 152)
(event-other basic :offset-assert 156)
(root-prim basic :offset-assert 160)
(riders basic :offset-assert 164)
(backup-collide-as uint64 :offset-assert 168)
(backup-collide-with uint64 :offset-assert 176)
)
:method-count-assert 56
:size-assert #xb8
test/decompiler/reference/engine/data/res-h_REF.gc
+1 -1
View File
@@ -33,7 +33,7 @@
(get-property-data (_type_ symbol symbol float pointer (pointer res-tag) pointer) pointer 9)
(get-property-struct (_type_ symbol symbol float structure (pointer res-tag) pointer) structure 10)
(get-property-value (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 11)
(get-property-value2 (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 12)
(get-property-value-float (_type_ symbol symbol float float (pointer res-tag) pointer) float 12)
(get-tag-index-data (_type_ int) pointer 13)
(get-tag-data (_type_ res-tag) pointer 14)
(dummy-15 (_type_ res-tag) res-tag 15)
test/decompiler/reference/engine/debug/assert-h_REF.gc
+70
View File
@@ -0,0 +1,70 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type __assert-info-private-struct
(deftype __assert-info-private-struct (structure)
((filename string :offset-assert 0)
(line-num uint16 :offset-assert 4)
(column-num uint16 :offset-assert 6)
)
:method-count-assert 11
:size-assert #x8
:flag-assert #xb00000008
(:methods
(set-private-assert-info (_type_ string uint16 uint16) int 9)
(print-private-assert-info (_type_) int 10)
)
)
;; definition for method 3 of type __assert-info-private-struct
(defmethod
inspect
__assert-info-private-struct
((obj __assert-info-private-struct))
(format #t "[~8x] ~A~%" obj '__assert-info-private-struct)
(format #t "~Tfilename: ~A~%" (-> obj filename))
(format #t "~Tline-num: ~D~%" (-> obj line-num))
(format #t "~Tcolumn-num: ~D~%" (-> obj column-num))
obj
)
;; definition for method 9 of type __assert-info-private-struct
(defmethod
set-private-assert-info
__assert-info-private-struct
((obj __assert-info-private-struct)
(filename string)
(line-num uint16)
(column-num uint16)
)
(set! (-> obj filename) filename)
(set! (-> obj line-num) (the-as uint line-num))
(set! (-> obj column-num) (the-as uint column-num))
0
)
;; definition for method 10 of type __assert-info-private-struct
(defmethod
print-private-assert-info
__assert-info-private-struct
((obj __assert-info-private-struct))
(format
#t
"file ~S.gc, line ~D, col ~D.~%"
(-> obj filename)
(-> obj line-num)
(-> obj column-num)
)
0
)
;; definition for symbol *__private-assert-info*, type __assert-info-private-struct
(define *__private-assert-info* (new 'static '__assert-info-private-struct))
;; failed to figure out what this is:
(let ((v0-4 0))
)
test/decompiler/reference/engine/entity/actor-link-h_REF.gc
+460
View File
@@ -0,0 +1,460 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for function entity-actor-lookup
;; INFO: Return type mismatch entity vs entity-actor.
;; Used lq/sq
(defun entity-actor-lookup ((lump res-lump) (name symbol) (idx int))
(local-vars (sv-16 res-tag))
(set! sv-16 (new 'static 'res-tag))
(let
((v1-1
(the-as
(pointer uint32)
(get-property-data
lump
name
'interp
-1000000000.0
(the-as pointer #f)
(& sv-16)
*res-static-buf*
)
)
)
)
(the-as
entity-actor
(when (and v1-1 (< idx (the-as int (-> sv-16 elt-count))))
(if (= (-> sv-16 elt-type) string)
(entity-by-name
(the-as string (-> (the-as (pointer uint32) (&+ v1-1 (* idx 4))) 0))
)
(entity-by-aid (-> (the-as (pointer uint32) (&+ v1-1 (* idx 4))) 0))
)
)
)
)
)
;; definition for function entity-actor-count
;; WARN: Check prologue - tricky store of r0
;; Used lq/sq
(defun entity-actor-count ((res res-lump) (name symbol))
(local-vars (tag res-tag))
(set! tag (new 'static 'res-tag))
(if
(get-property-data
res
name
'interp
-1000000000.0
(the-as pointer #f)
(& tag)
*res-static-buf*
)
(the-as int (-> tag elt-count))
0
)
)
;; definition of type actor-link-info
(deftype actor-link-info (basic)
((process process :offset-assert 4)
(next entity-actor :offset-assert 8)
(prev entity-actor :offset-assert 12)
)
:method-count-assert 26
:size-assert #x10
:flag-assert #x1a00000010
(:methods
(new (symbol type process) _type_ 0)
(get-matching-actor-type-mask (_type_ type) int 9)
(actor-count-before (_type_) int 10)
(link (_type_) entity-actor 11)
(get-next (_type_) entity-actor 12)
(get-prev (_type_) entity-actor 13)
(get-next-process (_type_) process 14)
(get-prev-process (_type_) process 15)
(apply-function-forward (_type_ (function entity-actor object object) object) int 16)
(apply-function-reverse (_type_ (function entity-actor object object) object) int 17)
(apply-all (_type_ (function entity-actor object object) object) int 18)
(send-to-all (_type_ object) none 19)
(send-to-all-after (_type_ object) object 20)
(send-to-all-before (_type_ object) object 21)
(send-to-next-and-prev (_type_ object) none 22)
(send-to-next (_type_ object) none 23)
(send-to-prev (_type_ object) none 24)
(actor-count (_type_) int 25)
)
)
;; definition for method 3 of type actor-link-info
(defmethod inspect actor-link-info ((obj actor-link-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tnext: ~A~%" (-> obj next))
(format #t "~Tprev: ~A~%" (-> obj prev))
obj
)
;; definition for method 27 of type entity-actor
(defmethod next-actor entity-actor ((obj entity-actor))
(entity-actor-lookup obj 'next-actor 0)
)
;; definition for method 28 of type entity-actor
(defmethod prev-actor entity-actor ((obj entity-actor))
(entity-actor-lookup obj 'prev-actor 0)
)
;; definition for method 0 of type actor-link-info
(defmethod
new
actor-link-info
((allocation symbol) (type-to-make type) (proc process))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(set! (-> obj process) proc)
(let ((ent (-> proc entity)))
(set!
(-> obj next)
(entity-actor-lookup (the-as res-lump ent) 'next-actor 0)
)
)
(let ((a0-2 (-> proc entity)))
(set!
(-> obj prev)
(entity-actor-lookup (the-as res-lump a0-2) 'prev-actor 0)
)
)
obj
)
)
;; definition for method 12 of type actor-link-info
(defmethod get-next actor-link-info ((obj actor-link-info))
(-> obj next)
)
;; definition for method 13 of type actor-link-info
(defmethod get-prev actor-link-info ((obj actor-link-info))
(-> obj prev)
)
;; definition for method 14 of type actor-link-info
;; INFO: Return type mismatch basic vs process.
(defmethod get-next-process actor-link-info ((obj actor-link-info))
(the-as
process
(and (-> obj next) (-> (the-as entity-links (-> obj next extra)) process))
)
)
;; definition for method 15 of type actor-link-info
;; INFO: Return type mismatch basic vs process.
(defmethod get-prev-process actor-link-info ((obj actor-link-info))
(the-as
process
(and (-> obj prev) (-> (the-as entity-links (-> obj prev extra)) process))
)
)
;; definition for method 11 of type actor-link-info
(defmethod link actor-link-info ((obj actor-link-info))
(let ((a0-1 (-> obj process entity)))
(set!
(-> obj next)
(entity-actor-lookup (the-as res-lump a0-1) 'next-actor 0)
)
)
(let ((a0-2 (-> obj process entity)))
(set!
(-> obj prev)
(entity-actor-lookup (the-as res-lump a0-2) 'prev-actor 0)
)
)
(-> obj next)
)
;; definition for method 16 of type actor-link-info
(defmethod
apply-function-forward
actor-link-info
((obj actor-link-info)
(arg0 (function entity-actor object object))
(arg1 object)
)
(let ((s3-0 (-> obj next)))
(while s3-0
(if (arg0 s3-0 arg1)
(return (the-as int #f))
)
(set! s3-0 (entity-actor-lookup s3-0 'next-actor 0))
)
)
0
)
;; definition for method 17 of type actor-link-info
(defmethod
apply-function-reverse
actor-link-info
((obj actor-link-info)
(arg0 (function entity-actor object object))
(arg1 object)
)
(let ((s3-0 (-> obj prev)))
(while s3-0
(if (arg0 s3-0 arg1)
(return (the-as int #f))
)
(set! s3-0 (entity-actor-lookup s3-0 'prev-actor 0))
)
)
0
)
;; definition for method 18 of type actor-link-info
(defmethod
apply-all
actor-link-info
((obj actor-link-info)
(arg0 (function entity-actor object object))
(arg1 object)
)
(let ((s4-0 (-> obj process entity)))
(while (let ((a0-2 s4-0))
(entity-actor-lookup (the-as res-lump a0-2) 'prev-actor 0)
)
(set! s4-0 (entity-actor-lookup (the-as res-lump s4-0) 'prev-actor 0))
)
(while s4-0
(if (arg0 (the-as entity-actor s4-0) arg1)
(return (the-as int #f))
)
(let ((a0-4 s4-0))
(set! s4-0 (entity-actor-lookup (the-as res-lump a0-4) 'next-actor 0))
)
)
)
0
)
;; definition for method 20 of type actor-link-info
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for method 21 of type actor-link-info
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for method 23 of type actor-link-info
;; INFO: Return type mismatch int vs none.
(defmethod send-to-next actor-link-info ((obj actor-link-info) (arg0 object))
(with-pp (let ((a0-1 (-> obj next)))
(when a0-1
(let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process)))
(when a0-2
(let ((v1-4 (new 'stack-no-clear 'event-message-block)))
(set! (-> v1-4 from) pp)
(set! (-> v1-4 num-params) 0)
(set! (-> v1-4 message) (the-as basic arg0))
(send-event-function a0-2 v1-4)
)
)
)
)
)
(let ((v0-1 0))
)
(none)
)
)
;; definition for method 24 of type actor-link-info
;; INFO: Return type mismatch int vs none.
(defmethod send-to-prev actor-link-info ((obj actor-link-info) (arg0 object))
(with-pp (let ((a0-1 (-> obj prev)))
(when a0-1
(let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process)))
(when a0-2
(let ((v1-4 (new 'stack-no-clear 'event-message-block)))
(set! (-> v1-4 from) pp)
(set! (-> v1-4 num-params) 0)
(set! (-> v1-4 message) (the-as basic arg0))
(send-event-function a0-2 v1-4)
)
)
)
)
)
(let ((v0-1 0))
)
(none)
)
)
;; definition for method 22 of type actor-link-info
(defmethod
send-to-next-and-prev
actor-link-info
((obj actor-link-info) (arg0 object))
(send-to-next obj arg0)
(send-to-prev obj arg0)
(none)
)
;; definition for method 19 of type actor-link-info
;; INFO: Return type mismatch object vs none.
(defmethod send-to-all actor-link-info ((obj actor-link-info) (arg0 object))
(send-to-all-after obj arg0)
(send-to-all-before obj arg0)
(none)
)
;; definition for method 25 of type actor-link-info
(defmethod actor-count actor-link-info ((obj actor-link-info))
(let ((actor (-> obj process entity))
(count 0)
)
(while (let ((a0-2 actor))
(entity-actor-lookup (the-as res-lump a0-2) 'prev-actor 0)
)
(set! actor (entity-actor-lookup (the-as res-lump actor) 'prev-actor 0))
)
(while actor
(+! count 1)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup (the-as res-lump a0-3) 'next-actor 0))
)
)
count
)
)
;; definition for method 9 of type actor-link-info
(defmethod
get-matching-actor-type-mask
actor-link-info
((obj actor-link-info) (matching-type type))
(let ((actor (the-as entity-actor (-> obj process entity)))
(mask 0)
)
(let ((current-bit 1))
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
)
(while actor
(if (= (-> actor etype) matching-type)
(set! mask (logior mask current-bit))
)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
(set! current-bit (* current-bit 2))
)
)
mask
)
)
;; definition for method 10 of type actor-link-info
(defmethod actor-count-before actor-link-info ((obj actor-link-info))
(let* ((this-actor (-> obj process entity))
(actor this-actor)
(count 0)
)
(while (let ((a0-2 actor))
(entity-actor-lookup (the-as res-lump a0-2) 'prev-actor 0)
)
(set! actor (entity-actor-lookup (the-as res-lump actor) 'prev-actor 0))
)
(while (!= actor this-actor)
(+! count 1)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup (the-as res-lump a0-3) 'next-actor 0))
)
)
count
)
)
;; definition for function actor-link-subtask-complete-hook
(defun
actor-link-subtask-complete-hook
((arg0 entity-actor) (arg1 (pointer symbol)))
(cond
((nonzero?
(logand
(-> (the-as entity-links (-> arg0 extra)) perm status)
(entity-perm-status complete)
)
)
(set! (-> arg1 0) #t)
#f
)
(else
(set! (-> arg1 0) #f)
#t
)
)
)
;; definition for function actor-link-dead-hook
(defun actor-link-dead-hook ((arg0 entity-actor) (arg1 (pointer symbol)))
(cond
((nonzero?
(logand
(-> (the-as entity-links (-> arg0 extra)) perm status)
(entity-perm-status dead)
)
)
(set! (-> arg1 0) #t)
#f
)
(else
(set! (-> arg1 0) #f)
#t
)
)
)
;; definition for function alt-actor-list-subtask-incomplete-count
(defun alt-actor-list-subtask-incomplete-count ((arg0 process-drawable))
(let
((alt-actor-count
(entity-actor-count (the-as res-lump (-> arg0 entity)) 'alt-actor)
)
(incomplete-count 0)
)
(dotimes (alt-actor-idx alt-actor-count)
(let
((a0-3
(entity-actor-lookup
(the-as res-lump (-> arg0 entity))
'alt-actor
alt-actor-idx
)
)
)
(if
(or
(not a0-3)
(zero?
(logand
(-> (the-as entity-links (-> a0-3 extra)) perm status)
(entity-perm-status complete)
)
)
)
(+! incomplete-count 1)
)
)
)
incomplete-count
)
)
test/decompiler/reference/engine/entity/entity-h_REF.gc
+1 -1
View File
@@ -63,7 +63,7 @@
(next-link entity-links :offset-assert 4)
(entity basic :offset-assert 8)
(process process :offset-assert 12)
(level basic :offset-assert 16)
(level level :offset-assert 16)
(vis-id int32 :offset-assert 20)
(trans vector :inline :offset-assert 32)
(perm entity-perm :inline :offset-assert 48)
test/decompiler/reference/engine/game/fact-h_REF.gc
+99 -97
View File
@@ -244,100 +244,102 @@
(pkup-type pickup-type)
(pkup-amount float)
)
(local-vars (pp process) (tag res-tag))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(let ((ent (-> proc entity)))
(if (zero? obj)
(begin
(let ((go-func (the-as (function string none) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(go-func a0-1)
)
(set! obj (the-as fact-info 0))
(goto cfg-10)
(local-vars (tag res-tag))
(with-pp
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(set! (-> obj process) proc)
(set! tag (new 'static 'res-tag))
(let
((v1-6
(the-as
(pointer int32)
((method-of-type res-lump get-property-data)
(the-as res-lump ent)
'eco-info
'interp
0.0
(the-as pointer #f)
(& tag)
*res-static-buf*
(let ((ent (-> proc entity)))
(if (zero? obj)
(begin
(let ((go-func (the-as (function string none) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(go-func a0-1)
)
(set! obj (the-as fact-info 0))
(goto cfg-10)
)
)
(set! (-> obj process) proc)
(set! tag (new 'static 'res-tag))
(let
((v1-6
(the-as
(pointer int32)
((method-of-type res-lump get-property-data)
(the-as res-lump ent)
'eco-info
'interp
0.0
(the-as pointer #f)
(& tag)
*res-static-buf*
)
)
)
)
)
(cond
(v1-6
(let ((a0-6 (-> tag elt-count)))
(set! (-> obj pickup-type) (the-as pickup-type (-> v1-6 0)))
(set! pkup-amount (cond
((< (the-as uint 1) (the-as uint a0-6))
(the float (-> v1-6 1))
(cond
(v1-6
(let ((a0-6 (-> tag elt-count)))
(set! (-> obj pickup-type) (the-as pickup-type (-> v1-6 0)))
(set! pkup-amount (cond
((< (the-as uint 1) (the-as uint a0-6))
(the float (-> v1-6 1))
)
(else
(empty)
pkup-amount
)
)
(else
(empty)
pkup-amount
)
)
)
)
(set! (-> obj pickup-amount) pkup-amount)
)
(else
(set! (-> obj pickup-type) pkup-type)
(set! (-> obj pickup-amount) pkup-amount)
)
(set! (-> obj pickup-amount) pkup-amount)
)
(else
(set! (-> obj pickup-type) pkup-type)
(set! (-> obj pickup-amount) pkup-amount)
)
)
)
(set!
(-> obj options)
(the-as
uint
((method-of-type res-lump get-property-value)
(the-as res-lump ent)
'options
'interp
-1000000000.0
(the-as uint128 0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(if (nonzero? (logand #x80200 (the-as int (-> obj options))))
(set!
(-> obj fade-time)
(-> obj options)
(the-as
uint
(the
int
(*
300.0
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump ent)
'timeout
'interp
-1000000000.0
(the-as uint128 0.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
((method-of-type res-lump get-property-value)
(the-as res-lump ent)
'options
'interp
-1000000000.0
(the-as uint128 0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(if (nonzero? (logand #x80200 (the-as int (-> obj options))))
(set!
(-> obj fade-time)
(the-as
uint
(the
int
(*
300.0
(the-as
float
((method-of-type res-lump get-property-value-float)
(the-as res-lump ent)
'timeout
'interp
-1000000000.0
0.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
)
@@ -345,9 +347,9 @@
)
)
)
(label cfg-10)
obj
)
(label cfg-10)
obj
)
)
@@ -379,12 +381,12 @@
(-> obj speed)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'speed
'interp
-1000000000.0
(the-as uint128 1.0)
1.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
@@ -394,12 +396,12 @@
(-> obj idle-distance)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'idle-distance
'interp
-1000000000.0
(the-as uint128 327680.0)
327680.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
@@ -409,12 +411,12 @@
(-> obj notice-top)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'notice-top
'interp
-1000000000.0
(the-as uint128 4096000.0)
4096000.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
@@ -424,12 +426,12 @@
(-> obj notice-bottom)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'notice-bottom
'interp
-1000000000.0
(the-as uint128 4096000.0)
4096000.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
@@ -439,12 +441,12 @@
(-> obj cam-horz)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'cam-horz
'interp
-1000000000.0
(the-as uint128 0.0)
0.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
@@ -454,12 +456,12 @@
(-> obj cam-vert)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'cam-vert
'interp
-1000000000.0
(the-as uint128 0.0)
0.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
@@ -469,12 +471,12 @@
(-> obj cam-notice-dist)
(the-as
float
((method-of-type res-lump get-property-value2)
((method-of-type res-lump get-property-value-float)
(the-as res-lump entity)
'cam-notice-dist
'interp
-1000000000.0
(the-as uint128 -4096.0)
-4096.0
(the-as (pointer res-tag) #f)
*res-static-buf*
)
test/decompiler/reference/engine/geometry/geometry-h_REF.gc
+5 -5
View File
@@ -3,11 +3,11 @@
;; definition of type curve
(deftype curve (structure)
((cverts uint32 :offset-assert 0)
(num-cverts int32 :offset-assert 4)
(knots uint32 :offset-assert 8)
(num-knots int32 :offset-assert 12)
(length float :offset-assert 16)
((cverts pointer :offset-assert 0)
(num-cverts int32 :offset-assert 4)
(knots pointer :offset-assert 8)
(num-knots int32 :offset-assert 12)
(length float :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
test/decompiler/reference/engine/geometry/vol-h_REF.gc
+102 -105
View File
@@ -78,130 +78,131 @@
new
vol-control
((allocation symbol) (type-to-make type) (arg0 process-drawable))
(local-vars (pp process))
(let
((gp-0
(the-as
object
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
(with-pp
(let
((gp-0
(the-as
object
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
)
)
(if (zero? (the-as vol-control gp-0))
(begin
(let ((t9-1 (the-as (function object object) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(t9-1 a0-1)
(if (zero? (the-as vol-control gp-0))
(begin
(let ((t9-1 (the-as (function object object) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(t9-1 a0-1)
)
(set! gp-0 0)
(goto cfg-13)
)
(set! gp-0 0)
(goto cfg-13)
)
)
(set! (-> (the-as vol-control gp-0) process) arg0)
(let* ((s5-1 (-> (the-as vol-control gp-0) process entity))
(s4-0
(->
((method-of-type res-lump lookup-tag-idx)
(the-as res-lump s5-1)
'vol
'exact
0.0
(set! (-> (the-as vol-control gp-0) process) arg0)
(let* ((s5-1 (-> (the-as vol-control gp-0) process entity))
(s4-0
(->
((method-of-type res-lump lookup-tag-idx)
(the-as res-lump s5-1)
'vol
'exact
0.0
)
lo
)
lo
)
)
(when (>= s4-0 0)
(let ((s3-0 s4-0)
(s2-0 (-> (-> (the-as res-lump s5-1) tag) s4-0))
)
(let ((v1-10 0))
)
(while (= (-> s2-0 name) (-> (-> (the-as res-lump s5-1) tag) s4-0 name))
(let
((v1-12
(make-property-data
(the-as res-lump s5-1)
0.0
(the-as res-tag-pair s3-0)
(the-as pointer #f)
)
)
(a0-8
(->
(the-as vol-control gp-0)
pos-vol
(-> (the-as vol-control gp-0) pos-vol-count)
)
)
)
(when (>= s4-0 0)
(let ((s3-0 s4-0)
(s2-0 (-> (-> (the-as res-lump s5-1) tag) s4-0))
)
(let ((v1-10 0))
)
(while (= (-> s2-0 name) (-> (-> (the-as res-lump s5-1) tag) s4-0 name))
(let
((v1-12
(make-property-data
(the-as res-lump s5-1)
0.0
(the-as res-tag-pair s3-0)
(the-as pointer #f)
)
)
(a0-8
(->
(the-as vol-control gp-0)
pos-vol
(-> (the-as vol-control gp-0) pos-vol-count)
)
)
(set! (-> a0-8 num-planes) (the-as int (-> s2-0 elt-count)))
(set! (-> a0-8 plane) (the-as uint v1-12))
)
(set! (-> a0-8 num-planes) (the-as int (-> s2-0 elt-count)))
(set! (-> a0-8 plane) (the-as uint v1-12))
(set!
(-> (the-as vol-control gp-0) pos-vol-count)
(+ (-> (the-as vol-control gp-0) pos-vol-count) 1)
)
(+! s3-0 1)
(set! s2-0 (-> (-> (the-as res-lump s5-1) tag) s3-0))
)
(set!
(-> (the-as vol-control gp-0) pos-vol-count)
(+ (-> (the-as vol-control gp-0) pos-vol-count) 1)
)
(+! s3-0 1)
(set! s2-0 (-> (-> (the-as res-lump s5-1) tag) s3-0))
)
)
)
)
(let* ((s5-2 (-> (the-as vol-control gp-0) process entity))
(s4-1
(->
((method-of-type res-lump lookup-tag-idx)
(the-as res-lump s5-2)
'cutoutvol
'exact
0.0
(let* ((s5-2 (-> (the-as vol-control gp-0) process entity))
(s4-1
(->
((method-of-type res-lump lookup-tag-idx)
(the-as res-lump s5-2)
'cutoutvol
'exact
0.0
)
lo
)
lo
)
)
(when (>= s4-1 0)
(let ((s3-1 s4-1)
(s2-1 (-> (-> (the-as res-lump s5-2) tag) s4-1))
)
(let ((v1-29 0))
)
(while (= (-> s2-1 name) (-> (-> (the-as res-lump s5-2) tag) s4-1 name))
(let
((v1-31
(make-property-data
(the-as res-lump s5-2)
0.0
(the-as res-tag-pair s3-1)
(the-as pointer #f)
)
)
(a0-19
(->
(the-as vol-control gp-0)
neg-vol
(-> (the-as vol-control gp-0) neg-vol-count)
)
)
)
(when (>= s4-1 0)
(let ((s3-1 s4-1)
(s2-1 (-> (-> (the-as res-lump s5-2) tag) s4-1))
)
(let ((v1-29 0))
)
(while (= (-> s2-1 name) (-> (-> (the-as res-lump s5-2) tag) s4-1 name))
(let
((v1-31
(make-property-data
(the-as res-lump s5-2)
0.0
(the-as res-tag-pair s3-1)
(the-as pointer #f)
)
)
(a0-19
(->
(the-as vol-control gp-0)
neg-vol
(-> (the-as vol-control gp-0) neg-vol-count)
)
)
(set! (-> a0-19 num-planes) (the-as int (-> s2-1 elt-count)))
(set! (-> a0-19 plane) (the-as uint v1-31))
)
(set! (-> a0-19 num-planes) (the-as int (-> s2-1 elt-count)))
(set! (-> a0-19 plane) (the-as uint v1-31))
(set!
(-> (the-as vol-control gp-0) neg-vol-count)
(+ (-> (the-as vol-control gp-0) neg-vol-count) 1)
)
(+! s3-1 1)
(set! s2-1 (-> (-> (the-as res-lump s5-2) tag) s3-1))
)
(set!
(-> (the-as vol-control gp-0) neg-vol-count)
(+ (-> (the-as vol-control gp-0) neg-vol-count) 1)
)
(+! s3-1 1)
(set! s2-1 (-> (-> (the-as res-lump s5-2) tag) s3-1))
)
)
)
(label cfg-13)
(the-as vol-control gp-0)
)
(label cfg-13)
(the-as vol-control gp-0)
)
)
@@ -209,7 +210,3 @@
(defmethod TODO-RENAME-11 vol-control ((obj vol-control))
(and *display-vol-marks* (nonzero? (logand (-> obj flags) 1)))
)
test/decompiler/reference/engine/math/quaternion_REF.gc
+15 -11
View File
@@ -1095,19 +1095,23 @@
;; definition (debug) for function quaternion-validate
;; INFO: Return type mismatch int vs none.
(defun-debug quaternion-validate ((arg0 quaternion))
(local-vars (pp process))
(let ((f0-0 (quaternion-norm arg0)))
(when (or (< 1.01 f0-0) (< f0-0 0.99))
(format #t "WARNING: bad quaternion (magnitude ~F) process is " f0-0)
(if (and pp (type-type? (-> pp type) process-tree))
(format #t "~A~%" (-> pp name))
(format #t "#f~%")
)
(with-pp (let ((f0-0 (quaternion-norm arg0)))
(when (or (< 1.01 f0-0) (< f0-0 0.99))
(format
#t
"WARNING: bad quaternion (magnitude ~F) process is "
f0-0
)
(if (and pp (type-type? (-> pp type) process-tree))
(format #t "~A~%" (-> pp name))
(format #t "#f~%")
)
)
)
(let ((v0-5 0))
)
(none)
)
(let ((v0-5 0))
)
(none)
)
;; definition for function quaternion-xz-angle
test/decompiler/reference/engine/nav/navigate-h_REF.gc
+655
View File
@@ -0,0 +1,655 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type nav-poly
(deftype nav-poly (structure)
((id uint8 :offset-assert 0)
(vertex uint8 3 :offset-assert 1)
(adj-poly uint8 3 :offset-assert 4)
(pat uint8 :offset-assert 7)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition for method 3 of type nav-poly
(defmethod inspect nav-poly ((obj nav-poly))
(format #t "[~8x] ~A~%" obj 'nav-poly)
(format #t "~Tid: ~D~%" (-> obj id))
(format #t "~Tvertex[3] @ #x~X~%" (-> obj vertex))
(format #t "~Tadj-poly[3] @ #x~X~%" (-> obj adj-poly))
(format #t "~Tpat: ~D~%" (-> obj pat))
obj
)
;; definition of type nav-vertex
(deftype nav-vertex (vector)
()
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition for method 3 of type nav-vertex
;; Used lq/sq
(defmethod inspect nav-vertex ((obj nav-vertex))
(format #t "[~8x] ~A~%" obj 'nav-vertex)
(format #t "~Tdata[4] @ #x~X~%" (&-> obj x))
(format #t "~Tx: ~f~%" (-> obj x))
(format #t "~Ty: ~f~%" (-> obj y))
(format #t "~Tz: ~f~%" (-> obj z))
(format #t "~Tw: ~f~%" (-> obj w))
(format #t "~Tquad: ~D~%" (-> obj quad))
obj
)
;; definition of type nav-sphere
(deftype nav-sphere (structure)
((trans sphere :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition for method 3 of type nav-sphere
(defmethod inspect nav-sphere ((obj nav-sphere))
(format #t "[~8x] ~A~%" obj 'nav-sphere)
(format #t "~Ttrans: #<sphere @ #x~X>~%" (-> obj trans))
obj
)
;; definition of type nav-ray
(deftype nav-ray (structure)
((current-pos vector :inline :offset-assert 0)
(dir vector :inline :offset-assert 16)
(dest-pos vector :inline :offset-assert 32)
(current-poly nav-poly :offset-assert 48)
(next-poly nav-poly :offset-assert 52)
(len float :offset-assert 56)
(last-edge int8 :offset-assert 60)
(terminated basic :offset-assert 64)
(reached-dest basic :offset-assert 68)
(hit-boundary basic :offset-assert 72)
(hit-gap basic :offset-assert 76)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
)
;; definition for method 3 of type nav-ray
(defmethod inspect nav-ray ((obj nav-ray))
(format #t "[~8x] ~A~%" obj 'nav-ray)
(format #t "~Tcurrent-pos: #<vector @ #x~X>~%" (-> obj current-pos))
(format #t "~Tdir: #<vector @ #x~X>~%" (-> obj dir))
(format #t "~Tdest-pos: #<vector @ #x~X>~%" (-> obj dest-pos))
(format #t "~Tcurrent-poly: #<nav-poly @ #x~X>~%" (-> obj current-poly))
(format #t "~Tnext-poly: #<nav-poly @ #x~X>~%" (-> obj next-poly))
(format #t "~Tlen: (meters ~m)~%" (-> obj len))
(format #t "~Tlast-edge: ~D~%" (-> obj last-edge))
(format #t "~Tterminated: ~A~%" (-> obj terminated))
(format #t "~Treached-dest: ~A~%" (-> obj reached-dest))
(format #t "~Thit-boundary: ~A~%" (-> obj hit-boundary))
(format #t "~Thit-gap: ~A~%" (-> obj hit-gap))
obj
)
;; definition of type nav-route-portal
(deftype nav-route-portal (structure)
((next-poly nav-poly :offset-assert 0)
(vertex nav-vertex 2 :offset-assert 4)
(edge-index int8 :offset-assert 12)
)
:method-count-assert 9
:size-assert #xd
:flag-assert #x90000000d
)
;; definition for method 3 of type nav-route-portal
(defmethod inspect nav-route-portal ((obj nav-route-portal))
(format #t "[~8x] ~A~%" obj 'nav-route-portal)
(format #t "~Tnext-poly: #<nav-poly @ #x~X>~%" (-> obj next-poly))
(format #t "~Tvertex[2] @ #x~X~%" (-> obj vertex))
(format #t "~Tedge-index: ~D~%" (-> obj edge-index))
obj
)
;; definition of type clip-travel-vector-to-mesh-return-info
(deftype clip-travel-vector-to-mesh-return-info (structure)
((found-boundary basic :offset-assert 0)
(intersection vector :inline :offset-assert 16)
(boundary-normal vector :inline :offset-assert 32)
(prev-normal vector :inline :offset-assert 48)
(next-normal vector :inline :offset-assert 64)
(poly nav-poly :offset-assert 80)
(gap-poly nav-poly :offset-assert 84)
(edge int32 :offset-assert 88)
(vert-prev vector :inline :offset-assert 96)
(vert-0 vector :inline :offset-assert 112)
(vert-1 vector :inline :offset-assert 128)
(vert-next vector :inline :offset-assert 144)
)
:method-count-assert 9
:size-assert #xa0
:flag-assert #x9000000a0
)
;; definition for method 3 of type clip-travel-vector-to-mesh-return-info
(defmethod
inspect
clip-travel-vector-to-mesh-return-info
((obj clip-travel-vector-to-mesh-return-info))
(format #t "[~8x] ~A~%" obj 'clip-travel-vector-to-mesh-return-info)
(format #t "~Tfound-boundary: ~A~%" (-> obj found-boundary))
(format #t "~Tintersection: #<vector @ #x~X>~%" (-> obj intersection))
(format #t "~Tboundary-normal: #<vector @ #x~X>~%" (-> obj boundary-normal))
(format #t "~Tprev-normal: #<vector @ #x~X>~%" (-> obj prev-normal))
(format #t "~Tnext-normal: #<vector @ #x~X>~%" (-> obj next-normal))
(format #t "~Tpoly: #<nav-poly @ #x~X>~%" (-> obj poly))
(format #t "~Tgap-poly: #<nav-poly @ #x~X>~%" (-> obj gap-poly))
(format #t "~Tedge: ~D~%" (-> obj edge))
(format #t "~Tvert-prev: #<vector @ #x~X>~%" (-> obj vert-prev))
(format #t "~Tvert-0: #<vector @ #x~X>~%" (-> obj vert-0))
(format #t "~Tvert-1: #<vector @ #x~X>~%" (-> obj vert-1))
(format #t "~Tvert-next: #<vector @ #x~X>~%" (-> obj vert-next))
obj
)
;; definition of type nav-node
(deftype nav-node (structure)
((center-x float :offset-assert 0)
(center-y float :offset-assert 4)
(center-z float :offset-assert 8)
(type uint16 :offset-assert 12)
(parent-offset uint16 :offset-assert 14)
(center vector :inline :offset 0)
(radius-x float :offset-assert 16)
(radius-y float :offset-assert 20)
(radius-z float :offset-assert 24)
(left-offset uint16 :offset-assert 28)
(right-offset uint16 :offset-assert 30)
(num-tris uint32 :offset 28)
(radius vector :inline :offset 16)
(scale-x float :offset-assert 32)
(first-tris uint8 4 :offset-assert 36)
(scale-z float :offset-assert 40)
(last-tris uint8 4 :offset-assert 44)
(scale vector :inline :offset 32)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
;; definition for method 3 of type nav-node
(defmethod inspect nav-node ((obj nav-node))
(format #t "[~8x] ~A~%" obj 'nav-node)
(format #t "~Tcenter-x: ~f~%" (-> obj center-x))
(format #t "~Tcenter-y: ~f~%" (-> obj center-y))
(format #t "~Tcenter-z: ~f~%" (-> obj center-z))
(format #t "~Ttype: ~D~%" (-> obj type))
(format #t "~Tparent-offset: ~D~%" (-> obj parent-offset))
(format #t "~Tcenter: #<vector @ #x~X>~%" (&-> obj center-x))
(format #t "~Tradius-x: ~f~%" (-> obj radius-x))
(format #t "~Tradius-y: ~f~%" (-> obj radius-y))
(format #t "~Tradius-z: ~f~%" (-> obj radius-z))
(format #t "~Tleft-offset: ~D~%" (-> obj left-offset))
(format #t "~Tright-offset: ~D~%" (-> obj right-offset))
(format #t "~Tnum-tris: ~D~%" (-> obj num-tris))
(format #t "~Tradius: #<vector @ #x~X>~%" (&-> obj radius-x))
(format #t "~Tscale-x: ~f~%" (-> obj scale-x))
(format #t "~Tfirst-tris[4] @ #x~X~%" (-> obj first-tris))
(format #t "~Tscale-z: ~f~%" (-> obj scale-z))
(format #t "~Tlast-tris[4] @ #x~X~%" (-> obj last-tris))
(format #t "~Tscale: #<vector @ #x~X>~%" (&-> obj scale-x))
obj
)
;; definition of type nav-lookup-elem
(deftype nav-lookup-elem (structure)
((vec vector :inline :offset-assert 0)
(y-thresh float :offset 12)
(time uint32 :offset-assert 16)
(node-offset uint32 :offset-assert 20)
(lookup-type uint8 :offset-assert 24)
(poly-ind uint8 :offset-assert 25)
(dummy0 uint16 :offset-assert 26)
(dummy uint32 :offset-assert 28)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
;; definition for method 3 of type nav-lookup-elem
(defmethod inspect nav-lookup-elem ((obj nav-lookup-elem))
(format #t "[~8x] ~A~%" obj 'nav-lookup-elem)
(format #t "~Tvec: #<vector @ #x~X>~%" (-> obj vec))
(format #t "~Ty-thresh: ~f~%" (-> obj vec w))
(format #t "~Ttime: ~D~%" (-> obj time))
(format #t "~Tnode-offset: ~D~%" (-> obj node-offset))
(format #t "~Tlookup-type: ~D~%" (-> obj lookup-type))
(format #t "~Tpoly-ind: ~D~%" (-> obj poly-ind))
(format #t "~Tdummy0: ~D~%" (-> obj dummy0))
(format #t "~Tdummy: ~D~%" (-> obj dummy))
obj
)
;; definition of type nav-mesh
(deftype nav-mesh (basic)
((user-list engine :offset-assert 4)
(poly-lookup-history uint8 2 :offset-assert 8)
(debug-time uint8 :offset-assert 10)
(static-sphere-count uint8 :offset-assert 11)
(static-sphere uint32 :offset-assert 12)
(bounds sphere :inline :offset-assert 16)
(origin vector :inline :offset-assert 32)
(cache nav-lookup-elem 4 :inline :offset-assert 48)
(node-count int32 :offset-assert 176)
(nodes uint32 :offset-assert 180)
(vertex-count int32 :offset-assert 184)
(vertex uint32 :offset-assert 188)
(poly-count int32 :offset-assert 192)
(poly uint32 :offset-assert 196)
(route uint32 :offset-assert 200)
)
:method-count-assert 30
:size-assert #xcc
:flag-assert #x1e000000cc
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 (_type_) none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 (_type_) none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
(dummy-27 () none 27)
(dummy-28 () none 28)
(dummy-29 () none 29)
)
)
;; definition for method 3 of type nav-mesh
(defmethod inspect nav-mesh ((obj nav-mesh))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tuser-list: ~A~%" (-> obj user-list))
(format #t "~Tpoly-lookup-history[2] @ #x~X~%" (-> obj poly-lookup-history))
(format #t "~Tdebug-time: ~D~%" (-> obj debug-time))
(format #t "~Tstatic-sphere-count: ~D~%" (-> obj static-sphere-count))
(format #t "~Tstatic-sphere: #x~X~%" (-> obj static-sphere))
(format #t "~Tbounds: ~`sphere`P~%" (-> obj bounds))
(format #t "~Torigin: ~`vector`P~%" (-> obj origin))
(format #t "~Tcache[4] @ #x~X~%" (-> obj cache))
(format #t "~Tnode-count: ~D~%" (-> obj node-count))
(format #t "~Tnodes: #x~X~%" (-> obj nodes))
(format #t "~Tvertex-count: ~D~%" (-> obj vertex-count))
(format #t "~Tvertex: #x~X~%" (-> obj vertex))
(format #t "~Tpoly-count: ~D~%" (-> obj poly-count))
(format #t "~Tpoly: #x~X~%" (-> obj poly))
(format #t "~Troute: #x~X~%" (-> obj route))
obj
)
;; definition of type check-vector-collision-with-nav-spheres-info
(deftype check-vector-collision-with-nav-spheres-info (structure)
((u float :offset-assert 0)
(intersect vector :inline :offset-assert 16)
(normal vector :inline :offset-assert 32)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
;; definition for method 3 of type check-vector-collision-with-nav-spheres-info
(defmethod
inspect
check-vector-collision-with-nav-spheres-info
((obj check-vector-collision-with-nav-spheres-info))
(format #t "[~8x] ~A~%" obj 'check-vector-collision-with-nav-spheres-info)
(format #t "~Tu: ~f~%" (-> obj u))
(format #t "~Tintersect: #<vector @ #x~X>~%" (-> obj intersect))
(format #t "~Tnormal: #<vector @ #x~X>~%" (-> obj normal))
obj
)
;; definition of type nav-gap-info
(deftype nav-gap-info (structure)
((dest vector :inline :offset-assert 0)
(poly nav-poly :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
;; definition for method 3 of type nav-gap-info
(defmethod inspect nav-gap-info ((obj nav-gap-info))
(format #t "[~8x] ~A~%" obj 'nav-gap-info)
(format #t "~Tdest: #<vector @ #x~X>~%" (-> obj dest))
(format #t "~Tpoly: #<nav-poly @ #x~X>~%" (-> obj poly))
obj
)
;; definition of type nav-control
(deftype nav-control (basic)
((flags nav-control-flags :offset-assert 4)
(process basic :offset-assert 8)
(shape collide-shape :offset-assert 12)
(mesh nav-mesh :offset-assert 16)
(gap-event basic :offset-assert 20)
(block-event basic :offset-assert 24)
(current-poly nav-poly :offset-assert 28)
(next-poly nav-poly :offset-assert 32)
(target-poly nav-poly :offset-assert 36)
(portal nav-route-portal 2 :offset-assert 40)
(nearest-y-threshold float :offset-assert 48)
(event-temp vector :inline :offset-assert 64)
(old-travel vector :inline :offset-assert 80)
(blocked-travel vector :inline :offset-assert 96)
(prev-pos vector :inline :offset-assert 112)
(extra-nav-sphere vector :inline :offset-assert 128)
(travel vector :inline :offset-assert 144)
(target-pos vector :inline :offset-assert 160)
(destination-pos vector :inline :offset-assert 176)
(block-time uint64 :offset-assert 192)
(block-count float :offset-assert 200)
(user-poly nav-poly :offset-assert 204)
(nav-cull-radius float :offset-assert 208)
(num-spheres int16 :offset-assert 212)
(max-spheres int16 :offset-assert 214)
(sphere sphere :inline :dynamic :offset-assert 224)
)
:method-count-assert 36
:size-assert #xe0
:flag-assert #x24000000e0
(:methods
(new (symbol type collide-shape int float) _type_ 0)
(dummy-9 () none 9)
(point-in-bounds? (_type_ vector) symbol 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(set-target-pos! (_type_ vector) none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
(dummy-27 () none 27)
(dummy-28 () none 28)
(should-display? (_type_) symbol 29)
(dummy-30 () none 30)
(dummy-31 () none 31)
(dummy-32 () none 32)
(dummy-33 () none 33)
(dummy-34 () none 34)
(dummy-35 () none 35)
)
)
;; definition for method 3 of type nav-control
(defmethod inspect nav-control ((obj nav-control))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tflags: #x~X~%" (-> obj flags))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tshape: ~A~%" (-> obj shape))
(format #t "~Tmesh: ~A~%" (-> obj mesh))
(format #t "~Tgap-event: ~A~%" (-> obj gap-event))
(format #t "~Tblock-event: ~A~%" (-> obj block-event))
(format #t "~Tcurrent-poly: #<nav-poly @ #x~X>~%" (-> obj current-poly))
(format #t "~Tnext-poly: #<nav-poly @ #x~X>~%" (-> obj next-poly))
(format #t "~Ttarget-poly: #<nav-poly @ #x~X>~%" (-> obj target-poly))
(format #t "~Tportal[2] @ #x~X~%" (-> obj portal))
(format
#t
"~Tnearest-y-threshold: (meters ~m)~%"
(-> obj nearest-y-threshold)
)
(format #t "~Tevent-temp: ~`vector`P~%" (-> obj event-temp))
(format #t "~Told-travel: ~`vector`P~%" (-> obj old-travel))
(format #t "~Tblocked-travel: ~`vector`P~%" (-> obj blocked-travel))
(format #t "~Tprev-pos: ~`vector`P~%" (-> obj prev-pos))
(format #t "~Textra-nav-sphere: ~`vector`P~%" (-> obj extra-nav-sphere))
(format #t "~Ttravel: ~`vector`P~%" (-> obj travel))
(format #t "~Ttarget-pos: ~`vector`P~%" (-> obj target-pos))
(format #t "~Tdestination-pos: ~`vector`P~%" (-> obj destination-pos))
(format #t "~Tblock-time: ~D~%" (-> obj block-time))
(format #t "~Tblock-count: ~f~%" (-> obj block-count))
(format #t "~Tuser-poly: #<nav-poly @ #x~X>~%" (-> obj user-poly))
(format #t "~Tnav-cull-radius: ~f~%" (-> obj nav-cull-radius))
(format #t "~Tnum-spheres: ~D~%" (-> obj num-spheres))
(format #t "~Tmax-spheres: ~D~%" (-> obj max-spheres))
(format #t "~Tsphere[0] @ #x~X~%" (-> obj sphere))
obj
)
;; definition for function nav-mesh-connect
;; Used lq/sq
(defun nav-mesh-connect ((proc process) (trans trsqv) (nav-cont nav-control))
(local-vars (sv-16 type) (sv-32 symbol))
(with-pp (let ((ent (-> proc entity)))
(when (zero? (-> (the-as entity-actor ent) nav-mesh))
(let
((lookup-entity
(entity-actor-lookup (the-as res-lump ent) 'nav-mesh-actor 0)
)
)
(if lookup-entity
(set! ent lookup-entity)
)
)
)
(let ((entity-nav-mesh (-> (the-as entity-actor ent) nav-mesh)))
(cond
((nonzero? entity-nav-mesh)
(when (zero? (-> entity-nav-mesh user-list))
(set!
process-level-heap
(->
(the-as
entity-links
(-> (the-as entity (-> pp entity)) extra)
)
level
heap
)
)
(let ((s1-0 (method-of-type engine new))
(s0-0 'process-level-heap)
)
(set! sv-16 engine)
(set! sv-32 'nav-engine)
(let
((a3-1
((method-of-type res-lump get-property-value)
(the-as res-lump ent)
'nav-max-users
'interp
-1000000000.0
(the-as uint128 32)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> entity-nav-mesh user-list)
(s1-0 s0-0 sv-16 sv-32 (the-as int a3-1))
)
)
)
(dummy-13 entity-nav-mesh)
(dummy-17 entity-nav-mesh)
)
(add-connection
(-> entity-nav-mesh user-list)
proc
(the-as (function object object object object object) nothing)
proc
nav-cont
trans
)
)
(else
(if (and nav-cont (-> proc entity))
(set!
(->
(the-as
entity-links
(-> (the-as entity (-> proc entity)) extra)
)
perm
status
)
(logior
(->
(the-as
entity-links
(-> (the-as entity (-> proc entity)) extra)
)
perm
status
)
(entity-perm-status bit-1)
)
)
)
(set! entity-nav-mesh *default-nav-mesh*)
)
)
entity-nav-mesh
)
)
)
)
;; definition for method 0 of type nav-control
;; INFO: Return type mismatch object vs nav-control.
(defmethod
new
nav-control
((allocation symbol)
(type-to-make type)
(shape collide-shape)
(sphere-count int)
(nearest-y-threshold-default float)
)
(with-pp
(let
((obj
(object-new
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (the-as uint (* sphere-count 16))))
)
)
)
(if (zero? obj)
(begin
(let ((t9-1 (the-as function enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
((the-as (function string none) t9-1) a0-1)
)
(set! obj (the-as nav-control 0))
(goto cfg-4)
)
)
(set! (-> obj max-spheres) sphere-count)
(set! (-> obj flags) (nav-control-flags bit8 bit13))
(set! (-> obj mesh) (nav-mesh-connect (-> shape process) shape obj))
(let ((ent (-> shape process entity)))
(set!
(-> obj nearest-y-threshold)
((method-of-type res-lump get-property-value-float)
(the-as res-lump ent)
'nearest-y-threshold
'interp
-1000000000.0
nearest-y-threshold-default
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set! (-> obj shape) shape)
(set! (-> obj process) (-> shape process))
(set! (-> obj gap-event) #f)
(set! (-> obj current-poly) #f)
(set! (-> obj next-poly) #f)
(set! (-> obj target-poly) #f)
(set! (-> obj user-poly) #f)
(set! (-> obj portal 0) #f)
(set! (-> obj portal 1) #f)
(set! (-> obj nav-cull-radius) 40960.0)
(label cfg-4)
(the-as nav-control obj)
)
)
)
;; definition for method 29 of type nav-control
(defmethod should-display? nav-control ((obj nav-control))
(and
*display-nav-marks*
(nonzero? (logand (-> obj flags) (nav-control-flags display-marks)))
)
)
;; definition for method 10 of type nav-control
(defmethod point-in-bounds? nav-control ((obj nav-control) (arg0 vector))
(let ((v1-1 (-> obj mesh bounds)))
(>= (-> v1-1 w) (vector-vector-distance arg0 v1-1))
)
)
;; definition for method 15 of type nav-control
;; INFO: Return type mismatch vector vs none.
;; Used lq/sq
(defmethod set-target-pos! nav-control ((obj nav-control) (arg0 vector))
(set! (-> obj target-pos quad) (-> arg0 quad))
(none)
)
;; definition for function has-nav-mesh?
;; INFO: Return type mismatch structure vs symbol.
(defun has-nav-mesh? ((arg0 entity-actor))
(the-as
symbol
(or
(-> arg0 nav-mesh)
((method-of-type res-lump get-property-struct)
arg0
'nav-mesh-actor
'interp
-1000000000.0
#f
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
)
test/decompiler/reference/engine/nav/path-h_REF.gc
+230
View File
@@ -0,0 +1,230 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type path-control
(deftype path-control (basic)
((flags path-control-flag :offset-assert 4)
(name basic :offset-assert 8)
(process basic :offset-assert 12)
(curve curve :inline :offset-assert 16)
(num-cverts int32 :offset 20)
(cverts pointer :offset 16)
)
:method-count-assert 21
:size-assert #x24
:flag-assert #x1500000024
(:methods
(new (symbol type process symbol float) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(length-as-float (_type_) float 15)
(dummy-16 () none 16)
(get-num-verts (_type_) int 17)
(should-display? (_type_) symbol 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
)
)
;; definition for method 3 of type path-control
(defmethod inspect path-control ((obj path-control))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tflags: #x~X~%" (-> obj flags))
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tcurve: #<curve @ #x~X>~%" (-> obj curve))
(format #t "~Tnum-cverts: ~D~%" (-> obj curve num-cverts))
(format #t "~Tcverts: #x~X~%" (-> obj curve cverts))
obj
)
;; definition of type curve-control
(deftype curve-control (path-control)
()
:method-count-assert 21
:size-assert #x24
:flag-assert #x1500000024
(:methods
(new (symbol type process symbol float) _type_ 0)
)
)
;; definition for method 3 of type curve-control
(defmethod inspect curve-control ((obj curve-control))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tflags: #x~X~%" (-> obj flags))
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tcurve: #<curve @ #x~X>~%" (-> obj curve))
(format #t "~Tnum-cverts: ~D~%" (-> obj curve num-cverts))
(format #t "~Tcverts: #x~X~%" (-> obj curve cverts))
obj
)
;; definition for method 0 of type path-control
;; INFO: Return type mismatch object vs path-control.
;; Used lq/sq
(defmethod
new
path-control
((allocation symbol)
(type-to-make type)
(proc process)
(name symbol)
(time float)
)
(local-vars (tag res-tag))
(with-pp
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(if (zero? obj)
(begin
(let ((t9-1 (the-as function enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
((the-as (function string none) t9-1) a0-1)
)
(set! obj (the-as path-control 0))
(goto cfg-9)
)
)
(set! (-> obj process) proc)
(set! (-> obj name) name)
(let ((ent (-> proc entity)))
(when (= name 'path)
(let
((lookup-entity
(entity-actor-lookup (the-as res-lump ent) 'path-actor 0)
)
)
(if lookup-entity
(set! ent lookup-entity)
)
)
)
(set! tag (new 'static 'res-tag))
(let
((data
((method-of-type res-lump get-property-data)
(the-as res-lump ent)
name
'interp
time
(the-as pointer #f)
(& tag)
*res-static-buf*
)
)
)
(cond
(data
(set! (-> obj curve cverts) data)
(set! (-> obj curve num-cverts) (the-as int (-> tag elt-count)))
)
(else
(set!
(-> obj flags)
(logior (-> obj flags) (path-control-flag not-found))
)
(set! (-> obj curve cverts) (the-as pointer #f))
(set! (-> obj curve num-cverts) 0)
(let ((v1-16 0))
)
)
)
)
)
(label cfg-9)
(the-as path-control obj)
)
)
)
;; definition for method 18 of type path-control
(defmethod should-display? path-control ((obj path-control))
(and
*display-path-marks*
(nonzero? (logand (-> obj flags) (path-control-flag display)))
)
)
;; definition for method 15 of type path-control
(defmethod length-as-float path-control ((obj path-control))
(the float (+ (-> obj curve num-cverts) -1))
)
;; definition for method 17 of type path-control
(defmethod get-num-verts path-control ((obj path-control))
(-> obj curve num-cverts)
)
;; definition for method 0 of type curve-control
(defmethod
new
curve-control
((allocation symbol)
(type-to-make type)
(proc process)
(name symbol)
(time float)
)
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(set! (-> obj process) proc)
(set! (-> obj name) name)
(let* ((ent (the-as entity (-> proc entity)))
(v1-2 name)
(s2-0 (cond
((= v1-2 'path)
'path-k
)
(else
(let ((s2-1 string->symbol))
(format (clear *temp-string*) "~A-k" name)
(s2-1 *temp-string*)
)
)
)
)
)
(let ((lookup-entity (entity-actor-lookup ent 'path-actor 0)))
(if lookup-entity
(set! ent lookup-entity)
)
)
(when (not (get-curve-data! ent (-> obj curve) name s2-0 time))
(cond
((> (-> obj curve num-cverts) 0)
(set! (-> obj type) path-control)
)
(else
(set!
(-> obj flags)
(logior (-> obj flags) (path-control-flag not-found))
)
(set! (-> obj curve cverts) (the-as pointer #f))
(set! (-> obj curve num-cverts) 0)
(let ((v1-11 0))
)
)
)
)
)
obj
)
)
;; failed to figure out what this is:
(let ((v0-9 0))
)
test/decompiler/reference/engine/sound/gsound-h_REF.gc
-4
View File
@@ -790,7 +790,3 @@
;; failed to figure out what this is:
(let ((v0-65 0))
)
test/decompiler/reference/engine/ui/progress-h_REF.gc
+316
View File
@@ -0,0 +1,316 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type count-info
(deftype count-info (structure)
((money-count int32 :offset-assert 0)
(buzzer-count int32 :offset-assert 4)
)
:pack-me
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition for method 3 of type count-info
(defmethod inspect count-info ((obj count-info))
(format #t "[~8x] ~A~%" obj 'count-info)
(format #t "~Tmoney-count: ~D~%" (-> obj money-count))
(format #t "~Tbuzzer-count: ~D~%" (-> obj buzzer-count))
obj
)
;; definition of type game-count-info
(deftype game-count-info (basic)
((length int32 :offset-assert 4)
(data count-info :inline :dynamic :offset-assert 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition for method 3 of type game-count-info
(defmethod inspect game-count-info ((obj game-count-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tdata[0] @ #x~X~%" (-> obj data))
obj
)
;; definition of type task-info-data
(deftype task-info-data (basic)
((task-id uint8 :offset-assert 4)
(task-name symbol 4 :offset-assert 8)
(text-index-when-resolved int32 :offset-assert 24)
)
:method-count-assert 9
:size-assert #x1c
:flag-assert #x90000001c
)
;; definition for method 3 of type task-info-data
(defmethod inspect task-info-data ((obj task-info-data))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Ttask-id: ~D~%" (-> obj task-id))
(format #t "~Ttask-name[4] @ #x~X~%" (-> obj task-name))
(format
#t
"~Ttext-index-when-resolved: ~D~%"
(-> obj text-index-when-resolved)
)
obj
)
;; definition of type level-tasks-info
(deftype level-tasks-info (basic)
((level-name-id uint32 :offset-assert 4)
(text-group-index int32 :offset-assert 8)
(nb-of-tasks int32 :offset-assert 12)
(buzzer-task-index int32 :offset-assert 16)
(task-info task-info-data 8 :offset-assert 20)
)
:method-count-assert 9
:size-assert #x34
:flag-assert #x900000034
)
;; definition for method 3 of type level-tasks-info
(defmethod inspect level-tasks-info ((obj level-tasks-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tlevel-name-id: ~D~%" (-> obj level-name-id))
(format #t "~Ttext-group-index: ~D~%" (-> obj text-group-index))
(format #t "~Tnb-of-tasks: ~D~%" (-> obj nb-of-tasks))
(format #t "~Tbuzzer-task-index: ~D~%" (-> obj buzzer-task-index))
(format #t "~Ttask-info[8] @ #x~X~%" (-> obj task-info))
obj
)
;; definition of type game-option
(deftype game-option (basic)
((option-type uint64 :offset-assert 8)
(name uint32 :offset-assert 16)
(scale basic :offset-assert 20)
(param1 float :offset-assert 24)
(param2 float :offset-assert 28)
(param3 int32 :offset-assert 32)
(value-to-modify uint32 :offset-assert 36)
)
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
)
;; definition for method 3 of type game-option
(defmethod inspect game-option ((obj game-option))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Toption-type: ~D~%" (-> obj option-type))
(format #t "~Tname: ~D~%" (-> obj name))
(format #t "~Tscale: ~A~%" (-> obj scale))
(format #t "~Tparam1: ~f~%" (-> obj param1))
(format #t "~Tparam2: ~f~%" (-> obj param2))
(format #t "~Tparam3: ~D~%" (-> obj param3))
(format #t "~Tvalue-to-modify: #x~X~%" (-> obj value-to-modify))
obj
)
;; definition of type progress
(deftype progress (process)
((current-debug-string int32 :offset-assert 112)
(current-debug-language int32 :offset-assert 116)
(current-debug-group int32 :offset-assert 120)
(in-out-position int32 :offset-assert 124)
(display-state uint64 :offset-assert 128)
(next-display-state uint64 :offset-assert 136)
(option-index int32 :offset-assert 144)
(selected-option basic :offset-assert 148)
(completion-percentage float :offset-assert 152)
(ready-to-run basic :offset-assert 156)
(display-level-index int32 :offset-assert 160)
(next-level-index int32 :offset-assert 164)
(task-index int32 :offset-assert 168)
(in-transition basic :offset-assert 172)
(last-in-transition basic :offset-assert 176)
(force-transition basic :offset-assert 180)
(stat-transition basic :offset-assert 184)
(level-transition int32 :offset-assert 188)
(language-selection uint64 :offset-assert 192)
(language-direction basic :offset-assert 200)
(language-transition basic :offset-assert 204)
(language-x-offset int32 :offset-assert 208)
(sides-x-scale float :offset-assert 212)
(sides-y-scale float :offset-assert 216)
(left-x-offset int32 :offset-assert 220)
(right-x-offset int32 :offset-assert 224)
(button-scale float :offset-assert 228)
(slot-scale float :offset-assert 232)
(left-side-x-scale float :offset-assert 236)
(left-side-y-scale float :offset-assert 240)
(right-side-x-scale float :offset-assert 244)
(right-side-y-scale float :offset-assert 248)
(small-orb-y-offset int32 :offset-assert 252)
(big-orb-y-offset int32 :offset-assert 256)
(transition-offset int32 :offset-assert 260)
(transition-offset-invert int32 :offset-assert 264)
(transition-percentage float :offset-assert 268)
(transition-percentage-invert float :offset-assert 272)
(transition-speed float :offset-assert 276)
(total-nb-of-power-cells int32 :offset-assert 280)
(total-nb-of-orbs int32 :offset-assert 284)
(total-nb-of-buzzers int32 :offset-assert 288)
(card-info mc-slot-info :offset-assert 292)
(last-option-index-change uint64 :offset-assert 296)
(video-mode-timeout uint64 :offset-assert 304)
(display-state-stack uint64 5 :offset-assert 312)
(option-index-stack uint32 5 :offset-assert 352)
(display-state-pos int32 :offset-assert 372)
(nb-of-icons int32 :offset-assert 376)
(icons uint32 6 :offset-assert 380)
(max-nb-of-particles int32 :offset-assert 404)
(nb-of-particles int32 :offset-assert 408)
(particles uint32 40 :offset-assert 412)
(particle-state uint32 40 :offset-assert 572)
)
:method-count-assert 59
:size-assert #x2dc
:flag-assert #x3b000002dc
(:methods
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(TODO-RENAME-23 (_type_ symbol symbol) none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
(dummy-27 () none 27)
(dummy-28 () none 28)
(dummy-29 () none 29)
(dummy-30 () none 30)
(dummy-31 () none 31)
(dummy-32 () none 32)
(dummy-33 () none 33)
(dummy-34 () none 34)
(dummy-35 () none 35)
(dummy-36 () none 36)
(dummy-37 () none 37)
(dummy-38 () none 38)
(dummy-39 () none 39)
(dummy-40 () none 40)
(dummy-41 () none 41)
(dummy-42 () none 42)
(dummy-43 () none 43)
(dummy-44 () none 44)
(dummy-45 () none 45)
(dummy-46 () none 46)
(dummy-47 () none 47)
(dummy-48 () none 48)
(dummy-49 () none 49)
(dummy-50 () none 50)
(dummy-51 () none 51)
(dummy-52 () none 52)
(dummy-53 () none 53)
(dummy-54 () none 54)
(dummy-55 () none 55)
(dummy-56 () none 56)
(dummy-57 () none 57)
(dummy-58 () none 58)
)
)
;; definition for method 3 of type progress
(defmethod inspect progress ((obj progress))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(format #t "~T~Tcurrent-debug-string: ~D~%" (-> obj current-debug-string))
(format #t "~T~Tcurrent-debug-language: ~D~%" (-> obj current-debug-language))
(format #t "~T~Tcurrent-debug-group: ~D~%" (-> obj current-debug-group))
(format #t "~T~Tin-out-position: ~D~%" (-> obj in-out-position))
(format #t "~T~Tdisplay-state: ~D~%" (-> obj display-state))
(format #t "~T~Tnext-display-state: ~D~%" (-> obj next-display-state))
(format #t "~T~Toption-index: ~D~%" (-> obj option-index))
(format #t "~T~Tselected-option: ~A~%" (-> obj selected-option))
(format #t "~T~Tcompletion-percentage: ~f~%" (-> obj completion-percentage))
(format #t "~T~Tready-to-run: ~A~%" (-> obj ready-to-run))
(format #t "~T~Tdisplay-level-index: ~D~%" (-> obj display-level-index))
(format #t "~T~Tnext-level-index: ~D~%" (-> obj next-level-index))
(format #t "~T~Ttask-index: ~D~%" (-> obj task-index))
(format #t "~T~Tin-transition: ~A~%" (-> obj in-transition))
(format #t "~T~Tlast-in-transition: ~A~%" (-> obj last-in-transition))
(format #t "~T~Tforce-transition: ~A~%" (-> obj force-transition))
(format #t "~T~Tstat-transition: ~A~%" (-> obj stat-transition))
(format #t "~T~Tlevel-transition: ~D~%" (-> obj level-transition))
(format #t "~T~Tlanguage-selection: ~D~%" (-> obj language-selection))
(format #t "~T~Tlanguage-direction: ~A~%" (-> obj language-direction))
(format #t "~T~Tlanguage-transition: ~A~%" (-> obj language-transition))
(format #t "~T~Tlanguage-x-offset: ~D~%" (-> obj language-x-offset))
(format #t "~T~Tsides-x-scale: ~f~%" (-> obj sides-x-scale))
(format #t "~T~Tsides-y-scale: ~f~%" (-> obj sides-y-scale))
(format #t "~T~Tleft-x-offset: ~D~%" (-> obj left-x-offset))
(format #t "~T~Tright-x-offset: ~D~%" (-> obj right-x-offset))
(format #t "~T~Tbutton-scale: ~f~%" (-> obj button-scale))
(format #t "~T~Tslot-scale: ~f~%" (-> obj slot-scale))
(format #t "~T~Tleft-side-x-scale: ~f~%" (-> obj left-side-x-scale))
(format #t "~T~Tleft-side-y-scale: ~f~%" (-> obj left-side-y-scale))
(format #t "~T~Tright-side-x-scale: ~f~%" (-> obj right-side-x-scale))
(format #t "~T~Tright-side-y-scale: ~f~%" (-> obj right-side-y-scale))
(format #t "~T~Tsmall-orb-y-offset: ~D~%" (-> obj small-orb-y-offset))
(format #t "~T~Tbig-orb-y-offset: ~D~%" (-> obj big-orb-y-offset))
(format #t "~T~Ttransition-offset: ~D~%" (-> obj transition-offset))
(format
#t
"~T~Ttransition-offset-invert: ~D~%"
(-> obj transition-offset-invert)
)
(format #t "~T~Ttransition-percentage: ~f~%" (-> obj transition-percentage))
(format
#t
"~T~Ttransition-percentage-invert: ~f~%"
(-> obj transition-percentage-invert)
)
(format #t "~T~Ttransition-speed: ~f~%" (-> obj transition-speed))
(format
#t
"~T~Ttotal-nb-of-power-cells: ~D~%"
(-> obj total-nb-of-power-cells)
)
(format #t "~T~Ttotal-nb-of-orbs: ~D~%" (-> obj total-nb-of-orbs))
(format #t "~T~Ttotal-nb-of-buzzers: ~D~%" (-> obj total-nb-of-buzzers))
(format #t "~T~Tcard-info: #<mc-slot-info @ #x~X>~%" (-> obj card-info))
(format
#t
"~T~Tlast-option-index-change: ~D~%"
(-> obj last-option-index-change)
)
(format #t "~T~Tvideo-mode-timeout: ~D~%" (-> obj video-mode-timeout))
(format #t "~T~Tdisplay-state-stack[5] @ #x~X~%" (&-> obj stack 200))
(format #t "~T~Toption-index-stack[5] @ #x~X~%" (&-> obj stack 240))
(format #t "~T~Tdisplay-state-pos: ~D~%" (-> obj display-state-pos))
(format #t "~T~Tnb-of-icons: ~D~%" (-> obj nb-of-icons))
(format #t "~T~Ticons[6] @ #x~X~%" (&-> obj stack 268))
(format #t "~T~Tmax-nb-of-particles: ~D~%" (-> obj max-nb-of-particles))
(format #t "~T~Tnb-of-particles: ~D~%" (-> obj nb-of-particles))
(format #t "~T~Tparticles[40] @ #x~X~%" (&-> obj stack 300))
(format #t "~T~Tparticle-state[40] @ #x~X~%" (&-> obj stack 460))
obj
)
;; definition for symbol *progress-process*, type (pointer progress)
(define *progress-process* (the-as (pointer progress) #f))
;; definition for symbol *progress-last-task-index*, type int
(define *progress-last-task-index* 0)
;; failed to figure out what this is:
(let ((v0-12 0))
)
test/decompiler/reference/kernel/gkernel_REF.gc
+67 -66
View File
@@ -200,12 +200,12 @@
;; definition for function remove-exit
(defun remove-exit ()
(local-vars (pp process))
(when (-> pp stack-frame-top)
(let ((v0-0 (-> pp stack-frame-top next)))
(set! (-> pp stack-frame-top) v0-0)
v0-0
)
(with-pp (when (-> pp stack-frame-top)
(let ((v0-0 (-> pp stack-frame-top next)))
(set! (-> pp stack-frame-top) v0-0)
v0-0
)
)
)
)
@@ -1515,14 +1515,14 @@
new
protect-frame
((allocation symbol) (type-to-make type) (arg0 (function object)))
(local-vars (pp process))
(let ((v0-0 (the-as object (+ (the-as int allocation) 4))))
(set! (-> (the-as protect-frame v0-0) type) type-to-make)
(set! (-> (the-as protect-frame v0-0) name) 'protect-frame)
(set! (-> (the-as protect-frame v0-0) exit) arg0)
(set! (-> (the-as protect-frame v0-0) next) (-> pp stack-frame-top))
(set! (-> pp stack-frame-top) (the-as protect-frame v0-0))
(the-as protect-frame v0-0)
(with-pp (let ((v0-0 (the-as object (+ (the-as int allocation) 4))))
(set! (-> (the-as protect-frame v0-0) type) type-to-make)
(set! (-> (the-as protect-frame v0-0) name) 'protect-frame)
(set! (-> (the-as protect-frame v0-0) exit) arg0)
(set! (-> (the-as protect-frame v0-0) next) (-> pp stack-frame-top))
(set! (-> pp stack-frame-top) (the-as protect-frame v0-0))
(the-as protect-frame v0-0)
)
)
)
@@ -1814,59 +1814,60 @@
;; WARN: Unsupported inline assembly instruction kind - [lw ra, return-from-thread(s7)]
;; WARN: Unsupported inline assembly instruction kind - [jr ra]
(defmethod deactivate process ((obj process))
(local-vars (pp process) (s7-0 none) (ra-0 int))
(when (!= (-> obj status) 'dead)
(set! (-> obj next-state) dead-state)
(if (-> obj entity)
(entity-deactivate-handler obj (-> obj entity))
)
(let ((s5-0 pp))
(let ((s4-0 (-> obj stack-frame-top)))
(while (the-as protect-frame s4-0)
(let ((v1-5 (-> s4-0 type)))
(if (or (= v1-5 protect-frame) (= v1-5 state))
((-> (the-as protect-frame s4-0) exit))
)
)
(set! (the-as protect-frame s4-0) (-> (the-as protect-frame s4-0) next))
)
)
(let ((s6-2 s5-0))
)
)
(process-disconnect obj)
(let ((v1-11 (-> obj child)))
(while v1-11
(let ((s5-1 (-> v1-11 0 brother)))
(deactivate (-> v1-11 0))
(set! v1-11 s5-1)
)
)
)
(return-process (-> obj pool) obj)
(set! (-> obj state) #f)
(set! (-> obj next-state) #f)
(set! (-> obj entity) #f)
(set! (-> obj pid) 0)
(cond
((= (-> *kernel-context* current-process) obj)
(set! (-> obj status) 'dead)
(.lw ra-0 return-from-thread s7-0)
(.jr ra-0)
(nop!)
(let ((v1-21 0))
)
)
((= (-> obj status) 'initialize)
(set! (-> obj status) 'dead)
(throw 'initialize #f)
)
)
(set! (-> obj status) 'dead)
(let ((v0-7 0))
)
(local-vars (s7-0 none) (ra-0 int))
(with-pp (when (!= (-> obj status) 'dead)
(set! (-> obj next-state) dead-state)
(if (-> obj entity)
(entity-deactivate-handler obj (-> obj entity))
)
(let ((s5-0 pp))
(let ((s4-0 (-> obj stack-frame-top)))
(while (the-as protect-frame s4-0)
(let ((v1-5 (-> s4-0 type)))
(if (or (= v1-5 protect-frame) (= v1-5 state))
((-> (the-as protect-frame s4-0) exit))
)
)
(set! s4-0 (-> (the-as protect-frame s4-0) next))
)
)
(let ((s6-2 s5-0))
)
)
(process-disconnect obj)
(let ((v1-11 (-> obj child)))
(while v1-11
(let ((s5-1 (-> v1-11 0 brother)))
(deactivate (-> v1-11 0))
(set! v1-11 s5-1)
)
)
)
(return-process (-> obj pool) obj)
(set! (-> obj state) #f)
(set! (-> obj next-state) #f)
(set! (-> obj entity) #f)
(set! (-> obj pid) 0)
(cond
((= (-> *kernel-context* current-process) obj)
(set! (-> obj status) 'dead)
(.lw ra-0 return-from-thread s7-0)
(.jr ra-0)
(nop!)
(let ((v1-21 0))
)
)
((= (-> obj status) 'initialize)
(set! (-> obj status) 'dead)
(throw 'initialize #f)
)
)
(set! (-> obj status) 'dead)
(let ((v0-7 0))
)
)
(none)
)
(none)
)
;; failed to figure out what this is:
test/decompiler/reference/kernel/gstate_REF.gc
+79 -83
View File
@@ -62,83 +62,78 @@
(arg4 object)
(arg5 object)
)
(local-vars
(pp process)
(s7-0 none)
(sp-0 none)
(sp-1 int)
(ra-0 int)
(sv-0 none)
)
(set!
(-> pp mask)
(logand (lognot (process-mask sleep sleep-code)) (-> pp mask))
)
(set! (-> pp mask) (logior (-> pp mask) (process-mask going)))
(cond
((= (-> pp status) 'initialize)
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(set! (-> pp status) 'initialize-go)
(throw 'initialize #t)
#t
(local-vars (s7-0 none) (sp-0 none) (sp-1 int) (ra-0 int) (sv-0 none))
(with-pp
(set!
(-> pp mask)
(logand (lognot (process-mask sleep sleep-code)) (-> pp mask))
)
((!= (-> *kernel-context* current-process) pp)
(let ((s0-0 (-> pp status)))
(set! (-> pp mask) (logior (-> pp mask) (process-mask going)))
(cond
((= (-> pp status) 'initialize)
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(set! (-> pp status) s0-0)
(set! (-> pp status) 'initialize-go)
(throw 'initialize #t)
#t
)
#t
)
((= (-> pp main-thread) (-> pp top-thread))
(set! (-> pp state) (-> pp next-state))
(let ((s0-1 (-> pp stack-frame-top)))
(while s0-1
(let ((v1-10 (-> s0-1 type)))
(if (or (= v1-10 protect-frame) (= v1-10 state))
((-> (the-as protect-frame s0-1) exit))
((!= (-> *kernel-context* current-process) pp)
(let ((s0-0 (-> pp status)))
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(set! (-> pp status) s0-0)
)
#t
)
((= (-> pp main-thread) (-> pp top-thread))
(set! (-> pp state) (-> pp next-state))
(let ((s0-1 (-> pp stack-frame-top)))
(while s0-1
(let ((v1-10 (-> s0-1 type)))
(if (or (= v1-10 protect-frame) (= v1-10 state))
((-> (the-as protect-frame s0-1) exit))
)
)
(set! s0-1 (-> s0-1 next))
)
)
(set! (-> pp mask) (logand (lognot (process-mask going)) (-> pp mask)))
(let ((s0-2 (-> pp state)))
(set! (-> pp event-hook) (-> s0-2 event))
(if (-> s0-2 exit)
(set! (-> pp stack-frame-top) s0-2)
(set! (-> pp stack-frame-top) #f)
)
(set! (-> pp post-hook) (-> s0-2 post))
(set! (-> pp trans-hook) (-> s0-2 trans))
(let ((t9-4 (-> s0-2 enter)))
(if t9-4
(t9-4 arg0 arg1 arg2 arg3 arg4 arg5)
)
)
(set! s0-1 (-> s0-1 next))
)
)
(set! (-> pp mask) (logand (lognot (process-mask going)) (-> pp mask)))
(let ((s0-2 (-> pp state)))
(set! (-> pp event-hook) (-> s0-2 event))
(if (-> s0-2 exit)
(set! (-> pp stack-frame-top) s0-2)
(set! (-> pp stack-frame-top) #f)
)
(set! (-> pp post-hook) (-> s0-2 post))
(set! (-> pp trans-hook) (-> s0-2 trans))
(let ((t9-4 (-> s0-2 enter)))
(if t9-4
(t9-4 arg0 arg1 arg2 arg3 arg4 arg5)
(let ((t9-5 (-> s0-2 trans)))
(if t9-5
(t9-5)
)
)
(let ((v1-28 (-> pp main-thread)))
(.lwu sp-1 28 v1-28)
)
(let ((t9-6 (-> s0-2 code)))
(.lw ra-0 return-from-thread-dead s7-0)
(.jr t9-6)
)
)
(let ((t9-5 (-> s0-2 trans)))
(if t9-5
(t9-5)
)
)
(let ((v1-28 (-> pp main-thread)))
(.lwu sp-1 28 v1-28)
)
(let ((t9-6 (-> s0-2 code)))
(.lw ra-0 return-from-thread-dead s7-0)
(.jr t9-6)
)
arg4
)
arg4
)
(else
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(when (!= (-> pp top-thread name) 'post)
(let ((v0-2 (the-as object return-from-thread)))
(.sw (the-as (function none) v0-2) 0 sp-0)
v0-2
(else
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(when (!= (-> pp top-thread name) 'post)
(let ((v0-2 (the-as object return-from-thread)))
(.sw (the-as (function none) v0-2) 0 sp-0)
v0-2
)
)
)
)
@@ -147,24 +142,25 @@
;; definition for function send-event-function
(defun send-event-function ((arg0 process) (arg1 event-message-block))
(local-vars (pp process))
(when (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
(let ((gp-0 pp))
(let ((s6-1 arg0))
)
(let
((v0-0
((-> arg0 event-hook)
(-> arg1 from)
(-> arg1 num-params)
(-> arg1 message)
arg1
(with-pp
(when (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
(let ((gp-0 pp))
(let ((s6-1 arg0))
)
(let
((v0-0
((-> arg0 event-hook)
(-> arg1 from)
(-> arg1 num-params)
(-> arg1 message)
arg1
)
)
)
(let ((s6-2 gp-0))
)
v0-0
)
(let ((s6-2 gp-0))
)
v0-0
)
)
)
test/goalc/test_with_game.cpp
+2
View File
@@ -835,6 +835,8 @@ struct VectorFloatTestCase {
virtual VectorFloatRegister getExpectedResult() = 0;
virtual void setJson(nlohmann::json& data, std::string func) = 0;
virtual ~VectorFloatTestCase() = default;
};
struct VectorFloatTestCase_TwoOperand : VectorFloatTestCase {
test/offline/offline_test_main.cpp
+24 -8
View File
@@ -46,23 +46,35 @@ const std::unordered_set<std::string> g_functions_expected_to_reject = {
"(method 9 bounding-box)", // handwritten asm loop
"(method 14 bounding-box)", // handwritten asm loop
// trig
"exp", "atan0", "sincos!", "sincos-rad!",
"exp",
"atan0",
"sincos!",
"sincos-rad!",
// matrix
"(method 9 matrix)", // handwritten asm loop
"matrix-axis-sin-cos!", "matrix-axis-sin-cos-vu!",
"matrix-axis-sin-cos!",
"matrix-axis-sin-cos-vu!",
// dma-h
"dma-count-until-done", // dma asm loop
"dma-sync-with-count", "dma-send-no-scratch", "dma-sync-fast",
"dma-sync-with-count",
"dma-send-no-scratch",
"dma-sync-fast",
// dma
"symlink2", "symlink3", "dma-sync-hang", // handwritten asm
"vector=", // asm branching
"symlink2",
"symlink3",
"dma-sync-hang", // handwritten asm
"vector=", // asm branching
// display
"vblank-handler", // asm
"vif1-handler", "vif1-handler-debug",
"vif1-handler",
"vif1-handler-debug",
// stats-h
"(method 11 perf-stat)", "(method 12 perf-stat)",
"(method 11 perf-stat)",
"(method 12 perf-stat)",
// ripple - asm
"ripple-execute-init", "ripple-create-wave-table", "ripple-apply-wave-table",
"ripple-execute-init",
"ripple-create-wave-table",
"ripple-apply-wave-table",
"ripple-matrix-scale",
// ripple - calls an asm function
"ripple-execute",
@@ -74,6 +86,10 @@ const std::unordered_set<std::string> g_functions_expected_to_reject = {
// collide-mesh-h
"(method 11 collide-mesh-cache)", // asm
// actor-link-h
"(method 21 actor-link-info)", // BUG: sc cfg / cfg-ir bug
"(method 20 actor-link-info)",
};
const std::unordered_set<std::string> g_functions_to_skip_compiling = {