mirror of
https://github.com/open-goal/jak-project
synced 2026-06-03 18:36:52 -04:00
21fefa0aaa
* clean up method stuff, fix a few small bugs, and add references for easy -h files * more small fixes and reference tests
549 lines
16 KiB
Common Lisp
549 lines
16 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition of type connectable
|
|
(deftype connectable (structure)
|
|
((next0 connectable :offset-assert 0)
|
|
(prev0 connectable :offset-assert 4)
|
|
(next1 connectable :offset-assert 8)
|
|
(prev1 connectable :offset-assert 12)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x10
|
|
:flag-assert #x900000010
|
|
)
|
|
|
|
;; definition for method 3 of type connectable
|
|
(defmethod inspect connectable ((obj connectable))
|
|
(format #t "[~8x] ~A~%" obj 'connectable)
|
|
(format #t "~Tnext0: ~`connectable`P~%" (-> obj next0))
|
|
(format #t "~Tprev0: ~`connectable`P~%" (-> obj prev0))
|
|
(format #t "~Tnext1: ~`connectable`P~%" (-> obj next1))
|
|
(format #t "~Tprev1: ~`connectable`P~%" (-> obj prev1))
|
|
obj
|
|
)
|
|
|
|
;; definition of type connection
|
|
(deftype connection (connectable)
|
|
((param0 (function object object object object object) :offset-assert 16)
|
|
(param1 basic :offset-assert 20)
|
|
(param2 basic :offset-assert 24)
|
|
(param3 basic :offset-assert 28)
|
|
(quad uint128 2 :offset 0)
|
|
)
|
|
:method-count-assert 14
|
|
:size-assert #x20
|
|
:flag-assert #xe00000020
|
|
(:methods
|
|
(get-engine (connection) engine 9)
|
|
(get-process (connection) process 10)
|
|
(belongs-to-engine? (connection engine) symbol 11)
|
|
(belongs-to-process? (connection process) symbol 12)
|
|
(move-to-dead (connection) connection 13)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type connection
|
|
(defmethod inspect connection ((obj connection))
|
|
(format #t "[~8x] ~A~%" obj 'connection)
|
|
(format #t "~Tnext0: ~`connectable`P~%" (-> obj next0))
|
|
(format #t "~Tprev0: ~`connectable`P~%" (-> obj prev0))
|
|
(format #t "~Tnext1: ~`connectable`P~%" (-> obj next1))
|
|
(format #t "~Tprev1: ~`connectable`P~%" (-> obj prev1))
|
|
(format #t "~Tparam0: ~A~%" (-> obj param0))
|
|
(format #t "~Tparam1: ~A~%" (-> obj param1))
|
|
(format #t "~Tparam2: ~A~%" (-> obj param2))
|
|
(format #t "~Tparam3: ~A~%" (-> obj param3))
|
|
(format #t "~Tquad[2] @ #x~X~%" (&-> obj next0))
|
|
obj
|
|
)
|
|
|
|
;; definition of type engine
|
|
(deftype engine (basic)
|
|
((name basic :offset-assert 4)
|
|
(length int16 :offset-assert 8)
|
|
(allocated-length int16 :offset-assert 10)
|
|
(engine-time uint64 :offset-assert 16)
|
|
(alive-list connectable :inline :offset-assert 32)
|
|
(alive-list-end connectable :inline :offset-assert 48)
|
|
(dead-list connectable :inline :offset-assert 64)
|
|
(dead-list-end connectable :inline :offset-assert 80)
|
|
(data connection 1 :inline :offset-assert 96)
|
|
)
|
|
:method-count-assert 24
|
|
:size-assert #x80
|
|
:flag-assert #x1800000080
|
|
(:methods
|
|
(new (symbol type basic int) _type_ 0)
|
|
(inspect-all-connections (engine) engine 9)
|
|
(apply-to-connections (engine (function connectable none)) int 10)
|
|
(apply-to-connections-reverse (engine (function connectable none)) int 11)
|
|
(execute-connections (engine object) int 12)
|
|
(execute-connections-and-move-to-dead (engine object) int 13)
|
|
(execute-connections-if-needed (engine object) int 14)
|
|
(add-connection (engine process (function object object object object object) object object object) connection 15)
|
|
(remove-from-process (engine process) int 16)
|
|
(remove-matching (engine (function connection engine symbol)) int 17)
|
|
(remove-all (engine) int 18)
|
|
(remove-by-param1 (engine object) int 19)
|
|
(remove-by-param2 (engine int) int 20)
|
|
(get-first-connectable (engine) connectable 21)
|
|
(get-last-connectable (engine) connectable 22)
|
|
(unknown-1 (engine (pointer uint32)) uint 23)
|
|
)
|
|
)
|
|
|
|
;; definition for method 12 of type connection
|
|
(defmethod belongs-to-process? connection ((obj connection) (arg0 process))
|
|
(= arg0 ((method-of-type connection get-process) obj))
|
|
)
|
|
|
|
;; definition for method 2 of type connection
|
|
(defmethod print connection ((obj connection))
|
|
(format
|
|
#t
|
|
"#<connection (~A ~A ~A ~A) @ #x~X>"
|
|
(-> obj param0)
|
|
(-> obj param1)
|
|
(-> obj param2)
|
|
(-> obj param3)
|
|
obj
|
|
)
|
|
obj
|
|
)
|
|
|
|
;; definition for method 9 of type connection
|
|
;; INFO: Return type mismatch pointer vs engine.
|
|
(defmethod get-engine connection ((obj connection))
|
|
(while (-> (the-as connectable obj) prev0)
|
|
(nop!)
|
|
(nop!)
|
|
(set! obj (the-as connection (-> (the-as connectable obj) prev0)))
|
|
)
|
|
(the-as engine (&+ (the-as pointer obj) -28))
|
|
)
|
|
|
|
;; definition for method 10 of type connection
|
|
;; INFO: Return type mismatch pointer vs process.
|
|
(defmethod get-process connection ((obj connection))
|
|
(while (-> (the-as connectable obj) prev1)
|
|
(nop!)
|
|
(nop!)
|
|
(set! obj (the-as connection (-> (the-as connectable obj) prev1)))
|
|
)
|
|
(the-as process (&+ (the-as pointer obj) -92))
|
|
)
|
|
|
|
;; definition for method 11 of type connection
|
|
(defmethod belongs-to-engine? connection ((obj connection) (arg0 engine))
|
|
(and
|
|
(< (the-as int arg0) (the-as int obj))
|
|
(< (the-as int obj) (the-as int (-> arg0 data (-> arg0 allocated-length))))
|
|
)
|
|
)
|
|
|
|
;; definition for method 21 of type engine
|
|
(defmethod get-first-connectable engine ((obj engine))
|
|
(-> obj alive-list next0)
|
|
)
|
|
|
|
;; definition for method 22 of type engine
|
|
(defmethod get-last-connectable engine ((obj engine))
|
|
(-> obj alive-list-end)
|
|
)
|
|
|
|
;; definition for method 23 of type engine
|
|
(defmethod unknown-1 engine ((obj engine) (arg0 (pointer uint32)))
|
|
(-> arg0 0)
|
|
)
|
|
|
|
;; definition for method 0 of type engine
|
|
(defmethod
|
|
new
|
|
engine
|
|
((allocation symbol) (type-to-make type) (name basic) (length int))
|
|
(let
|
|
((obj
|
|
(object-new
|
|
allocation
|
|
type-to-make
|
|
(the-as
|
|
int
|
|
(+ (-> type-to-make size) (the-as uint (shl (+ length -1) 5)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> (the-as engine obj) allocated-length) length)
|
|
(set! (-> (the-as engine obj) length) 0)
|
|
(set! (-> (the-as engine obj) name) name)
|
|
(set!
|
|
(-> (the-as engine obj) alive-list next0)
|
|
(-> (the-as engine obj) alive-list-end)
|
|
)
|
|
(set! (-> (the-as engine obj) alive-list prev0) #f)
|
|
(set! (-> (the-as engine obj) alive-list next1) #f)
|
|
(set! (-> (the-as engine obj) alive-list prev1) #f)
|
|
(set! (-> (the-as engine obj) alive-list-end next0) #f)
|
|
(set!
|
|
(-> (the-as engine obj) alive-list-end prev0)
|
|
(-> (the-as engine obj) alive-list)
|
|
)
|
|
(set! (-> (the-as engine obj) alive-list-end next1) #f)
|
|
(set! (-> (the-as engine obj) alive-list-end prev1) #f)
|
|
(set!
|
|
(-> (the-as engine obj) dead-list next0)
|
|
(the-as connectable (-> (the-as engine obj) data))
|
|
)
|
|
(set! (-> (the-as engine obj) dead-list prev0) #f)
|
|
(set! (-> (the-as engine obj) dead-list next1) #f)
|
|
(set! (-> (the-as engine obj) dead-list prev1) #f)
|
|
(set! (-> (the-as engine obj) dead-list-end next0) #f)
|
|
(set!
|
|
(-> (the-as engine obj) dead-list-end prev0)
|
|
(-> (the-as engine obj) data (+ length -1))
|
|
)
|
|
(set! (-> (the-as engine obj) dead-list-end next1) #f)
|
|
(set! (-> (the-as engine obj) dead-list-end prev1) #f)
|
|
(set!
|
|
(-> (the-as engine obj) data 0 prev0)
|
|
(-> (the-as engine obj) dead-list)
|
|
)
|
|
(set!
|
|
(-> (the-as engine obj) data 0 next0)
|
|
(the-as connectable (&+ (the-as pointer obj) 124))
|
|
)
|
|
(let ((idx-to-link 1)
|
|
(end-idx (+ length -2))
|
|
)
|
|
(while (>= end-idx idx-to-link)
|
|
(set!
|
|
(-> (the-as engine obj) data idx-to-link prev0)
|
|
(-> (the-as engine obj) data (+ idx-to-link -1))
|
|
)
|
|
(set!
|
|
(-> (the-as engine obj) data idx-to-link next0)
|
|
(-> (the-as engine obj) data (+ idx-to-link 1))
|
|
)
|
|
(+! idx-to-link 1)
|
|
)
|
|
)
|
|
(set!
|
|
(-> (the-as engine obj) data (+ length -1) prev0)
|
|
(-> (the-as engine obj) data (+ length -2))
|
|
)
|
|
(set!
|
|
(-> (the-as engine obj) data (+ length -1) next0)
|
|
(-> (the-as engine obj) dead-list-end)
|
|
)
|
|
(the-as engine obj)
|
|
)
|
|
)
|
|
|
|
;; definition for method 2 of type engine
|
|
(defmethod print engine ((obj engine))
|
|
(format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
|
|
obj
|
|
)
|
|
|
|
;; definition for method 3 of type engine
|
|
(defmethod inspect engine ((obj engine))
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~Tname: ~A~%" (-> obj name))
|
|
(format #t "~Tengine-time: ~D~%" (-> obj engine-time))
|
|
(format #t "~Tallocated-length: ~D~%" (-> obj allocated-length))
|
|
(format #t "~Tlength: ~D~%" (-> obj length))
|
|
(format #t "~Talive-list:~%")
|
|
(let ((s5-0 *print-column*))
|
|
(set! *print-column* (+ *print-column* (the-as uint 64)))
|
|
((method-of-type connectable inspect) (-> obj alive-list))
|
|
(set! *print-column* s5-0)
|
|
)
|
|
(format #t "~Talive-list-end:~%")
|
|
(let ((s5-1 *print-column*))
|
|
(set! *print-column* (+ *print-column* (the-as uint 64)))
|
|
((method-of-type connectable inspect) (-> obj alive-list-end))
|
|
(set! *print-column* s5-1)
|
|
)
|
|
(format #t "~Tdead-list:~%")
|
|
(let ((s5-2 *print-column*))
|
|
(set! *print-column* (+ *print-column* (the-as uint 64)))
|
|
((method-of-type connectable inspect) (-> obj dead-list))
|
|
(set! *print-column* s5-2)
|
|
)
|
|
(format #t "~Tdead-list-end:~%")
|
|
(let ((s5-3 *print-column*))
|
|
(set! *print-column* (+ *print-column* (the-as uint 64)))
|
|
((method-of-type connectable inspect) (-> obj dead-list-end))
|
|
(set! *print-column* s5-3)
|
|
)
|
|
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data))
|
|
obj
|
|
)
|
|
|
|
;; definition for method 4 of type engine
|
|
(defmethod length engine ((obj engine))
|
|
(-> obj length)
|
|
)
|
|
|
|
;; definition for method 5 of type engine
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of engine ((obj engine))
|
|
(the-as
|
|
int
|
|
(+ (-> engine size) (the-as uint (shl (+ (-> obj allocated-length) -1) 5)))
|
|
)
|
|
)
|
|
|
|
;; definition for method 10 of type engine
|
|
(defmethod
|
|
apply-to-connections
|
|
engine
|
|
((obj engine) (f (function connectable none)))
|
|
(let* ((current (-> obj alive-list next0))
|
|
(next (-> current next0))
|
|
)
|
|
(while (!= current (-> obj alive-list-end))
|
|
(f current)
|
|
(set! current next)
|
|
(set! next (-> next next0))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 11 of type engine
|
|
(defmethod
|
|
apply-to-connections-reverse
|
|
engine
|
|
((obj engine) (f (function connectable none)))
|
|
(let ((iter (-> obj alive-list-end prev0)))
|
|
(while (!= iter (-> obj alive-list))
|
|
(f iter)
|
|
(set! iter (-> iter prev0))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 12 of type engine
|
|
(defmethod execute-connections engine ((obj engine) (arg0 object))
|
|
(set! (-> obj engine-time) (-> *display* real-frame-counter))
|
|
(let ((ct (the-as connection (-> obj alive-list-end prev0))))
|
|
(while (!= ct (-> obj alive-list))
|
|
((-> ct param0) (-> ct param1) (-> ct param2) (-> ct param3) arg0)
|
|
(set! ct (the-as connection (-> ct prev0)))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 13 of type engine
|
|
(defmethod
|
|
execute-connections-and-move-to-dead
|
|
engine
|
|
((obj engine) (arg0 object))
|
|
(set! (-> obj engine-time) (-> *display* real-frame-counter))
|
|
(let ((ct (the-as connection (-> obj alive-list-end prev0))))
|
|
(while (!= ct (-> obj alive-list))
|
|
(let
|
|
((result
|
|
((-> ct param0) (-> ct param1) (-> ct param2) (-> ct param3) arg0)
|
|
)
|
|
)
|
|
(set! ct (the-as connection (-> ct prev0)))
|
|
(if (= result 'dead)
|
|
((method-of-type connection move-to-dead)
|
|
(the-as connection (-> ct next0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 14 of type engine
|
|
(defmethod execute-connections-if-needed engine ((obj engine) (arg0 object))
|
|
(if (!= (-> *display* real-frame-counter) (-> obj engine-time))
|
|
(execute-connections obj arg0)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for function connection-process-apply
|
|
(defun connection-process-apply ((proc process) (func (function object none)))
|
|
(when proc
|
|
(let ((iter (-> proc connection-list next1)))
|
|
(while iter
|
|
(func iter)
|
|
(set! iter (-> iter next1))
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
)
|
|
|
|
;; definition for method 9 of type engine
|
|
(defmethod inspect-all-connections engine ((obj engine))
|
|
(apply-to-connections
|
|
obj
|
|
(the-as (function connectable none) (method-of-type connection inspect))
|
|
)
|
|
obj
|
|
)
|
|
|
|
;; definition for method 15 of type engine
|
|
(defmethod
|
|
add-connection
|
|
engine
|
|
((obj engine)
|
|
(proc process)
|
|
(func (function object object object object object))
|
|
(p1 object)
|
|
(p2 object)
|
|
(p3 object)
|
|
)
|
|
(let ((con (the-as connection (-> obj dead-list next0))))
|
|
(when (not (or (not proc) (= con (-> obj dead-list-end))))
|
|
(set! (-> con param0) func)
|
|
(set! (-> con param1) (the-as basic p1))
|
|
(set! (-> con param2) (the-as basic p2))
|
|
(set! (-> con param3) (the-as basic p3))
|
|
(set! (-> obj dead-list next0) (-> con next0))
|
|
(set! (-> con next0 prev0) (-> obj dead-list))
|
|
(set! (-> con next0) (-> obj alive-list next0))
|
|
(set! (-> con next0 prev0) con)
|
|
(set! (-> con prev0) (-> obj alive-list))
|
|
(set! (-> obj alive-list next0) con)
|
|
(set! (-> con next1) (-> proc connection-list next1))
|
|
(if (-> con next1)
|
|
(set! (-> con next1 prev1) con)
|
|
)
|
|
(set! (-> con prev1) (-> proc connection-list))
|
|
(set! (-> proc connection-list next1) con)
|
|
(set! (-> obj length) (+ (-> obj length) 1))
|
|
con
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 13 of type connection
|
|
(defmethod move-to-dead connection ((obj connection))
|
|
(let ((v1-1 ((method-of-type connection get-engine) obj)))
|
|
(set! (-> obj prev0 next0) (-> obj next0))
|
|
(set! (-> obj next0 prev0) (-> obj prev0))
|
|
(set! (-> obj prev1 next1) (-> obj next1))
|
|
(if (-> obj next1)
|
|
(set! (-> obj next1 prev1) (-> obj prev1))
|
|
)
|
|
(set! (-> obj next0) (-> v1-1 dead-list next0))
|
|
(set! (-> obj next0 prev0) obj)
|
|
(set! (-> obj prev0) (-> v1-1 dead-list))
|
|
(set! (-> v1-1 dead-list next0) obj)
|
|
(set! (-> v1-1 length) (+ (-> v1-1 length) -1))
|
|
)
|
|
obj
|
|
)
|
|
|
|
;; definition for function process-disconnect
|
|
(defun process-disconnect ((arg0 process))
|
|
(when arg0
|
|
(let ((gp-0 (-> arg0 connection-list next1)))
|
|
(while gp-0
|
|
((method-of-type connection move-to-dead) (the-as connection gp-0))
|
|
(set! gp-0 (-> gp-0 next1))
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 16 of type engine
|
|
(defmethod remove-from-process engine ((obj engine) (arg0 process))
|
|
(when arg0
|
|
(let ((s5-0 (-> arg0 connection-list next1)))
|
|
(while s5-0
|
|
(if
|
|
((method-of-type connection belongs-to-engine?)
|
|
(the-as connection s5-0)
|
|
obj
|
|
)
|
|
((method-of-type connection move-to-dead) (the-as connection s5-0))
|
|
)
|
|
(set! s5-0 (-> s5-0 next1))
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 17 of type engine
|
|
(defmethod
|
|
remove-matching
|
|
engine
|
|
((obj engine) (arg0 (function connection engine symbol)))
|
|
(let* ((s4-0 (-> obj alive-list next0))
|
|
(s3-0 (-> s4-0 next0))
|
|
)
|
|
(while (!= s4-0 (-> obj alive-list-end))
|
|
(if (arg0 (the-as connection s4-0) obj)
|
|
((method-of-type connection move-to-dead) (the-as connection s4-0))
|
|
)
|
|
(set! s4-0 s3-0)
|
|
(set! s3-0 (-> s3-0 next0))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 18 of type engine
|
|
(defmethod remove-all engine ((obj engine))
|
|
(let* ((a0-1 (-> obj alive-list next0))
|
|
(s5-0 (-> a0-1 next0))
|
|
)
|
|
(while (!= a0-1 (-> obj alive-list-end))
|
|
((method-of-type connection move-to-dead) (the-as connection a0-1))
|
|
(set! a0-1 s5-0)
|
|
(set! s5-0 (-> s5-0 next0))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 19 of type engine
|
|
(defmethod remove-by-param1 engine ((obj engine) (p1-value object))
|
|
(let* ((current (-> obj alive-list next0))
|
|
(next (-> current next0))
|
|
)
|
|
(while (!= current (-> obj alive-list-end))
|
|
(if (= (-> (the-as connection current) param1) p1-value)
|
|
((method-of-type connection move-to-dead) (the-as connection current))
|
|
)
|
|
(set! current next)
|
|
(set! next (-> next next0))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; definition for method 20 of type engine
|
|
(defmethod remove-by-param2 engine ((obj engine) (p2-value int))
|
|
(let* ((current (-> obj alive-list next0))
|
|
(next (-> current next0))
|
|
)
|
|
(while (!= current (-> obj alive-list-end))
|
|
(if (= (-> (the-as connection current) param2) p2-value)
|
|
((method-of-type connection move-to-dead) (the-as connection current))
|
|
)
|
|
(set! current next)
|
|
(set! next (-> next next0))
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
|
|
|
|
|