mirror of
https://github.com/open-goal/jak-project
synced 2026-05-29 08:43:08 -04:00
ManDude
cd68cb671e
Major change to how `deftype` shows up in our code: - the decompiler will no longer emit the `offset-assert`, `method-count-assert`, `size-assert` and `flag-assert` parameters. There are extremely few cases where having this in the decompiled code is helpful, as the types there come from `all-types` which already has those parameters. This also doesn't break type consistency because: - the asserts aren't compared. - the first step of the test uses `all-types`, which has the asserts, which will throw an error if they're bad. - the decompiler won't emit the `heap-base` parameter unless necessary now. - the decompiler will try its hardest to turn a fixed-offset field into an `overlay-at` field. It falls back to the old offset if all else fails. - `overlay-at` now supports field "dereferencing" to specify the offset that's within a field that's a structure, e.g.: ```lisp (deftype foobar (structure) ((vec vector :inline) (flags int32 :overlay-at (-> vec w)) ) ) ``` in this structure, the offset of `flags` will be 12 because that is the final offset of `vec`'s `w` field within this structure. - **removed ID from all method declarations.** IDs are only ever automatically assigned now. Fixes #3068. - added an `:overlay` parameter to method declarations, in order to declare a new method that goes on top of a previously-defined method. Syntax is `:overlay <method-name>`. Please do not ever use this. - added `state-methods` list parameter. This lets you quickly specify a list of states to be put in the method table. Same syntax as the `states` list parameter. The decompiler will try to put as many states in this as it can without messing with the method ID order. Also changes `defmethod` to make the first type definition (before the arguments) optional. The type can now be inferred from the first argument. Fixes #3093. --------- Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
896 lines
30 KiB
Common Lisp
Vendored
Generated
896 lines
30 KiB
Common Lisp
Vendored
Generated
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition for method 2 of type res-tag
|
|
(defmethod print ((this res-tag))
|
|
(if (zero? (-> this inlined?))
|
|
(format
|
|
#t
|
|
"#<res-tag :name ~A :key-frame ~f :elt-type ~A :elt-count ~D>"
|
|
(-> this name)
|
|
(-> this key-frame)
|
|
(-> this elt-type)
|
|
(-> this elt-count)
|
|
)
|
|
(format
|
|
#t
|
|
"#<res-tag (i) :name ~A :key-frame ~f :elt-type ~A :elt-count ~D>"
|
|
(-> this name)
|
|
(-> this key-frame)
|
|
(-> this elt-type)
|
|
(-> this elt-count)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 4 of type res-tag
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod length ((this res-tag))
|
|
(the-as int (if (zero? (-> this inlined?))
|
|
(* (-> this elt-count) 4)
|
|
(* (-> this elt-count) (-> this elt-type size))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 13 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-tag-index-data ((this res-lump) (arg0 int))
|
|
(&+ (-> this data-base) (-> this tag arg0 data-offset))
|
|
)
|
|
|
|
;; definition for method 14 of type res-lump
|
|
(defmethod get-tag-data ((this res-lump) (arg0 res-tag))
|
|
(&+ (-> this data-base) (-> arg0 data-offset))
|
|
)
|
|
|
|
;; definition for method 0 of type res-lump
|
|
(defmethod new res-lump ((allocation symbol) (type-to-make type) (data-count int) (data-size int))
|
|
(let ((this (object-new
|
|
allocation
|
|
type-to-make
|
|
(the-as int (+ (-> type-to-make size) (* (+ data-count -1) 16) data-size))
|
|
)
|
|
)
|
|
)
|
|
(set! (-> this allocated-length) data-count)
|
|
(set! (-> this data-size) data-size)
|
|
(set! (-> this length) 0)
|
|
(set! (-> this data-base) (&-> (-> this tag) data-count))
|
|
(set! (-> this data-top) (&-> (-> this tag) data-count))
|
|
this
|
|
)
|
|
)
|
|
|
|
;; definition for method 4 of type res-lump
|
|
(defmethod length ((this res-lump))
|
|
(-> this length)
|
|
)
|
|
|
|
;; definition for method 5 of type res-lump
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this res-lump))
|
|
(the-as int (+ (-> this type psize) (* (-> this allocated-length) 16) (-> this data-size)))
|
|
)
|
|
|
|
;; definition for method 3 of type res-lump
|
|
;; INFO: this function exists in multiple non-identical object files
|
|
;; INFO: Used lq/sq
|
|
(defmethod inspect ((this res-lump))
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~Textra: ~A~%" (-> this extra))
|
|
(format #t "~Tallocated-length: ~D~%" (-> this allocated-length))
|
|
(format #t "~Tlength: ~D~%" (-> this length))
|
|
(format #t "~Tdata-base: #x~X~%" (-> this data-base))
|
|
(format #t "~Tdata-top: #x~X~%" (-> this data-top))
|
|
(format #t "~Tdata-size: #x~X~%" (-> this data-size))
|
|
(format #t "~Ttag[~D]: @ #x~X~%" (-> this allocated-length) (-> this tag))
|
|
(dotimes (i (-> this length))
|
|
(format #t "~T [~D] " i)
|
|
(print (-> this tag i))
|
|
(let ((t9-10 format)
|
|
(a0-12 #t)
|
|
(a1-9 " @ #x~X")
|
|
(a3-2 this)
|
|
(a2-9 i)
|
|
)
|
|
(t9-10 a0-12 a1-9 (&+ (-> a3-2 data-base) (-> a3-2 tag a2-9 data-offset)))
|
|
)
|
|
(cond
|
|
((zero? (-> this tag i inlined?))
|
|
(let ((t9-11 format)
|
|
(a0-14 #t)
|
|
(a1-10 " = ~A~%")
|
|
(a3-4 this)
|
|
(a2-17 i)
|
|
)
|
|
(t9-11 a0-14 a1-10 (-> (the-as (pointer uint32) (&+ (-> a3-4 data-base) (-> a3-4 tag a2-17 data-offset)))))
|
|
)
|
|
)
|
|
(else
|
|
(format #t "~%")
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 19 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; INFO: Return type mismatch int vs res-tag-pair.
|
|
(defmethod lookup-tag-idx ((this res-lump) (name-sym symbol) (mode symbol) (time float))
|
|
(local-vars (tag-idx int))
|
|
(when (or (= name-sym 'id)
|
|
(= name-sym 'aid)
|
|
(= name-sym 'trans)
|
|
(= name-sym 'rot)
|
|
(= name-sym 'nav-mesh)
|
|
(= name-sym 'process-type)
|
|
(= name-sym 'task)
|
|
)
|
|
(crash!)
|
|
0
|
|
)
|
|
(if (or (not this) (zero? this) (<= (-> this length) 0))
|
|
(return (new 'static 'res-tag-pair :lo #xffffffff :hi #xffffffff))
|
|
)
|
|
(let ((hi-tag-idx-out -1)
|
|
(lo-tag-idx-out -1)
|
|
)
|
|
(let ((most-recent-invalid-time-idx -1)
|
|
(type-chars (-> (the-as (pointer uint64) (-> (symbol->string name-sym) data)) 0))
|
|
)
|
|
(let ((max-search (+ (-> this length) -1))
|
|
(min-search 0)
|
|
)
|
|
(while (>= max-search min-search)
|
|
(let* ((check-idx (+ min-search (/ (- max-search min-search) 2)))
|
|
(diff (- type-chars (-> (the-as (pointer uint64) (-> (symbol->string (-> this tag check-idx name)) data)) 0)))
|
|
)
|
|
(cond
|
|
((zero? diff)
|
|
(set! tag-idx check-idx)
|
|
(goto cfg-32)
|
|
)
|
|
((< (the-as int diff) 0)
|
|
(set! max-search (+ check-idx -1))
|
|
)
|
|
(else
|
|
(set! min-search (+ check-idx 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! tag-idx -1)
|
|
(label cfg-32)
|
|
(if (< tag-idx 0)
|
|
(return (the-as res-tag-pair tag-idx))
|
|
)
|
|
(while (and (> tag-idx 0)
|
|
(= type-chars (-> (the-as (pointer uint64) (-> (symbol->string (-> this tag (+ tag-idx -1) name)) data)) 0))
|
|
)
|
|
(+! tag-idx -1)
|
|
)
|
|
(when (= mode 'base)
|
|
(set! lo-tag-idx-out tag-idx)
|
|
(set! hi-tag-idx-out tag-idx)
|
|
(goto cfg-73)
|
|
)
|
|
(let ((interp-tag-idx tag-idx)
|
|
(tag-ptr (&-> (-> this tag) tag-idx))
|
|
)
|
|
(while (not (or (>= interp-tag-idx (-> this length))
|
|
(< type-chars (-> (the-as (pointer uint64) (-> (symbol->string (-> tag-ptr 0 name)) data)) 0))
|
|
)
|
|
)
|
|
(cond
|
|
((!= name-sym (-> tag-ptr 0 name))
|
|
)
|
|
((= (-> tag-ptr 0 key-frame) time)
|
|
(set! lo-tag-idx-out interp-tag-idx)
|
|
(set! hi-tag-idx-out interp-tag-idx)
|
|
(goto cfg-73)
|
|
)
|
|
((and (>= time (-> tag-ptr 0 key-frame)) (!= mode 'exact))
|
|
(set! lo-tag-idx-out interp-tag-idx)
|
|
(set! hi-tag-idx-out interp-tag-idx)
|
|
(if (= (-> tag-ptr 0 key-frame) -1000000000.0)
|
|
(set! most-recent-invalid-time-idx interp-tag-idx)
|
|
)
|
|
)
|
|
((< time (-> tag-ptr 0 key-frame))
|
|
(if (and (!= lo-tag-idx-out most-recent-invalid-time-idx) (= mode 'interp))
|
|
(set! hi-tag-idx-out interp-tag-idx)
|
|
)
|
|
(goto cfg-73)
|
|
)
|
|
)
|
|
(+! interp-tag-idx 1)
|
|
(set! tag-ptr (&-> tag-ptr 1))
|
|
)
|
|
)
|
|
)
|
|
(label cfg-73)
|
|
(the-as res-tag-pair (logior (logand (the-as uint #xffffffff) lo-tag-idx-out) (shl hi-tag-idx-out 32)))
|
|
)
|
|
)
|
|
|
|
;; definition for method 20 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod make-property-data ((this res-lump) (time float) (result res-tag-pair) (buf pointer))
|
|
(rlet ((vf1 :class vf)
|
|
(vf2 :class vf)
|
|
(vf3 :class vf)
|
|
(vf4 :class vf)
|
|
)
|
|
(let* ((tag-lo (-> this tag (-> result lo)))
|
|
(tag-hi (-> this tag (-> result hi)))
|
|
(elt-count (-> tag-lo elt-count))
|
|
)
|
|
(cond
|
|
((zero? (-> tag-lo inlined?))
|
|
(&+ (-> this data-base) (-> tag-lo data-offset))
|
|
)
|
|
((or (not buf)
|
|
(= (-> result lo) (-> result hi))
|
|
(!= elt-count (-> tag-hi elt-count))
|
|
(!= (-> tag-lo elt-type) (-> tag-hi elt-type))
|
|
)
|
|
(let ((a0-4 tag-lo))
|
|
(&+ (-> this data-base) (-> a0-4 data-offset))
|
|
)
|
|
)
|
|
(else
|
|
(let* ((interp (/ (- time (-> tag-lo key-frame)) (- (-> tag-hi key-frame) (-> tag-lo key-frame))))
|
|
(a1-4 this)
|
|
(a2-7 tag-lo)
|
|
(src-lo (&+ (-> a1-4 data-base) (-> a2-7 data-offset)))
|
|
(src-hi (&+ (-> this data-base) (-> tag-hi data-offset)))
|
|
)
|
|
(case (-> tag-lo elt-type symbol)
|
|
(('float)
|
|
(dotimes (a0-8 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer float) (&+ buf (* a0-8 4))))
|
|
(+ (* (-> (the-as (pointer float) (&+ src-lo (* a0-8 4)))) (- 1.0 interp))
|
|
(* (-> (the-as (pointer float) (&+ src-hi (* a0-8 4)))) interp)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('integer 'sinteger 'uinteger 'int64 'uint64)
|
|
(let ((a0-9 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-9 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer int64) (&+ buf (* t0-9 8))))
|
|
(sar
|
|
(+ (* (the-as int (-> (the-as (pointer uint64) (&+ src-lo (* t0-9 8))))) (- 4096 a0-9))
|
|
(* (the-as int (-> (the-as (pointer uint64) (&+ src-hi (* t0-9 8))))) a0-9)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('int8)
|
|
(let ((a0-10 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-10 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer int8) (&+ buf t0-10)))
|
|
(sar
|
|
(+ (* (-> (the-as (pointer int8) (&+ src-lo t0-10))) (- 4096 a0-10))
|
|
(* (-> (the-as (pointer int8) (&+ src-hi t0-10))) a0-10)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('uint8)
|
|
(let ((a0-11 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-11 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer uint8) (&+ buf t0-11)))
|
|
(shr
|
|
(+ (* (-> (the-as (pointer uint8) (&+ src-lo t0-11))) (the-as uint (- 4096 a0-11)))
|
|
(* (-> (the-as (pointer uint8) (&+ src-hi t0-11))) (the-as uint a0-11))
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('int16)
|
|
(let ((a0-12 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-12 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer int16) (&+ buf (* t0-12 2))))
|
|
(sar
|
|
(+ (* (-> (the-as (pointer int16) (&+ src-lo (* t0-12 2)))) (- 4096 a0-12))
|
|
(* (-> (the-as (pointer int16) (&+ src-hi (* t0-12 2)))) a0-12)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('uint16)
|
|
(let ((a0-13 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-13 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer uint16) (&+ buf (* t0-13 2))))
|
|
(shr
|
|
(+ (* (-> (the-as (pointer uint16) (&+ src-lo (* t0-13 2)))) (the-as uint (- 4096 a0-13)))
|
|
(* (-> (the-as (pointer uint16) (&+ src-hi (* t0-13 2)))) (the-as uint a0-13))
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('int32)
|
|
(let ((a0-14 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-14 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer int32) (&+ buf (* t0-14 4))))
|
|
(sar
|
|
(+ (* (-> (the-as (pointer int32) (&+ src-lo (* t0-14 4)))) (- 4096 a0-14))
|
|
(* (-> (the-as (pointer int32) (&+ src-hi (* t0-14 4)))) a0-14)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('uint32)
|
|
(let ((a0-15 (the int (* 4096.0 interp))))
|
|
(dotimes (t0-15 (the-as int elt-count))
|
|
(set! (-> (the-as (pointer uint32) (&+ buf (* t0-15 4))))
|
|
(shr
|
|
(+ (* (-> (the-as (pointer uint32) (&+ src-lo (* t0-15 4)))) (the-as uint (- 4096 a0-15)))
|
|
(* (-> (the-as (pointer uint32) (&+ src-hi (* t0-15 4)))) (the-as uint a0-15))
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
buf
|
|
)
|
|
(('vector)
|
|
(let ((a0-16 interp))
|
|
(.mov vf3 a0-16)
|
|
)
|
|
(let ((a0-17 (- 1.0 interp)))
|
|
(.mov vf4 a0-17)
|
|
)
|
|
(dotimes (a0-18 (the-as int elt-count))
|
|
(let ((t0-17 (+ (* a0-18 16) (the-as int src-lo))))
|
|
(.lvf vf1 (&-> (the-as (pointer int128) t0-17)))
|
|
)
|
|
(let ((t0-19 (+ (* a0-18 16) (the-as int src-hi))))
|
|
(.lvf vf2 (&-> (the-as (pointer int128) t0-19)))
|
|
)
|
|
(.mul.x.vf vf1 vf1 vf4)
|
|
(.mul.x.vf vf2 vf2 vf3)
|
|
(.add.vf vf1 vf1 vf2)
|
|
(.svf (&-> (-> (the-as (inline-array vector) buf) a0-18) quad) vf1)
|
|
)
|
|
buf
|
|
)
|
|
(else
|
|
(let ((a0-19 tag-lo))
|
|
(&+ (-> this data-base) (-> a0-19 data-offset))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 9 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-property-data ((this res-lump)
|
|
(name symbol)
|
|
(mode symbol)
|
|
(time float)
|
|
(default pointer)
|
|
(tag-addr (pointer res-tag))
|
|
(buf-addr pointer)
|
|
)
|
|
(let ((tag-pair (lookup-tag-idx this name mode time)))
|
|
(cond
|
|
((< (the-as int tag-pair) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(set! default (make-property-data this time tag-pair buf-addr))
|
|
(if tag-addr
|
|
(set! (-> tag-addr 0) (-> this tag (-> tag-pair lo)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
default
|
|
)
|
|
|
|
;; definition for method 10 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; INFO: Return type mismatch object vs structure.
|
|
(defmethod get-property-struct ((this res-lump)
|
|
(name symbol)
|
|
(mode symbol)
|
|
(time float)
|
|
(default structure)
|
|
(tag-addr (pointer res-tag))
|
|
(buf-addr pointer)
|
|
)
|
|
(let ((tag-pair (lookup-tag-idx this name mode time)))
|
|
(cond
|
|
((< (the-as int tag-pair) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(set! default (the-as structure (make-property-data this time tag-pair buf-addr)))
|
|
(let ((tag (-> this tag (-> tag-pair lo))))
|
|
(if tag-addr
|
|
(set! (-> tag-addr 0) tag)
|
|
)
|
|
(if (zero? (-> tag inlined?))
|
|
(set! default (the-as structure (-> (the-as (pointer uint32) default))))
|
|
(empty)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as structure default)
|
|
)
|
|
|
|
;; definition for method 11 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; INFO: Return type mismatch int vs uint128.
|
|
(defmethod get-property-value ((this res-lump)
|
|
(name symbol)
|
|
(mode symbol)
|
|
(time float)
|
|
(default uint128)
|
|
(tag-addr (pointer res-tag))
|
|
(buf-addr pointer)
|
|
)
|
|
(let ((tag-pair (lookup-tag-idx this name mode time)))
|
|
(cond
|
|
((< (the-as int tag-pair) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(let* ((a0-2 (-> tag-pair lo))
|
|
(tag (-> this tag a0-2))
|
|
(tag-type (-> tag elt-type))
|
|
(data (make-property-data this time tag-pair buf-addr))
|
|
)
|
|
(if tag-addr
|
|
(set! (-> tag-addr 0) tag)
|
|
)
|
|
(cond
|
|
((type-type? (the-as type tag-type) uinteger)
|
|
(case (-> tag elt-type size)
|
|
((1)
|
|
(set! default (the-as uint128 (-> (the-as (pointer uint8) data))))
|
|
)
|
|
((2)
|
|
(set! default (the-as uint128 (-> (the-as (pointer uint16) data))))
|
|
)
|
|
((4)
|
|
(set! default (the-as uint128 (-> (the-as (pointer uint32) data))))
|
|
)
|
|
((16)
|
|
(set! default (-> (the-as (pointer uint128) data)))
|
|
)
|
|
(else
|
|
(set! default (the-as uint128 (-> (the-as (pointer uint64) data))))
|
|
)
|
|
)
|
|
)
|
|
((type-type? (the-as type tag-type) integer)
|
|
(case (-> tag elt-type size)
|
|
((1)
|
|
(set! default (the-as uint128 (-> (the-as (pointer int8) data))))
|
|
)
|
|
((2)
|
|
(set! default (the-as uint128 (-> (the-as (pointer int16) data))))
|
|
)
|
|
((4)
|
|
(set! default (the-as uint128 (-> (the-as (pointer int32) data))))
|
|
)
|
|
((16)
|
|
(set! default (-> (the-as (pointer uint128) data)))
|
|
)
|
|
(else
|
|
(set! default (the-as uint128 (-> (the-as (pointer uint64) data))))
|
|
)
|
|
)
|
|
)
|
|
((type-type? (the-as type tag-type) float)
|
|
(set! default (the-as uint128 (the int (-> (the-as (pointer float) data)))))
|
|
)
|
|
(else
|
|
(empty)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as uint128 default)
|
|
)
|
|
|
|
;; definition for method 12 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-property-value-float ((this res-lump)
|
|
(name symbol)
|
|
(mode symbol)
|
|
(time float)
|
|
(default float)
|
|
(tag-addr (pointer res-tag))
|
|
(buf-addr pointer)
|
|
)
|
|
(local-vars (v1-8 uint) (v1-11 int))
|
|
(let ((tag-pair (lookup-tag-idx this name mode time)))
|
|
(cond
|
|
((< (the-as int tag-pair) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(let* ((a0-2 (-> tag-pair lo))
|
|
(tag (-> this tag a0-2))
|
|
(tag-type (-> tag elt-type))
|
|
(data (make-property-data this time tag-pair buf-addr))
|
|
)
|
|
(if tag-addr
|
|
(set! (-> tag-addr 0) tag)
|
|
)
|
|
(cond
|
|
((type-type? (the-as type tag-type) float)
|
|
(set! default (-> (the-as (pointer float) data)))
|
|
)
|
|
((type-type? (the-as type tag-type) uinteger)
|
|
(case (-> tag elt-type size)
|
|
((1)
|
|
(set! v1-8 (-> (the-as (pointer uint8) data)))
|
|
)
|
|
((2)
|
|
(set! v1-8 (-> (the-as (pointer uint16) data)))
|
|
)
|
|
((4)
|
|
(set! v1-8 (-> (the-as (pointer uint32) data)))
|
|
)
|
|
((16)
|
|
(set! v1-8 (the-as uint (-> (the-as (pointer uint128) data))))
|
|
)
|
|
(else
|
|
(set! v1-8 (-> (the-as (pointer uint64) data)))
|
|
)
|
|
)
|
|
(set! default (the float v1-8))
|
|
)
|
|
((type-type? (the-as type tag-type) integer)
|
|
(case (-> tag elt-type size)
|
|
((1)
|
|
(set! v1-11 (-> (the-as (pointer int8) data)))
|
|
)
|
|
((2)
|
|
(set! v1-11 (-> (the-as (pointer int16) data)))
|
|
)
|
|
((4)
|
|
(set! v1-11 (-> (the-as (pointer int32) data)))
|
|
)
|
|
((16)
|
|
(set! v1-11 (the-as int (-> (the-as (pointer uint128) data))))
|
|
)
|
|
(else
|
|
(set! v1-11 (the-as int (-> (the-as (pointer uint64) data))))
|
|
)
|
|
)
|
|
(set! default (the float v1-11))
|
|
)
|
|
(else
|
|
(empty)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
default
|
|
)
|
|
|
|
;; definition for method 16 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod sort! ((this res-lump))
|
|
(let ((tags-sorted -1))
|
|
(while (nonzero? tags-sorted)
|
|
(set! tags-sorted 0)
|
|
(let ((i 0)
|
|
(tag-stop (+ (-> this length) -2))
|
|
)
|
|
(while (>= tag-stop i)
|
|
(let* ((tag1 (-> this tag i))
|
|
(tag2 (-> this tag (+ i 1)))
|
|
(tag-name1 (-> (the-as (pointer uint64) (-> (symbol->string (-> tag1 name)) data)) 0))
|
|
(tag-name2 (-> (the-as (pointer uint64) (-> (symbol->string (-> tag2 name)) data)) 0))
|
|
)
|
|
(when (or (< tag-name2 tag-name1) (and (= tag-name1 tag-name2) (< (-> tag2 key-frame) (-> tag1 key-frame))))
|
|
(+! tags-sorted 1)
|
|
(set! (-> this tag i) tag2)
|
|
(set! (-> this tag (+ i 1)) tag1)
|
|
)
|
|
)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 15 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod allocate-data-memory-for-tag! ((this res-lump) (arg0 res-tag))
|
|
(local-vars (resource-mem pointer))
|
|
(let* ((tag-pair (lookup-tag-idx this (-> arg0 name) 'exact (-> arg0 key-frame)))
|
|
(existing-tag (-> this tag (-> tag-pair lo)))
|
|
)
|
|
0
|
|
(if (and (>= (the-as int tag-pair) 0) (!= (-> arg0 key-frame) (-> arg0 key-frame)))
|
|
(set! tag-pair (new 'static 'res-tag-pair :lo #xffffffff :hi #xffffffff))
|
|
)
|
|
(if (zero? (-> arg0 elt-count))
|
|
(set! arg0 (copy-and-set-field arg0 elt-count 1))
|
|
)
|
|
(let ((data-size (length arg0)))
|
|
(cond
|
|
((and (>= (the-as int tag-pair) 0) (>= (the-as uint (length existing-tag)) (the-as uint data-size)))
|
|
(set! resource-mem (&+ (-> this data-base) (-> existing-tag data-offset)))
|
|
(when (logtest? (the-as int resource-mem) 7)
|
|
(set! resource-mem (logand -16 (&+ (-> this data-top) 15)))
|
|
(set! (-> this data-top) (&+ resource-mem data-size))
|
|
)
|
|
)
|
|
(else
|
|
(set! resource-mem (logand -16 (&+ (-> this data-top) 15)))
|
|
(set! (-> this data-top) (&+ resource-mem data-size))
|
|
)
|
|
)
|
|
(let* ((a0-22 arg0)
|
|
(s4-1 (copy-and-set-field a0-22 data-offset (&- resource-mem (the-as uint (-> this data-base)))))
|
|
)
|
|
(when (>= (the-as int (&+ resource-mem data-size)) (the-as int (&+ (-> this data-base) (-> this data-size))))
|
|
(format
|
|
0
|
|
"ERROR: attempting to a new tag ~`res-tag`P data of #x~X bytes to ~A, but data memory is full.~%"
|
|
s4-1
|
|
data-size
|
|
this
|
|
)
|
|
(return (the-as res-tag #f))
|
|
)
|
|
(cond
|
|
((< (the-as int tag-pair) 0)
|
|
(cond
|
|
((>= (-> this length) (-> this allocated-length))
|
|
(format 0 "ERROR: attempting to a new tag ~`res-tag`P to ~A, but tag memory is full.~%" s4-1 this)
|
|
(return (the-as res-tag #f))
|
|
)
|
|
(else
|
|
(set! (-> this tag (-> this length)) s4-1)
|
|
(+! (-> this length) 1)
|
|
(sort! this)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(set! (-> this tag (-> tag-pair lo)) s4-1)
|
|
)
|
|
)
|
|
s4-1
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 17 of type res-lump
|
|
(defmethod add-data! ((this res-lump) (arg0 res-tag) (arg1 pointer))
|
|
(let ((new-tag (allocate-data-memory-for-tag! this arg0)))
|
|
(when new-tag
|
|
(let* ((v1-2 this)
|
|
(a1-1 new-tag)
|
|
(tag-mem (&+ (-> v1-2 data-base) (-> a1-1 data-offset)))
|
|
)
|
|
(cond
|
|
((zero? (-> new-tag inlined?))
|
|
(length new-tag)
|
|
(set! (-> (the-as (pointer pointer) tag-mem) 0) arg1)
|
|
)
|
|
(else
|
|
(let ((a2-1 (length new-tag)))
|
|
(mem-copy! tag-mem arg1 a2-1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 18 of type res-lump
|
|
(defmethod add-32bit-data! ((this res-lump) (arg0 res-tag) (arg1 object))
|
|
(local-vars (sv-16 object))
|
|
(set! sv-16 arg1)
|
|
(let* ((v1-0 arg0)
|
|
(a1-4 (copy-and-set-field v1-0 inlined? 1))
|
|
)
|
|
(add-data! this a1-4 (& sv-16))
|
|
)
|
|
)
|
|
|
|
;; definition for method 21 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-curve-data! ((this res-lump) (arg0 curve) (arg1 symbol) (arg2 symbol) (arg3 float))
|
|
(local-vars (sv-16 res-tag) (sv-32 res-tag))
|
|
(let ((s5-0 #f))
|
|
(set! sv-16 (new 'static 'res-tag))
|
|
(let ((a0-2 ((method-of-object this get-property-data)
|
|
this
|
|
arg1
|
|
'exact
|
|
arg3
|
|
(the-as pointer #f)
|
|
(& sv-16)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
)
|
|
(when a0-2
|
|
(set! (-> arg0 cverts) (the-as (inline-array vector) a0-2))
|
|
(set! (-> arg0 num-cverts) (the-as int (-> sv-16 elt-count)))
|
|
(when (< 256 (-> arg0 num-cverts))
|
|
(format
|
|
0
|
|
"ERROR<GMJ>: curve has ~D control points--only ~D are allowed. Increase MAX-CURVE-CONTROL-POINTS or shorten the curve.~%"
|
|
(-> arg0 num-cverts)
|
|
256
|
|
)
|
|
(set! (-> arg0 num-cverts) 256)
|
|
)
|
|
(set! sv-32 (new 'static 'res-tag))
|
|
(let ((a0-6 ((method-of-object this get-property-data)
|
|
this
|
|
arg2
|
|
'exact
|
|
arg3
|
|
(the-as pointer #f)
|
|
(& sv-32)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
)
|
|
(when a0-6
|
|
(set! (-> arg0 knots) (the-as (pointer float) a0-6))
|
|
(set! (-> arg0 num-knots) (the-as int (-> sv-32 elt-count)))
|
|
(set! s5-0 #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
s5-0
|
|
)
|
|
)
|
|
|
|
;; definition for method 8 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; INFO: Return type mismatch int vs res-lump.
|
|
;; ERROR: Failed load: (set! v1-72 (l.wu (+ a0-58 -4))) at op 206
|
|
(defmethod mem-usage ((this res-lump) (block memory-usage-block) (flags int))
|
|
(local-vars (sv-16 int))
|
|
(let ((mem-use-id 48)
|
|
(mem-use-name "res")
|
|
)
|
|
(cond
|
|
((logtest? flags 256)
|
|
(set! mem-use-id 44)
|
|
(set! mem-use-name "camera")
|
|
)
|
|
((logtest? flags 64)
|
|
(set! mem-use-id 43)
|
|
(set! mem-use-name "entity")
|
|
)
|
|
((logtest? flags 128)
|
|
(set! mem-use-id 49)
|
|
(set! mem-use-name "ambient")
|
|
)
|
|
((logtest? flags 512)
|
|
(set! mem-use-id 73)
|
|
(set! mem-use-name "art-joint-geo")
|
|
)
|
|
)
|
|
(set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
|
|
(set! (-> block data mem-use-id name) mem-use-name)
|
|
(+! (-> block data mem-use-id count) 1)
|
|
(let ((obj-size (asize-of this)))
|
|
(+! (-> block data mem-use-id used) obj-size)
|
|
(+! (-> block data mem-use-id total) (logand -16 (+ obj-size 15)))
|
|
)
|
|
(dotimes (tag-idx (-> this length))
|
|
(when (zero? (-> this tag tag-idx inlined?))
|
|
(let* ((a1-4 this)
|
|
(a0-15 tag-idx)
|
|
(tag-data
|
|
(the-as basic (-> (the-as (pointer uint32) (&+ (-> a1-4 data-base) (-> a1-4 tag a0-15 data-offset)))))
|
|
)
|
|
)
|
|
(when (not (part-group-pointer? (the-as pointer tag-data)))
|
|
(case (-> tag-data type)
|
|
((symbol type)
|
|
)
|
|
((string)
|
|
(set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
|
|
(set! (-> block data mem-use-id name) mem-use-name)
|
|
(+! (-> block data mem-use-id count) 1)
|
|
(let ((v1-47 (asize-of tag-data)))
|
|
(+! (-> block data mem-use-id used) v1-47)
|
|
(+! (-> block data mem-use-id total) (logand -16 (+ v1-47 15)))
|
|
)
|
|
)
|
|
((nav-mesh collide-mesh)
|
|
(mem-usage (the-as collide-mesh tag-data) block flags)
|
|
)
|
|
((array)
|
|
(set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
|
|
(set! (-> block data mem-use-id name) mem-use-name)
|
|
(+! (-> block data mem-use-id count) 1)
|
|
(let ((v1-63 (asize-of (the-as (array object) tag-data))))
|
|
(+! (-> block data mem-use-id used) v1-63)
|
|
(+! (-> block data mem-use-id total) (logand -16 (+ v1-63 15)))
|
|
)
|
|
(set! sv-16 0)
|
|
(while (< sv-16 (-> (the-as array tag-data) length))
|
|
(let ((a0-58 (-> (the-as (array object) tag-data) sv-16)))
|
|
((method-of-type (rtype-of a0-58) mem-usage) a0-58 block flags)
|
|
)
|
|
(set! sv-16 (+ sv-16 1))
|
|
)
|
|
)
|
|
(else
|
|
(set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
|
|
(set! (-> block data mem-use-id name) mem-use-name)
|
|
(+! (-> block data mem-use-id count) 1)
|
|
(let ((v1-88 (asize-of tag-data)))
|
|
(+! (-> block data mem-use-id used) v1-88)
|
|
(+! (-> block data mem-use-id total) (logand -16 (+ v1-88 15)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as res-lump 0)
|
|
)
|
|
|
|
;; definition for symbol *res-static-buf*, type pointer
|
|
(define *res-static-buf* (malloc 'global 128))
|