Files
water111 637990314b wip: better stack var support (#4222)
Closes #736

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2026-04-19 00:14:44 +02:00

940 lines
33 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
;; WARN: 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))
"Get the data address of the n'th tag."
(&+ (-> 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))
"Get the data address of the specified 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) (arg0 int) (arg1 int))
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 16) arg1)))))
(set! (-> v0-0 allocated-length) arg0)
(set! (-> v0-0 data-size) arg1)
(set! (-> v0-0 length) 0)
(set! (-> v0-0 data-base) (&-> v0-0 tag arg0))
(set! (-> v0-0 data-top) (&-> v0-0 tag arg0))
v0-0
)
)
;; definition for method 4 of type res-lump
(defmethod length ((this res-lump))
(-> this length)
)
;; definition for method 5 of type res-lump
;; WARN: 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: 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 (s5-0 (-> this length))
(format #t "~T [~D] " s5-0)
(print (-> this tag s5-0))
(let ((t9-10 format)
(a0-12 #t)
(a1-9 " @ #x~X")
(a3-2 this)
(a2-9 s5-0)
)
(t9-10 a0-12 a1-9 (&+ (-> a3-2 data-base) (-> a3-2 tag a2-9 data-offset)))
)
(cond
((zero? (-> this tag s5-0 inlined?))
(let ((t9-11 format)
(a0-14 #t)
(a1-10 " = ~A~%")
(a3-4 this)
(a2-17 s5-0)
)
(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
;; WARN: Return type mismatch int vs res-tag-pair.
(defmethod lookup-tag-idx ((this res-lump) (arg0 symbol) (arg1 symbol) (arg2 float))
"Look up the index of the tag containing with the given name and timestamp.
Correct lookups return a res-tag-pair, which contains one tag index in the lower 32 bits and one in the upper 32 bits.
Depending on the mode, they may be the same, or they may be two tags that you should interpolate
between, if the exact time was not found.
@param name-sym should be the name of the thing you want.
@param time is for the timestamp you want.
If mode = 'base, then both the indices are the same and the timestamp is ignored.
If mode = 'interp, then it tries to get closest below/closest above (or both the same, if exact match found).
If mode = 'exact, then it requires an exact timestamp match and both indices are the same.
If things go wrong, returns a negative number."
(local-vars (t4-1 int))
(when (or (= arg0 'id)
(= arg0 'aid)
(= arg0 'trans)
(= arg0 'rot)
(= arg0 'nav-mesh)
(= arg0 'process-type)
(= arg0 'task)
)
(crash!)
0
)
(if (or (not this) (zero? this) (<= (-> this length) 0))
(return (new 'static 'res-tag-pair :lo #xffffffff :hi #xffffffff))
)
(let ((v1-14 -1)
(t0-6 -1)
)
(let ((t1-0 -1)
(t2-4 (-> (the-as (pointer uint64) (-> (symbol->string arg0) data)) 0))
)
(let ((t3-1 (+ (-> this length) -1))
(t4-0 0)
)
(while (>= t3-1 t4-0)
(let* ((t5-2 (+ t4-0 (/ (- t3-1 t4-0) 2)))
(t6-5 (- t2-4 (-> (the-as (pointer uint64) (-> (symbol->string (-> this tag t5-2 name)) data)) 0)))
)
(cond
((zero? t6-5)
(set! t4-1 t5-2)
(goto cfg-32)
)
((< (the-as int t6-5) 0)
(set! t3-1 (+ t5-2 -1))
)
(else
(set! t4-0 (+ t5-2 1))
)
)
)
)
)
(set! t4-1 -1)
(label cfg-32)
(if (< t4-1 0)
(return (the-as res-tag-pair t4-1))
)
(while (and (> t4-1 0)
(= t2-4 (-> (the-as (pointer uint64) (-> (symbol->string (-> this tag (+ t4-1 -1) name)) data)) 0))
)
(+! t4-1 -1)
)
(when (= arg1 'base)
(set! t0-6 t4-1)
(set! v1-14 t4-1)
(goto cfg-73)
)
(let ((t3-13 t4-1)
(t4-4 (&-> this tag t4-1))
)
(while (not (or (>= t3-13 (-> this length))
(< t2-4 (-> (&+ (the-as (pointer uint64) (symbol->string (-> t4-4 0 name))) 4) 0))
)
)
(cond
((!= arg0 (-> t4-4 0 name))
)
((= (-> t4-4 0 key-frame) arg2)
(set! t0-6 t3-13)
(set! v1-14 t3-13)
(goto cfg-73)
)
((and (>= arg2 (-> t4-4 0 key-frame)) (!= arg1 'exact))
(set! t0-6 t3-13)
(set! v1-14 t3-13)
(if (= (-> t4-4 0 key-frame) -1000000000.0)
(set! t1-0 t3-13)
)
)
((< arg2 (-> t4-4 0 key-frame))
(if (and (!= t0-6 t1-0) (= arg1 'interp))
(set! v1-14 t3-13)
)
(goto cfg-73)
)
)
(+! t3-13 1)
(set! t4-4 (&-> t4-4 1))
)
)
)
(label cfg-73)
(the-as res-tag-pair (logior (logand (the-as uint #xffffffff) t0-6) (shl v1-14 32)))
)
)
;; definition for method 20 of type res-lump
;; INFO: Used lq/sq
(defmethod make-property-data ((this res-lump) (arg1 float) (tag-pair res-tag-pair) (arg3 pointer))
"Returns (a pointer to) the value data of a property with the tag-pair.
If tag-pair does not represent an exact point in the timeline, then the data is interpolated based on time
with the result written into buf. buf must have enough space to copy all of the data.
Otherwise, simply returns an address to the resource binary."
(rlet ((vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
)
(let* ((t0-2 (-> this tag (-> tag-pair lo)))
(t1-2 (-> this tag (-> tag-pair hi)))
(v1-6 (-> t0-2 elt-count))
)
(cond
((zero? (-> t0-2 inlined?))
(&+ (-> this data-base) (-> t0-2 data-offset))
)
((or (not arg3)
(= (-> tag-pair lo) (-> tag-pair hi))
(!= v1-6 (-> t1-2 elt-count))
(!= (-> t0-2 elt-type) (-> t1-2 elt-type))
)
(let ((a0-4 t0-2))
(&+ (-> this data-base) (-> a0-4 data-offset))
)
)
(else
(let* ((f0-2 (/ (- arg1 (-> t0-2 key-frame)) (- (-> t1-2 key-frame) (-> t0-2 key-frame))))
(a1-4 this)
(a2-7 t0-2)
(a1-6 (&+ (-> a1-4 data-base) (-> a2-7 data-offset)))
(a2-13 (&+ (-> this data-base) (-> t1-2 data-offset)))
)
(case (-> t0-2 elt-type symbol)
(('float)
(dotimes (a0-8 (the-as int v1-6))
(set! (-> (the-as (pointer float) (&+ arg3 (* a0-8 4))))
(+ (* (-> (the-as (pointer float) (&+ a1-6 (* a0-8 4)))) (- 1.0 f0-2))
(* (-> (the-as (pointer float) (&+ a2-13 (* a0-8 4)))) f0-2)
)
)
)
arg3
)
(('integer 'sinteger 'uinteger 'int64 'uint64)
(let ((a0-10 (the int (* 4096.0 f0-2))))
(dotimes (t0-10 (the-as int v1-6))
(set! (-> (the-as (pointer int64) (&+ arg3 (* t0-10 8))))
(sar
(+ (* (the-as int (-> (the-as (pointer uint64) (&+ a1-6 (* t0-10 8))))) (- 4096 a0-10))
(* (the-as int (-> (the-as (pointer uint64) (&+ a2-13 (* t0-10 8))))) a0-10)
)
12
)
)
)
)
arg3
)
(('int8)
(let ((a0-12 (the int (* 4096.0 f0-2))))
(dotimes (t0-11 (the-as int v1-6))
(set! (-> (the-as (pointer int8) (&+ arg3 t0-11)))
(sar
(+ (* (-> (the-as (pointer int8) (&+ a1-6 t0-11))) (- 4096 a0-12))
(* (-> (the-as (pointer int8) (&+ a2-13 t0-11))) a0-12)
)
12
)
)
)
)
arg3
)
(('uint8)
(let ((a0-14 (the int (* 4096.0 f0-2))))
(dotimes (t0-12 (the-as int v1-6))
(set! (-> (the-as (pointer uint8) (&+ arg3 t0-12)))
(shr
(+ (* (-> (the-as (pointer uint8) (&+ a1-6 t0-12))) (the-as uint (- 4096 a0-14)))
(* (-> (the-as (pointer uint8) (&+ a2-13 t0-12))) (the-as uint a0-14))
)
12
)
)
)
)
arg3
)
(('int16)
(let ((a0-16 (the int (* 4096.0 f0-2))))
(dotimes (t0-13 (the-as int v1-6))
(set! (-> (the-as (pointer int16) (&+ arg3 (* t0-13 2))))
(sar
(+ (* (-> (the-as (pointer int16) (&+ a1-6 (* t0-13 2)))) (- 4096 a0-16))
(* (-> (the-as (pointer int16) (&+ a2-13 (* t0-13 2)))) a0-16)
)
12
)
)
)
)
arg3
)
(('uint16)
(let ((a0-18 (the int (* 4096.0 f0-2))))
(dotimes (t0-14 (the-as int v1-6))
(set! (-> (the-as (pointer uint16) (&+ arg3 (* t0-14 2))))
(shr
(+ (* (-> (the-as (pointer uint16) (&+ a1-6 (* t0-14 2)))) (the-as uint (- 4096 a0-18)))
(* (-> (the-as (pointer uint16) (&+ a2-13 (* t0-14 2)))) (the-as uint a0-18))
)
12
)
)
)
)
arg3
)
(('int32)
(let ((a0-20 (the int (* 4096.0 f0-2))))
(dotimes (t0-15 (the-as int v1-6))
(set! (-> (the-as (pointer int32) (&+ arg3 (* t0-15 4))))
(sar
(+ (* (-> (the-as (pointer int32) (&+ a1-6 (* t0-15 4)))) (- 4096 a0-20))
(* (-> (the-as (pointer int32) (&+ a2-13 (* t0-15 4)))) a0-20)
)
12
)
)
)
)
arg3
)
(('uint32)
(let ((a0-22 (the int (* 4096.0 f0-2))))
(dotimes (t0-16 (the-as int v1-6))
(set! (-> (the-as (pointer uint32) (&+ arg3 (* t0-16 4))))
(shr
(+ (* (-> (the-as (pointer uint32) (&+ a1-6 (* t0-16 4)))) (the-as uint (- 4096 a0-22)))
(* (-> (the-as (pointer uint32) (&+ a2-13 (* t0-16 4)))) (the-as uint a0-22))
)
12
)
)
)
)
arg3
)
(('vector)
(let ((a0-23 f0-2))
(.mov vf3 a0-23)
)
(let ((a0-25 (- 1.0 f0-2)))
(.mov vf4 a0-25)
)
(dotimes (a0-26 (the-as int v1-6))
(let ((t0-18 (+ (* a0-26 16) (the-as int a1-6))))
(.lvf vf1 (&-> (the-as (pointer int128) t0-18)))
)
(let ((t0-20 (+ (* a0-26 16) (the-as int a2-13))))
(.lvf vf2 (&-> (the-as (pointer int128) t0-20)))
)
(.mul.x.vf vf1 vf1 vf4)
(.mul.x.vf vf2 vf2 vf3)
(.add.vf vf1 vf1 vf2)
(.svf (&-> (the-as (pointer uint128) (+ (* a0-26 16) (the-as int arg3))) 0) vf1)
)
arg3
)
(else
(let ((a0-27 t0-2))
(&+ (-> this data-base) (-> a0-27 data-offset))
)
)
)
)
)
)
)
)
)
;; definition for method 9 of type res-lump
;; INFO: Used lq/sq
(defmethod get-property-data ((this res-lump)
(arg0 symbol)
(arg1 symbol)
(arg2 float)
(arg3 pointer)
(arg4 (pointer res-tag))
(arg5 pointer)
)
"Returns an address to a given property's data at a specific time stamp, or default on error.
@param name is the name of the property you want, mode is its lookup mode ('interp 'base 'exact), time is the timestamp.
@param default is the default result returned in the case of an error.
@param tag-addr is an address to a res-tag. The current base tag is written to this. Ignored if tag-addr is #f
@param buf-addr is an address to the data buffer used to write interpolated data to. It must have enough space! Only necessary for 'interp mode."
(let ((s3-0 (lookup-tag-idx this arg0 arg1 arg2)))
(cond
((< (the-as int s3-0) 0)
(empty)
)
(else
(set! arg3 (make-property-data this arg2 s3-0 arg5))
(if arg4
(set! (-> arg4 0) (-> this tag (-> s3-0 lo)))
)
)
)
)
arg3
)
;; definition for method 10 of type res-lump
;; INFO: Used lq/sq
;; WARN: Return type mismatch object vs structure.
(defmethod get-property-struct ((this res-lump)
(arg0 symbol)
(arg1 symbol)
(arg2 float)
(arg3 structure)
(arg4 (pointer res-tag))
(arg5 pointer)
)
"Returns a given struct property's value at a specific time stamp, or default on error.
@param name is the name of the property you want, `mode` is its lookup mode ('interp 'base 'exact), `time` is the timestamp.
@param default is the default result returned in the case of an error.
@param tag-addr is an address to a [[res-tag]]. The current base tag is written to this. Ignored if tag-addr is #f.
@param buf-addr is an address to the data buffer used to write interpolated data to.
It must have enough space! Only necessary for 'interp mode."
(let ((s3-0 (lookup-tag-idx this arg0 arg1 arg2)))
(cond
((< (the-as int s3-0) 0)
(empty)
)
(else
(set! arg3 (the-as structure (make-property-data this arg2 s3-0 arg5)))
(let ((v1-4 (-> this tag (-> s3-0 lo))))
(if arg4
(set! (-> arg4 0) v1-4)
)
(if (zero? (-> v1-4 inlined?))
(set! arg3 (the-as structure (-> (the-as (pointer uint32) arg3))))
(empty)
)
)
)
)
)
(the-as structure arg3)
)
;; definition for method 11 of type res-lump
;; INFO: Used lq/sq
;; WARN: Return type mismatch int vs uint128.
(defmethod get-property-value ((this res-lump)
(arg0 symbol)
(arg1 symbol)
(arg2 float)
(arg3 uint128)
(arg4 (pointer res-tag))
(arg5 pointer)
)
"Returns a given value property's value at a specific time stamp, or default on error.
@param name is the name of the property you want, `mode` is its lookup mode ('interp 'base 'exact), `time` is the timestamp.
@param default is the default result returned in the case of an error.
@param tag-addr is an address to a res-tag. The current base tag is written to this. Ignored if `tag-addr` is #f.
@param buf-addr is an address to the data buffer used to write interpolated data to.
It must have enough space! Only necessary for 'interp mode."
(let ((a2-1 (lookup-tag-idx this arg0 arg1 arg2)))
(cond
((< (the-as int a2-1) 0)
(empty)
)
(else
(let* ((a0-2 (-> a2-1 lo))
(s1-0 (-> this tag a0-2))
(s0-0 (-> s1-0 elt-type))
(gp-1 (make-property-data this arg2 a2-1 arg5))
)
(if arg4
(set! (-> arg4 0) s1-0)
)
(cond
((type-type? (the-as type s0-0) uinteger)
(case (-> s1-0 elt-type size)
((1)
(set! arg3 (the-as uint128 (-> (the-as (pointer uint8) gp-1))))
)
((2)
(set! arg3 (the-as uint128 (-> (the-as (pointer uint16) gp-1))))
)
((4)
(set! arg3 (the-as uint128 (-> (the-as (pointer uint32) gp-1))))
)
((16)
(set! arg3 (-> (the-as (pointer uint128) gp-1)))
)
(else
(set! arg3 (the-as uint128 (-> (the-as (pointer uint64) gp-1))))
)
)
)
((type-type? (the-as type s0-0) integer)
(case (-> s1-0 elt-type size)
((1)
(set! arg3 (the-as uint128 (-> (the-as (pointer int8) gp-1))))
)
((2)
(set! arg3 (the-as uint128 (-> (the-as (pointer int16) gp-1))))
)
((4)
(set! arg3 (the-as uint128 (-> (the-as (pointer int32) gp-1))))
)
((16)
(set! arg3 (-> (the-as (pointer uint128) gp-1)))
)
(else
(set! arg3 (the-as uint128 (-> (the-as (pointer uint64) gp-1))))
)
)
)
((type-type? (the-as type s0-0) float)
(set! arg3 (the-as uint128 (the int (-> (the-as (pointer float) gp-1)))))
)
(else
(empty)
)
)
)
)
)
)
(the-as uint128 arg3)
)
;; definition for method 12 of type res-lump
;; INFO: Used lq/sq
(defmethod get-property-value-float ((this res-lump)
(arg0 symbol)
(arg1 symbol)
(arg2 float)
(arg3 float)
(arg4 (pointer res-tag))
(arg5 pointer)
)
(local-vars (v1-8 uint) (v1-11 int))
(let ((a2-1 (lookup-tag-idx this arg0 arg1 arg2)))
(cond
((< (the-as int a2-1) 0)
(empty)
)
(else
(let* ((a0-2 (-> a2-1 lo))
(s1-0 (-> this tag a0-2))
(s0-0 (-> s1-0 elt-type))
(gp-1 (make-property-data this arg2 a2-1 arg5))
)
(if arg4
(set! (-> arg4 0) s1-0)
)
(cond
((type-type? (the-as type s0-0) float)
(set! arg3 (-> (the-as (pointer float) gp-1)))
)
((type-type? (the-as type s0-0) uinteger)
(case (-> s1-0 elt-type size)
((1)
(set! v1-8 (-> (the-as (pointer uint8) gp-1)))
)
((2)
(set! v1-8 (-> (the-as (pointer uint16) gp-1)))
)
((4)
(set! v1-8 (-> (the-as (pointer uint32) gp-1)))
)
((16)
(set! v1-8 (the-as uint (-> (the-as (pointer uint128) gp-1))))
)
(else
(set! v1-8 (-> (the-as (pointer uint64) gp-1)))
)
)
(set! arg3 (the float v1-8))
)
((type-type? (the-as type s0-0) integer)
(case (-> s1-0 elt-type size)
((1)
(set! v1-11 (-> (the-as (pointer int8) gp-1)))
)
((2)
(set! v1-11 (-> (the-as (pointer int16) gp-1)))
)
((4)
(set! v1-11 (-> (the-as (pointer int32) gp-1)))
)
((16)
(set! v1-11 (the-as int (-> (the-as (pointer uint128) gp-1))))
)
(else
(set! v1-11 (the-as int (-> (the-as (pointer uint64) gp-1))))
)
)
(set! arg3 (the float v1-11))
)
(else
(empty)
)
)
)
)
)
)
arg3
)
;; definition for method 16 of type res-lump
;; INFO: Used lq/sq
(defmethod sort! ((this res-lump))
"Sort all tags based on name, then key-frame."
(let ((v1-0 -1))
(while (nonzero? v1-0)
(set! v1-0 0)
(let ((a1-0 0)
(a2-1 (+ (-> this length) -2))
)
(while (>= a2-1 a1-0)
(let* ((a3-2 (-> this tag a1-0))
(t0-3 (-> this tag (+ a1-0 1)))
(t1-6 (-> (the-as (pointer uint64) (-> (symbol->string (-> a3-2 name)) data)) 0))
(t2-6 (-> (the-as (pointer uint64) (-> (symbol->string (-> t0-3 name)) data)) 0))
)
(when (or (< t2-6 t1-6) (and (= t1-6 t2-6) (< (-> t0-3 key-frame) (-> a3-2 key-frame))))
(+! v1-0 1)
(set! (-> this tag a1-0) t0-3)
(set! (-> this tag (+ a1-0 1)) a3-2)
)
)
(+! a1-0 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))
"Find space for the data described by arg0 in this.
Returns a tag with data-offset set correctly for this res-lump.
If the lump already contains memory for the given tag, and it is big enough,
it will be reused. Alignment will be at least 8 bytes.
If the input tag has elt-count = 0, it will return a tag for elt-count = 1."
(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) (>= (length existing-tag) 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) (tag res-tag) (arg2 pointer))
"Given a tag and a pointer to its data, copy it to this res-lump.
This doesn't seem to do the right thing if the given tag is a non-inline tag
with > 1 element."
(let ((a0-2 (allocate-data-memory-for-tag! this tag)))
(when a0-2
(let* ((v1-2 this)
(a1-1 a0-2)
(s4-0 (&+ (-> v1-2 data-base) (-> a1-1 data-offset)))
)
(cond
((zero? (-> a0-2 inlined?))
(length a0-2)
(set! (-> (the-as (pointer pointer) s4-0) 0) arg2)
)
(else
(let ((a2-1 (length a0-2)))
(mem-copy! s4-0 arg2 a2-1)
)
)
)
)
)
)
this
)
;; definition for method 18 of type res-lump
(defmethod add-32bit-data! ((this res-lump) (arg0 res-tag) (arg1 object))
"Add a single 32-bit value using [[add-data!]]."
(let* ((sv-16 arg1)
(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))
"Read curve data and write it to curve-target. Return #t if both
control points and knots data was succesfully read, #f otherwise."
(let ((s5-0 #f))
(let* ((sv-16 (new 'static 'res-tag))
(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)
)
(let* ((sv-32 (new 'static 'res-tag))
(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
;; WARN: Return type mismatch int vs res-lump.
;; WARN: Using new Jak 2 rtype-of
;; WARN: Using new Jak 2 rtype-of
;; WARN: Using new Jak 2 rtype-of
;; WARN: Using new Jak 2 rtype-of
;; WARN: Using new Jak 2 rtype-of
;; WARN: Using new Jak 2 rtype-of
(defmethod mem-usage ((this res-lump) (usage memory-usage-block) (flags int))
(let ((s3-0 48)
(s2-0 "res")
)
(cond
((logtest? flags 256)
(set! s3-0 44)
(set! s2-0 "camera")
)
((logtest? flags 64)
(set! s3-0 43)
(set! s2-0 "entity")
)
((logtest? flags 512)
(set! s3-0 76)
(set! s2-0 "art-joint-geo")
)
)
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
(set! (-> usage data s3-0 name) s2-0)
(+! (-> usage data s3-0 count) 1)
(let ((v1-19 (asize-of this)))
(+! (-> usage data s3-0 used) v1-19)
(+! (-> usage data s3-0 total) (logand -16 (+ v1-19 15)))
)
(dotimes (s1-0 (-> this length))
(when (zero? (-> this tag s1-0 inlined?))
(let* ((a1-4 this)
(a0-15 s1-0)
(s0-0 (the-as object (-> (the-as (pointer int32) (&+ (-> a1-4 data-base) (-> a1-4 tag a0-15 data-offset))))))
)
(when (not (part-group-pointer? (the-as pointer s0-0)))
(let ((v1-34 (rtype-of (the-as int s0-0))))
(cond
((or (= v1-34 symbol) (or (= v1-34 type) (= v1-34 pair)))
)
((= v1-34 string)
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
(set! (-> usage data s3-0 name) s2-0)
(+! (-> usage data s3-0 count) 1)
(let ((v1-48 ((method-of-type (rtype-of (the-as int s0-0)) asize-of) (the-as int s0-0))))
(+! (-> usage data s3-0 used) v1-48)
(+! (-> usage data s3-0 total) (logand -16 (+ v1-48 15)))
)
)
((or (= v1-34 nav-mesh) (= v1-34 collide-mesh))
(let ((a0-48 (the-as (array object) s0-0)))
((method-of-type (rtype-of a0-48) mem-usage) a0-48 usage flags)
)
)
((= v1-34 array)
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
(set! (-> usage data s3-0 name) s2-0)
(+! (-> usage data s3-0 count) 1)
(let* ((a0-53 (the-as (array object) s0-0))
(v1-68 ((method-of-type (rtype-of a0-53) asize-of) a0-53))
)
(+! (-> usage data s3-0 used) v1-68)
(+! (-> usage data s3-0 total) (logand -16 (+ v1-68 15)))
)
(let ((sv-16 0))
(while (< sv-16 (-> (the-as array s0-0) length))
(let ((a0-63 (-> (the-as (array object) s0-0) sv-16)))
((method-of-type (rtype-of a0-63) mem-usage) a0-63 usage flags)
)
(+! sv-16 1)
)
)
)
(else
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
(set! (-> usage data s3-0 name) s2-0)
(+! (-> usage data s3-0 count) 1)
(let* ((a0-68 (the-as int s0-0))
(v1-96 ((method-of-type (rtype-of a0-68) asize-of) a0-68))
)
(+! (-> usage data s3-0 used) v1-96)
(+! (-> usage data s3-0 total) (logand -16 (+ v1-96 15)))
)
)
)
)
)
)
)
)
)
(the-as res-lump 0)
)
;; definition for symbol *res-static-buf*, type pointer
(define *res-static-buf* (malloc 'global 128))