mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-21 17:47:44 -04:00
169 lines
4.2 KiB
Common Lisp
169 lines
4.2 KiB
Common Lisp
|
;;-*-Lisp-*-
|
||
|
(in-package goal)
|
||
|
|
||
|
;; definition for method 0 of type state
|
||
|
(defmethod
|
||
|
new
|
||
|
state
|
||
|
((allocation symbol)
|
||
|
(type-to-make type)
|
||
|
(name basic)
|
||
|
(code function)
|
||
|
(trans (function object))
|
||
|
(enter (function object object object object object object object))
|
||
|
(exit (function object))
|
||
|
(event (function basic int basic event-message-block object))
|
||
|
)
|
||
|
(let
|
||
|
((obj
|
||
|
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
|
||
|
)
|
||
|
)
|
||
|
(set! (-> obj name) name)
|
||
|
(set! (-> obj next) #f)
|
||
|
(set! (-> obj exit) exit)
|
||
|
(set! (-> obj code) code)
|
||
|
(set! (-> obj trans) trans)
|
||
|
(set! (-> obj post) #f)
|
||
|
(set! (-> obj enter) enter)
|
||
|
(set! (-> obj event) event)
|
||
|
obj
|
||
|
)
|
||
|
)
|
||
|
|
||
|
;; definition for function inherit-state
|
||
|
(defun inherit-state ((arg0 state) (arg1 state))
|
||
|
(set! (-> arg0 exit) (-> arg1 exit))
|
||
|
(set! (-> arg0 code) (-> arg1 code))
|
||
|
(set! (-> arg0 trans) (-> arg1 trans))
|
||
|
(set! (-> arg0 post) (-> arg1 post))
|
||
|
(set! (-> arg0 enter) (-> arg1 enter))
|
||
|
(set! (-> arg0 event) (-> arg1 event))
|
||
|
arg0
|
||
|
)
|
||
|
|
||
|
;; definition for method 2 of type state
|
||
|
(defmethod print state ((obj state))
|
||
|
(format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
|
||
|
obj
|
||
|
)
|
||
|
|
||
|
;; definition for function enter-state
|
||
|
;; WARN: Unsupported inline assembly instruction kind - [23]
|
||
|
;; WARN: Unsupported inline assembly instruction kind - [22]
|
||
|
;; WARN: Unsupported inline assembly instruction kind - [59]
|
||
|
;; WARN: Unsupported inline assembly instruction kind - [13]
|
||
|
(defun
|
||
|
enter-state
|
||
|
((arg0 object)
|
||
|
(arg1 object)
|
||
|
(arg2 object)
|
||
|
(arg3 object)
|
||
|
(arg4 object)
|
||
|
(arg5 object)
|
||
|
)
|
||
|
(local-vars (pp process) (s7-0 none) (sp-0 none) (sp-1 int) (ra-0 int))
|
||
|
(set! (-> pp mask) (logand -193 (the-as int (-> pp mask))))
|
||
|
(set! (-> pp mask) (logior (-> pp mask) 1024))
|
||
|
(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
|
||
|
)
|
||
|
((!= (-> *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 -1025 (the-as int (-> pp mask))))
|
||
|
(let ((s0-2 (-> pp state)))
|
||
|
(set! (-> pp event-hook) (-> s0-2 event))
|
||
|
(cond
|
||
|
((-> s0-2 exit)
|
||
|
(set! (-> pp stack-frame-top) s0-2)
|
||
|
(let ((v1-20 s0-2))
|
||
|
)
|
||
|
)
|
||
|
(else
|
||
|
(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)
|
||
|
)
|
||
|
)
|
||
|
arg4
|
||
|
)
|
||
|
(else
|
||
|
(set! (-> pp trans-hook) #f)
|
||
|
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
||
|
(if (!= (-> 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
|
||
|
)
|
||
|
)
|
||
|
)
|
||
|
)
|
||
|
)
|
||
|
|
||
|
;; definition for function send-event-function
|
||
|
(defun send-event-function ((arg0 process) (arg1 event-message-block))
|
||
|
(when (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
|
||
|
(let ((s6-1 arg0))
|
||
|
)
|
||
|
((-> arg0 event-hook)
|
||
|
(-> arg1 from)
|
||
|
(-> arg1 num-params)
|
||
|
(-> arg1 message)
|
||
|
arg1
|
||
|
)
|
||
|
)
|
||
|
)
|
||
|
|
||
|
;; definition for function looping-code
|
||
|
;; INFO: Return type mismatch none vs symbol.
|
||
|
(defun looping-code ()
|
||
|
(while #t
|
||
|
(suspend)
|
||
|
)
|
||
|
(the-as symbol #f)
|
||
|
)
|
||
|
|
||
|
;; failed to figure out what this is:
|
||
|
(none)
|