mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 21:27:52 -04:00
f1a93886e7
* decompile gstring * update * Update code_status.md * Update code_status.md * decompile gstate * add test for states, hope it passes * also test throw and catch xmms * update doc
353 lines
12 KiB
Common Lisp
353 lines
12 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: gstate.gc
|
|
;; name in dgo: gstate
|
|
;; dgos: KERNEL
|
|
|
|
#|
|
|
Summary of state system:
|
|
|
|
A process can be put into a state, using enter-state, or the go macro.
|
|
This will set up the process to run the appropriate handler functions defined by the state.
|
|
The state handlers are:
|
|
- enter : gets run before trans on the first time the state is used. Can be #f. Must return.
|
|
- trans : gets run before code each time the code is run. Can be #f. Must return.
|
|
- code : main thread. Can suspend. If it returns, the process dies
|
|
- exit : gets run when leaving a state. must return.
|
|
- event : not sure of the details here yet.
|
|
|
|
You can "go" to another state. This causes the current main thread execution to be abandoned.
|
|
If the main thread has exits/protects on the stack frame, they will be run first to clean up.
|
|
|
|
There are several ways to "go"
|
|
- go during init: when a process is being initialized with run-function-in-process, you can "go".
|
|
this causes the run-function-in-process to return, and the next time the process is dispatched
|
|
it will go into the other state. This will automatically set the process to waiting-to-run,
|
|
and shrink the process heap, if appropriate
|
|
|
|
- go from outside the process. You can temporarily set pp to another process, and have that
|
|
process go to another state. The actually go will occur the next time the process is scheduled.
|
|
|
|
- go from a non-main thread in the right process. You can do a go from a temporary thread, like trans or post.
|
|
If you do it from post, the go returns. If you do it from any other thread, the temporary thread
|
|
is immediately abandonded. Like the previous two, it will defer the actual go until the next time the
|
|
process runs.
|
|
|
|
- go from the main thread of the main process. This causes the (-> pp state) to change, the stack frames
|
|
to be cleaned up, and the old state's exit to be called. It will reset the stack, then run the code.
|
|
|
|
|#
|
|
|
|
;; fancy macro to accept variable arguments for go.
|
|
;; (defmacro go (next-state &rest args)
|
|
;; (if (< 6 (length args))
|
|
;; (error "too many arguments to go")
|
|
;; (let ((zero-args (repeated-list 0 (- 6 (length args)))))
|
|
;; `(with-pp
|
|
;; (set! (-> pp next-state) ,next-state)
|
|
;; (enter-state ,@args ,@zero-args)
|
|
;; )
|
|
;; )
|
|
;; )
|
|
;; )
|
|
|
|
;; cause the current process to change state
|
|
(defmacro go (next-state &rest args)
|
|
`(with-pp
|
|
(set! (-> pp next-state) ,next-state)
|
|
((the (function _varargs_ object) enter-state) ,@args)
|
|
)
|
|
)
|
|
|
|
;; cause the given process to change state.
|
|
(defmacro go-process (proc state &rest args)
|
|
`(with-pp
|
|
(protect (pp)
|
|
(set! pp ,proc)
|
|
(set! (-> pp next-state) ,state)
|
|
((the (function _varargs_ object) enter-state) ,@args)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; run the given function in a process right now.
|
|
;; will return to here when:
|
|
;; - you return
|
|
;; - you deactivate
|
|
;; - you go
|
|
;; - you throw to 'initialize
|
|
(defmacro run-now-in-process (proc func &rest args)
|
|
`((the (function _varargs_ object) run-function-in-process)
|
|
,proc ,func ,@args
|
|
)
|
|
)
|
|
|
|
;; sets the main thread of the given process to run the given thing.
|
|
;; this resets the main thread stack back to the top
|
|
(defmacro run-next-time-in-process (proc func &rest args)
|
|
`((the (function _varargs_ object) set-to-run)
|
|
(-> ,proc main-thread) ,func ,@args
|
|
)
|
|
)
|
|
|
|
;; display a listing of active processes.
|
|
(defmacro ps (&key (detail #f))
|
|
`(inspect-process-tree *active-pool* 0 0 ,detail)
|
|
)
|
|
|
|
|
|
;; define a state state
|
|
(defmacro defstate (state-name
|
|
&key (event #f)
|
|
&key (enter #f)
|
|
&key (trans #f)
|
|
&key (exit #f)
|
|
&key (code #f)
|
|
&key (post #f)
|
|
)
|
|
`(begin
|
|
(define ,state-name (new 'static 'state
|
|
:name (quote ,state-name)
|
|
:next #f
|
|
:exit #f
|
|
:code #f
|
|
:trans #f
|
|
:post #f
|
|
:enter #f
|
|
:event #f
|
|
)
|
|
)
|
|
,(if event
|
|
`(set! (-> ,state-name event) ,event)
|
|
`(none)
|
|
)
|
|
,(if enter
|
|
`(set! (-> ,state-name enter) (the (function object object object object object object object) ,enter))
|
|
`(none)
|
|
)
|
|
,(if trans
|
|
`(set! (-> ,state-name trans) ,trans)
|
|
`(none)
|
|
)
|
|
,(if exit
|
|
`(set! (-> ,state-name exit) ,exit)
|
|
`(none)
|
|
)
|
|
,(if code
|
|
`(set! (-> ,state-name code) ,code)
|
|
`(none)
|
|
)
|
|
,(if post
|
|
`(set! (-> ,state-name post) ,post)
|
|
`(none)
|
|
)
|
|
)
|
|
|
|
)
|
|
|
|
|
|
(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)))
|
|
"Allocate a new state. It seems like this isn't really used much and most states are
|
|
statically allocated and as a result don't have the constructor called."
|
|
(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
|
|
)
|
|
)
|
|
|
|
(defun inherit-state ((child state) (parent state))
|
|
"Copy handler functions from parent to child"
|
|
(set! (-> child exit) (-> parent exit))
|
|
(set! (-> child code) (-> parent code))
|
|
(set! (-> child trans) (-> parent trans))
|
|
(set! (-> child post) (-> parent post))
|
|
(set! (-> child enter) (-> parent enter))
|
|
(set! (-> child event) (-> parent event))
|
|
child
|
|
)
|
|
|
|
(defmethod print state ((obj state))
|
|
"Print a state."
|
|
(format '#t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
|
|
obj
|
|
)
|
|
|
|
(define-extern enter-state (function object object object object object object object))
|
|
(defun enter-state (arg0 arg1 arg2 arg3 arg4 arg5)
|
|
"Make the process stored in pp enter the state in pp next-state"
|
|
;;(declare (print-asm))
|
|
(with-pp
|
|
;; unsleep us
|
|
(process-mask-clear! (-> pp mask) sleep sleep-code)
|
|
;; mark as going
|
|
(process-mask-set! (-> pp mask) going)
|
|
(cond
|
|
((= (-> pp status) 'initialize)
|
|
;; did a go during initialize.
|
|
;; remove the old trans hook, if there was one
|
|
(set! (-> pp trans-hook) #f)
|
|
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
|
;; tell the kernel that we did a go during init
|
|
(set! (-> pp status) 'initialize-go)
|
|
;; abandon this thread, go back to what initialized us!
|
|
(throw 'initialize #t)
|
|
#t
|
|
)
|
|
((!= (-> *kernel-context* current-process) pp)
|
|
;; we aren't actually in process pp right now.
|
|
;; so set us up to go in the next run
|
|
(let ((status-backup (-> pp status)))
|
|
(set! (-> pp trans-hook) #f)
|
|
;; will set waiting-to-run
|
|
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
|
;; restore the old status.
|
|
(set! (-> pp status) status-backup)
|
|
#t
|
|
)
|
|
)
|
|
((= (-> pp main-thread) (-> pp top-thread))
|
|
;; we are in the right process, and in the main thread!
|
|
;; actually do a go!
|
|
(set! (-> pp state) (-> pp next-state))
|
|
|
|
;; loop through current stack frames
|
|
(let ((frame (-> pp stack-frame-top)))
|
|
(while frame
|
|
(let ((typ (-> frame type)))
|
|
(if (or (= typ protect-frame) (= typ state))
|
|
;; if we got a protect-frame or a state, call exit handler
|
|
((-> (the protect-frame frame) exit))
|
|
)
|
|
)
|
|
(set! frame (-> frame next))
|
|
)
|
|
)
|
|
|
|
;; done with going!
|
|
(process-mask-clear! (-> pp mask) going)
|
|
|
|
;; now, update the process:
|
|
(let ((new-state (-> pp state)))
|
|
;; event hook from the current state
|
|
(set! (-> pp event-hook) (-> new-state event))
|
|
;; if we have an exit, push it onto the stack frame
|
|
;; and also blow away the old stack frame
|
|
(if (-> new-state exit)
|
|
(set! (-> pp stack-frame-top) new-state)
|
|
(set! (-> pp stack-frame-top) #f)
|
|
)
|
|
(set! (-> pp post-hook) (-> new-state post))
|
|
(set! (-> pp trans-hook) (-> new-state trans))
|
|
;; now do the enter
|
|
(let ((enter-func (-> new-state enter)))
|
|
(if enter-func
|
|
(enter-func arg0 arg1 arg2 arg3 arg4 arg5)
|
|
)
|
|
)
|
|
;; now do the trans
|
|
(let ((trans-func (-> new-state trans)))
|
|
(if trans-func
|
|
(trans-func)
|
|
)
|
|
)
|
|
;; now we run the code, but in a tricky way.
|
|
(rlet ((temp)
|
|
(func)
|
|
(sp :reg rsp :type uint)
|
|
(off :reg r15 :type uint)
|
|
(carg0 :reg rdi)
|
|
(carg1 :reg rsi)
|
|
(carg2 :reg rdx)
|
|
(carg3 :reg rcx))
|
|
;; prepare args
|
|
;; compiler will likely have these on the stack, we need to get them in regs
|
|
;; before messing with the stack.
|
|
(.mov carg0 arg0)
|
|
(.mov carg1 arg1)
|
|
(.mov carg2 arg2)
|
|
(.mov carg3 arg3)
|
|
|
|
;; get the main code as an x86-64 pointer
|
|
(.mov func (-> new-state code))
|
|
(.add func off)
|
|
;; reset the stack (scary)
|
|
(.mov sp (-> pp main-thread stack-top))
|
|
(.add sp off)
|
|
;; push the return trampoline for when code returns.
|
|
(.mov temp return-from-thread-dead)
|
|
(.add temp off)
|
|
(.push temp)
|
|
;; and call!
|
|
(.jr func)
|
|
;; stupid hack so the compiler doesn't throw away these registers.
|
|
(.add carg0 carg1)
|
|
(.add carg2 carg3)
|
|
#f ;; can't get here
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
;; not in the main-thread.
|
|
;; so we set up the main thread to try again.
|
|
(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)
|
|
;; abandon this one too.
|
|
;; NOTE - this is different from GOAL.
|
|
;; GOAL installs this as the return address for this function and returns normally.
|
|
;; but we don't because I don't have an easy way to find where to stick this.
|
|
;; I can't see how this makes a difference, as all non-main threads seem
|
|
;; temporary, but if this turns out to be false, we will need to change this.
|
|
(rlet ((temp)
|
|
(off :reg r15 :type uint :reset-here #t))
|
|
(.mov temp return-from-thread)
|
|
(.add temp off)
|
|
(.push temp)
|
|
(.ret)
|
|
#f ;; can't get here
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun send-event-function ((proc process) (msg event-message-block))
|
|
(with-pp
|
|
(when (and proc (!= (-> proc type) process-tree) (-> proc event-hook))
|
|
(let ((pp-backup pp))
|
|
(set! pp proc)
|
|
(let ((result ((-> proc event-hook) (-> msg from) (-> msg num-params) (-> msg message) msg)))
|
|
(set! pp pp-backup)
|
|
result
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun looping-code ()
|
|
"Loop."
|
|
(while #t
|
|
(suspend)
|
|
)
|
|
#f
|
|
)
|