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

;;-*-Lisp-*-
(in-package goal)

;; name: gkernel-h.gc
;; name in dgo: gkernel-h
;; dgos: KERNEL

;; 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)
  )

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

;; this stores the current state of the kernel.
(deftype kernel-context (basic)
  ((prevent-from-run   process-mask  :offset-assert 4)  ;; don't run processes with any of these bits set.
   (require-for-run    process-mask  :offset-assert 8)  ;; unused
   (allow-to-run       process-mask  :offset-assert 12) ;; unused
   (next-pid           int32         :offset-assert 16) ;; next unused unique process ID
   (fast-stack-top     pointer       :offset-assert 20)
   (current-process    process       :offset-assert 24) ;; currently executing process
   (relocating-process basic         :offset-assert 28) ;; currently relocating process
   (relocating-min     int32         :offset-assert 32) ;; start of memory being relocated
   (relocating-max     int32         :offset-assert 36) ;; end of memory being relocated
   (relocating-offset  int32         :offset-assert 40) ;; how far the memory being relocated is moving
   (low-memory-message symbol        :offset-assert 44) ;; 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    :offset-assert 4) ;; name of the thread (usually a symbol?)
   (process       process  :offset-assert 8) ;; process that the thread belongs to
   (previous      thread   :offset-assert 12) ;; previous thread that was running in the process
   (suspend-hook  (function cpu-thread none) :offset-assert 16) ;; function to suspend this thread
   (resume-hook   (function cpu-thread none) :offset-assert 20) ;; function to resume this thread
   (pc            pointer  :offset-assert 24) ;; program counter of the thread
   (sp            pointer  :offset-assert 28) ;; stack pointer of the thread (actual stack)
   (stack-top     pointer  :offset-assert 32) ;; top of the thread's stack (actual stack)
   (stack-size    int32    :offset-assert 36) ;; size of the thread's stack (backup stack)
   )

  (:methods
    (stack-size-set! (_type_ int) none 9)
    (thread-suspend (_type_) none 10)
    (thread-resume  (_type_) none 11)
   )

  :size-assert #x28
  :method-count-assert 12
  :flag-assert #xc00000028
  ;; 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_ 0)
    (thread-suspend (_type_) none 10)
    (thread-resume  (_type_) none 11)
   )

  :size-assert #x80
  :method-count-assert 12
  :flag-assert #xc00000080
  )

