jak-project/test/decompiler/reference/decompiler-macros.gc

;; This file should contain an implementation for all macros that the decompiler uses in its output.

(defun ash ((value int) (shift-amount int))
  "Arithmetic shift value by shift-amount.
  A positive shift-amount will shift to the left and a negative will shift to the right.
  "
  ;; OpenGOAL does not support ash in the compiler, so we implement it here as an inline function.
  (declare (inline))
  (if (> shift-amount 0)
      (shl value shift-amount)
      (sar value (- shift-amount))
      )
  )

(defmacro suspend ()
  '(none)
  )

(defmacro empty-form ()
  '(none)
  )

(defmacro .sync.l ()
  `(none))

(defmacro make-u128 (upper lower)
  `(rlet ((result :class i128)
          (upper-xmm :class i128)
          (lower-xmm :class i128))
     (.mov upper-xmm ,upper)
     (.mov lower-xmm ,lower)
     (.pcpyld result upper-xmm lower-xmm)
     (the uint result)
     )
  )

(defmacro init-vf0-vector ()
  "Initializes the VF0 vector which is a constant vector in the VU set to <0,0,0,1>"
  `(.lvf vf0 (new 'static 'vector :x 0.0 :y 0.0 :z 0.0 :w 1.0))
  )

(defconstant SYM_TO_STRING_OFFSET #xff38)
(defmacro symbol->string (sym)
  "Convert a symbol to a goal string."
  `(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym))))
  )

(defmacro new-stack-matrix0 ()
  "Get a new matrix on the stack that's set to zero."
  `(let ((mat (new 'stack-no-clear 'matrix)))
     (set! (-> mat quad 0) (the-as uint128 0))
     (set! (-> mat quad 1) (the-as uint128 0))
     (set! (-> mat quad 2) (the-as uint128 0))
     (set! (-> mat quad 3) (the-as uint128 0))
     mat
     )
  )

(defmacro new-stack-vector0 ()
  "Get a stack vector that's set to 0.
   This is more efficient than (new 'stack 'vector) because
   this doesn't call the constructor."
  `(let ((vec (new 'stack-no-clear 'vector)))
     (set! (-> vec quad) (the-as uint128 0))
     vec
     )
  )

