mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-07-07 06:05:15 -04:00
Code Issues Packages Projects Releases Wiki Activity

[jak2] try to speed up compile a bit (#2596)

Browse Source
This commit is contained in:
water111
2023-04-30 14:13:52 -04:00
committed by GitHub
parent cb1daa032c
commit 5c9aa3facd
7 changed files with 378 additions and 261 deletions
Download Patch File Download Diff File Expand all files Collapse all files
common/goos/Interpreter.cpp
+64 -47
View File
@@ -202,9 +202,8 @@ void Interpreter::throw_eval_error(const Object& o, const std::string& err) {
*/
Object Interpreter::eval_with_rewind(const Object& obj,
const std::shared_ptr<EnvironmentObject>& env) {
Object result = Object::make_empty_list();
try {
result = eval(obj, env);
return eval(obj, env);
} catch (std::runtime_error& e) {
if (!disable_printing) {
printf("-----------------------------------------\n");
@@ -212,7 +211,6 @@ Object Interpreter::eval_with_rewind(const Object& obj,
}
throw e;
}
return result;
}
/*!
@@ -262,14 +260,14 @@ Arguments Interpreter::get_args(const Object& form, const Object& rest, const Ar
Arguments args;
// loop over forms in list
Object current = rest;
while (!current.is_empty_list()) {
auto arg = current.as_pair()->car;
const Object* current = &rest;
while (!current->is_empty_list()) {
const auto& arg = current->as_pair()->car;
// did we get a ":keyword"
if (arg.is_symbol() && arg.as_symbol()->name.at(0) == ':') {
auto key_name = arg.as_symbol()->name.substr(1);
auto kv = spec.named.find(key_name);
const auto& kv = spec.named.find(key_name);
// check for unknown key name
if (!spec.varargs && kv == spec.named.end()) {
@@ -282,12 +280,12 @@ Arguments Interpreter::get_args(const Object& form, const Object& rest, const Ar
}
// check for well-formed :key value expression
current = current.as_pair()->cdr;
if (current.is_empty_list()) {
current = &current->as_pair()->cdr;
if (current->is_empty_list()) {
throw_eval_error(form, "Key argument didn't have a value");
}
args.named[key_name] = current.as_pair()->car;
args.named[key_name] = current->as_pair()->car;
} else {
// not a keyword. Add to unnamed or rest, depending on what we expect
if (spec.varargs || args.unnamed.size() < spec.unnamed.size()) {
@@ -296,12 +294,12 @@ Arguments Interpreter::get_args(const Object& form, const Object& rest, const Ar
args.rest.push_back(arg);
}
}
current = current.as_pair()->cdr;
current = &current->as_pair()->cdr;
}
// Check expected key args and set default values on unset ones if possible
for (auto& kv : spec.named) {
auto defined_kv = args.named.find(kv.first);
const auto& defined_kv = args.named.find(kv.first);
if (defined_kv == args.named.end()) {
// key arg not given by user, try to use a default value.
if (kv.second.has_default) {
@@ -558,7 +556,7 @@ bool try_symbol_lookup(const Object& sym,
// loop up envs until we find it.
EnvironmentObject* search_env = env.get();
for (;;) {
auto kv = search_env->vars.find(sym.as_symbol());
const auto& kv = search_env->vars.find(sym.as_symbol());
if (kv != search_env->vars.end()) {
*dest = kv->second;
return true;
@@ -595,22 +593,22 @@ bool Interpreter::eval_symbol(const Object& sym,
* Evaluate a pair, either as special form, builtin form, macro application, or lambda application.
*/
Object Interpreter::eval_pair(const Object& obj, const std::shared_ptr<EnvironmentObject>& env) {
auto pair = obj.as_pair();
Object head = pair->car;
Object rest = pair->cdr;
const auto& pair = obj.as_pair();
const Object& head = pair->car;
const Object& rest = pair->cdr;
// first see if we got a symbol:
if (head.type == ObjectType::SYMBOL) {
auto head_sym = head.as_symbol();
const auto& head_sym = head.as_symbol();
// try a special form first
auto kv_sf = special_forms.find(head_sym->name);
const auto& kv_sf = special_forms.find(head_sym->name);
if (kv_sf != special_forms.end()) {
return ((*this).*(kv_sf->second))(obj, rest, env);
}
// try builtins next
auto kv_b = builtin_forms.find(head_sym->name);
const auto& kv_b = builtin_forms.find(head_sym->name);
if (kv_b != builtin_forms.end()) {
Arguments args = get_args(obj, rest, make_varargs());
// all "built-in" forms expect arguments to be evaluated (that's why they aren't special)
@@ -619,7 +617,7 @@ Object Interpreter::eval_pair(const Object& obj, const std::shared_ptr<Environme
}
// try custom forms next
auto kv_u = m_custom_forms.find(head_sym->name);
const auto& kv_u = m_custom_forms.find(head_sym->name);
if (kv_u != m_custom_forms.end()) {
Arguments args = get_args(obj, rest, make_varargs());
return (kv_u->second)(obj, args, env);
@@ -628,7 +626,7 @@ Object Interpreter::eval_pair(const Object& obj, const std::shared_ptr<Environme
// try macros next
Object macro_obj;
if (try_symbol_lookup(head, env, &macro_obj) && macro_obj.is_macro()) {
auto macro = macro_obj.as_macro();
const auto& macro = macro_obj.as_macro();
Arguments args = get_args(obj, rest, macro->args);
auto mac_env_obj = EnvironmentObject::make_new();
@@ -646,7 +644,7 @@ Object Interpreter::eval_pair(const Object& obj, const std::shared_ptr<Environme
throw_eval_error(obj, "head of form didn't evaluate to lambda");
}
auto lam = eval_head.as_lambda();
const auto& lam = eval_head.as_lambda();
Arguments args = get_args(obj, rest, lam->args);
eval_args(&args, env);
auto lam_env_obj = EnvironmentObject::make_new();
@@ -822,53 +820,55 @@ Object Interpreter::eval_quote(const Object& form,
*/
Object Interpreter::quasiquote_helper(const Object& form,
const std::shared_ptr<EnvironmentObject>& env) {
Object lst = form;
const Object* lst_iter = &form;
std::vector<Object> result;
for (;;) {
if (lst.type == ObjectType::PAIR) {
Object item = lst.as_pair()->car;
if (lst_iter->type == ObjectType::PAIR) {
const Object& item = lst_iter->as_pair()->car;
if (item.type == ObjectType::PAIR) {
if (item.as_pair()->car.type == ObjectType::SYMBOL &&
item.as_pair()->car.as_symbol()->name == "unquote") {
Object unquote_arg = item.as_pair()->cdr;
const Object& unquote_arg = item.as_pair()->cdr;
if (unquote_arg.type != ObjectType::PAIR ||
unquote_arg.as_pair()->cdr.type != ObjectType::EMPTY_LIST) {
throw_eval_error(form, "unquote must have exactly 1 arg");
}
item = eval_with_rewind(unquote_arg.as_pair()->car, env);
result.push_back(eval_with_rewind(unquote_arg.as_pair()->car, env));
lst_iter = &lst_iter->as_pair()->cdr;
continue;
} else if (item.as_pair()->car.type == ObjectType::SYMBOL &&
item.as_pair()->car.as_symbol()->name == "unquote-splicing") {
Object unquote_arg = item.as_pair()->cdr;
const Object& unquote_arg = item.as_pair()->cdr;
if (unquote_arg.type != ObjectType::PAIR ||
unquote_arg.as_pair()->cdr.type != ObjectType::EMPTY_LIST) {
throw_eval_error(form, "unquote must have exactly 1 arg");
}
item = eval_with_rewind(unquote_arg.as_pair()->car, env);
// bypass normal addition:
lst = lst.as_pair()->cdr;
Object to_add = item;
lst_iter = &lst_iter->as_pair()->cdr;
Object splice_result = eval_with_rewind(unquote_arg.as_pair()->car, env);
const Object* to_add = &splice_result;
for (;;) {
if (to_add.type == ObjectType::PAIR) {
result.push_back(to_add.as_pair()->car);
to_add = to_add.as_pair()->cdr;
} else if (to_add.type == ObjectType::EMPTY_LIST) {
if (to_add->type == ObjectType::PAIR) {
result.push_back(to_add->as_pair()->car);
to_add = &to_add->as_pair()->cdr;
} else if (to_add->type == ObjectType::EMPTY_LIST) {
break;
} else {
throw_eval_error(form, "malformed unquote-splicing result");
}
}
continue;
}
else {
item = quasiquote_helper(item, env);
} else {
result.push_back(quasiquote_helper(item, env));
lst_iter = &lst_iter->as_pair()->cdr;
continue;
}
}
lst = lst.as_pair()->cdr;
result.push_back(item);
} else if (lst.type == ObjectType::EMPTY_LIST) {
return build_list(result);
lst_iter = &lst_iter->as_pair()->cdr;
} else if (lst_iter->type == ObjectType::EMPTY_LIST) {
return build_list(std::move(result));
} else {
throw_eval_error(form, "malformed quasiquote");
}
@@ -1832,9 +1832,17 @@ Object Interpreter::eval_make_string_hash_table(const Object& form,
Object Interpreter::eval_hash_table_set(const Object& form,
Arguments& args,
const std::shared_ptr<EnvironmentObject>& /*env*/) {
vararg_check(form, args, {ObjectType::STRING_HASH_TABLE, ObjectType::STRING, {}}, {});
args.unnamed.at(0).as_string_hash_table()->data[args.unnamed.at(1).as_string()->data] =
args.unnamed.at(2);
vararg_check(form, args, {ObjectType::STRING_HASH_TABLE, {}, {}}, {});
const char* str = nullptr;
if (args.unnamed.at(1).is_symbol()) {
str = args.unnamed.at(1).as_symbol()->name.c_str();
} else if (args.unnamed.at(1).is_string()) {
str = args.unnamed.at(1).as_string()->data.c_str();
} else {
throw_eval_error(form, "Hash table must use symbol or string as the key.");
}
args.unnamed.at(0).as_string_hash_table()->data[str] = args.unnamed.at(2);
return Object::make_empty_list();
}
@@ -1844,9 +1852,18 @@ Object Interpreter::eval_hash_table_set(const Object& form,
Object Interpreter::eval_hash_table_try_ref(const Object& form,
Arguments& args,
const std::shared_ptr<EnvironmentObject>& /*env*/) {
vararg_check(form, args, {ObjectType::STRING_HASH_TABLE, ObjectType::STRING}, {});
vararg_check(form, args, {ObjectType::STRING_HASH_TABLE, {}}, {});
const auto* table = args.unnamed.at(0).as_string_hash_table();
const auto& it = table->data.find(args.unnamed.at(1).as_string()->data);
const char* str = nullptr;
if (args.unnamed.at(1).is_symbol()) {
str = args.unnamed.at(1).as_symbol()->name.c_str();
} else if (args.unnamed.at(1).is_string()) {
str = args.unnamed.at(1).as_string()->data.c_str();
} else {
throw_eval_error(form, "Hash table must use symbol or string as the key.");
}
const auto& it = table->data.find(str);
if (it == table->data.end()) {
// not in table
return PairObject::make_new(SymbolObject::make_new(reader.symbolTable, "#f"),
common/goos/Object.cpp
+1 -1
View File
@@ -204,7 +204,7 @@ Object build_list(std::vector<Object>&& objects) {
Object result;
result.type = ObjectType::PAIR;
result.heap_obj = head;
result.heap_obj = std::move(head);
return result;
}
game/overlord/jak2/iso.cpp
+10 -9
View File
@@ -198,11 +198,11 @@ void IsoQueueVagStream(VagCmd* cmd, int param_2) {
VagCmd* pVVar7;
VagCmd* new_stereo_cmd;
// HACK
if (!cmd->vag_dir_entry) {
printf("IsoQueueVagStream: no entry for %s\n", cmd->name);
return;
}
// we added a few null checks on vag_dir_entry.
// as far as I can tell, it's "okay" that some animations (like Jak's idle animation)
// don't have a corresponding audio. There's checks later on in this function that skip
// trying to open the VAG file when this happens, but the stereo/mono checks don't have this
// check. So we added them.
if (param_2 == 1) {
// CpuSuspendIntr(local_20);
@@ -210,8 +210,9 @@ void IsoQueueVagStream(VagCmd* cmd, int param_2) {
new_stereo_cmd = nullptr;
// allocate/find a vag cmd to hold this stream command. We don't own the incoming command.
if ((cmd->id == 0) || (((cmd->vag_dir_entry->flag & 1U) != 0 &&
(iVar1 = HowManyBelowThisPriority(cmd->priority, 0), iVar1 < 2))))
if ((cmd->id == 0) ||
(((cmd->vag_dir_entry && cmd->vag_dir_entry->flag & 1U) != 0 && // added null check
(iVar1 = HowManyBelowThisPriority(cmd->priority, 0), iVar1 < 2))))
goto LAB_000049dc;
new_cmd = FindThisVagStream(cmd->name, cmd->id);
if (!new_cmd) {
@@ -264,7 +265,7 @@ void IsoQueueVagStream(VagCmd* cmd, int param_2) {
new_cmd->sb_scanned = true;
// check for stereo
if ((new_cmd->vag_dir_entry->flag & 1U) != 0) {
if (cmd->vag_dir_entry && (new_cmd->vag_dir_entry->flag & 1U) != 0) { // added null check
// try allocating it
new_stereo_cmd = SmartAllocVagCmd(cmd);
if (!new_stereo_cmd) {
@@ -298,7 +299,7 @@ void IsoQueueVagStream(VagCmd* cmd, int param_2) {
new_cmd->sb_scanned = false;
RemoveVagCmd(new_cmd, 0);
FreeVagCmd(new_cmd, 0);
if ((new_cmd->vag_dir_entry->flag & 1U) != 0) {
if (cmd->vag_dir_entry && (new_cmd->vag_dir_entry->flag & 1U) != 0) { // added null check
new_stereo_cmd->sb_scanned = false;
RemoveVagCmd(new_stereo_cmd, 0);
FreeVagCmd(new_stereo_cmd, 0);
goal_src/jak1/engine/gfx/sprite/sparticle/sparticle-launcher-h.gc
+83 -60
View File
@@ -28,7 +28,7 @@
;; The `*part-group-id-table*` array stores a reference to every launch-group, indexed by group id.
;; Each launch-group is just a list of sparticle-launchers, stored as an index
;; A launcher is a single particle effect.
;; A launcher is a single particle effect.
;; The `*part-id-table*` has references to all particle effects.
;; It contains a list of "field-init-specs". When the particle effect starts, the system
;; iterates through this list and sets parameters about particles.
@@ -46,7 +46,7 @@
;; These are the user-settable state variables for each particle effect
(defenum sp-field-id
:type uint16
(misc-fields-start 0)
(spt-texture 1)
(spt-anim 2)
@@ -56,7 +56,7 @@
(spt-num 6)
(spt-sound 7)
(misc-fields-end 8)
(sprite-fields-start 9)
(spt-x 10)
(spt-y 11)
@@ -71,7 +71,7 @@
(spt-b 20)
(spt-a 21)
(sprite-fields-end 22)
(cpu-fields-start 23)
(spt-omega 24)
(spt-vel-x 25)
@@ -102,7 +102,7 @@
(spt-next-time 50)
(spt-next-launcher 51)
(cpu-fields-end 52)
(launch-fields-start 53)
(spt-launchrot-x 54)
(spt-launchrot-y 55)
@@ -115,7 +115,7 @@
(spt-conerot-radius 62)
(spt-rotate-y 63)
(launch-fields-end 64)
(spt-scale 65)
(spt-scalevel 66)
(spt-end 67)
@@ -322,27 +322,44 @@
`(-> *part-group-id-table* ,id)
)
(desfun param-float? (p)
(or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))
)
(desfun param-int? (p)
(or (integer? p) (and (pair? p) (eq? 'seconds (car p))))
)
(desfun param-symbol? (p)
(and (pair? p) (eq? 'quote (car p)))
)
(seval (begin
(define *sparticle-fields* '())
(define *sparticle-fields* (make-string-hash-table))
(doenum (name val 'sp-field-id)
(append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))))
(hash-table-set!
*sparticle-fields*
(if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
(list
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))
)
)
)
;; you cannot define these fields ever.
(define *sparticle-fields-banned* '(misc-fields-start
@@ -356,37 +373,35 @@
end
))
))
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(let ((last-field-id -1)
(param-float? (lambda (p) (or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))))
(param-int? (lambda (p) (or (integer? p) (and (pair? p) (eq? 'seconds (car p))))))
(param-symbol? (lambda (p) (and (pair? p) (eq? 'quote (car p))))))
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply (lambda (x)
(let* ((head (symbol->string (car x)))
;; the last field ID defined, to make sure that fields are defined in order.
(seval (define *last-field-id* -1))
(desfun process-init-spec (x)
(let* ((head (symbol->string (car x)))
(params (cdr x))
(field-name (string->symbol (string-substr head 1 0)))
(field (assoc field-name *sparticle-fields*)))
(when (not field)
(field-lookup (hash-table-try-ref *sparticle-fields* field-name))
(field (cdr field-lookup))
(store? (member ':store params))
(param-count (if store? (1- (length params)) (length params)))
)
(when (not (car field-lookup))
(fmt #t "unknown sparticle field {}\n" x))
(when (neq? (string-ref head 0) #\:)
(fmt #t "invalid sparticle field {}\n" x))
(when (member field-name *sparticle-fields-banned*)
(fmt #t "you cannot use sparticle field {}\n" field-name))
(let* ((field-id (cadr field))
(field-enum-name (caddr field))
(vel? (and #f (cadddr field)))
(param-count (length params))
; (when (member field-name *sparticle-fields-banned*)
; (fmt #t "you cannot use sparticle field {}\n" field-name))
(let ((field-id (car field))
(field-enum-name (cadr field))
(vel? (and #f (caddr field)))
(param0 (and (>= param-count 1) (first params)))
(param1 (and (>= param-count 2) (second params)))
(param2 (and (>= param-count 3) (third params))))
(when (>= last-field-id field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
(set! last-field-id field-id)
(when (>= *last-field-id* field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth *last-field-id* *sparticle-fields*)))
)
(set! *last-field-id* field-id)
(cond
((eq? field-name 'flags)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
@@ -401,36 +416,37 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
)
((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
(let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
(other-field-id (cadr other-field)))
(let* ((other-field-lookup (hash-table-try-ref *sparticle-fields* (cadr (member ':copy params))))
(other-field (cdr other-field-lookup))
(other-field-id (car other-field)))
(when (>= other-field-id field-id)
(fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
(fmt #t "warning copying to sparticle field {} from {} - you can only copy from fields before this one!\n" field-name (cadr other-field)) )
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag copy-from-other)
:initial-value ,(- other-field-id field-id) :random-mult 1)
)
)
((and (= 2 param-count) (symbol? param0) (eq? param0 ':data))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag object)
:pntr (the-as pointer ,(cadr (member ':data params))))
:object ,(cadr (member ':data params)))
)
((and (= 1 param-count) (param-symbol? param0))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag symbol)
:sym ,param0)
)
((and (= 1 param-count) (param-float? param0))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag float)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag ,(if store? 'float-store 'float))
:initial-valuef ,(if vel? `(/ ,param0 60.0) param0)
:random-rangef 0.0
:random-multf 1.0)
)
((and (= 2 param-count) (param-float? param0) (param-float? param1))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag float)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag ,(if store? 'float-store 'float))
:initial-valuef ,(if vel? `(/ ,param0 60.0) param0)
:random-rangef ,(if vel? `(/ ,param1 60.0) param1)
:random-multf 1.0)
)
((and (= 3 param-count) (param-float? param0) (param-float? param1) (param-float? param2))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag float)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag ,(if store? 'float-store 'float))
:initial-valuef ,(if vel? `(/ ,param0 60.0) param0)
:random-rangef ,param1
:random-multf ,(if vel? `(/ ,param2 60.0) param2))
@@ -463,12 +479,19 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)
)
))
) init-specs)
)
)
)
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(begin
(set! *last-field-id* -1)
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply process-init-spec init-specs)
(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)))
)
)
)
goal_src/jak2/engine/gfx/sprite/particles/sparticle-launcher-h.gc
+72 -47
View File
@@ -188,27 +188,44 @@
)
)
(desfun param-float? (p)
(or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))
)
(desfun param-int? (p)
(or (integer? p) (and (pair? p) (eq? 'seconds (car p))))
)
(desfun param-symbol? (p)
(and (pair? p) (eq? 'quote (car p)))
)
(seval (begin
(define *sparticle-fields* '())
(define *sparticle-fields* (make-string-hash-table))
(doenum (name val 'sp-field-id)
(append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))))
(hash-table-set!
*sparticle-fields*
(if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
(list
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))
)
)
)
;; you cannot define these fields ever.
(define *sparticle-fields-banned* '(misc-fields-start
@@ -222,38 +239,35 @@
end
))
))
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(let ((last-field-id -1)
(param-float? (lambda (p) (or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))))
(param-int? (lambda (p) (or (integer? p) (and (pair? p) (eq? 'seconds (car p))))))
(param-symbol? (lambda (p) (and (pair? p) (eq? 'quote (car p))))))
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply (lambda (x)
(let* ((head (symbol->string (car x)))
;; the last field ID defined, to make sure that fields are defined in order.
(seval (define *last-field-id* -1))
(desfun process-init-spec (x)
(let* ((head (symbol->string (car x)))
(params (cdr x))
(field-name (string->symbol (string-substr head 1 0)))
(field (assoc field-name *sparticle-fields*)))
(when (not field)
(field-lookup (hash-table-try-ref *sparticle-fields* field-name))
(field (cdr field-lookup))
(store? (member ':store params))
(param-count (if store? (1- (length params)) (length params)))
)
(when (not (car field-lookup))
(fmt #t "unknown sparticle field {}\n" x))
(when (neq? (string-ref head 0) #\:)
(fmt #t "invalid sparticle field {}\n" x))
(when (member field-name *sparticle-fields-banned*)
(fmt #t "you cannot use sparticle field {}\n" field-name))
(let* ((field-id (cadr field))
(field-enum-name (caddr field))
(vel? (and #f (cadddr field)))
(store? (member ':store params))
(param-count (if store? (1- (length params)) (length params)))
; (when (member field-name *sparticle-fields-banned*)
; (fmt #t "you cannot use sparticle field {}\n" field-name))
(let ((field-id (car field))
(field-enum-name (cadr field))
(vel? (and #f (caddr field)))
(param0 (and (>= param-count 1) (first params)))
(param1 (and (>= param-count 2) (second params)))
(param2 (and (>= param-count 3) (third params))))
(when (>= last-field-id field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
(set! last-field-id field-id)
(when (>= *last-field-id* field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth *last-field-id* *sparticle-fields*)))
)
(set! *last-field-id* field-id)
(cond
((eq? field-name 'flags)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
@@ -268,10 +282,11 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
)
((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
(let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
(other-field-id (cadr other-field)))
(let* ((other-field-lookup (hash-table-try-ref *sparticle-fields* (cadr (member ':copy params))))
(other-field (cdr other-field-lookup))
(other-field-id (car other-field)))
(when (>= other-field-id field-id)
(fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
(fmt #t "warning copying to sparticle field {} from {} - you can only copy from fields before this one!\n" field-name (cadr other-field)) )
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag copy-from-other)
:initial-value ,(- other-field-id field-id) :random-mult 1)
)
@@ -330,8 +345,18 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)
)
))
) init-specs)
)
)
)
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(begin
(set! *last-field-id* -1)
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply process-init-spec init-specs)
(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)))
)
test/decompiler/reference/jak1/decompiler-macros.gc
Generated Vendored
+76 -50
View File
@@ -693,27 +693,44 @@
`(-> *part-group-id-table* ,id)
)
(desfun param-float? (p)
(or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))
)
(desfun param-int? (p)
(or (integer? p) (and (pair? p) (eq? 'seconds (car p))))
)
(desfun param-symbol? (p)
(and (pair? p) (eq? 'quote (car p)))
)
(seval (begin
(define *sparticle-fields* '())
(define *sparticle-fields* (make-string-hash-table))
(doenum (name val 'sp-field-id)
(append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))))
(hash-table-set!
*sparticle-fields*
(if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
(list
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))
)
)
)
;; you cannot define these fields ever.
(define *sparticle-fields-banned* '(misc-fields-start
@@ -727,37 +744,35 @@
end
))
))
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(let ((last-field-id -1)
(param-float? (lambda (p) (or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))))
(param-int? (lambda (p) (or (integer? p) (and (pair? p) (eq? 'seconds (car p))))))
(param-symbol? (lambda (p) (and (pair? p) (eq? 'quote (car p))))))
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply (lambda (x)
(let* ((head (symbol->string (car x)))
;; the last field ID defined, to make sure that fields are defined in order.
(seval (define *last-field-id* -1))
(desfun process-init-spec (x)
(let* ((head (symbol->string (car x)))
(params (cdr x))
(field-name (string->symbol (string-substr head 1 0)))
(field (assoc field-name *sparticle-fields*)))
(when (not field)
(field-lookup (hash-table-try-ref *sparticle-fields* field-name))
(field (cdr field-lookup))
(store? (member ':store params))
(param-count (if store? (1- (length params)) (length params)))
)
(when (not (car field-lookup))
(fmt #t "unknown sparticle field {}\n" x))
(when (neq? (string-ref head 0) #\:)
(fmt #t "invalid sparticle field {}\n" x))
(when (member field-name *sparticle-fields-banned*)
(fmt #t "you cannot use sparticle field {}\n" field-name))
(let* ((field-id (cadr field))
(field-enum-name (caddr field))
(vel? (and #f (cadddr field)))
(param-count (length params))
; (when (member field-name *sparticle-fields-banned*)
; (fmt #t "you cannot use sparticle field {}\n" field-name))
(let ((field-id (car field))
(field-enum-name (cadr field))
(vel? (and #f (caddr field)))
(param0 (and (>= param-count 1) (first params)))
(param1 (and (>= param-count 2) (second params)))
(param2 (and (>= param-count 3) (third params))))
(when (>= last-field-id field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
(set! last-field-id field-id)
(when (>= *last-field-id* field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth *last-field-id* *sparticle-fields*)))
)
(set! *last-field-id* field-id)
(cond
((eq? field-name 'flags)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
@@ -772,36 +787,37 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
)
((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
(let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
(other-field-id (cadr other-field)))
(let* ((other-field-lookup (hash-table-try-ref *sparticle-fields* (cadr (member ':copy params))))
(other-field (cdr other-field-lookup))
(other-field-id (car other-field)))
(when (>= other-field-id field-id)
(fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
(fmt #t "warning copying to sparticle field {} from {} - you can only copy from fields before this one!\n" field-name (cadr other-field)) )
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag copy-from-other)
:initial-value ,(- other-field-id field-id) :random-mult 1)
)
)
((and (= 2 param-count) (symbol? param0) (eq? param0 ':data))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag object)
:pntr (the-as pointer ,(cadr (member ':data params))))
:object ,(cadr (member ':data params)))
)
((and (= 1 param-count) (param-symbol? param0))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag symbol)
:sym ,param0)
)
((and (= 1 param-count) (param-float? param0))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag float)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag ,(if store? 'float-store 'float))
:initial-valuef ,(if vel? `(/ ,param0 60.0) param0)
:random-rangef 0.0
:random-multf 1.0)
)
((and (= 2 param-count) (param-float? param0) (param-float? param1))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag float)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag ,(if store? 'float-store 'float))
:initial-valuef ,(if vel? `(/ ,param0 60.0) param0)
:random-rangef ,(if vel? `(/ ,param1 60.0) param1)
:random-multf 1.0)
)
((and (= 3 param-count) (param-float? param0) (param-float? param1) (param-float? param2))
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag float)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag ,(if store? 'float-store 'float))
:initial-valuef ,(if vel? `(/ ,param0 60.0) param0)
:random-rangef ,param1
:random-multf ,(if vel? `(/ ,param2 60.0) param2))
@@ -834,8 +850,18 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)
)
))
) init-specs)
)
)
)
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(begin
(set! *last-field-id* -1)
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply process-init-spec init-specs)
(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)))
)
test/decompiler/reference/jak2/decompiler-macros.gc
Generated Vendored
+72 -47
View File
@@ -1037,27 +1037,44 @@
)
)
(desfun param-float? (p)
(or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))
)
(desfun param-int? (p)
(or (integer? p) (and (pair? p) (eq? 'seconds (car p))))
)
(desfun param-symbol? (p)
(and (pair? p) (eq? 'quote (car p)))
)
(seval (begin
(define *sparticle-fields* '())
(define *sparticle-fields* (make-string-hash-table))
(doenum (name val 'sp-field-id)
(append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))))
(hash-table-set!
*sparticle-fields*
(if (string-starts-with? (symbol->string name) "spt-")
(string->symbol (string-substr (symbol->string name) 4 0))
name)
(list
val name (member name '(spt-vel-x
spt-vel-y
spt-vel-z
spt-scalevel-x
spt-scalevel-y
spt-rotvel-x
spt-rotvel-y
spt-rotvel-z
spt-fade-r
spt-fade-g
spt-fade-b
spt-fade-a
spt-accel-x
spt-accel-y
spt-accel-z))
)
)
)
;; you cannot define these fields ever.
(define *sparticle-fields-banned* '(misc-fields-start
@@ -1071,38 +1088,35 @@
end
))
))
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(let ((last-field-id -1)
(param-float? (lambda (p) (or (float? p) (and (pair? p) (eq? 'meters (car p))) (and (pair? p) (eq? 'degrees (car p))))))
(param-int? (lambda (p) (or (integer? p) (and (pair? p) (eq? 'seconds (car p))))))
(param-symbol? (lambda (p) (and (pair? p) (eq? 'quote (car p))))))
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply (lambda (x)
(let* ((head (symbol->string (car x)))
;; the last field ID defined, to make sure that fields are defined in order.
(seval (define *last-field-id* -1))
(desfun process-init-spec (x)
(let* ((head (symbol->string (car x)))
(params (cdr x))
(field-name (string->symbol (string-substr head 1 0)))
(field (assoc field-name *sparticle-fields*)))
(when (not field)
(field-lookup (hash-table-try-ref *sparticle-fields* field-name))
(field (cdr field-lookup))
(store? (member ':store params))
(param-count (if store? (1- (length params)) (length params)))
)
(when (not (car field-lookup))
(fmt #t "unknown sparticle field {}\n" x))
(when (neq? (string-ref head 0) #\:)
(fmt #t "invalid sparticle field {}\n" x))
(when (member field-name *sparticle-fields-banned*)
(fmt #t "you cannot use sparticle field {}\n" field-name))
(let* ((field-id (cadr field))
(field-enum-name (caddr field))
(vel? (and #f (cadddr field)))
(store? (member ':store params))
(param-count (if store? (1- (length params)) (length params)))
; (when (member field-name *sparticle-fields-banned*)
; (fmt #t "you cannot use sparticle field {}\n" field-name))
(let ((field-id (car field))
(field-enum-name (cadr field))
(vel? (and #f (caddr field)))
(param0 (and (>= param-count 1) (first params)))
(param1 (and (>= param-count 2) (second params)))
(param2 (and (>= param-count 3) (third params))))
(when (>= last-field-id field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
(set! last-field-id field-id)
(when (>= *last-field-id* field-id)
(fmt #t "field {} must come after field {}, not before\n" field-name (car (nth *last-field-id* *sparticle-fields*)))
)
(set! *last-field-id* field-id)
(cond
((eq? field-name 'flags)
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
@@ -1117,10 +1131,11 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
)
((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
(let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
(other-field-id (cadr other-field)))
(let* ((other-field-lookup (hash-table-try-ref *sparticle-fields* (cadr (member ':copy params))))
(other-field (cdr other-field-lookup))
(other-field-id (car other-field)))
(when (>= other-field-id field-id)
(fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
(fmt #t "warning copying to sparticle field {} from {} - you can only copy from fields before this one!\n" field-name (cadr other-field)) )
`(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag copy-from-other)
:initial-value ,(- other-field-id field-id) :random-mult 1)
)
@@ -1179,8 +1194,18 @@
`(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)
)
))
) init-specs)
)
)
)
(defmacro defpart (id &key (init-specs ()))
"define a new sparticle-launcher"
(begin
(set! *last-field-id* -1)
`(set! (-> *part-id-table* ,id)
(new 'static 'sparticle-launcher
:init-specs (new 'static 'inline-array sp-field-init-spec ,(1+ (length init-specs))
,@(apply process-init-spec init-specs)
(new 'static 'sp-field-init-spec :field (sp-field-id spt-end))
)))
)