;; 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                  :offset-assert 4)
   (mask     process-mask           :offset-assert 8)
   ;; tree
   (parent   (pointer process-tree) :offset-assert 12)
   (brother  (pointer process-tree) :offset-assert 16)
   (child    (pointer process-tree) :offset-assert 20)
   (ppointer (pointer process)      :offset-assert 24)

   ;; in cases where the process never moves, the kernel will set ppointer to the address of the self field
   (self     process-tree           :offset-assert 28)
   )

  (:methods
    (new (symbol type basic) _type_ 0)
    (activate (_type_ process-tree basic pointer) process-tree 9)
    (deactivate  (_type_) none 10)
    (init-from-entity! (_type_ entity-actor) none 11)
    (run-logic? (_type_) symbol 12)
    (process-tree-method-13 () none 13)
   )

  :size-assert #x20
  :method-count-assert 14
  :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 :offset-assert #x20)  ;; the memory pool we came from, and should return to when we die
   (status basic :offset-assert #x24)
   (pid int32 :offset-assert #x28)              ;; unqiue process ID
   (main-thread cpu-thread :offset-assert #x2c) ;; our suspendable main thread
   (top-thread thread :offset-assert #x30)      ;; currently running thread
   (entity entity-actor :offset-assert #x34)    ;; if we are a process spawned by an entity-actor, our entity
   (state state :offset-assert #x38)            ;; if we use the state system, our current state
   (trans-hook function :offset-assert #x3c)    ;; function to call for trans
   (post-hook function :offset-assert #x40)     ;; function to call for post
   (event-hook (function process int symbol event-message-block object) :offset-assert #x44) ;; function to call for events
   (allocated-length int32 :offset-assert #x48) ;; size not included in process (including fields + heap)
   (next-state state :offset-assert #x4c)       ;; if we are "going", the next state to go to.
   (heap-base pointer :offset-assert #x50)      ;; process heap
   (heap-top pointer :offset-assert #x54)
   (heap-cur pointer :offset-assert #x58)
   (stack-frame-top stack-frame :offset-assert #x5c)  ;; stack frame. top means "closest to current execution"
   (connection-list connectable :inline :offset-assert #x60) ;; list of engines we're connected to
   (stack uint8 :dynamic :offset-assert #x70) ;; memory for fields + process heap
   )
  (:methods
    (new (symbol type basic int) _type_ 0)
   )
  (:states
    dead-state
    empty-state)
  :size-assert #x70
  :method-count-assert 14
  :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_ 0)
    (get-process (_type_ type int) process 14)
    (return-process ( _type_ process) none 15)
   )
  :size-assert #x20
  :method-count-assert 16
  :flag-assert #x1000000020
  )

;; 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         :offset-assert 0) ;; the process of this record
   (prev dead-pool-heap-rec :offset-assert 4) ;; next rec in the linked list
   (next dead-pool-heap-rec :offset-assert 8) ;; prev. rec in the linked list
   )

  :pack-me ; don't worry about aligning me to 16-bytes in arrays and types.
  :size-assert #xc
  :method-count-assert 9
  :flag-assert #x90000000c
  )

;; 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                           :offset-assert #x20) ;; size of heap
   (compact-time        uint32                          :offset-assert #x24) ;; unused...
   (compact-count-targ  uint32                          :offset-assert #x28) ;; number of compactions requested
   (compact-count       uint32                          :offset-assert #x2c) ;; number of compactions perfomed
   (fill-percent        float                           :offset-assert #x30) ;; unused
   (first-gap           dead-pool-heap-rec              :offset-assert #x34) ;; the lowest process with a gap in the heap
   (first-shrink        dead-pool-heap-rec              :offset-assert #x38) ;; the lowest process that needs shrinking
   (heap                kheap :inline                   :offset-assert 64)   ;; our shared heap for processes
   (alive-list          dead-pool-heap-rec :inline      :offset-assert 80)   ;; records for processes that are alive
   (last                dead-pool-heap-rec :offset #x54 :offset-assert #x54) ;; overlay of (-> alive-list prev)
   (dead-list           dead-pool-heap-rec :inline      :offset-assert 92)   ;; unused records
   (process-list        dead-pool-heap-rec :inline :dynamic :offset-assert 104) ;; array of records
   )
  (:methods
    (new (symbol type basic int int) _type_ 0)
    (compact (dead-pool-heap int) none 16)
    (shrink-heap (dead-pool-heap process) dead-pool-heap 17)
    (churn (dead-pool-heap int) none 18)
    (memory-used (dead-pool-heap) int 19)
    (memory-total (dead-pool-heap) int 20)
    (gap-size (dead-pool-heap dead-pool-heap-rec) int 21)
    (gap-location (dead-pool-heap dead-pool-heap-rec) pointer 22)
    (find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 23)
    (find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 24)
    (memory-free (dead-pool-heap) int 25)
    (compact-time (dead-pool-heap) uint 26)
   )

  :size-assert #x68
  :method-count-assert #x1b
  :flag-assert #x1b00000068
  )


;; 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.
   )

  :size-assert #xc
  :method-count-assert 9
  :flag-assert #x90000000c
  :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 0)
   )
  :size-assert #xb0
  :method-count-assert 9
  :flag-assert #x9000000b0
  )

;; A protect frame is a frame which has a cleanup function called on exit.
(deftype protect-frame (stack-frame)
  ((exit (function none) :offset-assert 12)) ;; function to call to clean up

  (:methods
   (new (symbol type (function none)) protect-frame)
   )
  :size-assert 16
  :method-count-assert 9
  :flag-assert #x900000010
  )

;; 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)
   )
  :flag-assert #x900000008
  )

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


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

;; 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         :offset-assert  16)
   (trans (function none)  :offset-assert  20)
   (post  function         :offset-assert  24)
   (enter function         :offset-assert  28)
   (event (function process int symbol event-message-block object)  :offset-assert  32)
   )
  (:methods
    (new (symbol type symbol function
          (function none)
          function
          (function none)
          (function process int symbol event-message-block object)) _type_ 0)
    )
  :method-count-assert 9
  :size-assert         #x24
  :flag-assert         #x900000024
  )


;; this is used for the event system to pass around parameters from one process to another.
(deftype event-message-block (structure)
  ((to process :offset-assert 0)
   (from process :offset-assert 4)
   (num-params int32 :offset-assert 8)
   (message symbol :offset-assert 12)
   (param uint64 7 :offset-assert 16)
   )

  :size-assert #x48
  :method-count-assert 9
  :flag-assert #x900000048
  :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))
  )