(defmacro new-stack-quaternion0 ()
  "Get a stack quaternion that's set to 0.
   This is more efficient than (new 'stack 'quaternion) because
   this doesn't call the constructor."
  `(let ((q (new 'stack-no-clear 'quaternion)))
     (set! (-> q quad) (the-as uint128 0))
     q
     )
  )


(defmacro with-pp (&rest body)
  `(rlet ((pp :reg r13 :reset-here #t :type process))
         ,@body)
  )

(defmacro fabs (x)
  `(if (< (the float ,x) 0)
       (- (the float ,x))
       (the float ,x))
  )

(defconstant PI (the-as float #x40490fda))
(defconstant MINUS_PI (the-as float #xc0490fda))

(defmacro handle->process (handle)
  ;; the actual implementation is more clever than this.
  ;; Checks PID.
  `(let ((the-handle (the-as handle ,handle)))
     (if (-> the-handle process)
         (let ((proc (-> (-> the-handle process))))
           (if (= (-> the-handle pid) (-> proc pid))
               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)
  `(let ((the-process (the-as (pointer process) ,pproc)))
      (new 'static 'handle :process the-process :pid (-> the-process 0 pid))
      )
  )

(defmacro process->handle (proc)
  `(ppointer->handle (process->ppointer ,proc))
  )


(defmacro defbehavior (name process-type bindings &rest body)
  (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))
      )
  )

(defmacro b! (pred destination &key (delay '()) &key (likely-delay '()))
  "Branch!"
  ;; evaluate the predicate
  `(let ((should-branch ,pred))
     ;; normal delay slot:
     ,delay
     (when should-branch
       ,likely-delay
       (goto ,destination)
       )
     )
  )


;; meters are stored as (usually) a float, scaled by 4096.
;; this gives you reasonable accuracy as an integer.
(defglobalconstant METER_LENGTH 4096.0)

(defmacro meters (x)
  "Convert number to meters.
   If the input is a constant float or integer, the result will be a
   compile time constant float. Otherwise, it will not be constant.
   Returns float."

  ;; we don't have enough constant propagation for the compiler to figure this out.
  (cond
    ((float? x)
     (* METER_LENGTH x)
     )
    ((integer? x)
     (* METER_LENGTH x)
     )
    (#t
     `(* METER_LENGTH ,x)
     )
    )
  )

;; rotations are stored in 65,536ths of a full rotation.
;; like with meters, you get a reasonable accuracy as an integer.
;; additionally, it is a power-of-two, so wrapping rotations can be done
;; quickly by converting to an int, masking, and back to float
(defglobalconstant DEGREES_PER_ROT 65536.0)

;; this was deg in GOAL
(defmacro degrees (x)
  "Convert number to degrees unit.
   Will keep a constant float/int constant."
  (cond
    ((or (float? x) (integer? x))
     (* DEGREES_PER_ROT (/ (+ 0.0 x) 360.0))
     )
    (#t
     `(* (/ (the float ,x) 360.0)
         DEGREES_PER_ROT
         )
     )
    )
  )

;; times are stored in 300ths of a second.
;; this divides evenly into frames at both 50 and 60 fps.
;; typically these are stored as integers as more precision is not useful.
;; an unsigned 32-bit integer can store about 150 days
(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps

;; this was usec in GOAL
(defmacro seconds (x)
  "Convert number to seconds unit.
   Returns uint."
  (cond
    ((integer? x)
     (* TICKS_PER_SECOND x)
     )
    ((float? x)
     (* 1 (* 1.0 x TICKS_PER_SECOND))
     )
    (#t
     `(the uint (* TICKS_PER_SECOND ,x))
     )
    )
  )

(defmacro fsec (x)
  "Convert number to seconds unit.
   Returns float."
  (cond
    ((or (integer? x) (float? x))
     (* 1.0 TICKS_PER_SECOND x)
     )
    (#t
     `(* 1.0 TICKS_PER_SECOND ,x)
     )
    )
  )

;; maybe rename to "velocity"?
(defmacro vel-tick (vel)
  "turn a velocity value into a per-tick value"
  `(* (/ 1.0 ,TICKS_PER_SECOND) ,vel)
  )

(defmacro copy-and-set-field (original field-name field-value)
  `(let ((temp-copy ,original))
     (set! (-> temp-copy ,field-name) ,field-value)
     temp-copy
     )
  )

(defmacro set-vector! (v xv yv zv wv)
  "Set all fields in a vector"
  (with-gensyms (vec)
     `(let ((,vec ,v))
       (set! (-> ,vec x) ,xv)
       (set! (-> ,vec y) ,yv)
       (set! (-> ,vec z) ,zv)
       (set! (-> ,vec w) ,wv)
       ,vec
       ))
     )

;; cause the current process to change state
(defmacro go (next-state &rest args)
  `(with-pp
     (go-hook pp ,next-state ,@args)
     )
  )

(defmacro go-virtual (state-name &key (proc self) &rest args)
  "Change the current process to the virtual state of the given process."
  `(go (method-of-object ,proc ,state-name) ,@args)
  )

(defmacro static-sound-name (str)
  "Convert a string constant to a static sound-name."

  ;; all this is done at compile-time so we can come up with 2
  ;; 64-bit constants to use
  (when (> (string-length str) 16)
    (error "static-sound-name got a string that is too long")
    )
  (let ((lo-val 0)
        (hi-val 0)
        )
    (dotimes (i (string-length str))
      (if (>= i 8)
          (+! hi-val (ash (string-ref str i) (* 8 (- i 8))))
          (+! lo-val (ash (string-ref str i) (* 8 i)))
          )
      )
    `(new 'static 'sound-name :lo ,lo-val :hi ,hi-val)
    )
  )

(defmacro vftoi4.xyzw (dst src)
  "convert to 28.4 integer. This does the multiply while the number is still
   a float. This will have issues for very large floats, but it seems like this
   is how PCSX2 does it as well, so maybe it's right?
   NOTE: this is the only version of the instruction used in Jak 1, so we
   don't need to worry about masks."

  `(begin
    (rlet ((temp :class vf))
      (set! temp 16.0)
      (.mul.x.vf temp ,src temp)
      (.ftoi.vf ,dst temp)
      )
    )
  )

(defmacro vftoi12.xyzw (dst src)
  "convert to 20.12 integer. This does the multiply while the number is still
   a float. This will have issues for very large floats, but it seems like this
   is how PCSX2 does it as well, so maybe it's right?
   NOTE: this is the only version of the instruction used in Jak 1, so we
   don't need to worry about masks."

  `(begin
    (rlet ((temp :class vf))
      (set! temp 4096.0)
      (.mul.x.vf temp ,src temp)
      (.ftoi.vf ,dst temp)
      )
    )
  )

(defmacro vftoi15.xyzw (dst src)
  "convert to 17.15 integer. This does the multiply while the number is still
   a float. This will have issues for very large floats, but it seems like this
   is how PCSX2 does it as well, so maybe it's right?
   NOTE: this is the only version of the instruction used in Jak 1, so we
   don't need to worry about masks."

  `(begin
    (rlet ((temp :class vf))
      (set! temp 32768.0)
      (.mul.x.vf temp ,src temp)
      (.ftoi.vf ,dst temp)
      )
    )
  )

(defmacro vitof4.xyzw (dst src)
  "convert from a 28.4 integer. This does the multiply while the number is still
   a float. This will have issues for very large floats, but it seems like this
   is how PCSX2 does it as well, so maybe it's right?
   NOTE: this is the only version of the instruction used in Jak 1, so we
   don't need to worry about masks."

  `(begin
    (rlet ((temp :class vf))
      (set! temp 0.0625)
      (.mul.x.vf temp ,src temp)
      (.ftoi.vf ,dst temp)
      )
    )
  )

(defmacro vitof12.xyzw (dst src)
  "convert from a 20.12 integer. This does the multiply while the number is still
   a float. This will have issues for very large floats, but it seems like this
   is how PCSX2 does it as well, so maybe it's right?
   NOTE: this is the only version of the instruction used in Jak 1, so we
   don't need to worry about masks."

  `(begin
    (rlet ((temp :class vf))
      (set! temp 0.000244140625)
      (.mul.x.vf temp ,src temp)
      (.ftoi.vf ,dst temp)
      )
    )
  )

(defmacro vitof15.xyzw (dst src)
  "convert from a 17.15 integer. This does the multiply while the number is still
   a float. This will have issues for very large floats, but it seems like this
   is how PCSX2 does it as well, so maybe it's right?
   NOTE: this is the only version of the instruction used in Jak 1, so we
   don't need to worry about masks."

  `(begin
    (rlet ((temp :class vf))
      (set! temp 0.000030517578125)
      (.mul.x.vf temp ,src temp)
      (.ftoi.vf ,dst temp)
      )
    )
  )

;; 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
            (if (eq? (car hnd) old)
              (set-car! hnd new)
              )
            )
          )
      )
  `(none)
  )

(defmacro sext32 (in)
  `(sar (shl ,in 32) 32)
  )

(defmacro .sra (result in sa)
  `(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa)))
  )

(defmacro .movn (result value check original)
  `(if (!= ,check 0)
       (set! ,result (the-as int ,value))
       (set! ,result (the-as int ,original))
       )
  )

(defmacro .movz (result value check original)
  `(if (= ,check 0)
       (set! ,result (the-as int ,value))
       (set! ,result (the-as int ,original))
       )
  )

(defmacro .mfc0 (&rest stuff)
  `(empty)
  )

(defmacro res-lump-data (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time -1000000000.0))
  "Helper macro to get data from a res-lump without interpolation."
  `(the-as ,type ((method-of-type res-lump get-property-data)
                  ,lump
                  ,name
                  'interp
                  ,time
                  (the-as pointer #f)
                  ,tag-ptr
                  *res-static-buf*
                  )
           )
  )

(defmacro res-lump-data-exact (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time 0.0))
  "Helper macro to get start of data from a res-lump."
  `(the-as ,type ((method-of-type res-lump get-property-data)
                  ,lump
                  ,name
                  'exact
                  ,time
                  (the-as pointer #f)
                  ,tag-ptr
                  *res-static-buf*
                  )
           )
  )

(defmacro res-lump-struct (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time -1000000000.0))
  `(the-as ,type ((method-of-type res-lump get-property-struct)
                  ,lump
                  ,name
                  'interp
                  ,time
                  (the-as structure #f)
                  ,tag-ptr
                  *res-static-buf*
                  )
           )
  )

(defmacro res-lump-struct-exact (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time 0.0))
  `(the-as ,type ((method-of-type res-lump get-property-struct)
                  ,lump
                  ,name
                  'exact
                  ,time
                  (the-as structure #f)
                  ,tag-ptr
                  *res-static-buf*
                  )
           )
  )

(defmacro res-lump-value (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (default (the-as uint128 0)) &key (time -1000000000.0))
  "Helper macro to get a value from a res-lump with no interpolation."
  `(the-as ,type ((method-of-type res-lump get-property-value)
                  ,lump
                  ,name
                  'interp
                  ,time
                  ,default
                  ,tag-ptr
                  *res-static-buf*
                  )
           )
  )

(defmacro res-lump-float (lump name &key (tag-ptr (the-as (pointer res-tag) #f)) &key (default 0.0) &key (time -1000000000.0))
  "Helper macro to get a float from a res-lump with no interpolation."
  `((method-of-type res-lump get-property-value-float)
                  ,lump
                  ,name
                  'interp
                  ,time
                  ,default
                  ,tag-ptr
                  *res-static-buf*
                  )
  )

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

(defmacro sp-item (launcher
                    &key (fade-after 0.0)
                    &key (falloff-to 0.0)
                    &key (flags ())
                    &key (period 0)
                    &key (length 0)
                    &key (offset 0)
                    &key (hour-mask 0)
                    &key (binding 0)
                    )
  `(new 'static 'sparticle-group-item
        :launcher ,launcher
        :fade-after ,fade-after
        :falloff-to ,falloff-to
        :flags (sp-group-item-flag ,@flags)
        :period ,period
        :length ,length
        :offset ,offset
        :hour-mask ,hour-mask
        :binding ,binding
        )
  )

(defmacro sp-tex (field-name tex-id)
  `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-name) :tex ,tex-id)
  )

(defmacro sp-rnd-flt (field-name val range mult)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-valuef ,val
        :random-rangef ,range
        :random-multf ,mult
        :flags (sp-flag float-with-rand)
        )
  )

(defmacro sp-flt (field-name val)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-valuef ,val
        :random-rangef 0.0
        :random-multf 1.0
        :flags (sp-flag float-with-rand)
        )
  )

(defmacro sp-int (field-name val)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-value ,val
        :random-range 0
        :random-mult 1
        )
  )

(defmacro sp-int-plain-rnd (field-name val range mult)
  "For when we use plain integer, but set the randoms."
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-value ,val
        :random-range ,range
        :random-mult ,mult
        )
  )

(defmacro sp-rnd-int (field-name val range mult)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-value ,val
        :random-range ,range
        :random-multf ,mult
        :flags (sp-flag int-with-rand)
        )
  )


(defmacro sp-rnd-int-flt (field-name val range mult)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-valuef ,val
        :random-range ,range
        :random-multf ,mult
        :flags (sp-flag int-with-rand)
        )
  )

(defmacro sp-cpuinfo-flags (&rest flags)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id spt-flags)
        :initial-value (sp-cpuinfo-flag ,@flags)
        :random-mult 1
        )
  )

(defmacro sp-launcher-by-id (field-name val)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-value ,val
        :flags (sp-flag part-by-id)
        )
  )

(defmacro sp-func (field-name val)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :sym ,val
        :flags (sp-flag from-pointer)
        )
  )

(defmacro sp-sound (sound)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id spt-sound)
        :sound ,sound
        :flags (sp-flag plain-v2)
        )
  )

(defmacro sp-end ()
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id spt-end)
        )
  )

(defmacro sp-copy-from-other (field-name offset)
  `(new 'static 'sp-field-init-spec
        :field (sp-field-id ,field-name)
        :initial-value ,offset
        :random-mult 1
        :flags (sp-flag copy-from-other-field)
        )
  )

(defmacro defpartgroup (name &key id &key parts &key (duration 3000) &key (linger-duration 1500) &key (flags ()) &key bounds)
  "define a new part group. defines a constant with the name of the group and the value of the group's ID"
  `(begin
    (defconstant ,name ,id)
    (set! (-> *part-group-id-table* ,id)
      (new 'static 'sparticle-launch-group
          :duration ,duration
          :linger-duration ,linger-duration
          :flags (sp-group-flag ,@flags)
          :bounds ,bounds
          :name ,(symbol->string name)
          :length ,(length parts)
          :launcher (new 'static 'inline-array sparticle-group-item ,(length parts) ,@parts)
          )
      )
    )
  )

(defmacro part-group (id)
  `(-> *part-group-id-table* ,id)
  )

(defmacro defpart (id &key (init-specs ()))
  "define a new sparticle-launcher"
  `(set! (-> *part-id-table* ,id)
      (new 'static 'sparticle-launcher
          :init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
                  ,@init-specs
                  (sp-end)
                  )))
  )

(defmacro cmove-#f-zero (dest condition src)
  `(if (zero? ,condition)
       (set! ,dest #f)
       (set! ,dest ,src)
       )
   )

(defmacro move-if-not-zero (result value check original)
  `(if (!= ,check 0)
       (set! ,result (the-as int ,value))
       (set! ,result (the-as int ,original))
       )
  )

(defmacro shift-arith-right-32 (result in sa)
  `(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa)))
  )

(defmacro set-on-less-than (dest src1 src2)
  "dest = src1 < src2 ? 1 : 0 -- Compare as Signed Integers"
  `(if (< (the int ,src1) (the int ,src2))
       (set! ,dest 1)
       (set! ,dest 0)
       )
   )

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

;; vector-h
(defmacro static-spherem (x y z r)
  "actually makes a vector. use bspherem for sphere."
  `(new 'static 'vector :x (meters ,x) :y (meters ,y) :z (meters ,z) :w (meters ,r))
  )
(defmacro static-bspherem (x y z r)
  `(new 'static 'sphere :x (meters ,x) :y (meters ,y) :z (meters ,z) :w (meters ,r))
  )

;; art-h
(desfun art-elt->index (ag-name elt-name)
  (if (number? elt-name)
      elt-name
      (let ((ag-info (hash-table-try-ref *art-info* (symbol->string ag-name))))
          (if (not (car ag-info))
              -1
              (let ((elt-info (hash-table-try-ref (cdr ag-info) (symbol->string elt-name))))
                  (if (not (car elt-info))
                      -1
                      (cadr (cdr elt-info)))
                  )
              )
          )
      )
  )

(defmacro defskelgroup (name art-name joint-geom joint-anim lods
                        &key (shadow 0)
                        &key bounds
                        &key (longest-edge 0.0)
                        &key (texture-level 0)
                        &key (sort 0)
                        &key (version 6) ;; do NOT use this!
                        )

  "define a new static skeleton group"

  `(let ((skel (new 'static 'skeleton-group
                        :art-group-name ,(symbol->string art-name)
                        :bounds ,bounds
                        :longest-edge ,longest-edge
                        :version ,version
                        :max-lod ,(- (length lods) 1)
                        :shadow ,(art-elt->index (string->symbol-format "{}-ag" art-name) shadow)
                        :texture-level ,texture-level
                        :sort ,sort
                        )))
        ;; set joint geometry and joint bones
        (set! (-> skel jgeo) ,(art-elt->index (string->symbol-format "{}-ag" art-name) joint-geom))
        (set! (-> skel janim) ,(art-elt->index (string->symbol-format "{}-ag" art-name) joint-anim))

        ;; set lods
        ,@(apply-i (lambda (x i)
                      `(begin
                          (set! (-> skel mgeo ,i) ,(art-elt->index (string->symbol-format "{}-ag" art-name) (car x)))
                          (set! (-> skel lod-dist ,i) ,(cadr x))
                          )
                      ) lods)

        ;; define skel group
        (define ,name skel)
        )
  )

;; pad
(defmacro cpad-pressed (pad-idx)
  `(-> *cpad-list* cpads ,pad-idx button0-rel 0)
  )

(defmacro cpad-hold (pad-idx)
  `(-> *cpad-list* cpads ,pad-idx button0-abs 0)
  )

(defmacro cpad-pressed? (pad-idx &rest buttons)
  `(logtest? (cpad-pressed ,pad-idx) (pad-buttons ,@buttons))
  )

(defmacro cpad-hold? (pad-idx &rest buttons)
  `(logtest? (cpad-hold ,pad-idx) (pad-buttons ,@buttons))
  )

(fake-asm .sync.l)
(fake-asm .sync.p)
;; Copies the contents of a cop0 (system control) register to a gpr
(fake-asm .mfc0 dest src)
;; Copies the contents of a gpr to a cop0 (system control) register
(fake-asm .mtc0 dest src)
(fake-asm .mtpc dest src)
(fake-asm .mfpc dest src)

;; math
(defmacro seek! (place target rate)
  "Macro to use seek in-place. place is the base, and where the result is stored."
  `(set! ,place (seek ,place ,target ,rate))
  )

(defmacro seekl! (place target rate)
  "Macro to use seekl in-place. place is the base, and where the result is stored."
  `(set! ,place (seekl ,place ,target ,rate))
  )

(defmacro rand-float-gen (&key (gen *random-generator*))
  "Generate a float from [0, 1)"
  `(+ -1.0 (the-as float (logior #x3f800000 (/ (rand-uint31-gen ,gen) 256))))
  )

;; gsound-h
(defmacro sound-vol (vol)
  "convert to sound volume units"
  (if (number? vol)
      (* 1 (/ (* vol 1024) 100))
      `(the int (/ (* ,vol 1024) 100))
      )
  )

(defmacro static-sound-spec (name &key (num 1.0) &key (group 1)
                                  &key (volume #f)
                                  &key (pitch-mod 0)
                                  &key (fo-min 0) &key (fo-max 0)
                                  &key (mask ()))
  (let ((snd-mask mask)
        (snd-volume 100.0))
    (when (nonzero? fo-max) (cons! snd-mask 'fo-max))
    (when (nonzero? fo-min) (cons! snd-mask 'fo-min))
    (when (nonzero? pitch-mod) (cons! snd-mask 'pitch))
    (when volume (cons! snd-mask 'volume) (set! snd-volume volume))
    `(new 'static 'sound-spec
          :sound-name (static-sound-name ,name)
          :num ,num
          :group ,group
          :volume (sound-vol ,snd-volume)
          :pitch-mod ,pitch-mod
          :fo-min ,fo-min
          :fo-max ,fo-max
          :mask (sound-mask ,@snd-mask)
          ))
  )

;; gsound
(defmacro sound-play (name &key (id (new-sound-id))
                           &key (vol 100.0) &key (pitch 0) &key (bend 0)
                           &key (group sfx)
                           &key (position #t))
  `(sound-play-by-name (static-sound-name ,name) ,id (the int (* (/ 1024.0 100.0) ,vol)) (the int (* 1524.0 ,pitch)) ,bend (sound-group ,group) ,position)
  )

;; process-drawable
(defmacro ja-group (&key (chan 0))
  "get the frame group for self. default channel is 0, the base channel. returns #f if no frame group."
  `(if (> (-> self skel active-channels) ,chan)
       (-> self skel root-channel ,chan frame-group))
  )

(defmacro ja-group? (group &key (chan 0))
  "is self in this frame group on this channel? default is channel 0, which is the base channel."
  `(= (ja-group) ,group)
  )

(defmacro ja (&key (chan 0)
              &key (group! #f)
              &key (num! #f)
              &key (param0 #f)
              &key (param1 #f)
              &key (num-func #f)
              &key (frame-num #f)
              &key (frame-interp #f)
              &key (dist #f)
              &key (eval? #t)
              )
  "set various joint anim parameters for self and eval them.
   you can use this for playing animations!

   chan         = the channel to modify. defaults to 0 (base channel). this is usually what you want.
   group!       = when not #f, set this as the new frame-group. defaults to #f
   num!         = set the frame playback function. this is what determines what frame an animation is at. funcs below.
                  #f = no func will be set, and there wont be a frame eval.
   num-func     = sets the num-func field for the channel. this lets you change the function with eval'ing.
   param0       = 1st parameter for the playback function. ONLY USE THESE WITH num-func !!
   param1       = 2nd parameter for the playback function. ONLY USE THESE WITH num-func !!
   frame-num    = set the frame-num field.
   frame-interp = set the frame-interp field.
   dist         = set the dist field.

   available num! functions:
   - (+!)       = advance anim.
   - (-!)       = reverse anim.
   - (identity num) = play 'num' frame.
   - (seek! target speed) = animate towards frame target at a speed.
                            speed is optional and defaults to 1.0 when not provided.
                            target is optional and defaults to the last frame of the animation.
                            if you want to set the speed, you therefore must also set the target.
                            target can be max (no quote), which is just the same as the default value.
   - (loop! speed)  = loop animation at a speed. default speed is 1.0 when not provided.
   - (chan channel) = copy frame from another channel.
   - min = the start of the animation.
   - max = the end of the animation.
   "

  (let* ((num-args (if (pair? num!) (cdr num!) '()))
        (num! (if (pair? num!) (car num!) num!))
        (nf (cond
              ((or (eq? num! 'identity)
                   (eq? num! 'min)
                   (eq? num! 'max)
                   )
                   'num-func-identity)
              ((eq? num! 'none) 'num-func-none)
              ((eq? num! '+!) 'num-func-+!)
              ((eq? num! '-!) 'num-func--!)
              ((eq? num! 'seek!) 'num-func-seek!)
              ((eq? num! 'loop!) 'num-func-loop!)
              ((eq? num! 'blend-in!) 'num-func-blend-in!)
              ((eq? num! 'chan) 'num-func-chan)
              ))
        (p0 (if param0 param0
                (cond
                  ((eq? num! 'chan) `(the float ,(car num-args)))
                  ((eq? num! '+!)    (if (null? num-args) 1.0 (car num-args)))
                  ((eq? num! '-!)    (if (null? num-args) 1.0 (car num-args)))
                  ((eq? num! 'loop!) (if (null? num-args) 1.0 (if (eq? 'max (car num-args))
                                                                  (if group!
                                                                      `(the float (1- (-> (the art-joint-anim ,group!) data 0 length)))
                                                                      `(the float (1- (-> ja-ch frame-group data 0 length)))
                                                                      )
                                                                  (car num-args))))
                  ((eq? num! 'seek!) (if (or (null? num-args) (eq? (car num-args) 'max))
                                         (if group!
                                             `(the float (1- (-> (the art-joint-anim ,group!) data 0 length)))
                                             `(the float (1- (-> ja-ch frame-group data 0 length)))
                                             )
                                         (car num-args)))
                  )))
        (p1 (if param1 param1
                (cond
                  ((eq? num! 'seek!) (if (or (null? num-args) (null? (cdr num-args))) 1.0 (cadr num-args)))
                  )))
        (frame-num (if (eq? 'max frame-num) (if group!
                                                `(the float (1- (-> (the art-joint-anim ,group!) data 0 length)))
                                                `(the float (1- (-> ja-ch frame-group data 0 length)))
                                                )
                                            frame-num))
        (frame-group (if (or p0 p1 frame-num (not nf)) group! #f))
      )
  `(let ((ja-ch (-> self skel root-channel ,chan)))
      ,(if frame-interp `(set! (-> ja-ch frame-interp) ,frame-interp) `(none))
      ,(if dist `(set! (-> ja-ch dist) ,dist) `(none))
      ,(if frame-group `(set! (-> ja-ch frame-group) (the art-joint-anim ,frame-group)) `(none))
      ,(if p0 `(set! (-> ja-ch param 0) ,p0) `(none))
      ,(if p1 `(set! (-> ja-ch param 1) ,p1) `(none))
      ,(if num-func `(set! (-> ja-ch num-func) ,num-func) `(none))
      ,(if frame-num `(set! (-> ja-ch frame-num) ,frame-num) `(none))
      ,(if nf
          `(,(if eval? 'joint-control-channel-group-eval! 'joint-control-channel-group!)
              ja-ch (the art-joint-anim ,group!) ,nf)
          `(none))
      ,(cond
        ((eq? num! 'min) `(set! (-> ja-ch frame-num) 0.0))
        ((eq? num! 'max) (if group!
                             `(set! (-> ja-ch frame-num) (the float (1- (-> (the art-joint-anim ,group!) data 0 length))))
                             `(set! (-> ja-ch frame-num) (the float (1- (-> ja-ch frame-group data 0 length))))
                             ))
        ((eq? num! 'identity) `(set! (-> ja-ch frame-num) ,(car num-args)))
        (#t `(none))
        )
      ))
  )

(defmacro ja-no-eval (&key (chan 0)
                      &key (group! #f)
                      &key (num! #f)
                      &key (param0 #f)
                      &key (param1 #f)
                      &key (num-func #f)
                      &key (frame-num #f)
                      &key (frame-interp #f)
                      &key (dist #f)
                      )
  `(ja :eval? #f :chan ,chan :group! ,group! :num! ,num! :param0 ,param0 :param1 ,param1 :num-func ,num-func :frame-num ,frame-num :frame-interp ,frame-interp :dist ,dist)
  )

;; gkernel-h

(defconstant *scratch-memory-top* (the pointer #x70004000))
(defconstant DPROCESS_STACK_SIZE #x8000)

;; gkernel

(defconstant *kernel-dram-stack* (&+ *dram-stack* DPROCESS_STACK_SIZE))

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

;; generic-obs

(defmacro manipy-spawn (trans entity skel arg &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*))
  `(process-spawn manipy :init manipy-init ,trans ,entity ,skel ,arg :from ,from :to ,to :name ,name :stack-size ,stack-size :stack ,stack)
  )

;; game-h
(defmacro static-attack-info (&key (mask ()) &rest args)
  (when (!= (length args) 1)
      (error "static-attack-info can only have 1 arg"))
  (let ((mask-actual mask)
        (arg (car args))
        )
    (when (not (null? (assoc 'shove-up arg))) (cons! mask-actual 'shove-up))
    (when (not (null? (assoc 'shove-back arg))) (cons! mask-actual 'shove-back))
    (when (not (null? (assoc 'mode arg))) (cons! mask-actual 'mode))
    (when (not (null? (assoc 'vector arg))) (cons! mask-actual 'vector))
    (when (not (null? (assoc 'angle arg))) (cons! mask-actual 'angle))
    (when (not (null? (assoc 'control arg))) (cons! mask-actual 'control))
    `(let ((atk (new 'static 'attack-info :mask (attack-mask ,@mask-actual))))
        ,@(apply (lambda (x) (if (eq? (car x) 'vector)
                                 `(vector-copy! (-> atk ,(car x)) ,(cadr x))
                                 `(set! (-> atk ,(car x)) ,(cadr x))
                                )) arg)
        atk)
    )
  )

;; settings-h


(defmacro setting-control-func! (func s &rest args)
  (let ((argb #f)
        (argi 0)
        (argf 0.0)
        (setting (cadr s)))
    (cond
      ; ((or (eq? setting 'border-mode)
           ; (eq? setting 'allow-look-around)
           ; (eq? setting 'ocean-off)
           ; (eq? setting 'music)
           ; (eq? setting 'vibration)
           ; (eq? setting 'auto-save)
           ; (eq? setting 'allow-pause)
           ; (eq? setting 'allow-progress)
           ; (eq? setting 'play-hints)
           ; (eq? setting 'movie)
           ; (eq? setting 'talking)
           ; (eq? setting 'spooling)
           ; (eq? setting 'hint)
           ; (eq? setting 'ambient)
           ; )
        ; (set! argb (car args))
        ; )
      ; ((or (eq? setting 'bg-r)
           ; (eq? setting 'bg-g)
           ; (eq? setting 'bg-b)
           ; (eq? setting 'bg-a)
           ; (eq? setting 'bg-a-speed)
           ; (eq? setting 'bg-a-force)
           ; )
        ; (set! argf (car args))
        ; )
      ; ((or (eq? setting 'language)
           ; )
        ; (set! argi (car args))
        ; )
      ; ((or (eq? setting 'sound-flava)
           ; )
        ; (set! argi (car args))
        ; (set! argf (cadr args))
        ; )
      ; ((or (eq? setting 'process-mask)
           ; (eq? setting 'common-page)
           ; )
        ; (set! argb (car args))
        ; (set! argi (cadr args))
        ; )
      ; ((or (eq? setting 'sfx-volume)
           ; (eq? setting 'music-volume)
           ; (eq? setting 'ambient-volume)
           ; (eq? setting 'dialog-volume)
           ; (eq? setting 'sfx-volume-movie)
           ; (eq? setting 'music-volume-movie)
           ; (eq? setting 'ambient-volume-movie)
           ; (eq? setting 'dialog-volume-hint)
           ; )
        ; (set! argb (car args))
        ; (set! argf (cadr args))
        ; )
      (#t
        (set! argb (car args))
        (set! argf (cadr args))
        (set! argi (caddr args))
        )
      )
    `(,func *setting-control* (with-pp pp) ,s ,argb ,argf ,argi)
    )
  )

(defmacro add-setting! (s &rest args)
  `(setting-control-func! add-setting ,s ,@args)
  )
(defmacro set-setting! (s &rest args)
  `(setting-control-func! set-setting ,s ,@args)
  )
(defmacro remove-setting! (s)
  `(remove-setting *setting-control* (with-pp pp) ,s)
  )