2021-02-09 20:59:14 -05:00
|
|
|
;;-*-Lisp-*-
|
|
|
|
|
2020-09-12 20:41:12 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; BUILD SYSTEM
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
2020-09-06 17:42:20 -04:00
|
|
|
(defmacro m (file)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Make: compile a file fully and save the result"
|
2020-09-06 17:42:20 -04:00
|
|
|
`(asm-file ,file :color :write)
|
|
|
|
)
|
|
|
|
|
2021-06-01 16:07:45 -04:00
|
|
|
(defmacro md (file &rest path)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Make Debug: make + print disassembly for a file"
|
2021-06-12 12:55:38 -04:00
|
|
|
(if (null? path)
|
|
|
|
`(asm-file ,file :color :write :disassemble)
|
|
|
|
`(asm-file ,file :color :write :disassemble ,(first path))
|
|
|
|
)
|
2020-12-01 21:39:46 -05:00
|
|
|
)
|
|
|
|
|
2023-10-29 06:16:14 -04:00
|
|
|
(defmacro mda (file &rest path)
|
|
|
|
"Make Debug Asm Only: make + print disassembly (asm-only mode) for a file"
|
|
|
|
(if (null? path)
|
|
|
|
`(asm-file ,file :color :write :disassemble :disasm-code-only)
|
2023-10-29 23:20:02 -04:00
|
|
|
`(asm-file ,file :color :write :disassemble ,(first path) :disasm-code-only)
|
2023-10-29 06:16:14 -04:00
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-09-06 17:42:20 -04:00
|
|
|
(defmacro ml (file)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Make Load: make and load the file through the listener"
|
2020-09-06 17:42:20 -04:00
|
|
|
`(asm-file ,file :color :load :write)
|
2020-09-07 13:28:16 -04:00
|
|
|
)
|
|
|
|
|
2020-09-12 20:41:12 -04:00
|
|
|
(desfun make-build-command (file)
|
|
|
|
`(asm-file ,file :color :write)
|
|
|
|
)
|
|
|
|
|
2022-05-19 21:30:14 -04:00
|
|
|
(desfun run-frontend-command (file)
|
|
|
|
`(asm-file ,file :no-code)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro load-imports ()
|
|
|
|
`(begin
|
|
|
|
,@(apply run-frontend-command all-import-files)
|
|
|
|
)
|
|
|
|
)
|
2020-12-08 21:41:36 -05:00
|
|
|
|
|
|
|
(defmacro build-kernel ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Build kernel and create the KERNEL CGO"
|
2022-05-19 17:08:01 -04:00
|
|
|
`(make-cgo "KERNEL")
|
2020-12-08 21:41:36 -05:00
|
|
|
)
|
|
|
|
|
2020-09-12 20:41:12 -04:00
|
|
|
(defmacro build-game ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Build all game code and all game CGOs"
|
2022-05-19 17:08:01 -04:00
|
|
|
`(make-group "all-code")
|
2020-09-12 20:41:12 -04:00
|
|
|
)
|
|
|
|
|
2020-09-13 17:34:02 -04:00
|
|
|
(defmacro blg ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Build engine and kernel CGOs (code only, no data for now) and load them in the listener
|
|
|
|
Uses the blocking dgo-load."
|
2020-09-13 17:34:02 -04:00
|
|
|
`(begin
|
|
|
|
(build-game)
|
2022-06-05 15:20:33 -04:00
|
|
|
(dgo-load "kernel" global (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000)
|
2021-06-30 19:20:31 -04:00
|
|
|
(load-package "game" global)
|
2020-09-13 17:34:02 -04:00
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2021-06-27 22:23:27 -04:00
|
|
|
(defmacro lg ()
|
|
|
|
"Load an already built game."
|
2021-06-30 19:20:31 -04:00
|
|
|
`(load-package "game" global)
|
2021-06-27 22:23:27 -04:00
|
|
|
)
|
|
|
|
|
2020-10-24 22:51:40 -04:00
|
|
|
(defmacro tc ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Typecheck against the all-types file"
|
2023-03-08 20:07:26 -05:00
|
|
|
`(m "decompiler/config/jak1/all-types.gc")
|
2020-10-24 22:51:40 -04:00
|
|
|
)
|
|
|
|
|
2020-09-07 13:28:16 -04:00
|
|
|
(defmacro e ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Exit the compiler"
|
2020-09-07 13:28:16 -04:00
|
|
|
`(:exit)
|
|
|
|
)
|
|
|
|
|
2020-12-08 21:41:36 -05:00
|
|
|
(defmacro dbc ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Put the compiler in debug mode"
|
2020-09-14 20:24:05 -04:00
|
|
|
`(begin
|
|
|
|
(set-config! print-ir #t)
|
|
|
|
(set-config! print-regalloc #t)
|
|
|
|
)
|
|
|
|
)
|
2020-09-13 10:40:21 -04:00
|
|
|
|
2022-05-23 18:53:02 -04:00
|
|
|
(defmacro import (file-name)
|
|
|
|
`(asm-file ,file-name :no-code)
|
|
|
|
)
|
|
|
|
|
2022-02-19 13:10:10 -05:00
|
|
|
;; enum for text file encoding versions
|
|
|
|
(defenum game-text-version
|
|
|
|
(jak1-v1 10)
|
|
|
|
(jak1-v2 11)
|
|
|
|
(jak2 20)
|
|
|
|
(jak3 30)
|
|
|
|
(jakx 40)
|
|
|
|
)
|
|
|
|
|
2020-09-07 13:28:16 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; CONDITIONAL COMPILATION
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defmacro #when (clause &rest body)
|
|
|
|
`(#cond (,clause ,@body))
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro #unless (clause &rest body)
|
|
|
|
`(#cond ((not ,clause) ,@body))
|
|
|
|
)
|
|
|
|
|
2021-11-24 00:44:04 -05:00
|
|
|
(defmacro #if (clause true false)
|
|
|
|
`(#cond (,clause ,true) (#t ,false))
|
|
|
|
)
|
|
|
|
|
2022-01-18 01:14:47 -05:00
|
|
|
(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)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-09-07 13:28:16 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; TARGET CONTROL
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defmacro lt (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Listen to target. Opens a connection and flushes buffers"
|
2020-09-07 13:28:16 -04:00
|
|
|
`(begin
|
|
|
|
(listen-to-target ,@args)
|
|
|
|
(:status)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro r (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Reset the target state and reconnect."
|
2020-09-07 13:28:16 -04:00
|
|
|
`(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)
|
|
|
|
)
|
2020-09-12 13:11:42 -04:00
|
|
|
)
|
|
|
|
|
2020-09-24 17:19:23 -04:00
|
|
|
(defmacro shutdown-target ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Make the target exit. The runtime itself will exit and not restart automatically."
|
2020-09-24 17:19:23 -04:00
|
|
|
`(begin
|
|
|
|
(reset-target :shutdown)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-11-06 13:59:39 -05:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; DEBUGGER MACROS
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defmacro db (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Print bytes."
|
2020-11-06 13:59:39 -05:00
|
|
|
`(:pm 1 ,@args)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro dh (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Print halfwords (16-bits)"
|
2020-11-06 13:59:39 -05:00
|
|
|
`(:pm 2 ,@args)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro dw (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Print words (32-bits)"
|
2020-11-06 13:59:39 -05:00
|
|
|
`(:pm 4 ,@args)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro dd (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Print doublewords (64-bits)"
|
2020-11-06 13:59:39 -05:00
|
|
|
`(:pm 8 ,@args)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro df (&rest args)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Print floats (32-bit)"
|
2020-11-06 13:59:39 -05:00
|
|
|
`(:pm 4 ,@args :print-mode float)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro segfault ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Dereference the GOAL 0 pointer, which should be a segfault"
|
2020-11-06 13:59:39 -05:00
|
|
|
`(-> (the (pointer int) 0))
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro fpe ()
|
2021-03-01 11:15:24 -05:00
|
|
|
"Trigger a SIGFPE by doing integer division by zero"
|
2020-11-06 13:59:39 -05:00
|
|
|
`(/ 0 0)
|
|
|
|
)
|
2020-09-12 13:11:42 -04:00
|
|
|
|
2021-03-14 16:11:42 -04:00
|
|
|
(defmacro break! ()
|
|
|
|
"A breakpoint. Todo - should we use int3 instead?"
|
|
|
|
`(/ 0 0)
|
|
|
|
)
|
|
|
|
|
2021-04-11 16:07:01 -04:00
|
|
|
(defmacro crash! ()
|
|
|
|
"Cause a crash by attempting to deference 0x0"
|
|
|
|
`(-> (the (pointer uint8) 0))
|
|
|
|
)
|
|
|
|
|
2020-09-12 13:11:42 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; GOAL Syntax
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
2023-02-20 19:49:37 -05:00
|
|
|
|
2020-09-12 13:11:42 -04:00
|
|
|
;; Bind vars in body
|
|
|
|
(defmacro let (bindings &rest body)
|
[goalc] default to non-immediate lambdas if not requested (#2604)
This fixes a long time issue with `lambda`. The `lambda` is a bit
overloaded in OpenGOAL: it's used in the implementation of `let`, and
also to define local anonymous functions.
```
(defmacro let (bindings &rest body)
`((lambda :inline #t ,(apply first bindings) ,@body)
,@(apply second bindings)))
```
```
(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))))
```
In the first case of a `let`, a `return` from inside the `let` should
return from the functioning containing the `let`, not the scope of the
`lambda`. In the second case, we should return from the lambda. The way
we told the different between these cases was if the `lambda` was used
"immeidately", in the head of an expression (like it would be for the
`let` macro). But, this falsely triggers when an anonymous function is
used immediately: eg
```
((lambda () (return #f)))
```
should generate and call a real x86 function that returns immediately.
This should fix some death/mission failed stuff in jak 2.
2023-04-30 19:00:27 -04:00
|
|
|
`((lambda :immediate #t ,(apply first bindings) ,@body)
|
2020-09-12 13:11:42 -04:00
|
|
|
,@(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)
|
[goalc] default to non-immediate lambdas if not requested (#2604)
This fixes a long time issue with `lambda`. The `lambda` is a bit
overloaded in OpenGOAL: it's used in the implementation of `let`, and
also to define local anonymous functions.
```
(defmacro let (bindings &rest body)
`((lambda :inline #t ,(apply first bindings) ,@body)
,@(apply second bindings)))
```
```
(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))))
```
In the first case of a `let`, a `return` from inside the `let` should
return from the functioning containing the `let`, not the scope of the
`lambda`. In the second case, we should return from the lambda. The way
we told the different between these cases was if the `lambda` was used
"immeidately", in the head of an expression (like it would be for the
`let` macro). But, this falsely triggers when an anonymous function is
used immediately: eg
```
((lambda () (return #f)))
```
should generate and call a real x86 function that returns immediately.
This should fix some death/mission failed stuff in jak 2.
2023-04-30 19:00:27 -04:00
|
|
|
`((lambda :immediate #t (,(caar bindings))
|
2020-09-12 13:11:42 -04:00
|
|
|
(let* ,(cdr bindings) ,@body))
|
|
|
|
,(car (cdar bindings))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-01-27 19:33:34 -05:00
|
|
|
;; mlet, but recursive, allowing you to define variables in terms of others.
|
|
|
|
(defmacro mlet* (bindings &rest body)
|
|
|
|
(if (null? bindings)
|
|
|
|
`(begin ,@body)
|
[goalc] default to non-immediate lambdas if not requested (#2604)
This fixes a long time issue with `lambda`. The `lambda` is a bit
overloaded in OpenGOAL: it's used in the implementation of `let`, and
also to define local anonymous functions.
```
(defmacro let (bindings &rest body)
`((lambda :inline #t ,(apply first bindings) ,@body)
,@(apply second bindings)))
```
```
(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))))
```
In the first case of a `let`, a `return` from inside the `let` should
return from the functioning containing the `let`, not the scope of the
`lambda`. In the second case, we should return from the lambda. The way
we told the different between these cases was if the `lambda` was used
"immeidately", in the head of an expression (like it would be for the
`let` macro). But, this falsely triggers when an anonymous function is
used immediately: eg
```
((lambda () (return #f)))
```
should generate and call a real x86 function that returns immediately.
This should fix some death/mission failed stuff in jak 2.
2023-04-30 19:00:27 -04:00
|
|
|
`((lambda :immediate #t (,(caar bindings))
|
2022-01-27 19:33:34 -05:00
|
|
|
(mlet* ,(cdr bindings) ,@body))
|
|
|
|
,(car (cdar bindings))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-09-12 13:11:42 -04:00
|
|
|
;; Define a new function
|
|
|
|
(defmacro defun (name bindings &rest body)
|
2023-02-20 19:49:37 -05:00
|
|
|
(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))))
|
2020-09-13 17:34:02 -04:00
|
|
|
|
2021-06-25 17:55:50 -04:00
|
|
|
;; 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)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2021-02-20 11:42:46 -05:00
|
|
|
(defmacro defun-extern (function-name &rest type-info)
|
|
|
|
`(define-extern ,function-name (function ,@type-info))
|
|
|
|
)
|
|
|
|
|
2020-12-05 17:09:46 -05:00
|
|
|
(defmacro defun-debug (name bindings &rest body)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Define a function which is only present in debug mode. Otherwise the function becomes nothing"
|
2020-12-05 17:09:46 -05:00
|
|
|
`(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))
|
|
|
|
)
|
2021-02-09 20:24:33 -05:00
|
|
|
|
2020-12-05 17:09:46 -05:00
|
|
|
;; function not loaded, set function to the nothing function.
|
|
|
|
;; we don't typecheck this.
|
|
|
|
(define :no-typecheck #t ,name nothing)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2023-10-29 23:20:02 -04:00
|
|
|
(defmacro defun-debug-recursive (name return-type bindings &rest body)
|
|
|
|
`(begin
|
|
|
|
(define-extern ,name
|
|
|
|
(function ,@(apply (lambda (x)
|
|
|
|
(if (pair? x)
|
|
|
|
(second x)
|
|
|
|
'object)
|
|
|
|
)
|
|
|
|
bindings)
|
|
|
|
,return-type))
|
|
|
|
(if *debug-segment*
|
|
|
|
(defun-debug ,name ,bindings ,@body)
|
|
|
|
(define :no-typecheck #t ,name nothing))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2023-02-25 14:27:58 -05:00
|
|
|
(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)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2021-03-01 11:15:24 -05:00
|
|
|
(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)
|
2023-02-25 14:27:58 -05:00
|
|
|
(define-once ,name ,value)
|
2021-03-01 11:15:24 -05:00
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-09-13 17:34:02 -04:00
|
|
|
(defmacro while (test &rest body)
|
2021-03-01 11:15:24 -05:00
|
|
|
"While loop. The test is evaluated before body."
|
2020-09-13 17:34:02 -04:00
|
|
|
(with-gensyms (reloop test-exit)
|
|
|
|
`(begin
|
|
|
|
(goto ,test-exit)
|
|
|
|
(label ,reloop)
|
|
|
|
,@body
|
|
|
|
(label ,test-exit)
|
|
|
|
(when-goto ,test ,reloop)
|
|
|
|
#f
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-09-19 13:22:14 -04:00
|
|
|
(defmacro until (test &rest body)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Until loop. The body is evaluated before the test."
|
2020-09-19 13:22:14 -04:00
|
|
|
(with-gensyms (reloop)
|
|
|
|
`(begin
|
|
|
|
(label ,reloop)
|
|
|
|
,@body
|
|
|
|
(when-goto (not ,test) ,reloop)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro dotimes (var &rest body)
|
2021-07-23 18:30:49 -04:00
|
|
|
"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."
|
2020-09-19 13:22:14 -04:00
|
|
|
`(let (( ,(first var) 0))
|
|
|
|
(while (< ,(first var) ,(second var))
|
|
|
|
,@body
|
2021-04-22 18:31:54 -04:00
|
|
|
(1+! ,(first var))
|
2020-09-19 13:22:14 -04:00
|
|
|
)
|
|
|
|
,@(cddr var)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-12-05 17:09:46 -05:00
|
|
|
(defmacro countdown (var &rest body)
|
2021-03-01 11:15:24 -05:00
|
|
|
"Loop like for (int i = end; i-- > 0)"
|
2020-12-05 17:09:46 -05:00
|
|
|
`(let ((,(first var) ,(second var)))
|
|
|
|
(while (!= ,(first var) 0)
|
|
|
|
(set! ,(first var) (- ,(first var) 1))
|
|
|
|
,@body
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2021-07-25 00:23:30 -04:00
|
|
|
(defmacro loop (&rest body)
|
|
|
|
"Loop this code forever."
|
|
|
|
`(while #t
|
|
|
|
,@body)
|
|
|
|
)
|
|
|
|
|
2021-11-30 19:14:43 -05:00
|
|
|
(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))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
)
|
|
|
|
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2020-09-13 17:34:02 -04:00
|
|
|
;; Backup some values, and restore after executing body.
|
|
|
|
;; Non-dynamic (nonlocal jumps out of body will skip restore)
|
2021-06-29 20:30:52 -04:00
|
|
|
;; NOTE : GOAL protected defs in a FIFO manner (this is FILO/LIFO), this should be fixed at some point
|
2020-09-13 17:34:02 -04:00
|
|
|
(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)
|
2020-09-25 21:11:27 -04:00
|
|
|
(if (> (length others) 1)
|
|
|
|
(error "got too many arguments to if")
|
|
|
|
#f
|
|
|
|
)
|
2020-09-13 17:34:02 -04:00
|
|
|
(if (null? others)
|
|
|
|
`(cond (,condition ,true-case))
|
|
|
|
`(cond (,condition ,true-case)
|
|
|
|
(else ,(first others))
|
|
|
|
)
|
|
|
|
)
|
2020-09-18 22:02:27 -04:00
|
|
|
)
|
|
|
|
|
2020-09-19 16:50:42 -04:00
|
|
|
(defmacro when (condition &rest body)
|
|
|
|
`(if ,condition
|
|
|
|
(begin ,@body)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro unless (condition &rest body)
|
|
|
|
`(if (not ,condition)
|
|
|
|
(begin ,@body)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-05-21 15:47:41 -04:00
|
|
|
(defmacro aif (condition true &rest false)
|
2022-04-15 18:32:37 -04:00
|
|
|
"Anaphoric if, similar to Common Lisp"
|
2021-06-12 10:48:38 -04:00
|
|
|
|
2022-04-15 18:32:37 -04:00
|
|
|
`(let ((it ,condition))
|
|
|
|
(if it
|
|
|
|
,true
|
2022-05-21 15:47:41 -04:00
|
|
|
,@false
|
2021-06-12 10:48:38 -04:00
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-04-15 18:32:37 -04:00
|
|
|
(defmacro awhen (condition &rest body)
|
|
|
|
"Anaphoric when"
|
|
|
|
|
|
|
|
`(aif ,condition (begin ,@body) #f)
|
|
|
|
)
|
|
|
|
|
2021-02-07 18:21:00 -05:00
|
|
|
(defmacro return (val)
|
|
|
|
`(return-from #f ,val)
|
|
|
|
)
|
2020-09-19 13:22:14 -04:00
|
|
|
|
|
|
|
|
2021-03-17 19:26:35 -04:00
|
|
|
(defmacro empty ()
|
|
|
|
"The decompiler may use (empty) as the body of a loop with nothing in it."
|
|
|
|
`(none)
|
|
|
|
)
|
|
|
|
|
2022-01-02 18:02:10 -05:00
|
|
|
(defmacro case (switch &key (comp =) &rest cases)
|
2021-04-16 21:50:38 -04:00
|
|
|
"A switch-case construct. switch is saved onto a local variable and compared against each case, sequentially.
|
2022-04-15 18:32:37 -04:00
|
|
|
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)."
|
2021-04-16 21:50:38 -04:00
|
|
|
|
|
|
|
(with-gensyms (sw)
|
2021-05-25 16:36:36 -04:00
|
|
|
;; save the switch to a variable (only evaluated once)
|
2023-08-06 19:15:53 -04:00
|
|
|
`(let ((,sw ,switch))
|
2021-05-25 16:36:36 -04:00
|
|
|
;; build the cond construct with each case
|
2021-04-16 21:50:38 -04:00
|
|
|
(cond ,@(apply
|
2021-05-25 16:36:36 -04:00
|
|
|
(lambda (x) `(
|
|
|
|
;; each case is of format ((cond cond cond...) body)
|
2021-06-01 16:07:45 -04:00
|
|
|
,@(let ((conditions (first x)) ;; list of conditions, OR just else
|
2021-05-25 16:36:36 -04:00
|
|
|
(body (rest x))) ;; the body
|
|
|
|
|
|
|
|
(cond
|
2021-06-01 16:07:45 -04:00
|
|
|
;; if the condition is just 'else'
|
|
|
|
( (eq? conditions 'else)
|
2021-05-25 16:36:36 -04:00
|
|
|
`(else ,@body)
|
|
|
|
)
|
2021-06-01 16:07:45 -04:00
|
|
|
;; if the list is made up of a single condition
|
|
|
|
( (= (length conditions) 1)
|
2023-08-06 19:15:53 -04:00
|
|
|
`((,comp ,sw ,(first conditions)) ,@body)
|
2021-05-25 16:36:36 -04:00
|
|
|
)
|
2021-06-01 16:07:45 -04:00
|
|
|
;; otherwise it is made up of multiple conditions, or them together!
|
2021-05-25 16:36:36 -04:00
|
|
|
(#t
|
2023-08-06 19:15:53 -04:00
|
|
|
`((or ,@(apply (lambda (c) `(,comp ,sw ,c)) conditions)) ,@body)
|
2021-05-25 16:36:36 -04:00
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
2021-04-16 21:50:38 -04:00
|
|
|
cases)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-01-02 18:02:10 -05:00
|
|
|
(defmacro case-str (switch &rest cases)
|
|
|
|
"Same as case, but for string comparisons instead."
|
|
|
|
|
|
|
|
`(case ,switch ,@cases :comp string=)
|
|
|
|
)
|
|
|
|
|
2022-07-12 18:00:52 -04:00
|
|
|
(defmacro dolist (bindings &rest body)
|
|
|
|
`(let ((,(car bindings) ,(cadr bindings)))
|
|
|
|
(while (not (null? ,(car bindings)))
|
|
|
|
,@body
|
[goalc] default to non-immediate lambdas if not requested (#2604)
This fixes a long time issue with `lambda`. The `lambda` is a bit
overloaded in OpenGOAL: it's used in the implementation of `let`, and
also to define local anonymous functions.
```
(defmacro let (bindings &rest body)
`((lambda :inline #t ,(apply first bindings) ,@body)
,@(apply second bindings)))
```
```
(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))))
```
In the first case of a `let`, a `return` from inside the `let` should
return from the functioning containing the `let`, not the scope of the
`lambda`. In the second case, we should return from the lambda. The way
we told the different between these cases was if the `lambda` was used
"immeidately", in the head of an expression (like it would be for the
`let` macro). But, this falsely triggers when an anonymous function is
used immediately: eg
```
((lambda () (return #f)))
```
should generate and call a real x86 function that returns immediately.
This should fix some death/mission failed stuff in jak 2.
2023-04-30 19:00:27 -04:00
|
|
|
|
2022-07-12 18:00:52 -04:00
|
|
|
(set! ,(car bindings) (cdr ,(car bindings)))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2023-08-06 19:15:53 -04:00
|
|
|
|
|
|
|
(defmacro the-as-safe (type obj)
|
|
|
|
(with-gensyms (temp)
|
|
|
|
`(let ((,temp ,obj))
|
|
|
|
(if (type? ,temp ,type)
|
|
|
|
(the-as ,type ,temp))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2023-09-27 21:47:09 -04:00
|
|
|
(defmacro eq-any? (val &rest pred)
|
|
|
|
"is val equal to any of the values in pred? evaluated using or, so it short circuits."
|
|
|
|
(with-gensyms (val-var)
|
|
|
|
`(let ((,val-var ,val))
|
|
|
|
(or ,@(apply (lambda (x) `(= ,val-var ,x)) pred)))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
|
2023-08-06 19:15:53 -04:00
|
|
|
|
2020-09-18 22:02:27 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Math Macros
|
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
2021-04-22 18:31:54 -04:00
|
|
|
(defmacro 1+ (var)
|
2020-09-18 22:02:27 -04:00
|
|
|
`(+ ,var 1)
|
|
|
|
)
|
|
|
|
|
2022-03-10 19:25:01 -05:00
|
|
|
(defmacro inc (val)
|
|
|
|
"Increments a value"
|
|
|
|
`(1+ ,val))
|
|
|
|
|
2020-09-18 22:02:27 -04:00
|
|
|
(defmacro +! (place amount)
|
|
|
|
`(set! ,place (+ ,place ,amount))
|
|
|
|
)
|
|
|
|
|
2021-04-22 18:31:54 -04:00
|
|
|
(defmacro 1+! (place)
|
2022-05-19 21:30:14 -04:00
|
|
|
`(+! ,place 1)
|
2020-09-18 22:02:27 -04:00
|
|
|
)
|
|
|
|
|
2023-09-09 15:58:57 -04:00
|
|
|
(defmacro inc! (place)
|
|
|
|
`(+! ,place 1)
|
|
|
|
)
|
|
|
|
|
2021-06-04 13:22:50 -04:00
|
|
|
(defmacro 1- (var)
|
2022-05-19 21:30:14 -04:00
|
|
|
`(+ ,var -1)
|
2021-06-04 13:22:50 -04:00
|
|
|
)
|
|
|
|
|
2022-03-10 19:25:01 -05:00
|
|
|
(defmacro dec (val)
|
|
|
|
"Decrements a value"
|
|
|
|
`(1- ,val))
|
|
|
|
|
2020-09-18 22:02:27 -04:00
|
|
|
(defmacro -! (place amount)
|
|
|
|
`(set! ,place (- ,place ,amount))
|
|
|
|
)
|
|
|
|
|
2021-06-04 13:22:50 -04:00
|
|
|
(defmacro 1-! (place)
|
2022-05-19 21:30:14 -04:00
|
|
|
`(-! ,place 1)
|
2020-09-18 22:02:27 -04:00
|
|
|
)
|
|
|
|
|
2023-09-09 15:58:57 -04:00
|
|
|
(defmacro dec! (place)
|
|
|
|
`(-! ,place 1)
|
|
|
|
)
|
|
|
|
|
2021-06-04 13:22:50 -04:00
|
|
|
(defmacro *! (place amount)
|
|
|
|
`(set! ,place (* ,place ,amount))
|
2020-09-19 13:22:14 -04:00
|
|
|
)
|
|
|
|
|
2021-12-30 18:48:37 -05:00
|
|
|
(defmacro /! (place amount)
|
|
|
|
`(set! ,place (/ ,place ,amount))
|
|
|
|
)
|
|
|
|
|
2020-09-19 13:22:14 -04:00
|
|
|
(defmacro zero? (thing)
|
|
|
|
`(eq? ,thing 0)
|
|
|
|
)
|
|
|
|
|
2020-12-05 17:09:46 -05:00
|
|
|
(defmacro nonzero? (thing)
|
|
|
|
`(neq? ,thing 0)
|
|
|
|
)
|
|
|
|
|
2022-02-27 16:44:43 -05:00
|
|
|
(defmacro or! (place &rest args)
|
|
|
|
`(set! ,place (or ,place ,@args))
|
|
|
|
)
|
|
|
|
|
2021-09-06 20:35:03 -04:00
|
|
|
(defmacro not! (var)
|
|
|
|
`(set! ,var (not ,var)))
|
2022-03-10 19:25:01 -05:00
|
|
|
|
2021-09-06 20:35:03 -04:00
|
|
|
(defmacro true! (var)
|
|
|
|
`(set! ,var #t))
|
2022-03-10 19:25:01 -05:00
|
|
|
|
2021-09-06 20:35:03 -04:00
|
|
|
(defmacro false! (var)
|
|
|
|
`(set! ,var #f))
|
|
|
|
|
2023-05-18 18:12:23 -04:00
|
|
|
(defmacro max! (val maxval)
|
|
|
|
`(set! ,val (max ,val ,maxval)))
|
|
|
|
(defmacro min! (val minval)
|
|
|
|
`(set! ,val (min ,val ,minval)))
|
|
|
|
|
2021-08-01 17:11:32 -04:00
|
|
|
(defmacro minmax (val minval maxval)
|
|
|
|
`(max (min ,val ,maxval) ,minval)
|
|
|
|
)
|
2022-03-10 19:25:01 -05:00
|
|
|
|
2021-08-01 17:11:32 -04:00
|
|
|
(defmacro fminmax (val minval maxval)
|
|
|
|
`(fmax (fmin ,val ,maxval) ,minval)
|
2022-02-12 12:26:19 -05:00
|
|
|
)
|
2022-02-27 16:44:43 -05:00
|
|
|
(defmacro minmax! (val minval maxval)
|
|
|
|
`(set! ,val (max (min ,val ,maxval) ,minval))
|
|
|
|
)
|
|
|
|
(defmacro fminmax! (val minval maxval)
|
|
|
|
`(set! ,val (fmax (fmin ,val ,maxval) ,minval))
|
|
|
|
)
|
2022-02-12 12:26:19 -05:00
|
|
|
|
|
|
|
(defmacro maxmin (val minval maxval)
|
|
|
|
`(min (max ,val ,maxval) ,minval)
|
|
|
|
)
|
2022-03-10 19:25:01 -05:00
|
|
|
|
2022-02-12 12:26:19 -05:00
|
|
|
(defmacro fmaxmin (val minval maxval)
|
|
|
|
`(fmin (fmax ,val ,maxval) ,minval)
|
2021-08-01 17:11:32 -04:00
|
|
|
)
|
|
|
|
|
2020-09-25 21:11:27 -04:00
|
|
|
(defmacro &+! (val amount)
|
|
|
|
`(set! ,val (&+ ,val ,amount))
|
2020-09-19 13:22:14 -04:00
|
|
|
)
|
|
|
|
|
2020-09-25 21:11:27 -04:00
|
|
|
(defmacro &- (a b)
|
2021-03-14 16:11:42 -04:00
|
|
|
`(- (the-as int ,a) (the-as int ,b))
|
2020-09-19 16:50:42 -04:00
|
|
|
)
|
|
|
|
|
2020-09-25 21:11:27 -04:00
|
|
|
(defmacro &-> (&rest args)
|
|
|
|
`(& (-> ,@args))
|
2020-09-19 16:50:42 -04:00
|
|
|
)
|
|
|
|
|
2021-02-09 20:24:33 -05:00
|
|
|
(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))
|
|
|
|
)
|
|
|
|
|
2021-07-23 18:30:49 -04:00
|
|
|
(defmacro logclear (a b)
|
|
|
|
"Returns the result of setting the bits in b to zero in a"
|
2021-07-23 20:51:26 -04:00
|
|
|
;; put a first so the return type matches a.
|
|
|
|
`(logand ,a (lognot ,b))
|
2021-07-23 18:30:49 -04:00
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro logclear! (a b)
|
|
|
|
"Sets the bits in b to zero in a, in place"
|
2021-07-23 20:51:26 -04:00
|
|
|
`(set! ,a (logand ,a (lognot ,b)))
|
2021-07-23 18:30:49 -04:00
|
|
|
)
|
|
|
|
|
|
|
|
(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?"
|
2021-08-09 19:18:53 -04:00
|
|
|
`(= (logand ,b ,a) ,b)
|
2021-07-23 18:30:49 -04:00
|
|
|
)
|
|
|
|
|
2021-05-25 16:36:36 -04:00
|
|
|
(defmacro deref (t addr &rest fields)
|
|
|
|
`(-> (the-as (pointer ,t) ,addr) ,@fields)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro &deref (t addr &rest fields)
|
|
|
|
`(&-> (the-as (pointer ,t) ,addr) ,@fields)
|
|
|
|
)
|
|
|
|
|
2022-09-24 12:27:02 -04:00
|
|
|
(defmacro sext32 (in)
|
|
|
|
`(sar (shl ,in 32) 32)
|
|
|
|
)
|
|
|
|
|
2022-01-18 01:14:47 -05:00
|
|
|
(defmacro shift-arith-right-32 (result in sa)
|
|
|
|
`(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa)))
|
|
|
|
)
|
|
|
|
|
2022-01-31 20:44:54 -05:00
|
|
|
(defmacro /-0-guard (a b)
|
2023-11-04 14:25:13 -04:00
|
|
|
"same as divide but returns -1 when divisor is zero (EE-like, DIVU)."
|
2022-01-31 20:44:54 -05:00
|
|
|
`(let ((divisor ,b))
|
|
|
|
(if (zero? divisor)
|
2022-02-13 00:12:05 -05:00
|
|
|
-1
|
2022-01-31 20:44:54 -05:00
|
|
|
(/ ,a divisor))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2023-11-04 14:25:13 -04:00
|
|
|
(defmacro /-signed-0-guard (a b)
|
|
|
|
"same as divide but handles overflow and divide by zero like the EE's DIV instruction."
|
|
|
|
`(let ((divisor ,b)
|
|
|
|
(dividend ,a))
|
|
|
|
(cond
|
|
|
|
((and (= dividend -2147483648) (= divisor -1))
|
|
|
|
;; overflow case
|
|
|
|
-2147483648)
|
|
|
|
((zero? divisor)
|
|
|
|
(if (< dividend 0) 1 -1))
|
|
|
|
(else
|
|
|
|
(/ dividend divisor))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-02-13 00:12:05 -05:00
|
|
|
(defmacro mod-0-guard (a b)
|
2023-11-04 14:25:13 -04:00
|
|
|
"same as modulo but returns the dividend when divisor is zero (EE-like, DIVU)."
|
2022-02-13 00:12:05 -05:00
|
|
|
`(let ((divisor ,b))
|
|
|
|
(if (zero? divisor)
|
|
|
|
,a
|
|
|
|
(mod ,a divisor))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2023-11-04 14:25:13 -04:00
|
|
|
(defmacro mod-signed-0-guard (a b)
|
|
|
|
"same as modulo but handles overflow and divide by zero like the EE's DIV instruction."
|
|
|
|
`(let ((divisor ,b)
|
|
|
|
(dividend ,a))
|
|
|
|
(cond
|
|
|
|
((and (= dividend -2147483648) (= divisor -1))
|
|
|
|
;; overflow case
|
|
|
|
0)
|
|
|
|
((zero? divisor)
|
|
|
|
dividend)
|
|
|
|
(else
|
|
|
|
(mod dividend divisor))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-06-04 14:53:49 -04:00
|
|
|
(defmacro float->int (a)
|
|
|
|
"forcefully casts something as a float to int. be careful."
|
|
|
|
`(the int (the float ,a))
|
|
|
|
)
|
|
|
|
|
2020-09-25 21:11:27 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Bit Macros
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
2021-08-01 17:11:32 -04:00
|
|
|
(defmacro align-n (val n)
|
|
|
|
"align val to n-byte boundaries"
|
2022-02-07 19:15:37 -05:00
|
|
|
`(logand (- ,n) (+ (the-as int ,val) (- ,n 1)))
|
2020-09-19 16:50:42 -04:00
|
|
|
)
|
|
|
|
|
2021-08-01 17:11:32 -04:00
|
|
|
(defmacro align16 (val)
|
|
|
|
`(align-n ,val 16)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro align64 (val)
|
|
|
|
`(align-n ,val 64)
|
2020-11-22 12:59:55 -05:00
|
|
|
)
|
2020-09-19 16:50:42 -04:00
|
|
|
|
2021-12-30 18:48:37 -05:00
|
|
|
(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))
|
|
|
|
)
|
|
|
|
|
2020-09-19 13:22:14 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; 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)))
|
|
|
|
)
|
2020-09-19 16:50:42 -04:00
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro null? (arg)
|
|
|
|
;; todo, make this better
|
|
|
|
`(eq? ,arg '())
|
|
|
|
)
|
2021-03-01 11:15:24 -05:00
|
|
|
|
2020-09-19 16:50:42 -04:00
|
|
|
(defmacro caar (arg)
|
|
|
|
`(car (car ,arg))
|
|
|
|
)
|
|
|
|
|
2021-08-01 17:11:32 -04:00
|
|
|
(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))))
|
|
|
|
)
|
|
|
|
|
2021-12-09 18:39:40 -05:00
|
|
|
(defmacro dcons (a b)
|
|
|
|
`(new 'debug 'pair ,a ,b)
|
|
|
|
)
|
|
|
|
|
2022-04-18 18:31:59 -04:00
|
|
|
(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)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-03-10 19:25:01 -05:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; 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))
|
|
|
|
|
2020-09-19 16:50:42 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; METHOD STUFF
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
|
2021-02-09 20:59:14 -05:00
|
|
|
(defmacro object-new (allocation type-to-make &rest sz)
|
2020-09-19 16:50:42 -04:00
|
|
|
(if (null? sz)
|
2022-04-07 19:13:22 -04:00
|
|
|
`(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))
|
2020-09-19 16:50:42 -04:00
|
|
|
)
|
|
|
|
)
|
2020-09-24 17:19:23 -04:00
|
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; 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*)
|
2020-12-04 12:57:10 -05:00
|
|
|
)
|
2021-02-01 20:41:37 -05:00
|
|
|
|
|
|
|
|
2021-02-22 01:02:12 -05:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; (Fake) MIPS Macros
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
2021-04-16 21:50:38 -04:00
|
|
|
;; these are macros for MIPS instructions which we may want to keep in the source code for
|
2021-02-22 01:02:12 -05:00
|
|
|
;; 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))
|
|
|
|
)
|
2021-07-15 21:37:15 -04:00
|
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Build System
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defmacro makeo (object-name &rest flags)
|
|
|
|
"Make the given object. Can use a string, or not."
|
|
|
|
`(make ,(string-append
|
2022-06-30 21:11:58 -04:00
|
|
|
"$OUT/"
|
2021-07-15 21:37:15 -04:00
|
|
|
(if (string? object-name) object-name (symbol->string object-name))
|
|
|
|
".o"
|
|
|
|
)
|
|
|
|
,@flags)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro make-cgo (file)
|
2022-06-30 21:11:58 -04:00
|
|
|
`(make ,(string-append "$OUT/iso/" file ".CGO"))
|
2021-07-15 21:37:15 -04:00
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro make-dgo (file)
|
2022-06-30 21:11:58 -04:00
|
|
|
`(make ,(string-append "$OUT/iso/" file ".DGO"))
|
2021-07-15 21:37:15 -04:00
|
|
|
)
|
|
|
|
|
|
|
|
(defmacro make-group (name &key (verbose #f) &key (force #f))
|
|
|
|
`(make ,(string-append "GROUP:" name) :verbose ,verbose :force ,force)
|
|
|
|
)
|
|
|
|
|
2021-08-04 21:30:08 -04:00
|
|
|
(defmacro rl ()
|
|
|
|
`(begin
|
|
|
|
(make-group "iso")
|
|
|
|
(lg)
|
|
|
|
(dbg)
|
|
|
|
)
|
|
|
|
)
|
2021-08-31 11:05:03 -04:00
|
|
|
|
|
|
|
(defmacro mi ()
|
|
|
|
"Make ISO"
|
|
|
|
`(make-group "iso")
|
|
|
|
)
|
2021-11-23 18:25:57 -05:00
|
|
|
|
2022-08-15 18:46:29 -04:00
|
|
|
(defmacro mkr ()
|
|
|
|
"Make kernel"
|
|
|
|
`(make-group "kernel")
|
|
|
|
)
|
|
|
|
|
2021-12-26 11:43:16 -05:00
|
|
|
(defmacro mng ()
|
|
|
|
"Make engine"
|
|
|
|
`(make-group "engine")
|
|
|
|
)
|
|
|
|
|
2022-06-11 11:32:27 -04:00
|
|
|
(defmacro make-text ()
|
|
|
|
"Make Text"
|
|
|
|
`(make-group "text")
|
|
|
|
)
|
|
|
|
|
2023-08-30 13:36:10 -04:00
|
|
|
;; the default territory the game was built for. overriden in extractor.
|
|
|
|
;; this just fetches the goos constant with the same name (TODO fix this)
|
|
|
|
(defmacro __get_default_territory () *default-territory*)
|
|
|
|
(defconstant *default-territory* (__get_default_territory))
|
|
|
|
|
2021-08-09 19:18:53 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; 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))
|
2021-11-30 19:14:43 -05:00
|
|
|
|
2021-08-09 19:18:53 -04:00
|
|
|
,@(apply (lambda (x)
|
|
|
|
`(if (logtesta? ,val (,enum ,(car x)))
|
|
|
|
(format ,str ,(fmt #f "{} " (car x)))
|
|
|
|
)
|
2021-11-30 19:14:43 -05:00
|
|
|
|
2021-08-09 19:18:53 -04:00
|
|
|
) (reverse (get-enum-vals enum)))
|
2021-11-30 19:14:43 -05:00
|
|
|
|
2021-08-09 19:18:53 -04:00
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-04-30 14:48:24 -04:00
|
|
|
(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)
|
2022-05-19 17:08:01 -04:00
|
|
|
|
2022-04-30 14:48:24 -04:00
|
|
|
`(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))))
|
2022-05-19 17:08:01 -04:00
|
|
|
|
2022-04-30 14:48:24 -04:00
|
|
|
)
|
|
|
|
|
2022-01-15 16:52:47 -05:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;; 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))
|
|
|
|
)
|
2021-08-04 21:30:08 -04:00
|
|
|
|
2023-03-09 20:03:43 -05:00
|
|
|
(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))
|
2022-01-27 19:33:34 -05:00
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;; user stuf
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
2022-04-24 15:15:16 -04:00
|
|
|
(defmacro user? (&rest users)
|
|
|
|
(cond
|
|
|
|
((null? users) #f)
|
|
|
|
((eq? *user* (car users)) #t)
|
|
|
|
(#t `(user? ,@(cdr users)))
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
2022-01-27 19:33:34 -05:00
|
|
|
|
2022-05-19 21:30:14 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
2022-06-23 18:44:02 -04:00
|
|
|
;;;; art stuff
|
2022-05-19 21:30:14 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defmacro def-art-elt (group name idx)
|
|
|
|
"define a new art element. adds it to a global map stored in goos."
|
2022-05-23 18:53:02 -04:00
|
|
|
|
2022-05-19 21:30:14 -04:00
|
|
|
;; grab data about the art group
|
2022-05-21 19:36:14 -04:00
|
|
|
(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)
|
|
|
|
)
|
2022-05-19 21:30:14 -04:00
|
|
|
)
|
2022-05-21 19:36:14 -04:00
|
|
|
)
|
2022-05-19 21:30:14 -04:00
|
|
|
;; define a constant for it!
|
|
|
|
`(defconstant ,name (-> self draw art-group data ,idx))
|
|
|
|
)
|
|
|
|
|
2023-10-06 10:42:16 -04:00
|
|
|
(defmacro def-joint-node (jg name idx)
|
|
|
|
"define a new joint node for a joint geo. adds it to a global map stored in goos."
|
|
|
|
;; grab data about the joint geo
|
|
|
|
(let* ((jg-string (symbol->string jg))
|
|
|
|
(name-string name)
|
|
|
|
(jg-info-lookup (hash-table-try-ref *jg-info* jg-string))
|
|
|
|
(jg-info-exists (car jg-info-lookup))
|
|
|
|
(jg-info (cdr jg-info-lookup))
|
|
|
|
)
|
|
|
|
;; no joint geo was found, make a new one and add it.
|
|
|
|
(when (not jg-info-exists)
|
|
|
|
(set! jg-info (make-string-hash-table))
|
|
|
|
(hash-table-set! *jg-info* jg-string jg-info)
|
|
|
|
)
|
|
|
|
;; lookup name in our joint geo
|
|
|
|
(let* ((joint-name-lookup (hash-table-try-ref jg-info name-string))
|
|
|
|
(joint-name-exists (car joint-name-lookup))
|
|
|
|
(joint-new (list name idx))) ;; this is the format of the individual entries
|
|
|
|
;; found, check if valid
|
|
|
|
(if (and joint-name-exists (not (eq? (cdr joint-name-lookup) joint-new)))
|
|
|
|
(fmt #t "error redefining joint. data mismatch: {}\n" joint-new)
|
|
|
|
#f)
|
|
|
|
;; not found. add to the joint geo.
|
|
|
|
(when (not joint-name-exists)
|
|
|
|
(hash-table-set! jg-info name-string joint-new)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
;; `(defconstant ,name (-> self node-list data ,idx))
|
|
|
|
`(empty)
|
|
|
|
)
|
|
|
|
|
2023-06-07 20:04:16 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; built-in type stuff
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defmacro string? (val)
|
|
|
|
`(type? ,val string))
|
|
|
|
|
|
|
|
|
2022-07-06 21:18:08 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Load Project
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
2022-05-19 21:30:14 -04:00
|
|
|
|
2022-07-06 21:18:08 -04:00
|
|
|
(#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"))
|
|
|
|
)
|
|
|
|
)
|