mirror of
https://github.com/open-goal/jak-project.git
synced 2024-11-23 22:29:53 +00:00
18ddd1613c
Adds support for adding custom subtitles to Jak 2 audio. Comes with a new editor for the new system and format. Compared to the Jak 1 system, this is much simpler to make an editor for. Comes with a few subtitles already made as an example. Cutscenes are not officially supported but you can technically subtitle those with editor, so please don't right now. This new system supports multiple subtitles playing at once (even from a single source!) and will smartly push the subtitles up if there's a message already playing: ![image](https://github.com/open-goal/jak-project/assets/7569514/033e6374-a05a-4c31-b029-51868153a932) ![image](https://github.com/open-goal/jak-project/assets/7569514/5298aa6d-a183-446e-bdb6-61c4682df917) Unlike in Jak 1, it will not hide the bottom HUD when subtitles are active: ![image](https://github.com/open-goal/jak-project/assets/7569514/d466bfc0-55d0-4689-a6e1-b7784b9fff59) Sadly this leaves us with not much space for the subtitle region (and the subtitles are shrunk when the minimap is enabled) but when you have guards and citizens talking all the time, hiding the HUD every time anyone spoke would get really frustrating. The subtitle speaker is also color-coded now, because I thought that would be fun to do. TODO: - [x] proper cutscene support. - [x] merge mode for cutscenes so we don't have to rewrite the script? --------- Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
1062 lines
25 KiB
Common Lisp
1062 lines
25 KiB
Common Lisp
;;-*-Lisp-*-
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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)
|
|
)
|
|
|
|
(desfun run-frontend-command (file)
|
|
`(asm-file ,file :no-code)
|
|
)
|
|
|
|
(defmacro load-imports ()
|
|
`(begin
|
|
,@(apply run-frontend-command all-import-files)
|
|
)
|
|
)
|
|
|
|
(defmacro build-kernel ()
|
|
"Build kernel and create the KERNEL CGO"
|
|
`(make-cgo "KERNEL")
|
|
)
|
|
|
|
(defmacro build-game ()
|
|
"Build all game code and all game CGOs"
|
|
`(make-group "all-code")
|
|
)
|
|
|
|
(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 (link-flag output-load-msg output-load-true-msg execute-login print-login) #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/jak1/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)
|
|
)
|
|
)
|
|
|
|
(defmacro import (file-name)
|
|
`(asm-file ,file-name :no-code)
|
|
)
|
|
|
|
;; 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 :immediate #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 :immediate #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 :immediate #t (,(caar bindings))
|
|
(mlet* ,(cdr bindings) ,@body))
|
|
,(car (cdar bindings))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Define a new function
|
|
(defmacro defun (name bindings &rest body)
|
|
(let ((docstring ""))
|
|
(when (and (> (length body) 1) (string? (first body)))
|
|
(set! docstring (first body))
|
|
(set! body (cdr body)))
|
|
`(define ,name ,docstring (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-once (name value)
|
|
"define once. Does not set the symbol if it already has a value. It must have been at least forward-declared first!"
|
|
`(begin
|
|
(if (or (not ,name) (zero? ,name))
|
|
(set! ,name ,value)
|
|
)
|
|
)
|
|
)
|
|
|
|
(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)
|
|
(define-once ,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 aif (condition true &rest false)
|
|
"Anaphoric if, similar to Common Lisp"
|
|
|
|
`(let ((it ,condition))
|
|
(if it
|
|
,true
|
|
,@false
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro awhen (condition &rest body)
|
|
"Anaphoric when"
|
|
|
|
`(aif ,condition (begin ,@body) #f)
|
|
)
|
|
|
|
(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.
|
|
comp is the function to use when evaluating the clauses. It can be any valid head of a form (operator or call)."
|
|
|
|
(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=)
|
|
)
|
|
|
|
(defmacro dolist (bindings &rest body)
|
|
`(let ((,(car bindings) ,(cadr bindings)))
|
|
(while (not (null? ,(car bindings)))
|
|
,@body
|
|
|
|
(set! ,(car bindings) (cdr ,(car bindings)))
|
|
)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; Math Macros
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro 1+ (var)
|
|
`(+ ,var 1)
|
|
)
|
|
|
|
(defmacro inc (val)
|
|
"Increments a value"
|
|
`(1+ ,val))
|
|
|
|
(defmacro +! (place amount)
|
|
`(set! ,place (+ ,place ,amount))
|
|
)
|
|
|
|
(defmacro 1+! (place)
|
|
`(+! ,place 1)
|
|
)
|
|
|
|
(defmacro 1- (var)
|
|
`(+ ,var -1)
|
|
)
|
|
|
|
(defmacro dec (val)
|
|
"Decrements a value"
|
|
`(1- ,val))
|
|
|
|
(defmacro -! (place amount)
|
|
`(set! ,place (- ,place ,amount))
|
|
)
|
|
|
|
(defmacro 1-! (place)
|
|
`(-! ,place 1)
|
|
)
|
|
|
|
(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 or! (place &rest args)
|
|
`(set! ,place (or ,place ,@args))
|
|
)
|
|
|
|
(defmacro not! (var)
|
|
`(set! ,var (not ,var)))
|
|
|
|
(defmacro true! (var)
|
|
`(set! ,var #t))
|
|
|
|
(defmacro false! (var)
|
|
`(set! ,var #f))
|
|
|
|
(defmacro max! (val maxval)
|
|
`(set! ,val (max ,val ,maxval)))
|
|
(defmacro min! (val minval)
|
|
`(set! ,val (min ,val ,minval)))
|
|
|
|
(defmacro minmax (val minval maxval)
|
|
`(max (min ,val ,maxval) ,minval)
|
|
)
|
|
|
|
(defmacro fminmax (val minval maxval)
|
|
`(fmax (fmin ,val ,maxval) ,minval)
|
|
)
|
|
(defmacro minmax! (val minval maxval)
|
|
`(set! ,val (max (min ,val ,maxval) ,minval))
|
|
)
|
|
(defmacro fminmax! (val minval maxval)
|
|
`(set! ,val (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 sext32 (in)
|
|
`(sar (shl ,in 32) 32)
|
|
)
|
|
|
|
(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 modulo but returns the dividend when divisor is zero (EE-like)."
|
|
`(let ((divisor ,b))
|
|
(if (zero? divisor)
|
|
,a
|
|
(mod ,a divisor))
|
|
)
|
|
)
|
|
|
|
(defmacro float->int (a)
|
|
"forcefully casts something as a float to int. be careful."
|
|
`(the int (the float ,a))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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)
|
|
)
|
|
|
|
(defmacro cons! (lst val)
|
|
`(set! ,lst (cons ,val ,lst))
|
|
)
|
|
|
|
(defmacro swap! (a b)
|
|
"macro for swapping 2 variables"
|
|
`(let ((temp ,a))
|
|
(set! ,a ,b)
|
|
(set! ,b temp)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; ARRAYS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro first-arr (coll)
|
|
"Returns the first element in an array"
|
|
`(-> ,coll 0))
|
|
|
|
(defmacro last-arr (coll)
|
|
"Returns the last element in an array"
|
|
`(-> ,coll (dec (length ,coll))))
|
|
|
|
(defmacro last-idx-arr (coll)
|
|
"Returns the index of the last element in an array"
|
|
`(dec (length ,coll)))
|
|
|
|
(defmacro arr-idx-of (coll val def)
|
|
"Returns the index of an item in an array, returns <def> if is nothing is found."
|
|
`(block find-element
|
|
(dotimes (i (length ,coll))
|
|
(if (= ,val (-> ,coll i))
|
|
(return-from find-element i)))
|
|
,def))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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/"
|
|
(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 mkr ()
|
|
"Make kernel"
|
|
`(make-group "kernel")
|
|
)
|
|
|
|
(defmacro mng ()
|
|
"Make engine"
|
|
`(make-group "engine")
|
|
)
|
|
|
|
(defmacro make-text ()
|
|
"Make Text"
|
|
`(make-group "text")
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; 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)))
|
|
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro doenum (bindings &rest body)
|
|
"run body while iterating through an enum.
|
|
WARNING: enums are NOT A RUNTIME TYPE! There is an UNWOUND loop with body in it!! Use with caution."
|
|
;; (doenum (name-var val-var enum &rest result) &rest body)
|
|
|
|
`(begin ,@(apply (lambda (x)
|
|
;; (fmt #t "{}\n" x)
|
|
`(let (
|
|
(,(first bindings) ,(symbol->string (car x))) ;; name
|
|
(,(second bindings) ,(cdr x)) ;; value
|
|
)
|
|
,@body
|
|
)) (get-enum-vals (third bindings))))
|
|
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; 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))
|
|
)
|
|
|
|
(defmacro basically-zero? (val)
|
|
"Checks if the value is within 0.000000000000000001 of zero (to solve float comparison bugs)"
|
|
`(<= (fabs (- ,val 0.0))
|
|
0.000000000000000001))
|
|
|
|
(defmacro basically-not-zero? (val)
|
|
"Checks if the value is NOT within 0.000000000000000001 of zero (to solve float comparison bugs)"
|
|
`(> (fabs (- ,val 0.0))
|
|
0.000000000000000001))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; user stuf
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro get-user ()
|
|
`(quote ,*user*)
|
|
)
|
|
|
|
(defmacro user? (&rest users)
|
|
(cond
|
|
((null? users) #f)
|
|
((eq? *user* (car users)) #t)
|
|
(#t `(user? ,@(cdr users)))
|
|
)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; art stuff
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro def-art-elt (group name idx)
|
|
"define a new art element. adds it to a global map stored in goos."
|
|
|
|
;; grab data about the art group
|
|
(let* ((group-string (symbol->string group))
|
|
(name-string (symbol->string name))
|
|
(ag-info-lookup (hash-table-try-ref *art-info* group-string))
|
|
(ag-info-exists (car ag-info-lookup))
|
|
(ag-info (cdr ag-info-lookup))
|
|
)
|
|
;; no art group was found, make a new one and add it.
|
|
(when (not ag-info-exists)
|
|
(set! ag-info (make-string-hash-table))
|
|
(hash-table-set! *art-info* group-string ag-info)
|
|
)
|
|
;; lookup art element in our art group
|
|
(let* ((elt-info-lookup (hash-table-try-ref ag-info name-string))
|
|
(elt-info-exists (car elt-info-lookup))
|
|
(elt-new (list name idx))) ;; this is the format of the individual entries
|
|
;; found, check if valid
|
|
(if (and elt-info-exists (not (eq? (cdr elt-info-lookup) elt-new)))
|
|
(fmt #t "error redefining art element. data mismatch: {}" elt-info elt-new)
|
|
#f)
|
|
;; not found. add to the art-group.
|
|
(when (not elt-info-exists)
|
|
(hash-table-set! ag-info name-string elt-new)
|
|
)
|
|
)
|
|
)
|
|
;; define a constant for it!
|
|
`(defconstant ,name (-> self draw art-group data ,idx))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; built-in type stuff
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro string? (val)
|
|
`(type? ,val string))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Load Project
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(#cond
|
|
((eq? GAME_VERSION 'jak1)
|
|
(asm-file "goal_src/jak1/compiler-setup.gc")
|
|
(seval (fmt #t "Jak 1 Mode\n"))
|
|
)
|
|
((eq? GAME_VERSION 'jak2)
|
|
(asm-file "goal_src/jak2/compiler-setup.gc")
|
|
(seval (fmt #t "Jak 2 Mode\n"))
|
|
)
|
|
)
|