jak-project/goal_src/jak1/kernel/gkernel-h.gc

;;-*-Lisp-*-
(in-package goal)
(bundles "KERNEL.CGO")
(require "kernel/gcommon.gc")

;; Type definitions and constants for the GOAL Kernel. The GOAL kernel is dipatched
;; from C++ through the *kernel-dispatcher* and is responsible for:
;; - running all GOAL code
;; - handling creation, destruction, and compaction of GOAL processes
;; - managing GOAL threads and the "suspend" keyword
;; - handling stack frames, nonlocal throws used by the state system
;; - process handles.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONSTANTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; if set, will attempt to detect memory corruption and stack overflow bugs
;; to some extent.
(defglobalconstant KERNEL_DEBUG #t)

;; -hardware

;; processes can execute using the scratchpad as their stack to get better
;; performance. The scratchpad address is #x70000000 to #x70004000 on PS2.
;; On PC, we'll detect the use of the scratchpad within gkernel.gc and move it elsewhere.
(defconstant *scratch-memory-top* (the pointer #x70004000))

;; -versions-

;; the version of the kernel. This is checked in the C Kernel.
;; This must match the version in common/versions.h when building gk
(defconstant *kernel-major-version* 2)

(defconstant *kernel-minor-version* 0)

;; the version of the OVERLORD I/O driver.
;; this may be unused.
(defconstant *irx-major-version* 1)

(defconstant *irx-minor-version* 2)

;; -memory-

;; in GOAL threads, to save memory, each thread owns a tiny stack to store
;; the stack when suspended, and copies it to and from a larger stack for execution.
;; Attempting to suspend a thread in a deep callstack will fail because the tiny stack won't have
;; enough room. But this strategy saves memory in the end.

;; the size of the single large "DRAM" execution stack (14 kB increased to 32 kB in PC)
(defconstant DPROCESS_STACK_SIZE #x8000)

;; the size of the execution stack, if not using the big DRAM stack.
;; OpenGOAL NOTE: 7kB -> 24kB
(defconstant PROCESS_STACK_SIZE (#if PC_PORT #x6000 #x1c00))

;; default size of stack to backup for a process
(defconstant PROCESS_STACK_SAVE_SIZE 256)

;; the size of the shared heap used by dynamically sized processes
(#if PC_BIG_MEMORY
  (defconstant PROCESS_HEAP_MULT 3) ;; 3x actors
  (defconstant PROCESS_HEAP_MULT 1))

(defconstant PROCESS_HEAP_SIZE (* PROCESS_HEAP_MULT 984 1024))

;; -system-

;; tab size for printing.
(defconstant *tab-size* (the binteger 8))

(defconstant *gtype-basic-offset* 4)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ENUMS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; bitfield enum to indicate properties about a process-tree
;; Some of these bits are used by the kernel for book-keeping, but others
;; can be set by the user to prevent a process from running in certain conditions.

(defenum process-mask
  :bitfield #t
  :type uint32
  (execute 0) ;; when set, prevents a process from running, in every case.
  (draw 1) ;; unused
  (pause 2) ;; when set, the process won't run if the game is paused.
  (menu 3) ;; when set, the process won't run if the debug menu system is open
  (progress 4) ;; the process won't run if the start menu (progress menu) is open
  (actor-pause 5) ;; when set, the entity system will try to pause it automatically if you are far away.
  (sleep 6) ;; prevents the process from running, but can be woken up by state changes.
  (sleep-code 7) ;; do not run the code (main thread) of this process (other stuff runs)
  (process-tree 8) ;; not an actual process, just a "tree node" for organization
  (heap-shrunk 9) ;; actor heap compactor has already shrunk the heap of this proc
  (going 10) ;; there is a next state set that will be entered next time (pending enter-state)
  (movie 11) ;; when set, don't run if we are in a movie
  (movie-subject 12) ;; set on silostep, unused otherwise.
  (target 13) ;; set on target
  (sidekick 14) ;; set on sidekick
  (crate 15) ;; set on all crates
  (collectable 16) ;; set on all collectables
  (enemy 17) ;; set on all enemies (inclues stuff like seagulls)
  (camera 18) ;; set on all cameras
  (platform 19) ;; set on all platforms
  (ambient 20) ;; set on all ambients
  (entity 21) ;; set on all processes spawned from entities
  (projectile 22) ;; set on all projectiles
  (attackable 23) ;; set on all "attackables" that can be targeted by projectiles or similar
  (death 24) ;; set on misty-conveyor, appears unused.
  )

;; -961
;; these bits are cleared when inheriting the mask from a parent process.
(defconstant PROCESS_CLEAR_MASK (lognot (process-mask sleep sleep-code process-tree heap-shrunk)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MACROS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; trigger an exception. (GOAL used lw r0, 2(r0))
(defmacro break ()
  `(/ 0 0))

(defmacro msg-err (&rest args)
  "Print a message to stdout immediately. This won't appear in the compiler.
   This is useful if the game is crashing before messages can be flushed
   to compiler."
  `(format 0 ,@args))

;; DECOMP BEGINS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TYPES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; this stores the current state of the kernel.
(deftype kernel-context (basic)
  ((prevent-from-run   process-mask) ;; don't run processes with any of these bits set.
   (require-for-run    process-mask) ;; unused
   (allow-to-run       process-mask) ;; unused
   (next-pid           int32) ;; next unused unique process ID
   (fast-stack-top     pointer)
   (current-process    process) ;; currently executing process
   (relocating-process basic) ;; currently relocating process
   (relocating-min     int32) ;; start of memory being relocated
   (relocating-max     int32) ;; end of memory being relocated
   (relocating-offset  int32) ;; how far the memory being relocated is moving
   (low-memory-message symbol) ;; should we print warnings if low on memory?
   )
  :size-assert #x30
  :method-count-assert 9
  :flag-assert #x900000030)

;; A thread belongs to a process and has a reference to a stack.
;; they have an "execution stack", which is where the stack goes when the thread runs.
;; and optionally a "backup stack", which stores the stack when the thread doesn't run.
;; this means threads can't leak pointers to stack variables to other threads...
;; optionally, threads may know how to suspend/resume themselves.

(declare-type process basic)

(declare-type stack-frame basic)

(declare-type state basic)

(declare-type cpu-thread basic)

(declare-type dead-pool basic)

(declare-type event-message-block structure)

;; NOTE! - this type is created in kscheme.cpp. It has room for 12 methods and size 0x28 bytes.
(deftype thread (basic)
  ((name         basic) ;; name of the thread (usually a symbol?)
   (process      process) ;; process that the thread belongs to
   (previous     thread) ;; previous thread that was running in the process
   (suspend-hook (function cpu-thread none)) ;; function to suspend this thread
   (resume-hook  (function cpu-thread none)) ;; function to resume this thread
   (pc           pointer) ;; program counter of the thread
   (sp           pointer) ;; stack pointer of the thread (actual stack)
   (stack-top    pointer) ;; top of the thread's stack (actual stack)
   (stack-size   int32) ;; size of the thread's stack (backup stack)
   )
  (:methods
   (stack-size-set! (_type_ int) none)
   (thread-suspend (_type_) none)
   (thread-resume (_type_) none))
  ;; is already defined in kscheme but we define it again.
  )

;; A CPU thread is a thread which has some memory to save registers and a stack
(deftype cpu-thread (thread)
  (;; This is what GOAL did:
   ;; (rreg   uint64 8        :offset-assert 40)   ;; general purpose saved registers
   ;; (freg   float 6         :offset-assert 104)  ;; floating point registers
   ;; OpenGOAL has only 5 saved registers but 8 fregs, so we swap a rreg for 2 fregs.
   (rreg  uint64 7 :offset-assert 40)
   (freg  float 8)
   ;; This is the same between GOAL and OpenGOAL
   (stack uint8 :dynamic :offset-assert 128) ;; stack memory (dynamic array)
   )
  (:methods
   (new (symbol type process symbol int pointer) _type_)
   (thread-suspend (_type_) none)
   (thread-resume (_type_) none)))

;; ppointer system:
;;  a process may move in memory, but we need a way to keep track of a process.
;;  this is where "ppointer" comes in. It is a GOAL (pointer process), like a C Process**.
;;  Each process must contain a ppointer that can be used to find it. The process pointed to by
;;  the ppointer must be a valid process or #f at all times.

;; Parent type of all process tree nodes.
;; A process-tree is a left-child right-sibling binary tree
;; (except GOAL is old and it looks like they called them left-child right-brother trees back then)
(declare-type entity-actor basic)

(deftype process-tree (basic)
  ((name     basic)
   (mask     process-mask)
   ;; tree
   (parent   (pointer process-tree))
   (brother  (pointer process-tree))
   (child    (pointer process-tree))
   (ppointer (pointer process))
   ;; in cases where the process never moves, the kernel will set ppointer to the address of the self field
   (self     process-tree))
  (:methods
   (new (symbol type basic) _type_)
   (activate (_type_ process-tree basic pointer) process-tree)
   (deactivate (_type_) none)
   (init-from-entity! (_type_ entity-actor) none)
   (run-logic? (_type_) symbol)
   (process-tree-method-13 () none))
  :no-runtime-type ;; already defined by kscheme. Don't do it again.
  )

;; A GOAL process.  A GOAL process contains memory and a suspendable main-thread.
(deftype process (process-tree)
  ((pool             dead-pool) ;; the memory pool we came from, and should return to when we die
   (status           basic)
   (pid              int32) ;; unqiue process ID
   (main-thread      cpu-thread) ;; our suspendable main thread
   (top-thread       thread) ;; currently running thread
   (entity           entity-actor) ;; if we are a process spawned by an entity-actor, our entity
   (state            state) ;; if we use the state system, our current state
   (trans-hook       function) ;; function to call for trans
   (post-hook        function) ;; function to call for post
   (event-hook       (function process int symbol event-message-block object)) ;; function to call for events
   (allocated-length int32) ;; size not included in process (including fields + heap)
   (next-state       state) ;; if we are "going", the next state to go to.
   (heap-base        pointer) ;; process heap
   (heap-top         pointer)
   (heap-cur         pointer)
   (stack-frame-top  stack-frame) ;; stack frame. top means "closest to current execution"
   (connection-list  connectable :inline) ;; list of engines we're connected to
   (stack            uint8 :dynamic) ;; memory for fields + process heap
   )
  (:methods
   (new (symbol type basic int) _type_))
  (:states
   dead-state
   empty-state)
  :no-runtime-type ;; already defined by kscheme. Don't do it again.
  )

;; A dead pool is simply a process-tree node which contains all dead processes.
;; It supports getting and returning processes.
(deftype dead-pool (process-tree)
  (;; nothing new!
   )
  (:methods
   (new (symbol type int int basic) _type_)
   (get-process (_type_ type int) process)
   (return-process (_type_ process) none)))

;; A dead-pool-heap-rec is a record for a process which lives on a dead-pool-heap.
;; The dead-pool-heap may move processes around in memory, but we need some constant address for each process.
;; This is a small record that will be updated by the kernel so it always points to the process.
;; A handle can use a pointer to this type's "process" field as a fixed ppointer.
(deftype dead-pool-heap-rec (structure)
  ((process process) ;; the process of this record
   (prev    dead-pool-heap-rec) ;; next rec in the linked list
   (next    dead-pool-heap-rec) ;; prev. rec in the linked list
   )
  :pack-me ; don't worry about aligning me to 16-bytes in arrays and types.
  )

;; This is a pool of dead processes which can be dynamically sized and allocated from a common heap.
;; It doesn't quite behave like a tree, so there's some hacks related to child/brother etc.
;; Alive processes in a dead-pool-heap can be relocated and compacted to reduce heap fragmentation.
(deftype dead-pool-heap (dead-pool)
  ((allocated-length   int32) ;; size of heap
   (compact-time       uint32) ;; unused...
   (compact-count-targ uint32) ;; number of compactions requested
   (compact-count      uint32) ;; number of compactions perfomed
   (fill-percent       float) ;; unused
   (first-gap          dead-pool-heap-rec) ;; the lowest process with a gap in the heap
   (first-shrink       dead-pool-heap-rec) ;; the lowest process that needs shrinking
   (heap               kheap :inline) ;; our shared heap for processes
   (alive-list         dead-pool-heap-rec :inline) ;; records for processes that are alive
   (last               dead-pool-heap-rec :overlay-at (-> alive-list prev))
   (dead-list          dead-pool-heap-rec :inline) ;; unused records
   (process-list       dead-pool-heap-rec :inline :dynamic) ;; array of records
   )
  (:methods
   (new (symbol type basic int int) _type_)
   (compact (dead-pool-heap int) none)
   (shrink-heap (dead-pool-heap process) dead-pool-heap)
   (churn (dead-pool-heap int) none)
   (memory-used (dead-pool-heap) int)
   (memory-total (dead-pool-heap) int)
   (gap-size (dead-pool-heap dead-pool-heap-rec) int)
   (gap-location (dead-pool-heap dead-pool-heap-rec) pointer)
   (find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec)
   (find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec)
   (memory-free (dead-pool-heap) int)
   (compact-time (dead-pool-heap) uint)))

;; GOAL can create a series of stack frames for unwinding/cleaning up.
;; This is the parent type for any stack frame.
(deftype stack-frame (basic)
  ((name symbol :offset 4)
   (next stack-frame :offset 8) ;; follow this to get to the root frame, away from top.
   )
  :no-runtime-type ;; already constructed, don't do it again.
  )

;; A catch frame is a frame you can "throw" to, by name.
;; You can "throw" out of a function and into a calling function, just like C++ exceptions.
(deftype catch-frame (stack-frame)
  ((sp   int32 :offset 12) ;; where to reset the stack when throwing.
   (ra   int32 :offset 16) ;; where to jump when throwing
   ;; In GOAL
   ;; (freg float 6 :offset-assert 20) ;; saved floating point registers from "catch" statement
   ;; (rreg uint128 8 :offset-assert 48) ;; saved GPRs from "catch" statement (ugh they are 128s)
   ;; In OpenGOAL, we swap a rreg for 4 more fregs.
   (freg float 10 :offset-assert 20) ;; only use 8
   (rreg uint128 7) ;; only use 5
   )
  (:methods
   (new (symbol type symbol function (pointer uint64)) object)))

;; A protect frame is a frame which has a cleanup function called on exit.
(deftype protect-frame (stack-frame)
  ((exit (function object))) ;; function to call to clean up
  (:methods
   (new (symbol type (function object)) protect-frame)))

;; A handle is a reference to a _specific_ process.
;; There are two tricks here:
;; 1). A process can be relocated in memory, so we can't just store a process.
;;   Instead, we use a (pointer process) that points to a non-moving record.
;;   dead-pool-heap takes care of maintaining these.
;; 2). Process memory can be reused. We don't want to get confused by this.
;;   So we also store a unique PID to the specific activation of a process.
;;   This way we can check the handle's PID against the PID in the process.
(deftype handle (uint64)
  ((process (pointer process) :offset 0) ;; set to #f for null.
   (pid     int32 :offset 32)
   (u64     uint64 :offset 0)))

(defmethod inspect ((this handle))
  (format #t "[~8x] ~A~%" 'handle)
  (format #t "~Tprocess: #x~x~%" (-> this process))
  (format #t "~Tpid: ~D~%" (-> this pid))
  this)

(defmacro handle->process (handle)
  "Convert a handle to a process. If the process no longer exists, returns #f."
  `(let ((the-handle (the-as handle ,handle)))
    (if (-> the-handle process) ;; if we don't point to a process, kernel sets this to #f
      (let ((proc (-> (-> the-handle process))))
        (if (= (-> the-handle pid) (-> proc pid)) ;; make sure it's the same process
          proc)))))

(defmacro ppointer->process (ppointer)
  "convert a (pointer process) to a process."
  ;; this uses the self field, which seems to always just get set to the object.
  ;; perhaps when deleting a process you could have it set self to #f?
  ;; I don't see this happen anywhere though, so it's not clear.
  `(let ((the-pp ,ppointer)) (the process-tree (if the-pp (-> the-pp 0 self)))))

(defmacro process->ppointer (proc)
  "safely get a (pointer process) from a process, returning #f if invalid."
  `(let ((the-proc ,proc)) (if the-proc (-> the-proc ppointer))))

(defmacro ppointer->handle (pproc)
  "convert a ppointer to a handle. assumes the ppointer is valid."
  `(let ((the-process (the-as (pointer process) ,pproc)))
    (new 'static 'handle :process the-process :pid (-> the-process 0 pid))))

(defmacro process->handle (proc)
  "convert a process to a handle. if proc is #f, returns a #f handle."
  `(ppointer->handle (process->ppointer ,proc)))

(defmethod print ((this handle))
  "print a handle"
  (if (nonzero? (-> this u64)) ;; zero-initialized handles can't be derefenced safely.
    (format #t
            "#<handle :process ~A :pid ~D>"
            (handle->process this) ;; actually print the process stored
            (-> this pid))
    (format #t "#<handle :process 0 :pid 0>"))
  this)

;; A "state" is a collection of 6 functions that describe what code a process should run.
;; It contains "code", the code that's suspended and resumed,
;;             "trans", a function called before code is resumed
;;             "post", a function called after code is suspended
;;             "enter", a function to call when entering this state
;;             "event", a function to call to handle events sent to the process
;;             "exit", a function to call when exiting the state or deactivating the process.
;; While "state" is technically a stack frame, it's always the base stack frame, and just used for the exit
;; so if you abort out of a process, it cleans up the state too.
(deftype state (protect-frame)
  ((code  function)
   (trans (function object))
   (post  function)
   (enter function)
   (event (function process int symbol event-message-block object)))
  (:methods
   (new (symbol type symbol function (function object) function (function object) (function process int symbol event-message-block object)) _type_)))

;; this is used for the event system to pass around parameters from one process to another.
(deftype event-message-block (structure)
  ((to         process)
   (from       process)
   (num-params int32)
   (message    symbol)
   (param      uint64 7))
  :always-stack-singleton)

(defmacro process-stack-used (proc)
  ;; get how much stack the top thread of a process has used.
  `(- (the int (-> ,proc top-thread stack-top)) (the int (-> ,proc top-thread sp))))

(defmacro process-stack-size (proc)
  ;; get how much stack the top thread of a process has
  `(-> ,proc top-thread stack-size))

(defmacro process-heap-used (proc)
  ;; get how much heap a process has used.
  `(- (-> ,proc allocated-length) (- (the int (-> ,proc heap-top)) (the int (-> ,proc heap-cur)))))

(defmacro process-heap-size (proc)
  ;; get how much heap a process has
  `(the int (-> ,proc allocated-length)))

(defmacro process-mask? (mask enum-value)
  `(!= 0 (logand ,mask (process-mask ,enum-value))))

(defmacro process-mask-set! (mask &rest enum-value)
  ;; sets the given bits in the process mask (with or)
  `(set! ,mask (logior ,mask (process-mask ,@enum-value))))

(defmacro process-mask-clear! (mask &rest enum-value)
  ;; sets the given bits in the process mask (with or)
  `(set! ,mask (logand ,mask (lognot (process-mask ,@enum-value)))))

(defmacro suspend ()
  "suspend the current process, to be resumed on the next frame."
  `(rlet ((pp :reg r13 :reset-here #t))
    ;; debug check for stack overflow here, where we can easily print the process name.
    (#when (or KERNEL_DEBUG)
      (rlet ((sp :reg rsp :reset-here #t :type int)
             (off :reg r15 :type uint))
        (let* ((sp-goal (- sp off))
               (stack-top-goal (-> (the process pp) top-thread stack-top))
               (stack-used (&- stack-top-goal sp-goal))
               (stack-size (-> (the process pp) top-thread stack-size)))
          (when (> stack-used stack-size)
            (format 0 "ERROR: suspend called without enough stack in proc:~%~A~%Stack: ~D/~D~%" pp stack-used stack-size)))))
    ;; set to the current thread
    (set! pp (-> (the process pp) top-thread))
    ;; call the suspend hook (put nothing as the argument)
    ((-> (the cpu-thread pp) suspend-hook) (the cpu-thread 0))
    ;; the kernel will set pp (possibly to a new value, if we've been relocated) on resume.
    ))

(defmacro process-deactivate ()
  "deactivate (kill) the current process"
  `(rlet ((pp :reg r13 :reset-here #t :type process)) (deactivate pp)))

(defmacro with-pp (&rest body)
  "execute the body with pp bound to the current process register."
  `(rlet ((pp :reg r13 :reset-here #t :type process)) ,@body))

(defconstant PP (with-pp pp))

(defmacro with-proc (bindings &rest body)
  "execute the body with process register set to the given value and bound to pp.
   it is recommended to use run-now-in-process over this"
  `(rlet ((pp :reg r13 :reset-here #t :type process)) (protect (pp) (set! pp ,(car bindings)) ,@body)))

(defmacro defbehavior (name process-type bindings &rest body)
  "define a new behavior. This is simply a function where self is bound to the process register,
   which is assumed to have type process-type."
  (if (and (> (length body) 1) ;; more than one thing in function
           (string? (first body)) ;; first thing is a string
           )
    ;; then it's a docstring and we ignore it.
    `(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@(cdr body)))
    ;; otherwise don't ignore it.
    `(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body))))

(defconstant INVALID_HANDLE (the handle #f))

(defmacro handle->name (handle)
  "get the name of a process using a handle. #f is the result if the handle was invalid."
  (with-gensyms (proc)
    `(let ((,proc (handle->process ,handle))) (if ,proc (-> ,proc name)))))

(defmacro with-children (bindings &rest body)
  "run body for each child. not recursive.
   bindings are: (child proc); proc = process we do this on; child = var name for the current child ptr."
  `(let ((,(first bindings) (-> ,(second bindings) child)))
    (while ,(first bindings)
      ,@body
      (set! ,(first bindings) (-> ,(first bindings) 0 brother)))))

(defmacro kheap-alloc (heap size)
  "allocate space for a kheap"
  `(let ((heap ,heap)
        (size ,size))
    (set! (-> heap base) (malloc 'global size))
    (set! (-> heap current) (-> heap base))
    (set! (-> heap top-base) (&+ (-> heap base) size))
    (set! (-> heap top) (-> heap top-base))))

(defmacro kheap-reset (heap)
  "reset the kheap, so you can use its memory again"
  `(let ((heap ,heap)) (set! (-> heap current) (-> heap base))))

(defmacro with-sp (&rest body)
  "execute the body with sp bound to the current stack pointer (be careful!)"
  `(rlet ((sp :reg rsp :reset-here #t :type pointer)) ,@body))

(defmacro scratchpad-object (type &key (offset 0))
  "Access an object on the scratchpad."
  `(the-as ,type (&+ *fake-scratchpad-data* ,offset)))

(defmacro scratchpad-ptr (type &key (offset 0))
  "Create a pointer to an object on the scratchpad."
  `(the-as (pointer ,type) (&+ *fake-scratchpad-data* ,offset)))

;; Some assembly functions in GOAL are ported to C++, then accessed from GOAL using these mips2c macros.
(defmacro def-mips2c (name type)
  "Define a mips2c object (typically a function)."
  `(begin
    (define-extern ,name ,type)
    (set! ,name (the-as ,type (__pc-get-mips2c ,(symbol->string name))))))

(defmacro defmethod-mips2c (name method-id method-type)
  "Define a mips2c method."
  `(method-set! ,method-type ,method-id (__pc-get-mips2c ,name)))