mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
af447aeab7
* add subtitles support (tools + goal + text file). * add to build system proper * better handling of line speakers * billy test subtitles * adjust timings * better handling of subtitle timing + citadel subs * press square to toggle cutscene subtitles * improve DirectRenderer performance * clang * dont error out if there's no user files * make system supports multiple inputs for subtitles * clang * oh no typo!! * avoid future issues * fix warp gate crash * remove no longer necessary code in DirectRenderer * remove temp prints * delete triplicate code * i found a better way * fix make issues with subtitles * force avx compilation
922 lines
21 KiB
Common Lisp
922 lines
21 KiB
Common Lisp
;;-*-Lisp-*-
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; OTHER STUFF
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; get list of all goal files
|
|
(asm-file "goal_src/build/all_files.gc")
|
|
|
|
;; tell compiler about stuff defined/implemented in the runtime.
|
|
(asm-file "goal_src/kernel-defs.gc")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; BUILD SYSTEM
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro m (file)
|
|
"Make: compile a file fully and save the result"
|
|
`(asm-file ,file :color :write)
|
|
)
|
|
|
|
(defmacro md (file &rest path)
|
|
"Make Debug: make + print disassembly for a file"
|
|
(if (null? path)
|
|
`(asm-file ,file :color :write :disassemble)
|
|
`(asm-file ,file :color :write :disassemble ,(first path))
|
|
)
|
|
)
|
|
|
|
(defmacro ml (file)
|
|
"Make Load: make and load the file through the listener"
|
|
`(asm-file ,file :color :load :write)
|
|
)
|
|
|
|
(desfun make-build-command (file)
|
|
`(asm-file ,file :color :write)
|
|
)
|
|
|
|
|
|
(defmacro build-kernel ()
|
|
"Build kernel and create the KERNEL CGO"
|
|
`(begin
|
|
,@(apply make-build-command all-kernel-goal-files)
|
|
(build-dgos "goal_src/build/kernel_dgos.gc")
|
|
)
|
|
)
|
|
|
|
(defmacro build-game ()
|
|
"Build all game code and all game CGOs"
|
|
`(begin
|
|
(build-kernel)
|
|
,@(apply make-build-command all-goal-files)
|
|
(build-dgos "goal_src/build/game_dgos.gc")
|
|
)
|
|
)
|
|
|
|
(defmacro build-data ()
|
|
"Build all game data"
|
|
`(begin
|
|
(asm-data-file game-text "assets/game_text.txt")
|
|
(asm-data-file game-count "assets/game_count.txt")
|
|
(asm-data-file dir-tpages "assets/tpage-dir.txt")
|
|
)
|
|
)
|
|
|
|
(defmacro blg ()
|
|
"Build engine and kernel CGOs (code only, no data for now) and load them in the listener
|
|
Uses the blocking dgo-load."
|
|
`(begin
|
|
(build-game)
|
|
(dgo-load "kernel" global #xf #x200000)
|
|
(load-package "game" global)
|
|
)
|
|
)
|
|
|
|
(defmacro lg ()
|
|
"Load an already built game."
|
|
`(load-package "game" global)
|
|
)
|
|
|
|
(defmacro tc ()
|
|
"Typecheck against the all-types file"
|
|
`(m "decompiler/config/all-types.gc")
|
|
)
|
|
|
|
(defmacro e ()
|
|
"Exit the compiler"
|
|
`(:exit)
|
|
)
|
|
|
|
(defmacro dbc ()
|
|
"Put the compiler in debug mode"
|
|
`(begin
|
|
(set-config! print-ir #t)
|
|
(set-config! print-regalloc #t)
|
|
)
|
|
)
|
|
|
|
;; enum for text file encoding versions
|
|
(defenum game-text-version
|
|
(jak1-v1 10)
|
|
(jak1-v2 11)
|
|
(jak2 20)
|
|
(jak3 30)
|
|
(jakx 40)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; CONDITIONAL COMPILATION
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro #when (clause &rest body)
|
|
`(#cond (,clause ,@body))
|
|
)
|
|
|
|
(defmacro #unless (clause &rest body)
|
|
`(#cond ((not ,clause) ,@body))
|
|
)
|
|
|
|
(defmacro #if (clause true false)
|
|
`(#cond (,clause ,true) (#t ,false))
|
|
)
|
|
|
|
(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 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)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; TARGET CONTROL
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro lt (&rest args)
|
|
"Listen to target. Opens a connection and flushes buffers"
|
|
`(begin
|
|
(listen-to-target ,@args)
|
|
(:status)
|
|
)
|
|
)
|
|
|
|
(defmacro r (&rest args)
|
|
"Reset the target state and reconnect."
|
|
`(begin
|
|
;; connect, so we can send reset. if we're already connected, does nothing
|
|
(listen-to-target ,@args)
|
|
;; send a reset message, disconnecting us
|
|
(reset-target)
|
|
;; establish connection again
|
|
(listen-to-target ,@args)
|
|
;; flush buffers
|
|
(:status)
|
|
)
|
|
)
|
|
|
|
(defmacro shutdown-target ()
|
|
"Make the target exit. The runtime itself will exit and not restart automatically."
|
|
`(begin
|
|
(reset-target :shutdown)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; DEBUGGER MACROS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro db (&rest args)
|
|
"Print bytes."
|
|
`(:pm 1 ,@args)
|
|
)
|
|
|
|
(defmacro dh (&rest args)
|
|
"Print halfwords (16-bits)"
|
|
`(:pm 2 ,@args)
|
|
)
|
|
|
|
(defmacro dw (&rest args)
|
|
"Print words (32-bits)"
|
|
`(:pm 4 ,@args)
|
|
)
|
|
|
|
(defmacro dd (&rest args)
|
|
"Print doublewords (64-bits)"
|
|
`(:pm 8 ,@args)
|
|
)
|
|
|
|
(defmacro df (&rest args)
|
|
"Print floats (32-bit)"
|
|
`(:pm 4 ,@args :print-mode float)
|
|
)
|
|
|
|
(defmacro segfault ()
|
|
"Dereference the GOAL 0 pointer, which should be a segfault"
|
|
`(-> (the (pointer int) 0))
|
|
)
|
|
|
|
(defmacro fpe ()
|
|
"Trigger a SIGFPE by doing integer division by zero"
|
|
`(/ 0 0)
|
|
)
|
|
|
|
(defmacro break! ()
|
|
"A breakpoint. Todo - should we use int3 instead?"
|
|
`(/ 0 0)
|
|
)
|
|
|
|
(defmacro crash! ()
|
|
"Cause a crash by attempting to deference 0x0"
|
|
`(-> (the (pointer uint8) 0))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; GOAL Syntax
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; Bind vars in body
|
|
(defmacro let (bindings &rest body)
|
|
`((lambda :inline-only #t ,(apply first bindings) ,@body)
|
|
,@(apply second bindings)))
|
|
|
|
;; Let, but recursive, allowing you to define variables in terms of others.
|
|
(defmacro let* (bindings &rest body)
|
|
(if (null? bindings)
|
|
`(begin ,@body)
|
|
`((lambda :inline-only #t (,(caar bindings))
|
|
(let* ,(cdr bindings) ,@body))
|
|
,(car (cdar bindings))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; mlet, but recursive, allowing you to define variables in terms of others.
|
|
(defmacro mlet* (bindings &rest body)
|
|
(if (null? bindings)
|
|
`(begin ,@body)
|
|
`((lambda :inline-only #t (,(caar bindings))
|
|
(mlet* ,(cdr bindings) ,@body))
|
|
,(car (cdar bindings))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Define a new function
|
|
(defmacro defun (name 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 ,bindings ,@(cdr body)))
|
|
;; otherwise don't ignore it.
|
|
`(define ,name (lambda :name ,name ,bindings ,@body))
|
|
)
|
|
)
|
|
|
|
;; the compiler can't figure out types of a recursive function without
|
|
;; first knowing the return type, so we use this form to forward declare
|
|
;; and define a function.
|
|
(defmacro defun-recursive (name return-type bindings &rest body)
|
|
`(begin
|
|
(define-extern ,name
|
|
(function ,@(apply (lambda (x)
|
|
(if (pair? x)
|
|
(second x)
|
|
'object)
|
|
)
|
|
bindings)
|
|
,return-type))
|
|
(defun ,name ,bindings ,@body)
|
|
)
|
|
)
|
|
|
|
(defmacro defun-extern (function-name &rest type-info)
|
|
`(define-extern ,function-name (function ,@type-info))
|
|
)
|
|
|
|
(defmacro defun-debug (name bindings &rest body)
|
|
"Define a function which is only present in debug mode. Otherwise the function becomes nothing"
|
|
`(if *debug-segment*
|
|
,(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 :segment debug ,bindings ,@(cdr body)))
|
|
;; otherwise don't ignore it.
|
|
`(define ,name (lambda :name ,name :segment debug ,bindings ,@body))
|
|
)
|
|
|
|
;; function not loaded, set function to the nothing function.
|
|
;; we don't typecheck this.
|
|
(define :no-typecheck #t ,name nothing)
|
|
)
|
|
)
|
|
|
|
(defmacro define-perm (name type value)
|
|
"Define 'permanent', meaning the original definition will not be blown away by a file reload.
|
|
If the value of the symbol is unset (zero) or set to false, it will be defined.
|
|
Otherwise, no effect, other than to inform the type system of the symbol type."
|
|
`(begin
|
|
(define-extern ,name ,type)
|
|
(if (or (not ,name) (zero? ,name))
|
|
(set! ,name ,value)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro while (test &rest body)
|
|
"While loop. The test is evaluated before body."
|
|
(with-gensyms (reloop test-exit)
|
|
`(begin
|
|
(goto ,test-exit)
|
|
(label ,reloop)
|
|
,@body
|
|
(label ,test-exit)
|
|
(when-goto ,test ,reloop)
|
|
#f
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro until (test &rest body)
|
|
"Until loop. The body is evaluated before the test."
|
|
(with-gensyms (reloop)
|
|
`(begin
|
|
(label ,reloop)
|
|
,@body
|
|
(when-goto (not ,test) ,reloop)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro dotimes (var &rest body)
|
|
"Loop like for (int i = 0; i < end; i++)
|
|
var is a list made up of a variable to bind the amount to (second item), and the remaining forms are evaluated after the loop is finished."
|
|
`(let (( ,(first var) 0))
|
|
(while (< ,(first var) ,(second var))
|
|
,@body
|
|
(1+! ,(first var))
|
|
)
|
|
,@(cddr var)
|
|
)
|
|
)
|
|
|
|
(defmacro countdown (var &rest body)
|
|
"Loop like for (int i = end; i-- > 0)"
|
|
`(let ((,(first var) ,(second var)))
|
|
(while (!= ,(first var) 0)
|
|
(set! ,(first var) (- ,(first var) 1))
|
|
,@body
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro loop (&rest body)
|
|
"Loop this code forever."
|
|
`(while #t
|
|
,@body)
|
|
)
|
|
|
|
(defmacro doarray (bindings &rest body)
|
|
"iterate over an array. usage: (doarray (<array entry name> <array>) <code>)"
|
|
|
|
(with-gensyms (len i)
|
|
(let ((val (first bindings))
|
|
(arr (second bindings)))
|
|
|
|
`(let* ((,len (-> ,arr length))
|
|
(,i 0)
|
|
(,val (-> ,arr ,i)))
|
|
(while (< ,i ,len)
|
|
,@body
|
|
(1+! ,i)
|
|
(set! ,val (-> ,arr ,i))
|
|
)
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
)
|
|
|
|
;; Backup some values, and restore after executing body.
|
|
;; Non-dynamic (nonlocal jumps out of body will skip restore)
|
|
;; NOTE : GOAL protected defs in a FIFO manner (this is FILO/LIFO), this should be fixed at some point
|
|
(defmacro protect (defs &rest body)
|
|
(if (null? defs)
|
|
;; nothing to backup, just insert body (base case)
|
|
`(begin ,@body)
|
|
|
|
;; a unique name for the thing we are backing up
|
|
(with-gensyms (backup)
|
|
;; store the original value of the first def in backup
|
|
`(let ((,backup ,(first defs)))
|
|
;; backup any other things which need backing up
|
|
(protect ,(cdr defs)
|
|
;; execute the body
|
|
,@body
|
|
)
|
|
;; restore the first thing
|
|
(set! ,(first defs) ,backup)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro if (condition true-case &rest others)
|
|
(if (> (length others) 1)
|
|
(error "got too many arguments to if")
|
|
#f
|
|
)
|
|
(if (null? others)
|
|
`(cond (,condition ,true-case))
|
|
`(cond (,condition ,true-case)
|
|
(else ,(first others))
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro when (condition &rest body)
|
|
`(if ,condition
|
|
(begin ,@body)
|
|
)
|
|
)
|
|
|
|
(defmacro unless (condition &rest body)
|
|
`(if (not ,condition)
|
|
(begin ,@body)
|
|
)
|
|
)
|
|
|
|
(defmacro swhen (condition &rest body)
|
|
"Same as when, but saves the branch condition onto a variable named bc"
|
|
|
|
`(let ((bc ,condition))
|
|
(if bc
|
|
(begin ,@body)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro return (val)
|
|
`(return-from #f ,val)
|
|
)
|
|
|
|
|
|
(defmacro empty ()
|
|
"The decompiler may use (empty) as the body of a loop with nothing in it."
|
|
`(none)
|
|
)
|
|
|
|
(defmacro case (switch &key (comp =) &rest cases)
|
|
"A switch-case construct. switch is saved onto a local variable and compared against each case, sequentially.
|
|
else can be used like the 'default' case, but it must be the last one."
|
|
|
|
(with-gensyms (sw)
|
|
;; save the switch to a variable (only evaluated once)
|
|
`(let ((sw ,switch))
|
|
;; build the cond construct with each case
|
|
(cond ,@(apply
|
|
(lambda (x) `(
|
|
;; each case is of format ((cond cond cond...) body)
|
|
,@(let ((conditions (first x)) ;; list of conditions, OR just else
|
|
(body (rest x))) ;; the body
|
|
|
|
(cond
|
|
;; if the condition is just 'else'
|
|
( (eq? conditions 'else)
|
|
`(else ,@body)
|
|
)
|
|
;; if the list is made up of a single condition
|
|
( (= (length conditions) 1)
|
|
`((,comp sw ,(first conditions)) ,@body)
|
|
)
|
|
;; otherwise it is made up of multiple conditions, or them together!
|
|
(#t
|
|
`((or ,@(apply (lambda (c) `(,comp sw ,c)) conditions)) ,@body)
|
|
)
|
|
)
|
|
|
|
)
|
|
)
|
|
)
|
|
cases)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro case-str (switch &rest cases)
|
|
"Same as case, but for string comparisons instead."
|
|
|
|
`(case ,switch ,@cases :comp string=)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; Math Macros
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro 1+ (var)
|
|
`(+ ,var 1)
|
|
)
|
|
|
|
(defmacro +! (place amount)
|
|
`(set! ,place (+ ,place ,amount))
|
|
)
|
|
|
|
(defmacro 1+! (place)
|
|
`(set! ,place (+ 1 ,place))
|
|
)
|
|
|
|
(defmacro 1- (var)
|
|
`(- ,var 1)
|
|
)
|
|
|
|
(defmacro -! (place amount)
|
|
`(set! ,place (- ,place ,amount))
|
|
)
|
|
|
|
(defmacro 1-! (place)
|
|
`(set! ,place (- 1 ,place))
|
|
)
|
|
|
|
(defmacro *! (place amount)
|
|
`(set! ,place (* ,place ,amount))
|
|
)
|
|
|
|
(defmacro /! (place amount)
|
|
`(set! ,place (/ ,place ,amount))
|
|
)
|
|
|
|
(defmacro zero? (thing)
|
|
`(eq? ,thing 0)
|
|
)
|
|
|
|
(defmacro nonzero? (thing)
|
|
`(neq? ,thing 0)
|
|
)
|
|
|
|
(defmacro not! (var)
|
|
`(set! ,var (not ,var)))
|
|
(defmacro true! (var)
|
|
`(set! ,var #t))
|
|
(defmacro false! (var)
|
|
`(set! ,var #f))
|
|
|
|
(defmacro minmax (val minval maxval)
|
|
`(max (min ,val ,maxval) ,minval)
|
|
)
|
|
(defmacro fminmax (val minval maxval)
|
|
`(fmax (fmin ,val ,maxval) ,minval)
|
|
)
|
|
|
|
(defmacro maxmin (val minval maxval)
|
|
`(min (max ,val ,maxval) ,minval)
|
|
)
|
|
(defmacro fmaxmin (val minval maxval)
|
|
`(fmin (fmax ,val ,maxval) ,minval)
|
|
)
|
|
|
|
(defmacro &+! (val amount)
|
|
`(set! ,val (&+ ,val ,amount))
|
|
)
|
|
|
|
(defmacro &- (a b)
|
|
`(- (the-as int ,a) (the-as int ,b))
|
|
)
|
|
|
|
(defmacro &-> (&rest args)
|
|
`(& (-> ,@args))
|
|
)
|
|
|
|
(defmacro logior! (place amount)
|
|
`(set! ,place (logior ,place ,amount))
|
|
)
|
|
|
|
(defmacro logxor! (place amount)
|
|
`(set! ,place (logxor ,place ,amount))
|
|
)
|
|
|
|
(defmacro logand! (place amount)
|
|
`(set! ,place (logand ,place ,amount))
|
|
)
|
|
|
|
(defmacro logclear (a b)
|
|
"Returns the result of setting the bits in b to zero in a"
|
|
;; put a first so the return type matches a.
|
|
`(logand ,a (lognot ,b))
|
|
)
|
|
|
|
(defmacro logclear! (a b)
|
|
"Sets the bits in b to zero in a, in place"
|
|
`(set! ,a (logand ,a (lognot ,b)))
|
|
)
|
|
|
|
(defmacro logtest? (a b)
|
|
"does a have any of the bits in b?"
|
|
`(nonzero? (logand ,a ,b))
|
|
)
|
|
|
|
(defmacro logtesta? (a b)
|
|
"does a have ALL of the bits in b?"
|
|
`(= (logand ,b ,a) ,b)
|
|
)
|
|
|
|
(defmacro deref (t addr &rest fields)
|
|
`(-> (the-as (pointer ,t) ,addr) ,@fields)
|
|
)
|
|
|
|
(defmacro &deref (t addr &rest fields)
|
|
`(&-> (the-as (pointer ,t) ,addr) ,@fields)
|
|
)
|
|
|
|
(defmacro shift-arith-right-32 (result in sa)
|
|
`(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa)))
|
|
)
|
|
|
|
(defmacro /-0-guard (a b)
|
|
"same as divide but returns -1 when divisor is zero (EE-like)."
|
|
`(let ((divisor ,b))
|
|
(if (zero? divisor)
|
|
-1
|
|
(/ ,a divisor))
|
|
)
|
|
)
|
|
|
|
(defmacro mod-0-guard (a b)
|
|
"same as divide but returns the remainder when divisor is zero (EE-like)."
|
|
`(let ((divisor ,b))
|
|
(if (zero? divisor)
|
|
,a
|
|
(mod ,a divisor))
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Bit Macros
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defmacro align-n (val n)
|
|
"align val to n-byte boundaries"
|
|
`(logand (- ,n) (+ (the-as int ,val) (- ,n 1)))
|
|
)
|
|
|
|
(defmacro align16 (val)
|
|
`(align-n ,val 16)
|
|
)
|
|
|
|
(defmacro align64 (val)
|
|
`(align-n ,val 64)
|
|
)
|
|
|
|
(defmacro bit-field (type val base size &key (signed #t))
|
|
"extract bits from an integer value."
|
|
(when (and (integer? base) (integer? size))
|
|
(when (> (+ base size) 64)
|
|
(error "cannot extract fields across 64-bit boundaries"))
|
|
(when (< base 0)
|
|
(error "bitfield base cannot be negative"))
|
|
(when (< size 0)
|
|
(error "bitfield size cannot be negative"))
|
|
)
|
|
`(,(if signed 'sar 'shr) (shl ,val (- 64 (+ ,size ,base))) (- 64 ,size))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; TYPE STUFF
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro basic? (obj)
|
|
;; todo, make this more efficient
|
|
`(= 4 (logand (the integer ,obj) #b111))
|
|
)
|
|
|
|
(defmacro pair? (obj)
|
|
;; todo, make this more efficient
|
|
;`(= 2 (logand (the integer ,obj) #b111))
|
|
`(< (shl (the-as int ,obj) 62) 0)
|
|
)
|
|
|
|
(defmacro not-pair? (obj)
|
|
`(>= (shl (the-as int ,obj) 62) 0)
|
|
)
|
|
|
|
(defmacro binteger? (obj)
|
|
`(zero? (logand (the integer ,obj) #b111))
|
|
)
|
|
|
|
(defmacro rtype-of (obj)
|
|
`(cond ((binteger? ,obj) binteger)
|
|
((pair? ,obj) pair)
|
|
(else (-> (the basic ,obj) type))
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; PAIR STUFF
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(defmacro cons (a b)
|
|
`(new 'global 'pair ,a ,b)
|
|
)
|
|
|
|
(defmacro list (&rest args)
|
|
(if (null? args)
|
|
(quote '())
|
|
`(cons ,(car args) (list ,@(cdr args)))
|
|
)
|
|
)
|
|
|
|
(defmacro null? (arg)
|
|
;; todo, make this better
|
|
`(eq? ,arg '())
|
|
)
|
|
|
|
(defmacro caar (arg)
|
|
`(car (car ,arg))
|
|
)
|
|
|
|
(defmacro cadr (arg)
|
|
`(car (cdr ,arg))
|
|
)
|
|
|
|
(defmacro cddr (arg)
|
|
`(cdr (cdr ,arg))
|
|
)
|
|
|
|
(defmacro caddr (arg)
|
|
`(car (cdr (cdr ,arg)))
|
|
)
|
|
|
|
(defmacro cadddr (arg)
|
|
`(car (cdr (cdr (cdr ,arg))))
|
|
)
|
|
|
|
(defmacro dcons (a b)
|
|
`(new 'debug 'pair ,a ,b)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; METHOD STUFF
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(defmacro object-new (allocation type-to-make &rest sz)
|
|
(if (null? sz)
|
|
`(the ,(current-method-type) ((method-of-type object new) ,allocation ,type-to-make (the int (-> ,type-to-make size))))
|
|
`(the ,(current-method-type) ((method-of-type object new) ,allocation ,type-to-make ,@sz))
|
|
)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; TEST STUFF
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro expect-eq (a b &key (name "unknown"))
|
|
`(if (!= ,a ,b)
|
|
(format #t "Test Failed On Test ~D: ~A~%" *test-count* ,name)
|
|
(+! *test-count* 1)
|
|
)
|
|
)
|
|
|
|
(defmacro expect-true (a)
|
|
`(expect-eq ,a #t)
|
|
)
|
|
|
|
(defmacro expect-false (a)
|
|
`(expect-eq ,a #f)
|
|
)
|
|
|
|
(defmacro start-test (test-name)
|
|
`(begin
|
|
(define *test-name* ,test-name)
|
|
(define *test-count* 0)
|
|
)
|
|
)
|
|
|
|
(defmacro finish-test ()
|
|
`(format #t "Test ~A: ~D Passes~%" *test-name* *test-count*)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; (Fake) MIPS Macros
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; these are macros for MIPS instructions which we may want to keep in the source code for
|
|
;; readibility/curiosity/documentation, but will not translate into any actual instructions at all
|
|
|
|
;; A macro that generates a macro for the specified instruction
|
|
(defmacro fake-asm (asm-name &rest args)
|
|
`(defmacro ,asm-name (,@args) `(none))
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Build System
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro makeo (object-name &rest flags)
|
|
"Make the given object. Can use a string, or not."
|
|
`(make ,(string-append
|
|
"out/obj/"
|
|
(if (string? object-name) object-name (symbol->string object-name))
|
|
".o"
|
|
)
|
|
,@flags)
|
|
)
|
|
|
|
(defmacro make-cgo (file)
|
|
`(make ,(string-append "out/iso/" file ".CGO"))
|
|
)
|
|
|
|
(defmacro make-dgo (file)
|
|
`(make ,(string-append "out/iso/" file ".DGO"))
|
|
)
|
|
|
|
(defmacro make-group (name &key (verbose #f) &key (force #f))
|
|
`(make ,(string-append "GROUP:" name) :verbose ,verbose :force ,force)
|
|
)
|
|
|
|
(defmacro rl ()
|
|
`(begin
|
|
(make-group "iso")
|
|
(lg)
|
|
(dbg)
|
|
)
|
|
)
|
|
|
|
(defmacro mi ()
|
|
"Make ISO"
|
|
`(make-group "iso")
|
|
)
|
|
|
|
(defmacro mng ()
|
|
"Make engine"
|
|
`(make-group "engine")
|
|
)
|
|
|
|
(defmacro mh1 ()
|
|
"Make hub1"
|
|
`(make-group "hub1")
|
|
)
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; enum stuff
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro enum->string (enum input)
|
|
"return the name of an enum value"
|
|
|
|
`(case ,input
|
|
,@(apply (lambda (x) `(((,enum ,(car x) )) ,(symbol->string (car x) ) )) (reverse (get-enum-vals enum)))
|
|
(else "*unknown*")
|
|
)
|
|
)
|
|
|
|
(defmacro bit-enum->string (enum input stream)
|
|
"print the enum bits in input to stream"
|
|
|
|
(with-gensyms (val str)
|
|
`(let ((,val ,input)
|
|
(,str ,stream))
|
|
|
|
,@(apply (lambda (x)
|
|
`(if (logtesta? ,val (,enum ,(car x)))
|
|
(format ,str ,(fmt #f "{} " (car x)))
|
|
)
|
|
|
|
) (reverse (get-enum-vals enum)))
|
|
|
|
)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; float macros
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(defmacro fabs (x)
|
|
"Floating point absolute value"
|
|
;; in GOAL this was implemented by the compiler.
|
|
;; at some point, this could be more optimized.
|
|
;; MIPS has an explicit abs.s instruction, but x86-64 doesn't.
|
|
;; modern clang on O3 does a comiss/branch and this is probably pretty close.
|
|
`(if (< (the float ,x) 0)
|
|
(- (the float ,x))
|
|
(the float ,x))
|
|
)
|
|
|
|
(defmacro sqrtf (x)
|
|
`(sqrtf-no-fabs (fabs ,x))
|
|
)
|
|
|
|
;; load the default project
|
|
(load-project "goal_src/game.gp")
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; user stuf
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro __get-user ()
|
|
`(quote ,*user*)
|
|
)
|
|
|
|
(defconstant *user* (__get-user))
|
|
|
|
|
|
|
|
|