mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
7ce58f709f
* some jp support to fix some errors in the original game * music fade toggle * recognize `process-new` macros!! * strip casts in this macro * rename macro * fix cast typecheck * update source 1 * detect kernel stack case * less boilerplate * `manipy-spawn` special case * pretty printer improvements * revert dumb thing from earlier * use shell detection on `send-event` * fix some events * remove unused argument * detect `static-attack-info` and add `CondNoElse` to shell detect * better `attack-info` detect * support `process-spawn` in multi-lets * detect `rand-float-gen` pt 1 * detect as return value * detect in `countdown` and `dotimes` * oops this wasnt working * fancier `send-event`s * clang * update source!! * fix tests * fine jeez * uh okay * fix some accidental regressions * fix more regressions * regression fixes * fix big bug... * extra safety!
515 lines
19 KiB
Common Lisp
515 lines
19 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 use "go" to change the state of a process. This causes the process 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 immediately, 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 actual go will occur the next time the process is scheduled.
|
|
Use the go-process macro to do this.
|
|
|
|
- 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 and the rest of the post runs. 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.
|
|
Unlike the others, this means you "go" immediately.
|
|
|
|
The compiler has two special hooks related to states: go-hook and define-state-hook.
|
|
These take care of doing a go and a state definition and properly checking types.
|
|
|
|
The define-state-hook takes a state object and handlers and defines a global symbol
|
|
with the appropriate state type.
|
|
|
|
The go-hook calls enter state and sets (-> proc next-state) for the given process.
|
|
It type checks the arguments for the entry function.
|
|
|
|
|#
|
|
|
|
(defmacro go (next-state &rest args)
|
|
"Change the state of the current process.
|
|
This will only return if this is called within the post thread.
|
|
Otherwise, execution stops here and the kernel will run the next state next time."
|
|
`(with-pp
|
|
(go-hook pp ,next-state ,@args)
|
|
)
|
|
)
|
|
|
|
(defmacro go-virtual (state-name &key (proc self) &rest args)
|
|
"Same as go, but use a virtual state."
|
|
`(go (method-of-object ,proc ,state-name) ,@args)
|
|
)
|
|
|
|
(defmacro go-process (proc next-state &rest args)
|
|
"Make another process go."
|
|
`(with-pp
|
|
(protect (pp)
|
|
(set! pp ,proc)
|
|
(go-hook pp ,next-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)
|
|
"Run a function in another process right now."
|
|
`((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)
|
|
"Set up a process to run a function the next time it is scheduled."
|
|
`((the (function _varargs_ object) set-to-run)
|
|
(-> ,proc main-thread) ,func ,@args
|
|
)
|
|
)
|
|
|
|
(defmacro process-spawn-function (proc-type func &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args)
|
|
"Start a new process that runs a function on its main thread.
|
|
Returns a pointer to the new process (or #f? on error)."
|
|
|
|
(with-gensyms (new-proc)
|
|
`(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size))))
|
|
(when ,new-proc
|
|
((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name `(quote ,proc-type)) ,stack)
|
|
(run-next-time-in-process ,new-proc ,func ,@args)
|
|
(the (pointer ,proc-type) (-> ,new-proc ppointer))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro process-spawn (proc-type &key (init #f) &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args)
|
|
"Start a new process and run an init function on it.
|
|
Returns a pointer to the new process, or #f (or is it 0?) if something goes wrong."
|
|
|
|
(with-gensyms (new-proc)
|
|
`(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size))))
|
|
(when ,new-proc
|
|
((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name `(quote ,proc-type)) ,stack)
|
|
(run-now-in-process ,new-proc ,(if init init (string->symbol (fmt #f "{}-init-by-other" proc-type))) ,@args)
|
|
(the (pointer ,proc-type) (-> ,new-proc ppointer))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; display a listing of active processes.
|
|
(defmacro ps (&key (detail #f))
|
|
`(inspect-process-tree *active-pool* 0 0 ,detail)
|
|
)
|
|
|
|
;; use a compile-time list to keep track of the type of an anonymous behavior.
|
|
(seval (define *defstate-type-stack* '()))
|
|
(desfun def-state-check-behavior (beh-form beh-type)
|
|
"check if code block is an anonymous behavior. needed for anonymous behaviors on defstate."
|
|
|
|
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
|
|
(push! *defstate-type-stack* beh-type)
|
|
)
|
|
)
|
|
(defmacro clear-def-state-stack ()
|
|
(set! *defstate-type-stack* '())
|
|
`(none)
|
|
)
|
|
;; *no-state* is just used for the compiler to know whether a handler was actually set or not
|
|
(defmacro defstate (state-name parents
|
|
&key (virtual #f)
|
|
&key (event *no-state*)
|
|
&key (enter *no-state*)
|
|
&key (trans *no-state*)
|
|
&key (exit *no-state*)
|
|
&key (code *no-state*)
|
|
&key (post *no-state*)
|
|
)
|
|
"Define a new state!"
|
|
|
|
(with-gensyms (new-state)
|
|
(let ((defstate-type (first parents)))
|
|
(when (not (null? *defstate-type-stack*))
|
|
(fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}"
|
|
*defstate-type-stack*)
|
|
)
|
|
(set! *defstate-type-stack* '())
|
|
;; check for default handlers
|
|
(let ((default-handlers (assoc defstate-type *default-state-handlers*)))
|
|
(when (not (null? default-handlers))
|
|
;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers)
|
|
;; event
|
|
(set! default-handlers (cadr default-handlers))
|
|
(when (and (eq? event '*no-state*) (car default-handlers))
|
|
(set! event (car default-handlers)))
|
|
;; enter
|
|
(set! default-handlers (cdr default-handlers))
|
|
(when (and (eq? enter '*no-state*) (car default-handlers))
|
|
(set! enter (car default-handlers)))
|
|
;; trans
|
|
(set! default-handlers (cdr default-handlers))
|
|
(when (and (eq? trans '*no-state*) (car default-handlers))
|
|
(set! trans (car default-handlers)))
|
|
;; exit
|
|
(set! default-handlers (cdr default-handlers))
|
|
(when (and (eq? exit '*no-state*) (car default-handlers))
|
|
(set! exit (car default-handlers)))
|
|
;; code
|
|
(set! default-handlers (cdr default-handlers))
|
|
(when (and (eq? code '*no-state*) (car default-handlers))
|
|
(set! code (car default-handlers)))
|
|
;; post
|
|
(set! default-handlers (cdr default-handlers))
|
|
(when (and (eq? post '*no-state*) (car default-handlers))
|
|
(set! post (car default-handlers)))
|
|
|
|
(set! default-handlers (cdr default-handlers))
|
|
)
|
|
)
|
|
(def-state-check-behavior event defstate-type)
|
|
(def-state-check-behavior enter defstate-type)
|
|
(def-state-check-behavior trans defstate-type)
|
|
(def-state-check-behavior exit defstate-type)
|
|
(def-state-check-behavior code defstate-type)
|
|
(def-state-check-behavior post defstate-type)
|
|
`(let ((,new-state (new 'static 'state
|
|
:name (quote ,state-name)
|
|
:next #f
|
|
:exit #f
|
|
:code #f
|
|
:trans #f
|
|
:post #f
|
|
:enter #f
|
|
:event #f
|
|
)
|
|
))
|
|
;; the compiler will set the fields of the given state and define the symbol.
|
|
;; This way it can check the individual function types, make sure they make sense, and create
|
|
;; a state with the appropriate type.
|
|
,(if virtual
|
|
`(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
|
|
`(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
|
|
)
|
|
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro behavior (bindings &rest body)
|
|
"Define an anonymous behavior for a process state. This may only be used inside a defstate!"
|
|
|
|
(let ((behavior-type (first *defstate-type-stack*)))
|
|
(pop! *defstate-type-stack*)
|
|
`(lambda :behavior ,behavior-type ,bindings ,@body)
|
|
)
|
|
)
|
|
|
|
;; set the default handler functions for a process's state handlers
|
|
(seval (define *default-state-handlers* '()))
|
|
(defmacro defstatehandler (proc
|
|
&key (event #f)
|
|
&key (enter #f)
|
|
&key (trans #f)
|
|
&key (exit #f)
|
|
&key (code #f)
|
|
&key (post #f))
|
|
(let ((old (assoc proc *default-state-handlers*))
|
|
(new (list proc (list event enter trans exit code post))))
|
|
(if (null? old)
|
|
(append!! *default-state-handlers* new) ;; add new set of default handlers
|
|
(dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones
|
|
(when (eq? (car hnd) old)
|
|
(set-car! hnd new)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
`(none)
|
|
)
|
|
|
|
(defmethod new state
|
|
((allocation symbol)
|
|
(type-to-make type)
|
|
(name symbol)
|
|
(code function)
|
|
(trans (function none))
|
|
(enter function)
|
|
(exit (function none))
|
|
(event (function process int symbol 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"
|
|
(cond
|
|
((nonzero? parent)
|
|
(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))
|
|
)
|
|
(else
|
|
;; Note: this is added to let us defstate on a child before the parent.
|
|
;; The child won't be usable like this, but it will prevent a crash.
|
|
(format 0 "[STATE ERROR] inherit-state got a null parent state. Child is ~A~%" (-> child name))
|
|
)
|
|
)
|
|
|
|
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"
|
|
(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 us up to run enter-state again, the next time we're scheduled.
|
|
(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!
|
|
;; we will do a nonlocal control transfer to the new state's code.
|
|
;; the new state can then suspend and get back to the kernel dispatcher lambda
|
|
;; like normal.
|
|
|
|
;; change state!
|
|
(set! (-> pp state) (-> pp next-state))
|
|
|
|
;; do exits
|
|
(let ((frame (-> pp stack-frame-top)))
|
|
(while frame
|
|
(case (-> frame type)
|
|
((protect-frame state)
|
|
((-> (the-as protect-frame frame) exit))
|
|
)
|
|
)
|
|
(set! frame (-> frame next))
|
|
)
|
|
)
|
|
|
|
;; done with going, clear the mask
|
|
(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))
|
|
|
|
|
|
;; start up the new state. First run the enter function
|
|
(let ((enter-func (-> new-state enter)))
|
|
(if enter-func
|
|
((the (function _varargs_ none) enter-func) arg0 arg1 arg2 arg3 arg4 arg5)
|
|
)
|
|
)
|
|
|
|
;; run the trans function before the code.
|
|
(let ((trans-func (-> new-state trans)))
|
|
(if trans-func
|
|
(trans-func)
|
|
)
|
|
)
|
|
;; now we run the code, but in a tricky way.
|
|
;; we need to:
|
|
;; - make sure that when this code returns, we do a deactivate
|
|
;; - reset the stack to the top, so we can't just call the code.
|
|
(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) ;; will deactivate
|
|
(.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) ;; could probably just call this...
|
|
(.add temp off)
|
|
(.push temp)
|
|
(.ret)
|
|
#f ;; can't get here
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun send-event-function ((proc process-tree) (msg event-message-block))
|
|
"Function to send an event to a process. Please use the send-event macros when possible"
|
|
|
|
(with-pp
|
|
(when (and proc (!= (-> proc type) process-tree) (-> (the process proc) event-hook))
|
|
(let ((pp-backup pp))
|
|
(set! pp (the process proc))
|
|
(let ((result ((-> (the process proc) event-hook) (-> msg from) (-> msg num-params) (-> msg message) msg)))
|
|
(set! pp pp-backup)
|
|
result
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro send-event (proc msg &key (from (with-pp pp)) &rest params)
|
|
"Send an event to a process. This should be used over send-event-function"
|
|
|
|
`(let ((event-data (new 'stack-no-clear 'event-message-block)))
|
|
(set! (-> event-data from) ,from)
|
|
(set! (-> event-data num-params) ,(length params))
|
|
(set! (-> event-data message) ,msg)
|
|
,@(apply-i (lambda (x i) `(set! (-> event-data param ,i) (the-as uint ,x))) params)
|
|
(send-event-function ,proc event-data)
|
|
)
|
|
)
|
|
|
|
(defun looping-code ()
|
|
"Loop."
|
|
(loop
|
|
(suspend)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defmacro set-state-time ()
|
|
"set the state-time field of the current object to the current time. process-drawable has one"
|
|
|
|
`(set! (-> self state-time) (current-time))
|
|
)
|
|
|
|
(defmacro time-passed ()
|
|
"how much time has passed since set-state-time"
|
|
`(- (current-time) (-> self state-time))
|
|
)
|
|
|
|
(defmacro time-passed? (time)
|
|
"has it been 'time' since set-state-time?"
|
|
`(>= (time-passed) ,time)
|
|
)
|
|
|
|
|
|
|