mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 00:57:44 -04:00
fa061ef7eb
* [timer decomp] preliminary decomp * [goal-lib] add inplace macros for logior, logxor, lognor and logand * [timer decomp] Finish decomp for now * [timer decomp] OCD whitespace * [all-types] fix type consistency Sorry mr. decompiler but you will have to take the hit * [timer decomp] Fix more type consistency * [timer decomp] ACTUALLY fix it + script so I don't forget * [timer] automatically choose gpr for rlet's
488 lines
10 KiB
Common Lisp
488 lines
10 KiB
Common 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
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; compile, color, and save a file
|
|
(defmacro m (file)
|
|
`(asm-file ,file :color :write)
|
|
)
|
|
|
|
;; compile, color, save, and disassemble a file.
|
|
;; make "debug".
|
|
(defmacro md (file)
|
|
`(asm-file ,file :color :write :disassemble)
|
|
)
|
|
|
|
;; compile, color, load and save a file
|
|
(defmacro ml (file)
|
|
`(asm-file ,file :color :load :write)
|
|
)
|
|
|
|
(desfun make-build-command (file)
|
|
`(asm-file ,file :color :write)
|
|
)
|
|
|
|
|
|
(defmacro build-kernel ()
|
|
`(begin
|
|
,@(apply make-build-command all-kernel-goal-files)
|
|
(build-dgos "goal_src/build/kernel_dgos.txt")
|
|
)
|
|
)
|
|
|
|
(defmacro build-game ()
|
|
`(begin
|
|
(build-kernel)
|
|
,@(apply make-build-command all-goal-files)
|
|
(build-dgos "goal_src/build/game_dgos.txt")
|
|
)
|
|
)
|
|
|
|
(defmacro build-data ()
|
|
`(begin
|
|
(asm-data-file game-text "assets/game_text.txt")
|
|
(asm-data-file game-count "assets/game_count.txt")
|
|
)
|
|
)
|
|
|
|
(defmacro blg ()
|
|
`(begin
|
|
(build-game)
|
|
(dgo-load "kernel" global #xf #x200000)
|
|
(dgo-load "game" global #xf #x200000)
|
|
)
|
|
)
|
|
|
|
(defmacro tc ()
|
|
`(m "decompiler/config/all-types.gc")
|
|
)
|
|
|
|
(defmacro e ()
|
|
`(:exit)
|
|
)
|
|
|
|
(defmacro dbc ()
|
|
`(begin
|
|
(set-config! print-ir #t)
|
|
(set-config! print-regalloc #t)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; CONDITIONAL COMPILATION
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro #when (clause &rest body)
|
|
`(#cond (,clause ,@body))
|
|
)
|
|
|
|
(defmacro #unless (clause &rest body)
|
|
`(#cond ((not ,clause) ,@body))
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; TARGET CONTROL
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro lt (&rest args)
|
|
;; shortcut for listen-to-target. also sends a :status command to make sure
|
|
;; all buffers on the target are flushed.
|
|
`(begin
|
|
(listen-to-target ,@args)
|
|
(:status)
|
|
)
|
|
)
|
|
|
|
(defmacro r (&rest args)
|
|
;; shortcut to completely reset the target and connect, regardless of current state
|
|
`(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 ()
|
|
`(begin
|
|
(reset-target :shutdown)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; DEBUGGER MACROS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro db (&rest args)
|
|
`(:pm 1 ,@args)
|
|
)
|
|
|
|
(defmacro dh (&rest args)
|
|
`(:pm 2 ,@args)
|
|
)
|
|
|
|
(defmacro dw (&rest args)
|
|
`(:pm 4 ,@args)
|
|
)
|
|
|
|
(defmacro dd (&rest args)
|
|
`(:pm 8 ,@args)
|
|
)
|
|
|
|
(defmacro df (&rest args)
|
|
`(:pm 4 ,@args :print-mode float)
|
|
)
|
|
|
|
(defmacro segfault ()
|
|
`(-> (the (pointer int) 0))
|
|
)
|
|
|
|
(defmacro fpe ()
|
|
`(/ 0 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))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; 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))
|
|
)
|
|
)
|
|
|
|
;; Define a new function, but only if we're debugging.
|
|
;; TODO - should place the function in the debug segment!
|
|
(defmacro defun-debug (name bindings &rest body)
|
|
`(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 while (test &rest 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)
|
|
(with-gensyms (reloop)
|
|
`(begin
|
|
(label ,reloop)
|
|
,@body
|
|
(when-goto (not ,test) ,reloop)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro dotimes (var &rest body)
|
|
`(let (( ,(first var) 0))
|
|
(while (< ,(first var) ,(second var))
|
|
,@body
|
|
(+1! ,(first var))
|
|
)
|
|
,@(cddr var)
|
|
)
|
|
)
|
|
|
|
(defmacro countdown (var &rest body)
|
|
`(let ((,(first var) ,(second var)))
|
|
(while (!= ,(first var) 0)
|
|
(set! ,(first var) (- ,(first var) 1))
|
|
,@body
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Backup some values, and restore after executing body.
|
|
;; Non-dynamic (nonlocal jumps out of body will skip restore)
|
|
(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 +! (place amount)
|
|
`(set! ,place (+ ,place ,amount))
|
|
)
|
|
|
|
(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 return (val)
|
|
`(return-from #f ,val)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
;; Math Macros
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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 1- (var)
|
|
`(- ,var 1)
|
|
)
|
|
|
|
(defmacro zero? (thing)
|
|
`(eq? ,thing 0)
|
|
)
|
|
|
|
(defmacro nonzero? (thing)
|
|
`(neq? ,thing 0)
|
|
)
|
|
|
|
(defmacro &+! (val amount)
|
|
`(set! ,val (&+ ,val ,amount))
|
|
)
|
|
|
|
(defmacro &- (a b)
|
|
`(- (the-as uint ,a) (the-as uint ,b))
|
|
)
|
|
|
|
(defmacro &-> (&rest args)
|
|
`(& (-> ,@args))
|
|
)
|
|
|
|
(defmacro logior! (place amount)
|
|
`(set! ,place (logior ,place ,amount))
|
|
)
|
|
|
|
(defmacro logxor! (place amount)
|
|
`(set! ,place (logxor ,place ,amount))
|
|
)
|
|
|
|
(defmacro lognor! (place amount)
|
|
`(set! ,place (lognor ,place ,amount))
|
|
)
|
|
|
|
(defmacro logand! (place amount)
|
|
`(set! ,place (logand ,place ,amount))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Bit Macros
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defmacro align16 (value)
|
|
`(logand #xfffffff0 (+ (the-as integer ,value) 15))
|
|
)
|
|
|
|
(defmacro align64 (value)
|
|
`(logand -64 (+ (the-as int ,value) 63))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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))
|
|
)
|
|
|
|
(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))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; METHOD STUFF
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(defmacro object-new (&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*)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Decompiler Macros
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defmacro <.si (a b)
|
|
`(< (the-as int ,a) (the-as int ,b))
|
|
)
|
|
|
|
(defmacro <0.si (a)
|
|
`(< (the-as int ,a) (the-as int 0))
|
|
) |