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

[jak2] decomp gkernel, setup offline tests (#1638)

Browse Source 
* add comments

* oops

* format'

* spelling is hard
This commit is contained in:
water111
2022-07-12 18:50:18 -04:00
committed by GitHub
parent d66af4f4c7
commit dc652d10c5
39 changed files with 14858 additions and 2046 deletions
Download Patch File Download Diff File Expand all files Collapse all files
decompiler/IR2/AtomicOpTypeAnalysis.cpp
+12 -1
View File
@@ -190,7 +190,7 @@ TP_Type SimpleExpression::get_type(const TypeState& input,
}
// new for jak 2:
if (env.version == GameVersion::Jak2 && in_type.is_integer_constant() &&
in_type.get_integer_constant() <= UINT32_MAX) {
(s64)((s32)in_type.get_integer_constant()) == (s64)in_type.get_integer_constant()) {
return TP_Type::make_from_ts("float");
}
return in_type;
@@ -649,6 +649,17 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input,
}
}
if (env.version == GameVersion::Jak2 && tc(dts, TypeSpec("symbol"), arg1_type) &&
!m_args[0].is_int() && is_int_or_uint(dts, arg0_type)) {
if (arg0_type.is_integer_constant(jak2::SYM_TO_STRING_OFFSET)) {
// symbol -> GOAL String
// NOTE - the offset doesn't fit in a s16, so it's loaded into a register first.
// so we expect the arg to be a variable, and the type propagation will figure out the
// integer constant.
return TP_Type::make_from_ts(dts.ts.make_pointer_typespec("string"));
}
}
if (tc(dts, TypeSpec("structure"), arg1_type) && !m_args[0].is_int() &&
is_int_or_uint(dts, arg0_type)) {
if (arg1_type.typespec() == TypeSpec("symbol") &&
decompiler/IR2/FormExpressionAnalysis.cpp
+78 -17
View File
@@ -97,6 +97,19 @@ Form* try_cast_simplify(Form* in,
return in;
}
if (env.version == GameVersion::Jak2) {
if (new_type == TypeSpec("float")) {
auto ic = get_goal_integer_constant(in, env);
if (ic) {
// ASSERT(*ic <= UINT32_MAX);
ASSERT((s64)*ic == (s64)(s32)*ic);
float f;
memcpy(&f, &ic.value(), sizeof(float));
return pool.form<ConstantFloatElement>(f);
}
}
}
if (new_type == TypeSpec("meters")) {
auto fc = get_goal_float_constant(in);
@@ -682,6 +695,15 @@ void SimpleExpressionElement::update_from_stack_identity(const Env& env,
}
}
bool u64_valid_for_float_constant(u64 in) {
u32 top = in >> 32;
if (top == 0 || top == UINT32_MAX) {
return true;
} else {
return false;
}
}
void SimpleExpressionElement::update_from_stack_gpr_to_fpr(const Env& env,
FormPool& pool,
FormStack& stack,
@@ -712,12 +734,10 @@ void SimpleExpressionElement::update_from_stack_gpr_to_fpr(const Env& env,
auto frm = pool.alloc_sequence_form(nullptr, src_fes);
if (src_fes.size() == 1) {
auto int_constant = get_goal_integer_constant(frm, env);
if (int_constant && (*int_constant <= UINT32_MAX)) {
if (int_constant && u64_valid_for_float_constant(*int_constant)) {
float flt;
memcpy(&flt, &int_constant.value(), sizeof(float));
result->push_back(pool.alloc_element<ConstantFloatElement>(flt));
return;
}
@@ -964,7 +984,18 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env,
// try to find symbol to string stuff
auto arg0_int = get_goal_integer_constant(args.at(0), env);
if (arg0_int && (*arg0_int == DECOMP_SYM_INFO_OFFSET + 4) &&
u64 symbol_to_string_offset = -1;
switch (env.version) {
case GameVersion::Jak1:
symbol_to_string_offset = DECOMP_SYM_INFO_OFFSET + 4;
break;
case GameVersion::Jak2:
symbol_to_string_offset = jak2::SYM_TO_STRING_OFFSET;
break;
default:
ASSERT(false);
}
if (arg0_int && (*arg0_int == symbol_to_string_offset) &&
arg1_type.typespec() == TypeSpec("symbol")) {
result->push_back(pool.alloc_element<GetSymbolStringPointer>(args.at(1)));
return;
@@ -2636,23 +2667,53 @@ bool try_to_rewrite_matrix_inline_ctor(const Env& env, FormPool& pool, FormStack
// zeroing the rows:
std::vector<RegisterAccess> write_vars;
for (int i = 0; i < 4; i++) {
auto elt = matrix_entries->at(i + 1).elt;
if (env.version == GameVersion::Jak1) {
for (int i = 0; i < 4; i++) {
auto elt = matrix_entries->at(i + 1).elt;
auto matcher = Matcher::set(
Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i),
DerefTokenMatcher::string("quad")}),
Matcher::cast("uint128", Matcher::integer(0)));
auto matcher = Matcher::set(
Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i),
DerefTokenMatcher::string("quad")}),
Matcher::cast("uint128", Matcher::integer(0)));
auto mr = match(matcher, elt);
if (mr.matched) {
if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) {
auto mr = match(matcher, elt);
if (mr.matched) {
if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) {
return false;
}
write_vars.push_back(*mr.maps.regs.at(0));
} else {
return false;
}
}
} else {
for (int i = 0; i < 4; i++) {
auto elt = matrix_entries->at(i + 1).elt;
Matcher matcher;
if (i == 3) {
matcher = Matcher::set(Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("trans"),
DerefTokenMatcher::string("quad")}),
Matcher::cast("uint128", Matcher::integer(0)));
} else {
matcher = Matcher::set(
Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("quad"), DerefTokenMatcher::integer(i)}),
Matcher::cast("uint128", Matcher::integer(0)));
}
auto mr = match(matcher, elt);
if (mr.matched) {
if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) {
return false;
}
write_vars.push_back(*mr.maps.regs.at(0));
} else {
return false;
}
write_vars.push_back(*mr.maps.regs.at(0));
} else {
return false;
}
}
decompiler/ObjectFile/ObjectFileDB_IR2.cpp
+1 -3
View File
@@ -103,9 +103,7 @@ void ObjectFileDB::analyze_functions_ir2(
if (!output_dir.string().empty()) {
ir2_write_results(output_dir, config, imports, data);
} else {
if (!skip_functions.empty()) {
data.output_with_skips = ir2_final_out(data, imports, skip_functions);
}
data.output_with_skips = ir2_final_out(data, imports, skip_functions);
data.full_output = ir2_final_out(data, imports, {});
}
decompiler/analysis/atomic_op_builder.cpp
+1
View File
@@ -308,6 +308,7 @@ std::unique_ptr<AtomicOp> make_asm_op(const Instruction& i0, int idx) {
case InstructionKind::MSUBAS:
case InstructionKind::MSUBS:
case InstructionKind::ADDAS:
case InstructionKind::RSQRTS:
// Moves / Loads / Stores
case InstructionKind::CTC2:
decompiler/config/jak2/all-types.gc
+3360 -1969
View File
File diff suppressed because it is too large Load Diff
decompiler/config/jak2/anonymous_function_types.jsonc
+6
View File
@@ -6,5 +6,11 @@
[26, "(function process symbol)"],
[23, "(function process symbol)"],
[17, "(function process symbol)"]
],
"level": [
[5, "(function none)"]
],
"main": [
[3, "(function none :behavior process)"]
]
}
decompiler/config/jak2/hacks.jsonc
+10 -2
View File
@@ -37,7 +37,7 @@
"(anon-function 54 script)", "(anon-function 52 script)", "(anon-function 49 script)", "(anon-function 33 script)", "debug-menu-func-decode",
"scene-player-init", "(method 77 spyder)", "(method 77 flamer)", "(method 77 grenadier)", "(method 224 bot)", "(method 77 rapid-gunner)",
// until loop without nop:
"rand-vu-int-count-excluding", "rand-vu-int-range-exclude", "(method 9 history)", "history-print", "history-draw",
"(method 9 history)", "history-print", "history-draw",
"(method 9 sparticle-launcher)", "(method 18 tracking-spline)", "cam-string-find-position-rel!", "cam-layout-entity-volume-info-create",
"process-drawable-shock-skel-effect", "target-history-print", "display-list-control", "anim-test-anim-list-handler",
"anim-test-sequence-list-handler", "anim-tester-get-playing-item", "(method 9 mysql-nav-graph)", "(method 58 nav-graph-editor)",
@@ -47,7 +47,7 @@
// actual asm
"quad-copy!", "return-from-thread", "return-from-thread-dead", "reset-and-call", "(method 10 cpu-thread)",
"(method 11 cpu-thread)", "(method 0 catch-frame)", "throw-dispatch", "throw", "run-function-in-process",
"set-to-run-bootstrap", "return-from-exception",
"set-to-run-bootstrap", "return-from-exception", "exp",
"symlink2", "blerc-a-fragment", "blerc-execute", "foreground-check-longest-edge-asm", "generic-light-proc",
"shadow-add-single-edges","shadow-add-facing-single-tris", "shadow-add-double-tris", "shadow-add-double-edges",
@@ -95,7 +95,15 @@
},
"blocks_ending_in_asm_branch": {
"closest-pt-in-triangle": [17],
// this one is all asm branches
"circle-circle-xz-intersect": [
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
],
"find-knot-span": [0, 1, 2, 3, 5, 6, 7, 8, 9],
"curve-evaluate!": [0, 2, 5, 6, 7, 8, 9]
},
// Sometimes the game might use format strings that are fetched dynamically,
decompiler/config/jak2/label_types.jsonc
+67 -1
View File
@@ -1 +1,67 @@
{}
{
"profile": [
["L14", "profile-work"]
],
"math": [
["L103", "(pointer float)", 32],
["L102", "(pointer float)", 32]
],
// possible for auto-labeling
"vector-h": [
["L36", "vector"],
["L35", "vector"],
["L34", "vector"],
["L33", "vector"],
["L32", "vector"],
["L31", "vector"],
["L30", "vector"]
],
"matrix": [
["L65", "matrix"]
],
"quaternion-h": [
["L1", "quaternion"]
],
"quaternion": [
["L85", "vector"],
["L84", "vector"],
["L83", "vector"],
["L82", "vector"],
["L81", "vector"],
["L80", "vector"],
["L79", "vector"],
["L78", "vector"]
],
"trigonometry": [
["L93", "vector"],
["L92", "vector"],
["L91", "vector"]
],
"video-h": [
["L1", "video-params"]
],
"geometry": [
["L132", "vector"]
],
"texture-h": [
["L10", "texture-base"],
["L9", "texture-base"],
["L8", "texture-base"],
["L7", "texture-base"],
["L6", "texture-base"],
["L5", "texture-base"]
],
"texture-anim-h": [
["L1", "(pointer uint32)", 64]
],
"main-h": [
["L3", "frame-stats"]
],
"font-h": [
["L20", "matrix"],
["L19", "font-work"]
]
}
decompiler/config/jak2/stack_structures.jsonc
+262
View File
@@ -1,4 +1,266 @@
{
// possible for automatic detection:
"(method 23 trsqv)": [[16, "vector"]],
"(method 24 trsqv)": [[16, "vector"]],
"(method 18 bounding-box)": [[16, "vector"], [32, "vector"]],
"(method 12 bounding-box)": [[16, "liang-barsky-line-clip-params"]],
"matrixp*!": [[16, "matrix"]],
"vector3s-matrix*!": [[16, "vector"]],
"vector3s-rotate*!": [[16, "vector"]],
"matrix-rotate-zyx!": [
[16, "matrix"],
[80, "matrix"]
],
"matrix-rotate-xyz!": [
[16, "vector"],
[32, "vector"],
[80, "matrix"]
],
"matrix-rotate-zxy!": [
[16, "matrix"],
[80, "matrix"]
],
"matrix-rotate-yxz!": [
[16, "matrix"],
[80, "matrix"]
],
"matrix-rotate-yzx!": [
[16, "matrix"],
[80, "matrix"]
],
"matrix-rotate-yxy!": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"matrix-rotate-yx!": [[16, "matrix"]],
"transform-matrix-calc!": [
[16, "matrix"],
[80, "matrix"]
],
"transform-matrix-parent-calc!": [
[16, "matrix"],
[80, "matrix"]
],
"matrix->quat": [
[16, "matrix"]
],
"matrix<-quat": [
[16, "vector"],
[32, "matrix"]
],
"matrix->transformq": [
[16, "matrix"]
],
"matrix-rotate-xyz-2!": [
[16, "matrix"],
[80, "matrix"]
],
"matrix-with-scale->quaternion": [[16, "matrix"]],
"quaternion-exp!": [[16, "vector"]],
"quaternion-slerp!": [[16, "vector"]],
"quaternion-zxy!": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"vector-x-quaternion!": [[16, "matrix"]],
"vector-y-quaternion!": [[16, "matrix"]],
"vector-z-quaternion!": [[16, "matrix"]],
"quaternion-x-angle": [[16, "vector"]],
"quaternion-y-angle": [[16, "vector"]],
"quaternion-z-angle": [[16, "vector"]],
"quaternion-rotate-local-x!": [[16, "quaternion"]],
"quaternion-rotate-local-y!": [[16, "quaternion"]],
"quaternion-rotate-local-z!": [[16, "quaternion"]],
"quaternion-rotate-y!": [[16, "quaternion"]],
"quaternion-rotate-x!": [
[16, "quaternion"],
[32, "vector"]
],
"quaternion-rotate-z!": [
[16, "quaternion"],
[32, "vector"]
],
"quaternion-delta-y": [
[16, "vector"],
[32, "vector"]
],
"quaternion-rotate-y-to-vector!": [
[16, "quaternion"],
[32, "vector"],
[48, "quaternion"]
],
"quaternion-xz-angle": [
[16, "matrix"],
[80, "vector"]
],
"vector-rotate-x!": [
[16, "quaternion"],
[32, "matrix"]
],
"vector-rotate-y!": [
[16, "quaternion"],
[32, "matrix"]
],
"vector-rotate-z!": [
[16, "quaternion"],
[32, "matrix"]
],
"quaternion-axis-angle!": [
[16, "vector"]
],
"quaternion-vector-angle!": [
[16, "vector"]
],
"quaternion-look-at!": [
[16, "matrix"]
],
"quaternion-pseudo-seek": [
[16, "quaternion"],
[32, "quaternion"]
],
"quaternion-smooth-seek!": [
[16, ["inline-array", "quaternion", 2]]
],
"eul->matrix": [[16, "vector"]],
"eul->quat": [[16, "matrix"]],
"quat->eul": [[16, "matrix"]],
"vector-sincos!": [[16, "vector"]],
"vector-reflect-flat-gravity!": [[16, "vector"], [32, "vector"]],
"vector-line-distance": [
[16, "vector"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"vector-line-distance-point!": [
[16, "vector"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"forward-up-nopitch->inv-matrix": [[16, "vector"]],
"forward-up-nopitch->quaternion": [[16, "matrix"]],
"forward-up->quaternion": [
[16, "matrix"],
[80, "vector"]
],
"quaternion-from-two-vectors!": [[16, "vector"]],
"quaternion-from-two-vectors-max-angle!": [[16, "vector"]],
"matrix-from-two-vectors!": [[16, "vector"]],
"matrix-from-two-vectors-max-angle!": [[16, "vector"]],
"matrix-from-two-vectors-max-angle-partial!": [[16, "vector"]],
"matrix-from-two-vectors-partial-linear!": [[16, "vector"]],
"matrix-remove-z-rot": [
[16, "vector"],
[32, "matrix"]
],
"matrix-rot-diff!": [
[16, "quaternion"],
[32, "quaternion"],
[48, "quaternion"]
],
"quaternion-seek": [
[16, "matrix"],
[80, "matrix"],
[144, "quaternion"]
],
"vector-segment-overlap": [
[16, "vector"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"line-sphere-intersection?": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"forward-up->inv-matrix": [
[16, "vector"]
],
"quaternion-from-two-vectors-partial!": [
[16, "vector"]
],
"quaternion-from-two-vectors-max-angle-partial!": [
[16, "vector"]
],
"matrix-from-two-vectors-smooth!": [
[16, "vector"]
],
"matrix-from-two-vectors-the-long-way-smooth!": [
[16, "vector"]
],
"quaternion-from-two-vectors-smooth!": [
[16, "matrix"]
],
"vector-deg-seek": [[16, "matrix"]],
"vector-deg-slerp": [
[16, "matrix"],
[80, "vector"],
[96, "vector"]
],
"circle-test": [
[16, "sphere"],
[32, "sphere"],
[48, "vector"],
[64, "vector"]
],
"vector-vector-deg-slerp!": [
[16, "vector"],
[32, "vector"],
[48, "quaternion"],
[64, "quaternion"],
[80, "quaternion"],
[96, "vector"]
],
"vector-circle-tangent-new": [
[16, "sphere"],
[32, "vector"],
[48, "vector"]
],
"vector-circle-tangent": [
[16, "sphere"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"curve-length": [
[16, "vector"],
[32, "vector"]
],
"curve-closest-point": [
[16, "vector"],
[32, "vector"]
],
"closest-pt-in-triangle": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"vector-plane-distance": [[16, "vector"]],
"vector-smooth-seek!": [[16, "vector"]],
"vector-vector-angle-safe": [[16, "vector"], [32, "vector"]],
"move-target-from-pad": [
[16, "vector"],
[32, "vector"],
[48, "matrix"]
],
"reverse-transform-point!": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"init-for-transform": [
[16, "matrix"],
[80, "matrix"],
[144, "vector4s-3"],
[192, "vector"],
[208, "vector4s-3"]
],
"placeholder-do-not-add-below!": []
}
decompiler/config/jak2/type_casts.jsonc
+112
View File
@@ -65,5 +65,117 @@
[101, "t9", "(function object object object object object object none)"]
],
"send-event-function": [[[7, 15], "a0", "process"]],
"logf": [
[12, "f0", "float"],
[12, "f1", "float"],
[19, "f0", "float"],
[19, "f1", "float"]
],
"log2f": [
[12, "f0", "float"],
[12, "f1", "float"],
[19, "f0", "float"],
[19, "f1", "float"]
],
"log2": [[3, "v1", "int"]],
"cube-root": [
[[0,33], "f0", "float"],
[[0,33], "f1", "float"],
[[0,33], "f2", "float"]
],
"vector-x-quaternion!": [[10, "v1", "(pointer uint128)"]],
"vector-y-quaternion!": [[10, "v1", "(pointer uint128)"]],
"vector-z-quaternion!": [[10, "v1", "(pointer uint128)"]],
"dma-buffer-add-vu-function": [[[9, 33], "t2", "dma-packet"]],
"dma-buffer-add-buckets": [
[[1, 4], "v1", "dma-bucket"],
[5, "v1", "pointer"],
[[9, 11], "v1", "dma-bucket"],
[11, "v1", "pointer"]
],
"dma-buffer-patch-buckets": [
[[6,8], "a0", "(inline-array dma-bucket)"],
[8, "a3", "pointer"],
[14, "a0", "(inline-array dma-bucket)"],
[3, "a0", "(inline-array dma-bucket)"],
[36, "a0", "(inline-array dma-bucket)"],
[10, "a0", "(inline-array dma-bucket)"],
[18, "a0", "(inline-array dma-bucket)"],
[[29,33], "a0", "dma-packet"],
[34, "a0", "(inline-array dma-bucket)"]
],
"dma-bucket-insert-tag": [
[[2, 6], "v1", "dma-bucket"],
[3, "a0", "dma-bucket"]
],
"disasm-vif-details": [
[[62, 94], "s3", "(pointer uint32)"],
[[98, 130], "s3", "(pointer uint16)"],
[[134, 164], "s3", "(pointer uint32)"],
[[168, 198], "s3", "(pointer uint16)"],
[[202, 225], "s3", "(pointer uint16)"]
],
"disasm-vif-tag": [
[[81, 85], "t1", "vif-stcycl-imm"],
[242, "a0", "vif-unpack-imm"]
],
"disasm-dma-list": [
[25, "v1", "dma-tag"],
[153, "v1", "dma-packet"],
[189, "v1", "dma-packet"],
[229, "v1", "dma-packet"],
[258, "v1", "dma-packet"],
[302, "v1", "dma-packet"],
[308, "v1", "dma-packet"],
[152, "v1", "(pointer uint64)"],
[167, "v1", "(pointer uint64)"],
[176, "v1", "(pointer uint64)"],
[198, "v1", "(pointer uint64)"],
[207, "v1", "(pointer uint64)"],
[238, "v1", "(pointer uint64)"],
[247, "v1", "(pointer uint64)"],
[282, "v1", "(pointer uint64)"],
[291, "v1", "(pointer uint64)"],
[324, "v1", "(pointer uint64)"],
[334, "v1", "(pointer uint64)"]
],
"calculate-basis-functions-vector!": [
[[8, 20], "v1", "(pointer float)"],
[[0, 60], "f1", "float"]
],
"curve-evaluate!": [[62, "s5", "pointer"]],
"vector4-array-add!": [
[11, "s5", "(inline-array vector4)"],
[12, "s4", "(inline-array vector4)"],
[13, "gp", "(inline-array vector4)"]],
"vector4-array-sub!": [
[11, "s5", "(inline-array vector4)"],
[12, "s4", "(inline-array vector4)"],
[13, "gp", "(inline-array vector4)"]],
"vector4-array-mul!": [
[11, "s5", "(inline-array vector4)"],
[12, "s4", "(inline-array vector4)"],
[13, "gp", "(inline-array vector4)"]],
"vector4-array-scale!": [
[11, "s5", "(inline-array vector4)"],
[12, "gp", "(inline-array vector4)"]],
"vector4-array-madd!": [
[13, "s5", "(inline-array vector4)"],
[14, "s4", "(inline-array vector4)"],
[15, "gp", "(inline-array vector4)"]],
"vector4-array-msub!": [
[13, "s5", "(inline-array vector4)"],
[14, "s4", "(inline-array vector4)"],
[15, "gp", "(inline-array vector4)"]],
"vector4-array-lerp!": [
[13, "s5", "(inline-array vector4)"],
[14, "s4", "(inline-array vector4)"],
[15, "gp", "(inline-array vector4)"]],
"placeholder-do-not-add-below": []
}
decompiler/config/jak2_ntsc_v1.jsonc
+1 -1
View File
@@ -19,7 +19,7 @@
"disassemble_code": true,
// Run the decompiler
"decompile_code": false,
"decompile_code": true,
"find_functions": true,
decompiler/util/data_decompile.cpp
+1 -1
View File
@@ -924,7 +924,7 @@ goos::Object decompile_structure(const TypeSpec& type,
}
// first, let's see if it's a value or reference
auto field_type_info = ts.lookup_type(field.type());
auto field_type_info = ts.lookup_type_allow_partial_def(field.type());
if (!field_type_info->is_reference()) {
// value type. need to get bytes.
ASSERT(!field.is_inline());
goal_src/jak2/dgos/engine.gd
+371
View File
@@ -0,0 +1,371 @@
("ENGINE.CGO"
("types-h.o" "types-h")
("vu1-macros.o" "vu1-macros")
("math.o" "math")
("vector-h.o" "vector-h")
("gravity-h.o" "gravity-h")
("bounding-box-h.o" "bounding-box-h")
("matrix-h.o" "matrix-h")
("quaternion-h.o" "quaternion-h")
("euler-h.o" "euler-h")
("transform-h.o" "transform-h")
("geometry-h.o" "geometry-h")
("trigonometry-h.o" "trigonometry-h")
("transformq-h.o" "transformq-h")
("bounding-box.o" "bounding-box")
("matrix.o" "matrix")
("transform.o" "transform")
("quaternion.o" "quaternion")
("euler.o" "euler")
("trigonometry.o" "trigonometry")
("gsound-h.o" "gsound-h")
("timer-h.o" "timer-h")
("vif-h.o" "vif-h")
("dma-h.o" "dma-h")
("video-h.o" "video-h")
("vu1-user-h.o" "vu1-user-h")
("profile-h.o" "profile-h")
("dma.o" "dma")
("dma-buffer.o" "dma-buffer")
("dma-bucket.o" "dma-bucket")
("dma-disasm.o" "dma-disasm")
("pad.o" "pad")
("gs.o" "gs")
("display-h.o" "display-h")
("geometry.o" "geometry")
("timer.o" "timer")
("vector.o" "vector")
("file-io.o" "file-io")
("loader-h.o" "loader-h")
("texture-h.o" "texture-h")
("texture-anim-h.o" "texture-anim-h")
("lights-h.o" "lights-h")
("mood-h.o" "mood-h")
("level-h.o" "level-h")
("capture-h.o" "capture-h")
("math-camera-h.o" "math-camera-h")
("math-camera.o" "math-camera")
("font-h.o" "font-h")
("decomp-h.o" "decomp-h")
("profile.o" "profile")
("display.o" "display")
("connect.o" "connect")
("text-id-h.o" "text-id-h")
("text-h.o" "text-h")
("camera-defs-h.o" "camera-defs-h")
("trail-h.o" "trail-h")
("minimap-h.o" "minimap-h")
("bigmap-h.o" "bigmap-h")
("settings-h.o" "settings-h")
("capture.o" "capture")
("memory-usage-h.o" "memory-usage-h")
("blit-displays-h.o" "blit-displays-h")
("texture.o" "texture")
("main-h.o" "main-h")
("mspace-h.o" "mspace-h")
("drawable-h.o" "drawable-h")
("drawable-group-h.o" "drawable-group-h")
("drawable-inline-array-h.o" "drawable-inline-array-h")
("draw-node-h.o" "draw-node-h")
("drawable-tree-h.o" "drawable-tree-h")
("drawable-actor-h.o" "drawable-actor-h")
("region-h.o" "region-h")
("traffic-h.o" "traffic-h")
("game-task-h.o" "game-task-h")
("task-control-h.o" "task-control-h")
("generic-h.o" "generic-h")
("sky-h.o" "sky-h")
("ocean-h.o" "ocean-h")
("ocean-trans-tables.o" "ocean-trans-tables")
("ocean-tables.o" "ocean-tables")
("ocean-frames.o" "ocean-frames")
("time-of-day-h.o" "time-of-day-h")
("art-h.o" "art-h")
("generic-vu1-h.o" "generic-vu1-h")
("merc-h.o" "merc-h")
("generic-merc-h.o" "generic-merc-h")
("generic-tie-h.o" "generic-tie-h")
("generic-work-h.o" "generic-work-h")
("shadow-cpu-h.o" "shadow-cpu-h")
("shadow-vu1-h.o" "shadow-vu1-h")
("memcard-h.o" "memcard-h")
("game-info-h.o" "game-info-h")
("gui-h.o" "gui-h")
("ambient-h.o" "ambient-h")
("speech-h.o" "speech-h")
("wind-h.o" "wind-h")
("prototype-h.o" "prototype-h")
("joint-h.o" "joint-h")
("bones-h.o" "bones-h")
("foreground-h.o" "foreground-h")
("engines.o" "engines")
("lightning-h.o" "lightning-h")
("res-h.o" "res-h")
("res.o" "res")
("lights.o" "lights")
("dynamics-h.o" "dynamics-h")
("surface-h.o" "surface-h")
("pat-h.o" "pat-h")
("fact-h.o" "fact-h")
("aligner-h.o" "aligner-h")
("penetrate-h.o" "penetrate-h")
("game-h.o" "game-h")
("script-h.o" "script-h")
("scene-h.o" "scene-h")
("sync-info-h.o" "sync-info-h")
("pov-camera-h.o" "pov-camera-h")
("smush-control-h.o" "smush-control-h")
("debug-h.o" "debug-h")
("joint-mod-h.o" "joint-mod-h")
("collide-func-h.o" "collide-func-h")
("collide-mesh-h.o" "collide-mesh-h")
("collide-shape-h.o" "collide-shape-h")
("generic-obs-h.o" "generic-obs-h")
("trajectory-h.o" "trajectory-h")
("collide-target-h.o" "collide-target-h")
("collide-touch-h.o" "collide-touch-h")
("collide-edge-grab-h.o" "collide-edge-grab-h")
("process-drawable-h.o" "process-drawable-h")
("process-focusable.o" "process-focusable")
("process-taskable-h.o" "process-taskable-h")
("focus.o" "focus")
("effect-control-h.o" "effect-control-h")
("collide-frag-h.o" "collide-frag-h")
("collide-hash-h.o" "collide-hash-h")
("chain-physics-h.o" "chain-physics-h")
("projectile-h.o" "projectile-h")
("find-nearest-h.o" "find-nearest-h")
("target-h.o" "target-h")
("stats-h.o" "stats-h")
("bsp-h.o" "bsp-h")
("collide-cache-h.o" "collide-cache-h")
("collide-h.o" "collide-h")
("shrubbery-h.o" "shrubbery-h")
("tie-h.o" "tie-h")
("tfrag-h.o" "tfrag-h")
("background-h.o" "background-h")
("subdivide-h.o" "subdivide-h")
("entity-h.o" "entity-h")
("sprite-h.o" "sprite-h")
("simple-sprite-h.o" "simple-sprite-h")
("eye-h.o" "eye-h")
("sparticle-launcher-h.o" "sparticle-launcher-h")
("sparticle-h.o" "sparticle-h")
("actor-link-h.o" "actor-link-h")
("camera-h.o" "camera-h")
("cam-debug-h.o" "cam-debug-h")
("cam-interface-h.o" "cam-interface-h")
("cam-update-h.o" "cam-update-h")
("hud-h.o" "hud-h")
("progress-h.o" "progress-h")
("rpc-h.o" "rpc-h")
("path-h.o" "path-h")
("nav-mesh-h.o" "nav-mesh-h")
("nav-control-h.o" "nav-control-h")
("spatial-hash-h.o" "spatial-hash-h")
("actor-hash-h.o" "actor-hash-h")
("load-dgo.o" "load-dgo")
("ramdisk.o" "ramdisk")
("gsound.o" "gsound")
("transformq.o" "transformq")
("collide-func.o" "collide-func")
("joint.o" "joint")
("joint-mod.o" "joint-mod")
("chain-physics.o" "chain-physics")
("cylinder.o" "cylinder")
("wind-work.o" "wind-work")
("wind.o" "wind")
("bsp.o" "bsp")
("subdivide.o" "subdivide")
("sprite.o" "sprite")
("sprite-distort.o" "sprite-distort")
("sprite-glow.o" "sprite-glow")
("debug-sphere.o" "debug-sphere")
("debug.o" "debug")
("history.o" "history")
("merc-vu1.o" "merc-vu1")
("emerc-vu1.o" "emerc-vu1")
("merc-blend-shape.o" "merc-blend-shape")
("merc.o" "merc")
("emerc.o" "emerc")
("ripple.o" "ripple")
("bones.o" "bones")
("debug-foreground.o" "debug-foreground")
("foreground.o" "foreground")
("generic-vu0.o" "generic-vu0")
("generic-vu1.o" "generic-vu1")
("generic-effect.o" "generic-effect")
("generic-merc.o" "generic-merc")
("generic-tie.o" "generic-tie")
("shadow-cpu.o" "shadow-cpu")
("shadow-vu1.o" "shadow-vu1")
("warp.o" "warp")
("texture-anim.o" "texture-anim")
("texture-anim-funcs.o" "texture-anim-funcs")
("texture-anim-tables.o" "texture-anim-tables")
("blit-displays.o" "blit-displays")
("font-data.o" "font-data")
("font.o" "font")
("decomp.o" "decomp")
("background.o" "background")
("draw-node.o" "draw-node")
("shrubbery.o" "shrubbery")
("shrub-work.o" "shrub-work")
("tfrag-near.o" "tfrag-near")
("tfrag.o" "tfrag")
("tfrag-methods.o" "tfrag-methods")
("tfrag-work.o" "tfrag-work")
("tie.o" "tie")
("etie-vu1.o" "etie-vu1")
("etie-near-vu1.o" "etie-near-vu1")
("tie-near.o" "tie-near")
("tie-work.o" "tie-work")
("tie-methods.o" "tie-methods")
("sync-info.o" "sync-info")
("trajectory.o" "trajectory")
("sparticle-launcher.o" "sparticle-launcher")
("sparticle.o" "sparticle")
("entity-table.o" "entity-table")
("loader.o" "loader")
("game-info.o" "game-info")
("game-task.o" "game-task")
("game-save.o" "game-save")
("settings.o" "settings")
("mood-tables.o" "mood-tables")
("mood-tables2.o" "mood-tables2")
("mood.o" "mood")
("mood-funcs.o" "mood-funcs")
("mood-funcs2.o" "mood-funcs2")
("weather-part.o" "weather-part")
("time-of-day.o" "time-of-day")
("sky-data.o" "sky-data")
("sky-tng.o" "sky-tng")
("load-state.o" "load-state")
("level-info.o" "level-info")
("level.o" "level")
("text.o" "text")
("collide-hash.o" "collide-hash")
("collide-probe.o" "collide-probe")
("collide-frag.o" "collide-frag")
("collide-mesh.o" "collide-mesh")
("collide-touch.o" "collide-touch")
("collide-edge-grab.o" "collide-edge-grab")
("collide-shape.o" "collide-shape")
("collide-shape-rider.o" "collide-shape-rider")
("collide.o" "collide")
("collide-planes.o" "collide-planes")
("spatial-hash.o" "spatial-hash")
("actor-hash.o" "actor-hash")
("merc-death.o" "merc-death")
("water-flow.o" "water-flow")
("water-h.o" "water-h")
("camera.o" "camera")
("cam-interface.o" "cam-interface")
("cam-master.o" "cam-master")
("cam-states.o" "cam-states")
("cam-states-dbg.o" "cam-states-dbg")
("cam-combiner.o" "cam-combiner")
("cam-update.o" "cam-update")
("vol-h.o" "vol-h")
("cam-layout.o" "cam-layout")
("cam-debug.o" "cam-debug")
("cam-start.o" "cam-start")
("process-drawable.o" "process-drawable")
("ambient.o" "ambient")
("speech.o" "speech")
("region.o" "region")
("fma-sphere.o" "fma-sphere")
("script.o" "script")
("generic-obs.o" "generic-obs")
("lightning.o" "lightning")
("carry-h.o" "carry-h")
("pilot-h.o" "pilot-h")
("gun-h.o" "gun-h")
("board-h.o" "board-h")
("darkjak-h.o" "darkjak-h")
("target-util.o" "target-util")
("target-part.o" "target-part")
("gun-part.o" "gun-part")
("collide-reaction-target.o" "collide-reaction-target")
("logic-target.o" "logic-target")
("sidekick.o" "sidekick")
("voicebox.o" "voicebox")
("collectables-part.o" "collectables-part")
("debug-part.o" "debug-part")
("find-nearest.o" "find-nearest")
("task-arrow.o" "task-arrow")
("projectile.o" "projectile")
("target-handler.o" "target-handler")
("target-anim.o" "target-anim")
("target.o" "target")
("target2.o" "target2")
("target-swim.o" "target-swim")
("target-carry.o" "target-carry")
("target-darkjak.o" "target-darkjak")
("target-death.o" "target-death")
("target-gun.o" "target-gun")
("gun-util.o" "gun-util")
("gun-blue-shot.o" "gun-blue-shot")
("gun-yellow-shot.o" "gun-yellow-shot")
("gun-red-shot.o" "gun-red-shot")
("gun-dark-shot.o" "gun-dark-shot")
("gun-states.o" "gun-states")
("board-util.o" "board-util")
("target-board.o" "target-board")
("board-part.o" "board-part")
("board-states.o" "board-states")
("mech-h.o" "mech-h")
("menu.o" "menu")
("drawable.o" "drawable")
("drawable-group.o" "drawable-group")
("drawable-inline-array.o" "drawable-inline-array")
("drawable-tree.o" "drawable-tree")
("prototype.o" "prototype")
("main-collide.o" "main-collide")
("video.o" "video")
("main.o" "main")
("collide-cache.o" "collide-cache")
("collide-debug.o" "collide-debug")
("relocate.o" "relocate")
("memory-usage.o" "memory-usage")
("entity.o" "entity")
("path.o" "path")
("vol.o" "vol")
("nav-mesh.o" "nav-mesh")
("nav-control.o" "nav-control")
("aligner.o" "aligner")
("water.o" "water")
("collectables.o" "collectables")
("task-control.o" "task-control")
("scene.o" "scene")
("pov-camera.o" "pov-camera")
("powerups.o" "powerups")
("crates.o" "crates")
("hud.o" "hud")
("hud-classes.o" "hud-classes")
("progress-static.o" "progress-static")
("progress.o" "progress")
("progress-draw.o" "progress-draw")
("ocean.o" "ocean")
("ocean-vu0.o" "ocean-vu0")
("ocean-texture.o" "ocean-texture")
("ocean-mid.o" "ocean-mid")
("ocean-transition.o" "ocean-transition")
("ocean-near.o" "ocean-near")
("minimap.o" "minimap")
("bigmap-data.o" "bigmap-data")
("bigmap.o" "bigmap")
("eye.o" "eye")
("glist-h.o" "glist-h")
("glist.o" "glist")
("anim-tester.o" "anim-tester")
("viewer.o" "viewer")
("part-tester.o" "part-tester")
("editable-h.o" "editable-h")
("editable.o" "editable")
("editable-player.o" "editable-player")
("mysql-nav-graph.o" "mysql-nav-graph")
("nav-graph-editor.o" "nav-graph-editor")
("sampler.o" "sampler")
("default-menu.o" "default-menu")
)
goal_src/jak2/dgos/kernel.gd
+10
View File
@@ -0,0 +1,10 @@
("KERNEL.CGO"
("gcommon.o" "gcommon")
("gstring-h.o" "gstring-h")
("gkernel-h.o" "gkernel-h")
("gkernel.o" "gkernel")
("pskernel.o" "pskernel")
("gstring.o" "gstring")
("dgo-h.o" "dgo-h")
("gstate.o" "gstate")
)
goal_src/jak2/game.gp
+404 -1
View File
@@ -161,6 +161,404 @@
(cgo "KERNEL.CGO" "kernel.gd")
;;;;;;;;;;;;;
;; engine
;;;;;;;;;;;;;
(goal-src-sequence
"engine/"
:deps
("$OUT/obj/gcommon.o"
"$OUT/obj/gstate.o"
"$OUT/obj/gstring.o"
"$OUT/obj/gkernel.o"
)
"util/types-h.gc"
"ps2/vu1-macros.gc"
"math/math.gc"
"math/vector-h.gc"
"physics/gravity-h.gc"
"geometry/bounding-box-h.gc"
"math/matrix-h.gc"
"math/quaternion-h.gc"
"math/euler-h.gc"
"math/transform-h.gc"
"geometry/geometry-h.gc"
"math/trigonometry-h.gc"
"math/transformq-h.gc"
"geometry/bounding-box.gc"
"math/matrix.gc"
"math/transform.gc"
"math/quaternion.gc"
"math/euler.gc"
"math/trigonometry.gc"
"sound/gsound-h.gc"
"ps2/timer-h.gc"
"ps2/vif-h.gc"
"dma/dma-h.gc"
"gfx/hw/video-h.gc"
"gfx/vu1-user-h.gc"
"util/profile-h.gc"
"dma/dma.gc"
"dma/dma-buffer.gc"
"dma/dma-bucket.gc"
"dma/dma-disasm.gc"
"ps2/pad.gc"
"gfx/hw/gs.gc"
"gfx/hw/display-h.gc"
"geometry/geometry.gc"
"ps2/timer.gc"
"math/vector.gc"
"load/file-io.gc"
"load/loader-h.gc"
"gfx/texture/texture-h.gc"
"gfx/texture/texture-anim-h.gc"
"gfx/lights-h.gc"
"gfx/mood/mood-h.gc"
"level/level-h.gc"
"util/capture-h.gc"
"gfx/math-camera-h.gc"
"gfx/math-camera.gc"
"gfx/font-h.gc"
"load/decomp-h.gc"
"util/profile.gc"
"gfx/hw/display.gc"
"engine/connect.gc"
"ui/text-id-h.gc"
"ui/text-h.gc"
"camera/camera-defs-h.gc"
)
(goal-src-sequence
"levels/"
:deps ("$OUT/obj/camera-defs-h.o")
"city/common/trail-h.gc"
)
(goal-src-sequence
"engine/"
:deps
("$OUT/obj/trail-h.o")
"ui/minimap-h.gc"
"ui/bigmap-h.gc"
"game/settings-h.gc"
"util/capture.gc"
"debug/memory-usage-h.gc"
"gfx/blit-displays-h.gc"
"gfx/texture/texture.gc"
"game/main-h.gc"
"anim/mspace-h.gc"
"draw/drawable-h.gc"
"draw/drawable-group-h.gc"
"draw/drawable-inline-array-h.gc"
"draw/draw-node-h.gc"
"draw/drawable-tree-h.gc"
"draw/drawable-actor-h.gc"
"level/region-h.gc"
"ai/traffic-h.gc"
"game/task/game-task-h.gc"
"game/task/task-control-h.gc"
"gfx/generic/generic-h.gc"
"gfx/sky/sky-h.gc"
"gfx/ocean/ocean-h.gc"
"gfx/ocean/ocean-trans-tables.gc"
"gfx/ocean/ocean-tables.gc"
"gfx/ocean/ocean-frames.gc"
"gfx/mood/time-of-day-h.gc"
"data/art-h.gc"
"gfx/generic/generic-vu1-h.gc"
"gfx/merc/merc-h.gc"
"gfx/merc/generic-merc-h.gc"
"gfx/tie/generic-tie-h.gc"
"gfx/generic/generic-work-h.gc"
"gfx/foreground/shadow-cpu-h.gc"
"gfx/foreground/shadow-vu1-h.gc"
"ps2/memcard-h.gc"
"game/game-info-h.gc"
"ui/gui-h.gc"
"ambient/ambient-h.gc"
"sound/speech-h.gc"
"gfx/background/wind-h.gc"
"gfx/background/prototype-h.gc"
"anim/joint-h.gc"
"gfx/foreground/bones-h.gc"
"gfx/foreground/foreground-h.gc"
"engine/engines.gc"
"gfx/lightning-h.gc"
"entity/res-h.gc"
"entity/res.gc"
"gfx/lights.gc"
"physics/dynamics-h.gc"
"target/surface-h.gc"
"collide/pat-h.gc"
"game/fact-h.gc"
"anim/aligner-h.gc"
"game/penetrate-h.gc"
"game/game-h.gc"
"util/script-h.gc"
"scene/scene-h.gc"
"util/sync-info-h.gc"
"camera/pov-camera-h.gc"
"util/smush-control-h.gc"
"debug/debug-h.gc"
"anim/joint-mod-h.gc"
"collide/collide-func-h.gc"
"collide/collide-mesh-h.gc"
"collide/collide-shape-h.gc"
"common_objs/generic-obs-h.gc"
"physics/trajectory-h.gc"
"collide/collide-target-h.gc"
"collide/collide-touch-h.gc"
"collide/collide-edge-grab-h.gc"
"process-drawable/process-drawable-h.gc"
"process-drawable/process-focusable.gc"
"process-drawable/process-taskable-h.gc"
"process-drawable/focus.gc"
"game/effect-control-h.gc"
"collide/collide-frag-h.gc"
"spatial-hash/collide-hash-h.gc"
"physics/chain-physics-h.gc"
"common_objs/projectile-h.gc"
"collide/find-nearest-h.gc"
"target/target-h.gc"
"debug/stats-h.gc"
"level/bsp-h.gc"
"collide/collide-cache-h.gc"
"collide/collide-h.gc"
"gfx/shrub/shrubbery-h.gc"
"gfx/tie/tie-h.gc"
"gfx/tfrag/tfrag-h.gc"
"gfx/background/background-h.gc"
"gfx/background/subdivide-h.gc"
"entity/entity-h.gc"
"gfx/sprite/sprite-h.gc"
"gfx/sprite/simple-sprite-h.gc"
"gfx/foreground/eye-h.gc"
"gfx/sprite/particles/sparticle-launcher-h.gc"
"gfx/sprite/particles/sparticle-h.gc"
"entity/actor-link-h.gc"
"camera/camera-h.gc"
"camera/cam-debug-h.gc"
"camera/cam-interface-h.gc"
"camera/cam-update-h.gc"
"ui/hud-h.gc"
"ui/progress/progress-h.gc"
"ps2/rpc-h.gc"
"geometry/path-h.gc"
"nav/nav-mesh-h.gc"
"nav/nav-control-h.gc"
"spatial-hash/spatial-hash-h.gc"
"spatial-hash/actor-hash-h.gc"
"load/load-dgo.gc"
"load/ramdisk.gc"
"sound/gsound.gc"
"math/transformq.gc"
"collide/collide-func.gc"
"anim/joint.gc"
"anim/joint-mod.gc"
"physics/chain-physics.gc"
"geometry/cylinder.gc"
"gfx/background/wind-work.gc"
"gfx/background/wind.gc"
"level/bsp.gc"
"gfx/background/subdivide.gc"
"gfx/sprite/sprite.gc"
"gfx/sprite/sprite-distort.gc"
"gfx/sprite/sprite-glow.gc"
"debug/debug-sphere.gc"
"debug/debug.gc"
"debug/history.gc"
"gfx/merc/merc-vu1.gc"
"gfx/merc/emerc-vu1.gc"
"gfx/merc/merc-blend-shape.gc"
"gfx/merc/merc.gc"
"gfx/merc/emerc.gc"
"gfx/foreground/ripple.gc"
"gfx/foreground/bones.gc"
"gfx/foreground/debug-foreground.gc"
"gfx/foreground/foreground.gc"
"gfx/generic/generic-vu0.gc"
"gfx/generic/generic-vu1.gc"
"gfx/generic/generic-effect.gc"
"gfx/generic/generic-merc.gc"
"gfx/generic/generic-tie.gc"
"gfx/foreground/shadow-cpu.gc"
"gfx/foreground/shadow-vu1.gc"
"gfx/warp.gc"
"gfx/texture/texture-anim.gc"
"gfx/texture/texture-anim-funcs.gc"
"gfx/texture/texture-anim-tables.gc"
"gfx/blit-displays.gc"
"data/font-data.gc"
"gfx/font.gc"
"load/decomp.gc"
"gfx/background/background.gc"
"draw/draw-node.gc"
"gfx/shrub/shrubbery.gc"
"gfx/shrub/shrub-work.gc"
"gfx/tfrag/tfrag-near.gc"
"gfx/tfrag/tfrag.gc"
"gfx/tfrag/tfrag-methods.gc"
"gfx/tfrag/tfrag-work.gc"
"gfx/tie/tie.gc"
"gfx/tie/etie-vu1.gc"
"gfx/tie/etie-near-vu1.gc"
"gfx/tie/tie-near.gc"
"gfx/tie/tie-work.gc"
"gfx/tie/tie-methods.gc"
"util/sync-info.gc"
"physics/trajectory.gc"
"gfx/sprite/particles/sparticle-launcher.gc"
"gfx/sprite/particles/sparticle.gc"
"entity/entity-table.gc"
"load/loader.gc"
"game/game-info.gc"
"game/task/game-task.gc"
"game/game-save.gc"
"game/settings.gc"
"gfx/mood/mood-tables.gc"
"gfx/mood/mood-tables2.gc"
"gfx/mood/mood.gc"
"gfx/mood/mood-funcs.gc"
"gfx/mood/mood-funcs2.gc"
"gfx/mood/weather-part.gc"
"gfx/mood/time-of-day.gc"
"gfx/sky/sky-data.gc"
"gfx/sky/sky-tng.gc"
"load/load-state.gc"
"level/level-info.gc"
"level/level.gc"
"ui/text.gc"
"spatial-hash/collide-hash.gc"
"collide/collide-probe.gc"
"collide/collide-frag.gc"
"collide/collide-mesh.gc"
"collide/collide-touch.gc"
"collide/collide-edge-grab.gc"
"collide/collide-shape.gc"
"collide/collide-shape-rider.gc"
"collide/collide.gc"
"collide/collide-planes.gc"
"spatial-hash/spatial-hash.gc"
"spatial-hash/actor-hash.gc"
"gfx/merc/merc-death.gc"
"common_objs/water-flow.gc"
"common_objs/water-h.gc"
"camera/camera.gc"
"camera/cam-interface.gc"
"camera/cam-master.gc"
"camera/cam-states.gc"
"camera/cam-states-dbg.gc"
"camera/cam-combiner.gc"
"camera/cam-update.gc"
"geometry/vol-h.gc"
"camera/cam-layout.gc"
"camera/cam-debug.gc"
"camera/cam-start.gc"
"process-drawable/process-drawable.gc"
"ambient/ambient.gc"
"sound/speech.gc"
"level/region.gc"
"anim/fma-sphere.gc"
"util/script.gc"
"common_objs/generic-obs.gc"
"gfx/lightning.gc"
"target/mech_suit/carry-h.gc"
"game/pilot-h.gc"
"target/gun/gun-h.gc"
"target/board/board-h.gc"
"target/darkjak-h.gc"
"target/target-util.gc"
"target/target-part.gc"
"target/gun/gun-part.gc"
"target/collide-reaction-target.gc"
"target/logic-target.gc"
"target/sidekick.gc"
"common_objs/voicebox.gc"
"common_objs/collectables-part.gc"
"debug/debug-part.gc"
"collide/find-nearest.gc"
"game/task/task-arrow.gc"
"common_objs/projectile.gc"
"target/target-handler.gc"
"target/target-anim.gc"
"target/target.gc"
"target/target2.gc"
"target/target-swim.gc"
"target/target-carry.gc"
"target/target-darkjak.gc"
"target/target-death.gc"
"target/target-gun.gc"
"target/gun/gun-util.gc"
"target/gun/gun-blue-shot.gc"
"target/gun/gun-yellow-shot.gc"
"target/gun/gun-red-shot.gc"
"target/gun/gun-dark-shot.gc"
"target/gun/gun-states.gc"
"target/board/board-util.gc"
"target/board/target-board.gc"
"target/board/board-part.gc"
"target/board/board-states.gc"
"target/mech_suit/mech-h.gc"
"debug/menu.gc"
"draw/drawable.gc"
"draw/drawable-group.gc"
"draw/drawable-inline-array.gc"
"draw/drawable-tree.gc"
"gfx/background/prototype.gc"
"collide/main-collide.gc"
"gfx/hw/video.gc"
"game/main.gc"
"collide/collide-cache.gc"
"collide/collide-debug.gc"
"entity/relocate.gc"
"debug/memory-usage.gc"
"entity/entity.gc"
"geometry/path.gc"
"geometry/vol.gc"
"nav/nav-mesh.gc"
"nav/nav-control.gc"
"anim/aligner.gc"
"common_objs/water.gc"
"common_objs/collectables.gc"
"game/task/task-control.gc"
"scene/scene.gc"
"camera/pov-camera.gc"
"common_objs/powerups.gc"
"common_objs/crates.gc"
"ui/hud.gc"
"ui/hud-classes.gc"
"ui/progress/progress-static.gc"
"ui/progress/progress.gc"
"ui/progress/progress-draw.gc"
"gfx/ocean/ocean.gc"
"gfx/ocean/ocean-vu0.gc"
"gfx/ocean/ocean-texture.gc"
"gfx/ocean/ocean-mid.gc"
"gfx/ocean/ocean-transition.gc"
"gfx/ocean/ocean-near.gc"
"ui/minimap.gc"
"ui/bigmap-data.gc"
"ui/bigmap.gc"
"gfx/foreground/eye.gc"
"util/glist-h.gc"
"util/glist.gc"
"debug/anim-tester.gc"
"debug/viewer.gc"
"debug/part-tester.gc"
"debug/editable-h.gc"
"debug/editable.gc"
"debug/editable-player.gc"
"debug/nav/mysql-nav-graph.gc"
"debug/nav/nav-graph-editor.gc"
"debug/sampler.gc"
"debug/default-menu.gc"
)
(cgo "ENGINE.CGO" "engine.gd")
;;;;;;;;;;;;;;;;;;;;;
;; ISO Group
;;;;;;;;;;;;;;;;;;;;;
@@ -173,4 +571,9 @@
,@(reverse *all-mus*)
,@(reverse *all-vag*)
,@(reverse *all-cgos*))
)
)
;; used for the type consistency test.
(group-list "all-code"
`(,@(reverse *all-gc*))
)
goal_src/jak2/kernel-defs.gc
+38 -18
View File
@@ -5,6 +5,26 @@
;;;; kscheme - InitHeapAndSymbol
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defenum kmalloc-flags
:bitfield #t
(align-16 4)
(align-64 6)
(align-256 8)
(memset 12)
(top 13)
)
(defenum link-flag
:bitfield #t
:type int32
(output-load-msg 0)
(output-load-true-msg 1)
(execute-login 2)
(print-login 3)
(force-debug 4)
(fast-link 5)
)
;; fixed symbols
(define-extern #f symbol)
(define-extern #t symbol)
@@ -59,32 +79,32 @@
;; InitHeapAndSymbol
(define-extern _format (function _varargs_ object))
(define-extern method-set! (function type int object none)) ;; may actually return function.
(define-extern kmemopen (function kheap string none))
(define-extern kmemclose (function none))
(define-extern *enable-method-set* int)
(define-extern *listener-function* (function object))
(define-extern *debug-segment* symbol)
(define-extern dgo-load (function string kheap link-flag int none))
(define-extern malloc (function symbol int pointer))
(defenum kmalloc-flags
:bitfield #t
(align-16 4)
(align-64 6)
(align-256 8)
(memset 12)
(top 13)
)
(declare-type cpad-info basic)
(define-extern cpad-open (function cpad-info int cpad-info))
(define-extern cpad-get-data (function cpad-info cpad-info))
(defenum link-flag
:bitfield #t
:type int32
(output-load-msg 0)
(output-load-true-msg 1)
(execute-login 2)
(print-login 3)
(force-debug 4)
(fast-link 5)
)
(declare-type mouse-info basic)
(define-extern mouse-get-data (function mouse-info none))
(define-extern scf-get-territory (function int)) ;; not actually a scf function...
(define-extern __read-ee-timer (function uint))
(define-extern __mem-move (function pointer pointer uint none))
(define-extern file-stream-read (function file-stream pointer int int))
(define-extern file-stream-open (function file-stream basic symbol file-stream))
(define-extern file-stream-length (function file-stream int))
;; PC stuff
goal_src/jak2/kernel/dgo-h.gc
+22
View File
@@ -5,3 +5,25 @@
;; name in dgo: dgo-h
;; dgos: KERNEL
;; I suspect that these are unused, and were for an older version of DGO.
;; All DGO stuff is handled on the IOP.
(deftype dgo-entry (structure)
((offset uint32 :offset-assert 0)
(length uint32 :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype dgo-file (basic)
((num-go-files uint32 :offset-assert 4)
(total-length uint32 :offset-assert 8)
(rsvd uint32 :offset-assert 12)
(data uint8 :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
goal_src/jak2/kernel/gcommon.gc
+449 -20
View File
@@ -24,36 +24,63 @@
;; GOAL code to the frame profiler in C++.
(defglobalconstant PC_PROFILER_ENABLE #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GOAL language constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; distance from a symbol pointer to a (pointer string)
;; this relies on the memory layout of the symbol table
;; this must match SYM_TO_STRING_OFFSET in goal_constants.h
(defconstant SYM_TO_STRING_OFFSET #xff37)
(defmacro symbol->string (sym)
"Convert a symbol to a goal string."
`(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym))))
)
;; pointers larger than this are invalid by valid?
(defconstant END_OF_MEMORY #x8000000)
(defun identity ((arg0 object))
"Return the input. Works for any 64-bit value."
arg0
)
(defun 1/ ((arg0 float))
"Floating point reciprocal"
(declare (inline))
(/ 1.0 arg0)
)
;; These functions exist a function objects that wrap the compiler's built-in operators.
(defun + ((arg0 int) (arg1 int))
"Add two integers (64-bit)."
(+ arg0 arg1)
)
(defun - ((arg0 int) (arg1 int))
"Subtract two integers (64-bit)."
(- arg0 arg1)
)
(defun * ((arg0 int) (arg1 int))
"Multiply two integers (32-bit)"
(* arg0 arg1)
)
(defun / ((arg0 int) (arg1 int))
"Divide two integers (32-bit, signed)"
(/ arg0 arg1)
)
(defun mod ((arg0 int) (arg1 int))
"Integer mod (signed, 32-bit)"
(mod arg0 arg1)
)
(defun rem ((arg0 int) (arg1 int))
"Integer mod (signed, 32-bit). Even though it's called rem, it behaves the same as mod."
(mod arg0 arg1)
)
@@ -70,7 +97,7 @@
)
(defun abs ((a int))
"Take the absolute value of an integer"
"Take the absolute value of a 64-bit signed integer"
(declare (inline))
;; OpenGOAL doesn't support abs, so we implement it here.
(if (> a 0)
@@ -80,30 +107,31 @@
)
(defun min ((a int) (b int))
"Compute minimum."
"Compute minimum of two 64-bit signed integers."
(declare (inline))
;; OpenGOAL doesn't support min, so we implement it here.
(if (> a b) b a)
)
(defun max ((a int) (b int))
"Compute maximum."
"Compute maximum of two 64-bit signed integer."
(declare (inline))
;; OpenGOAL doesn't support max so we implement it here.
(if (> a b) a b)
)
(defun logior ((arg0 int) (arg1 int))
"Logical or (64-bit)"
(logior arg0 arg1)
)
(defun logand ((arg0 int) (arg1 int))
"Logical and (64-bit)"
(logand arg0 arg1)
)
(defun lognor ((a int) (b int))
"Compute not or."
"Compute not or (64-bit)."
;; Note - MIPS has a 'nor' instruction, but x86 doesn't.
;; the OpenGOAL x86 compiler therefore doesn't have a nor operation,
;; so lognor is implemented by this inline function instead.
@@ -112,18 +140,22 @@
)
(defun logxor ((arg0 int) (arg1 int))
"Logical exclusive or (64-bit)"
(logxor arg0 arg1)
)
(defun lognot ((arg0 int))
"Logical not (64-bit)"
(lognot arg0)
)
(defun false-func ()
"Return #f."
#f
)
(defun true-func ()
"Return #t."
#t
)
@@ -131,12 +163,15 @@
;; format
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The "format" function is implemented in C but is called _format.
;; This defines the format function to point to the same thing as _format.
(define format _format)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; numeric types
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; vec4s: 4 floats packed into a 128-bit integer register. This is rarely used.
(deftype vec4s (uint128)
((x float :offset 0 :size 32)
(y float :offset 32 :size 32)
@@ -148,19 +183,8 @@
:flag-assert #x900000010
)
(defmethod inspect vec4s ((obj vec4s))
(when (not obj)
(return obj)
)
(format #t "[~8x] ~A~%" obj 'vec4s)
(format #t "~1Tx: ~f~%" (-> obj x))
(format #t "~1Ty: ~f~%" (-> obj y))
(format #t "~1Tz: ~f~%" (-> obj z))
(format #t "~1Tw: ~f~%" (-> obj w))
obj
)
(defmethod print vec4s ((obj vec4s))
"Custom print for vec4s that prints the 4 values."
(format #t "#<vector ~F ~F ~F ~F @ #x~X>"
(-> obj x)
(-> obj y)
@@ -170,6 +194,20 @@
obj
)
;; vector: main 4-element floating point vector.
(deftype vector (structure)
((data float 4 :offset-assert 0)
(x float :offset 0)
(y float :offset 4)
(z float :offset 8)
(w float :offset 12)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(defmacro print128 (value &key (stream #t))
"Print a 128-bit value"
`(let ((temp (new 'stack-no-clear 'array 'uint64 2)))
@@ -190,6 +228,8 @@
)
)
;; bfloat: boxed float type. A floating point number with type information.
;; It's a heap allocated basic.
(deftype bfloat (basic)
((data float :offset-assert 4)
)
@@ -208,10 +248,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod asize-of type ((obj type))
"Get the size in memory of a type. The value calculated here is wrong."
(the-as int (logand (the-as uint #xfffffff0) (+ (* (-> obj allocated-length) 4) 43)))
)
(defun basic-type? ((arg0 basic) (arg1 type))
"Is the given basic an object of the given type?"
(let ((v1-0 (-> arg0 type))
(a0-1 object)
)
@@ -226,6 +268,7 @@
)
(defun type-type? ((arg0 type) (arg1 type))
"Is the given type equal to, or a child of, the second type?"
(let ((v1-0 object))
(if (= arg1 v1-0)
(return #t)
@@ -241,6 +284,7 @@
)
(defun type? ((arg0 object) (arg1 type))
"Is the given object an object of the given type? Works for any boxed object (basic, symbol, binteger, pair)."
(let ((v1-0 object)
(a0-1 (rtype-of arg0))
)
@@ -258,6 +302,7 @@
)
(defun find-parent-method ((arg0 type) (arg1 int))
"Go up the type tree and find the first parent type that has a different implementation for the given method."
(local-vars (v0-0 function))
(let ((v1-2 (-> arg0 method-table arg1)))
(until (!= v0-0 v1-2)
@@ -275,6 +320,7 @@
)
(defun ref ((arg0 object) (arg1 int))
"Get the n-th item in a linked list. No range checking."
(dotimes (v1-0 arg1)
(nop!)
(nop!)
@@ -284,6 +330,7 @@
)
(defmethod length pair ((obj pair))
"Get the length of a linked list."
(local-vars (v0-0 int))
(cond
((null? obj)
@@ -303,10 +350,12 @@
)
(defmethod asize-of pair ((obj pair))
"Get the size in memory of a pair."
(the-as int (-> pair size))
)
(defun last ((arg0 object))
"Get the last object in a list."
(let ((v0-0 arg0))
(while (not (null? (cdr v0-0)))
(nop!)
@@ -318,6 +367,7 @@
)
(defun member ((arg0 object) (arg1 object))
"Is obj in the list lst? Returns pair with obj as its car, or #f if not found."
(let ((v1-0 arg1))
(while (not (or (null? v1-0) (= (car v1-0) arg0)))
(set! v1-0 (cdr v1-0))
@@ -329,10 +379,11 @@
)
;; need to forward declare this, we haven't loaded the string library yet.
(define-extern name= (function basic basic symbol))
(define-extern name= (function object object symbol))
(defun nmember ((arg0 basic) (arg1 object))
(while (not (or (null? arg1) (name= (the-as basic (car arg1)) arg0)))
"Is obj in the list lst? Check with the name= function."
(while (not (or (null? arg1) (name= (car arg1) arg0)))
(set! arg1 (cdr arg1))
)
(if (not (null? arg1))
@@ -341,6 +392,8 @@
)
(defun assoc ((arg0 object) (arg1 object))
"Is item in the association list alist?
Returns the key-value pair."
(let ((v1-0 arg1))
(while (not (or (null? v1-0) (= (car (car v1-0)) arg0)))
(set! v1-0 (cdr v1-0))
@@ -352,6 +405,9 @@
)
(defun assoce ((arg0 object) (arg1 object))
"Is there an entry with key item in the association list alist?
Returns the key-value pair.
Treats a key of 'else like an else case"
(let ((v1-0 arg1))
(while (not (or (null? v1-0) (= (car (car v1-0)) arg0) (= (car (car v1-0)) 'else)))
(set! v1-0 (cdr v1-0))
@@ -363,6 +419,9 @@
)
(defun nassoc ((arg0 string) (arg1 object))
"Is there an entry named item-name in the association list alist?
Checks name with nmember or name= so you can have multiple keys.
Returns the ([key|(key..)] . value) pair."
(while (not (or (null? arg1) (let ((a1-1 (car (car arg1))))
(if (pair? a1-1)
(nmember arg0 a1-1)
@@ -379,6 +438,9 @@
)
(defun nassoce ((arg0 string) (arg1 object))
"Is there an entry named item-name in the association list alist?
Checks name with nmember for multiple keys or name= for single.
Allows else as a single key that always matches"
(while (not (or (null? arg1) (let ((s4-0 (car (car arg1))))
(if (pair? s4-0)
(nmember arg0 s4-0)
@@ -395,6 +457,7 @@
)
(defun append! ((arg0 object) (arg1 object))
"Append back to front, return the combined list."
(cond
((null? arg0)
arg1
@@ -416,6 +479,7 @@
)
(defun delete! ((arg0 object) (arg1 object))
"Remove the first occurance of item from lst (where item is actual a pair in the list)"
(the-as pair
(cond
((= arg0 (car arg1))
@@ -440,6 +504,7 @@
)
(defun delete-car! ((arg0 object) (arg1 object))
"Remove the first first occurance of an element from the list where (car elt) is item."
(cond
((= arg0 (car (car arg1)))
(cdr arg1)
@@ -462,12 +527,22 @@
)
(defun insert-cons! ((arg0 object) (arg1 object))
"Update an association list to have the given (key . value) pair kv.
If it already exists in the list, remove it.
DANGER: this function allocates memory on the global heap."
(let ((a3-0 (delete-car! (car arg0) arg1)))
(cons arg0 a3-0)
)
)
(defun sort ((arg0 pair) (arg1 (function object object object)))
"Sort a list, using compare-func to compare elements.
The comparison function can return either an integer or a true/false.
For integers, use a positive number to represent first > second
Ex: (sort lst -) will sort in ascending order
For booleans, you must explicitly use TRUE and not a truthy value.
Ex: (sort my-list (lambda ((x int) (y int)) (< x y))) will sort ascending.
NOTE: if you use an integer, don't accidentally return TRUE."
(let ((s4-0 -1))
(while (nonzero? s4-0)
(set! s4-0 0)
@@ -491,6 +566,15 @@
arg0
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; inline-array-class
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is used as base class for boxed inline arrays.
;; The heap-base of the _type_ object will be used to store the stride
;; This way, you don't pay the price of storing the stride in each object.
;; however, as far as we've seen, nothing actually reads the stride.
(deftype inline-array-class (basic)
((length int32 :offset-assert 4)
(allocated-length int32 :offset-assert 8)
@@ -505,6 +589,8 @@
)
(defmethod new inline-array-class ((allocation symbol) (type-to-make type) (arg0 int))
"Allocate a new inline-array-class object with room for the given number of objects.
Both length and allocated-length are set to the given size"
(let ((v0-0 (object-new
allocation
type-to-make
@@ -521,14 +607,32 @@
)
(defmethod length inline-array-class ((obj inline-array-class))
"Get the length of the inline-array-class. This is the length field,
not how much storage there is"
(-> obj length)
)
(defmethod asize-of inline-array-class ((obj inline-array-class))
"Get the size in memory of an inline-array-class."
(the-as int (+ (-> obj type size) (* (-> obj allocated-length) (the-as int (-> obj type heap-base)))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; array
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the GOAL array type is a boxed array.
;; it is a basic that knows its content type, currently used length, and allocated length.
;; It can hold:
;; any boxed object (gets 4 bytes, so bintegers get clipped to 32-bits)
;; any structure/reference/pointer
;; any integer/float
;; It cannot hold any inlined structures.
(defmethod new array ((allocation symbol) (type-to-make type) (arg0 type) (arg1 int))
"Allocate a new array to hold len elements of type content-type.
The content should either be a numeric type (child of number)
or the content should be a reference (will get 4-bytes for a pointer)"
(let ((v0-1 (object-new
allocation
type-to-make
@@ -698,6 +802,7 @@
)
(defmethod inspect array ((obj array))
"Inspect an array"
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tallocated-length: ~D~%" (-> obj allocated-length))
(format #t "~Tlength: ~D~%" (-> obj length))
@@ -773,10 +878,12 @@
)
(defmethod length array ((obj array))
"Get the length of an array"
(-> obj length)
)
(defmethod asize-of array ((obj array))
"Get the size in memory of an array"
(the-as
int
(+ (-> obj type size) (* (-> obj allocated-length) (if (type-type? (-> obj content-type) number)
@@ -788,7 +895,13 @@
)
)
;;;;;;;;;;;;;;;;;;;;;;;;
;; memory manipulation
;;;;;;;;;;;;;;;;;;;;;;;;
(defun mem-copy! ((arg0 pointer) (arg1 pointer) (arg2 int))
"Memory copy. Not a very efficient optimization, but has no restrictions.
Increasing address copy."
(let ((v0-0 arg0))
(dotimes (v1-0 arg2)
(set! (-> (the-as (pointer uint8) arg0)) (-> (the-as (pointer uint8) arg1)))
@@ -800,6 +913,10 @@
)
(defun qmem-copy<-! ((arg0 pointer) (arg1 pointer) (arg2 int))
"Memory copy by quadword. More efficient, but has restrictions:
- dst and src should be 16-byte aligned.
- size in bytes will be rounded up to 16-bytes
- Ascending address copy."
(let ((v0-0 arg0))
(countdown (v1-1 (/ (+ arg2 15) 16))
(set! (-> (the-as (pointer uint128) arg0)) (-> (the-as (pointer uint128) arg1)))
@@ -811,6 +928,10 @@
)
(defun qmem-copy->! ((arg0 pointer) (arg1 pointer) (arg2 int))
"Memory copy by quadword (16-bytes). More efficient, but has restrictions:
- dst and src should be 16-byte aligned.
- size in bytes will be rounding up to nearest 16-bytes
- Descending address copy"
(let ((v0-0 arg0))
(let* ((v1-1 (/ (+ arg2 15) 16))
(a0-1 (&+ arg0 (* v1-1 16)))
@@ -828,6 +949,8 @@
)
(defun mem-set32! ((arg0 pointer) (arg1 int) (arg2 int))
"Normal memset, but by 32-bit word.
NOTE: argument order is swapped from C"
(let ((v0-0 arg0))
(dotimes (v1-0 arg1)
(set! (-> (the-as (pointer int32) arg0)) arg2)
@@ -839,6 +962,8 @@
)
(defun mem-or! ((arg0 pointer) (arg1 pointer) (arg2 int))
"Set the dst to (logior dst src) byte by byte.
Not very efficient."
(let ((v0-0 arg0))
(dotimes (v1-0 arg2)
(logior! (-> (the-as (pointer uint8) arg0)) (-> (the-as (pointer uint8) arg1)))
@@ -861,13 +986,38 @@
(* x (fact (+ x -1))))
)
;;;;;;;;;;;;;;;;;;;;;;;;
;; printing
;;;;;;;;;;;;;;;;;;;;;;;;
;; the column that will be printed to by format.
(define *print-column* (the-as binteger 0))
;; note: normal use of print/inspect will have the compiler pick the appropriate method
;; for non-basics. However, it may be useful to have print/inspect available as a function
;; as well, allowing you to use it as a function pointer.
;; in this case, we can only do the right thing on boxed objects.
(defun print ((arg0 object))
"Print out any boxed object. Does NOT insert a newline."
((method-of-type (rtype-of arg0) print) arg0)
)
(defmacro printl (obj)
"Print out a boxed object and a newline.
Note: we define both a macro and a function on purpose.
The compiler will use the macro over the function, which will
allow it to pick the correct print method for non-boxed objects"
`(begin
(print ,obj)
(format #t "~%")
,obj
)
)
(defun printl ((arg0 object))
"Print out any boxed object and a newline at the end."
(let ((a0-1 arg0))
((method-of-type (rtype-of a0-1) print) a0-1)
)
@@ -876,10 +1026,13 @@
)
(defun inspect ((arg0 object))
"Inspect any boxed object."
((method-of-type (rtype-of arg0) inspect) arg0)
)
(defun-debug mem-print ((arg0 (pointer uint32)) (arg1 int))
"Print memory to runtime stdout by quadword.
Input count is in 32-bit words"
(dotimes (s4-0 (/ arg1 4))
(format
0
@@ -894,9 +1047,11 @@
#f
)
;; unused
(define *trace-list* '())
(defun print-tree-bitmask ((arg0 int) (arg1 int))
"Print out a single entry for a process tree 'tree' diagram"
(dotimes (s4-0 arg1)
(if (zero? (logand arg0 1))
(format #t " ")
@@ -908,9 +1063,229 @@
)
(defun breakpoint-range-set! ((arg0 uint) (arg1 uint) (arg2 uint))
"Sets some debug register (COP0 Debug, dab, dabm) to break on memory access.
This is not supported in OpenGOAL."
(break!)
)
;;;;;;;;;;;;;;;;;;;;;;;
;; valid
;;;;;;;;;;;;;;;;;;;;;;;
(defmacro start-of-symbol-table ()
`(rlet ((st :reg r14 :reset-here #t :type uint))
(the uint (- st 32768))
)
)
(defmacro end-of-symbol-table ()
`(rlet ((st :reg r14 :reset-here #t :type uint))
(the uint (+ st 32768))
)
)
(define-extern boolean type) ;; not really... but they use it here as if it was one.
(define-extern valid? (function object type symbol symbol object symbol))
(defun valid? ((arg0 object) (arg1 type) (arg2 symbol) (arg3 symbol) (arg4 object))
"Check if the given object is valid. This will work for structures, pairs, basics, bintegers, symbols, and types.
If you set expected-type to #f, it just checks for a 4-byte aligned address that's in GOAL memory.
If you're checking a structure, set expected-type to structure. This requires 16-byte alignment
Note: packed inline structures in arrays or fields will not pass this check.
Otherwise, set it to the type you expect. More specific types will pass.
If allow-false is #t, a #f will always pass. Otherwise, #f will fail (unless you're looking for a symbol).
Use allow-false if you want to allow a 'null' reference.
The name is only used when printing out an error if the check fails.
Use a name of #f to suppress error prints.
"
(let ((v1-1
(and (>= (the-as uint arg0) (start-of-symbol-table)) (< (the-as uint arg0) END_OF_MEMORY))
)
)
(cond
((not arg1)
(cond
((logtest? (the-as int arg0) 3)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object (misaligned)~%" arg0 arg2)
)
#f
)
((not v1-1)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object (bad address)~%" arg0 arg2)
)
#f
)
(else
#t
)
)
)
((and arg3 (not arg0))
#t
)
((= arg1 structure)
(cond
((logtest? (the-as int arg0) 15)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((or (not v1-1) (< (the-as uint arg0) (end-of-symbol-table)))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
(else
#t
)
)
)
((= arg1 pair)
(cond
((not (pair? arg0))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((not v1-1)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
(else
#t
)
)
)
((= arg1 binteger)
(cond
((zero? (logand (the-as int arg0) 7))
#t
)
(else
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
)
)
((or (= arg1 symbol) (= arg1 boolean))
(cond
((zero? (logand (the-as int arg0) 1))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((or (not v1-1) (< (the-as int arg0) (start-of-symbol-table))(>= (the-as int arg0) (end-of-symbol-table)))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
(else
#t
)
)
)
((!= (logand (the-as int arg0) 7) 4)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((not v1-1)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
((and (= arg1 type) (!= (rtype-of arg0) type))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
arg0
arg2
arg1
(rtype-of arg0)
)
)
#f
)
((and (!= arg1 type) (not (valid? (rtype-of arg0) type #f #t 0)))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
arg0
arg2
arg1
(rtype-of arg0)
)
)
#f
)
((not (type? arg0 arg1))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (is type '~A' instead)~%"
arg0
arg2
arg1
(rtype-of arg0)
)
)
#f
)
((= arg1 symbol)
(cond
((>= (the-as uint arg0) (end-of-symbol-table))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (not in symbol table)~%"
arg0
arg2
arg1
)
)
#f
)
(else
#t
)
)
)
((< (the-as uint arg0) (end-of-symbol-table))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (inside symbol table)~%"
arg0
arg2
arg1
)
)
#f
)
(else
#t
)
)
)
)
;;;;;;;;;;;;;;;;;;;;
;; Profiler Macros
;;;;;;;;;;;;;;;;;;;;
@@ -957,4 +1332,58 @@
,@body
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;
;; Decompiler Macros
;;;;;;;;;;;;;;;;;;;;;;;;
;; inserted by the decompiler for assembly branches.
(defmacro b! (pred destination &key (delay '()) &key (likely-delay '()))
"Branch!"
;; evaluate the predicate
`(let ((should-branch ,pred))
;; normal delay slot:
,delay
(when should-branch
,likely-delay
(goto ,destination)
)
)
)
;; the decompiler may fail to recognize setting fields of a 128-bit bitfield
;; and will rely on this macro:
(defmacro copy-and-set-field (original field-name field-value)
`(let ((temp-copy ,original))
(set! (-> temp-copy ,field-name) ,field-value)
temp-copy
)
)
;; inserted by the decompiler if a c->goal bool conversion can't be compacted into a single
;; expression.
(defmacro cmove-#f-zero (dest condition src)
`(if (zero? ,condition)
(set! ,dest #f)
(set! ,dest ,src)
)
)
(defmacro empty-form ()
`(none)
)
;;;;;;;;;;;;;;;;;;;;;;;
;; PC Port asm macros
;;;;;;;;;;;;;;;;;;;;;;;
(#when PC_PORT
;; SYNC is an EE instruction that waits for various memory access and DMA to be completed
;; DMA will be instant in the PC port, so these are no longer necessary
(fake-asm .sync.l)
(fake-asm .sync.p)
;; Copies the contents of a cop0 (system control) register to a gpr
(fake-asm .mfc0 dest src)
;; Copies the contents of a gpr to a cop0 (system control) register
(fake-asm .mtc0 dest src)
)
goal_src/jak2/kernel/gkernel-h.gc
+683 -1
View File
@@ -6,4 +6,686 @@
;; dgos: KERNEL
(defconstant *kernel-major-version* 2)
(defconstant *kernel-minor-version* 0)
(defconstant *kernel-minor-version* 0)
(defconstant DPROCESS_STACK_SIZE (#if PC_PORT #x8000 #x3800))
(defconstant PROCESS_STACK_SIZE (#if PC_PORT #x6000 #x1c00))
(defconstant *tab-size* (the binteger 8))
(defconstant *gtype-basic-offset* 4)
;; if set, will attempt to detect memory corruption and stack overflow bugs
;; to some extent.
(defglobalconstant KERNEL_DEBUG #t)
(defconstant *scratch-memory-top* (the pointer #x70004000))
;; Each process has a bitmask.
;; The kernel can be configured to skip processes with certain mask bits set.
(defenum process-mask
:type uint32
:bitfield #t
(execute 0)
(freeze 1)
(pause 2)
(menu 3)
(progress 4)
(actor-pause 5)
(sleep 6)
(sleep-code 7)
(process-tree 8)
(heap-shrunk 9)
(going 10)
(kernel-run 11)
(no-kill 12)
(movie 13)
(dark-effect 14)
(target 15)
(sidekick 16)
(crate 17)
(bit18 18) ;; unused?
(enemy 19)
(camera 20)
(platform 21)
(ambient 22)
(entity 23)
(projectile 24)
(bot 25)
(collectable 26)
(death 27)
(no-track 28)
(guard 29)
(vehicle 30)
(civilian 31)
)
;; forward declarations
(declare-type process-tree basic)
(declare-type process process-tree)
(declare-type entity basic)
(declare-type entity-actor entity)
(declare-type dead-pool basic)
(declare-type level basic)
(declare-type state basic)
(declare-type event-message-block structure)
(declare-type stack-frame basic)
(declare-type cpu-thread basic)
;; The state of the kernel, containing the masks to allow/deny certain processes,
;; the currently running process, and the currently relocating process.
(deftype kernel-context (basic)
((prevent-from-run process-mask :offset-assert 4)
(require-for-run process-mask :offset-assert 8)
(allow-to-run process-mask :offset-assert 12)
(next-pid int32 :offset-assert 16)
(fast-stack-top pointer :offset-assert 20)
(current-process process :offset-assert 24)
(relocating-process basic :offset-assert 28)
(relocating-min int32 :offset-assert 32)
(relocating-max int32 :offset-assert 36)
(relocating-offset int32 :offset-assert 40)
(relocating-level level :offset-assert 44)
(low-memory-message symbol :offset-assert 48)
(login-object basic :offset-assert 52)
)
:method-count-assert 9
:size-assert #x38
:flag-assert #x900000038
)
;; The usual "time" type.
(deftype time-frame (int64)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; times are stored in 300ths of a second.
;; this divides evenly into frames at both 50 and 60 fps.
;; typically these are stored as integers as more precision is not useful.
;; an unsigned 32-bit integer can store about 150 days
(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps
;; this was usec in GOAL
(defmacro seconds (x)
"Convert number to seconds unit.
Returns uint."
(cond
((integer? x)
(* TICKS_PER_SECOND x)
)
((float? x)
(* 1 (* 1.0 x TICKS_PER_SECOND))
)
(#t
`(the uint (* TICKS_PER_SECOND ,x))
)
)
)
;; Each clock counts in 3 different ways:
;;
;; 1). A "frame counter", which, confusingly, doesn't count frames.
;; It counts elapsed time, in 1/300ths of a second.
;; This counts in real-time, even if the game is lagging.
;;
;; 2). A "integral-frame-counter", which counts the number of vsyncs.
;; This doens't count the number of frames the game actually manages to draw,
;; just the number of vsyncs. It counts at different rates in NTSC/PAL.
;; NOTE: changing clock-ratio will make this count faster/slower. This only counts real
;; vsyncs if clock-ratio is 1.0.
;;
;; 3). The "time ratio", which adjusts based on the actual achieved framerate.
;; Unlike the others, this isn't a incrementing counter, but instead ratios:
;; time-adjust-ratio, frames-per-second, seconds-per-frame.
;;
;; For the most part, users should just adjust per-frame values by time-adjust-ratio, and this will
;; compensate for pal/ntsc, lag, and clock-ratio scaling.
;;
;; The clock won't tick if its process-mask is prevent-from-run in the kernel.
;; A clock can change the rate it runs at with clock-ratio.
;; Note: both integral-frame-counter and seconds-per-frame/frames-per-second are affected by
;; clock-ratio, which is somewhat weird.
;; Changing clock-ratio will make integral-frame-counter not count actual vsyncs
(deftype clock (basic)
((index int32 :offset-assert 4) ;; which clock we are, in *display*
(mask process-mask :offset-assert 8) ;; mask for ticking
(clock-ratio float :offset-assert 12) ;; how fast to run. 1.0 = realtime.
(accum float :offset-assert 16) ;; fractional time for frame-counter (time-frame units)
(integral-accum float :offset-assert 20) ;; fractional time for integral (time-frame untis)
(frame-counter time-frame :offset-assert 24) ;; how much time has gone by since reset (time-frame units)
(old-frame-counter time-frame :offset-assert 32) ;; the frame-counter on the last engine iteration
(integral-frame-counter uint64 :offset-assert 40) ;; how many vsyncs have gone by since reset
(old-integral-frame-counter uint64 :offset-assert 48) ;; the integral-frame-counter on the last engine iteration
(sparticle-data vector :inline :offset-assert 64) ;; sparticle timescale info
(seconds-per-frame float :offset-assert 80) ;; how many seconds (not time-frames) should go by in 1 vsync
(frames-per-second float :offset-assert 84) ;; inverse of above
(time-adjust-ratio float :offset-assert 88) ;; 1, if the game runs at 60fps NTSC with clock-ratio = 1.
)
:method-count-assert 15
:size-assert #x5c
:flag-assert #xf0000005c
(:methods
(new (symbol type int) _type_ 0)
(update-rates! (_type_ float) float 9)
(advance-by! (_type_ float) clock 10)
(tick! (_type_) clock 11)
(save! (_type_ (pointer uint64)) int 12)
(load! (_type_ (pointer uint64)) int 13)
(reset! (_type_) none 14)
)
)
(defmethod new clock ((allocation symbol) (type-to-make type) (arg0 int))
"Create a new clock and initialize to a non-zero time."
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 index) arg0)
(set! (-> gp-0 frame-counter) (seconds 1000))
(set! (-> gp-0 integral-frame-counter) (the-as uint 300000))
(set! (-> gp-0 old-frame-counter) (+ (-> gp-0 frame-counter) -1))
(set! (-> gp-0 old-integral-frame-counter) (+ (-> gp-0 integral-frame-counter) -1))
(update-rates! gp-0 1.0)
gp-0
)
)
;; The basic node used to organize processes into a tree.
;; The process types themselves are children of the process-tree type
;; Typically, each instance of a game object is a process.
(deftype process-tree (basic)
((name string :offset-assert 4)
(mask process-mask :offset-assert 8)
(clock clock :offset-assert 12)
(parent (pointer process-tree) :offset-assert 16)
(brother (pointer process-tree) :offset-assert 20)
(child (pointer process-tree) :offset-assert 24)
(ppointer (pointer process) :offset-assert 28)
(self process-tree :offset-assert 32)
)
(:methods
(new (symbol type string) _type_ 0)
(activate (_type_ process-tree basic pointer) process-tree 9)
(deactivate (_type_) none 10)
(init-from-entity! (_type_ entity-actor) none 11) ;; todo check
(run-logic? (_type_) symbol 12)
(dummy-13 () none 13)
)
:size-assert #x24
:method-count-assert 14
:no-runtime-type
)
;; Each process has a single "main" thread that is suspended and resumed.
;; The "thread" object is what holds the needed state to start, suspend, and resume execution.
;; Additionally, the kernel creates various temporary threads to run single functions.
;; These "temporary" threads are never suspended.
;; unlike modern implementations, the "thread" objects store small "backup" stacks (often only 100's of bytes).
;; when a thread is suspended, it copies the stack from the execution stack to the backup stack.
;; this seems silly, but it has an advantage to reduce memory - typically threads suspend without a very deep call
;; stack, so the backup stack can be much, much smaller than a single large, shared execution stack.
(deftype thread (basic)
((name symbol :offset-assert 4)
(process process :offset-assert 8)
(previous thread :offset-assert 12)
(suspend-hook (function cpu-thread none) :offset-assert 16) ;; called by user to suspend
(resume-hook (function cpu-thread none) :offset-assert 20) ;; called by kernel to resume
(pc pointer :offset-assert 24) ;; pc (x86 rip) to resume to
(sp pointer :offset-assert 28) ;; stack pointer of thread
(stack-top pointer :offset-assert 32) ;; stack to execute on
(stack-size int32 :offset-assert 36) ;; size of _suspend_ stack
)
:method-count-assert 12
:size-assert #x28
:flag-assert #xc00000028
(:methods
(stack-size-set! (_type_ int) none 9)
(thread-suspend (_type_) none 10)
(thread-resume (_type_) none 11)
)
)
;; additional information to context switch
(deftype cpu-thread (thread)
((rreg uint64 7 :offset-assert 40) ;; GPRs
(freg float 8 :offset-assert 96) ;; FPRs
(stack uint8 :dynamic :offset-assert 128) ;; backup stack (dynamically sized)
)
:method-count-assert 12
:size-assert #x80
:flag-assert #xc00000080
(:methods
(new (symbol type process symbol int pointer) _type_ 0)
)
)
;; Base type for all actual processes.
;; this can be used directly, or child types can be made.
(deftype process (process-tree)
((pool dead-pool ) ;; where to return us when we die
(status symbol :offset-assert 40) ;; used by kernel to track init/death
(pid int32 ) ;; globally unique ID, never reused for another
(main-thread cpu-thread :offset-assert 48) ;; suspendable main thread
(top-thread cpu-thread :offset-assert 52) ;; currently running thread
(entity entity :offset-assert 56) ;; if we were spawned from an entity, that entity
(level level :offset-assert 60) ;; if we're associated with a level, that level
(state state :offset-assert 64) ;; current state, if we're in one
(next-state state :offset-assert 68) ;; set if we have a pending (go)
(trans-hook function :offset-assert 72) ;; function to run before resuming
(post-hook function :offset-assert 76) ;; function to run after suspending
;; function to run if we receive an event
(event-hook (function process int symbol event-message-block object) :offset-assert 80)
;; process heap size
(allocated-length int32 :offset-assert 84)
;; ??
(pad0 uint32 2)
;; process heap
(heap-base pointer :offset-assert 96)
(heap-top pointer :offset-assert 100)
(heap-cur pointer :offset-assert 104)
;; linked list of stack frames that have been created.
;; note that these aren't created on every function call, only
;; if the user explicitly creates a catch block or similar
(stack-frame-top stack-frame :offset-assert 108)
;; list of engines this process is connected to
(connection-list connectable :inline :offset-assert 112)
;; the process memory: contains child fields, then the process heap.
(stack uint8 :dynamic :offset-assert 128)
)
(:methods
(new (symbol type string int) _type_ 0)
)
(:states
dead-state
empty-state)
:size-assert #x80
:method-count-assert 14
:no-runtime-type ;; already defined by kscheme. Don't do it again.
)
;; dead-pool is the simplest way to store dead processes - it's just a tree of processes that
;; are inactive.
(deftype dead-pool (process-tree)
()
:method-count-assert 16
:size-assert #x24
:flag-assert #x1000000024
(:methods
(new (symbol type int int string) _type_ 0)
(get-process (_type_ type int) process 14)
(return-process (_type_ process) none 15)
)
)
;; dead-pool-heap is a special thing - it pretends to be a dead-pool, but secretly
;; creates and destroys processes on demand, as they are requested/returned.
;; to do this, it has a single large heap and memory allocator.
;; to prevent fragmentation of this heap, it has a relocate/compaction system
;; that moves processes in memory.
;; A dead-pool-heap-rec is a record for a process used by the handle system.
;; The kernel will make sure that:
;; - the dead-pool-heap-rec for a process will continue to point to that process until the process
;; is killed.
;; - the dead-pool-heap-rec itself is never moved in memory, and it always points to some process, or #f.
;; (it is always safe to do (-> rec process pid) and see if it still points to your process)
(deftype dead-pool-heap-rec (structure)
((process process :offset-assert 0)
(prev dead-pool-heap-rec :offset-assert 4)
(next dead-pool-heap-rec :offset-assert 8)
)
:pack-me
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
;; the actual pool implementation
(deftype dead-pool-heap (dead-pool)
((allocated-length int32 :offset-assert 36)
(compact-time uint32 :offset-assert 40)
(compact-count-targ uint32 :offset-assert 44)
(compact-count uint32 :offset-assert 48)
(fill-percent float :offset-assert 52)
(first-gap dead-pool-heap-rec :offset-assert 56)
(first-shrink dead-pool-heap-rec :offset-assert 60)
(heap kheap :inline :offset-assert 64)
(alive-list dead-pool-heap-rec :inline :offset-assert 80)
(last dead-pool-heap-rec :offset 84)
(dead-list dead-pool-heap-rec :inline :offset-assert 92)
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
)
:method-count-assert 28
:size-assert #x68
:flag-assert #x1c00000068
(:methods
(new (symbol type string int int) _type_ 0)
(init (_type_ symbol int) none 16)
(compact (dead-pool-heap int) none 17)
(shrink-heap (dead-pool-heap process) dead-pool-heap 18)
(churn (dead-pool-heap int) none 19)
(memory-used (_type_) int 20)
(memory-total (_type_) int 21)
(memory-free (dead-pool-heap) int 22)
(compact-time (dead-pool-heap) uint 23)
(gap-size (dead-pool-heap dead-pool-heap-rec) int 24)
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25)
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26)
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27)
)
)
;; parent type for all kinds of stack-frames.
;; at least for jak 1, these are only used internally by the kernel
;; "next" brings you "up" the stack (toward the caller)
(deftype stack-frame (basic)
((name symbol :offset 4)
(next stack-frame :offset 8)
)
:size-assert #xc
:method-count-assert 9
:flag-assert #x90000000c
)
;; a "catch" frame is a frame that can be "thrown" to.
;; the "throw" is a nonlocal control flow back to the state befor the "catch" block.
(deftype catch-frame (stack-frame)
((sp int32 :offset-assert 12)
(ra int32 :offset-assert 16)
(freg float 6 :offset-assert 20)
(rreg uint128 8 :offset-assert 48)
)
:method-count-assert 9
:size-assert #xb0
:flag-assert #x9000000b0
(:methods
(new (symbol type symbol function (pointer uint64)) object 0)
)
)
;; a "protect" frame is a way to indicate there's a "exit" function that should
;; run if there's a "throw" or "abandon".
(deftype protect-frame (stack-frame)
((exit (function none) :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type (function none)) protect-frame 0)
)
)
;; a handle is a safe way to refer to a process. It solves two problems:
;; - it allows you to find a process that moves in memory
;; - it allows you to tell if the original process has died. otherwise you may get confused
;; because there could be another process located at the exact same address.
(deftype handle (uint64)
((process (pointer process) :offset 0 :size 32) ;; additional level of indirection to support moving processes
(pid int32 :offset 32 :size 32) ;; unique pid to check if it's the same process or not.
(u64 uint64 :offset 0 :size 64)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(defmethod inspect handle ((obj handle))
(when (not obj)
(return obj)
)
(format #t "[~8x] ~A~%" obj 'handle)
(format #t "~1Tprocess: #x~X~%" (-> obj process))
(format #t "~1Tpid: ~D~%" (-> obj pid))
obj
)
(defmacro handle->process (handle)
"Convert a handle to a process. If the process no longer exists, returns #f."
`(let ((the-handle (the-as handle ,handle)))
(if (-> the-handle process) ;; if we don't point to a process, kernel sets this to #f
(let ((proc (-> (-> the-handle process))))
(if (= (-> the-handle pid) (-> proc pid)) ;; make sure it's the same process
proc
)
)
)
)
)
(defmacro ppointer->process (ppointer)
"convert a (pointer process) to a process."
;; this uses the self field, which seems to always just get set to the object.
;; confirmed in Jak 1 that using self here is useless, not sure...
`(let ((the-pp ,ppointer))
(the process-tree (if the-pp (-> the-pp 0 self)))
)
)
(defmacro process->ppointer (proc)
"safely get a (pointer process) from a process, returning #f if invalid."
`(let ((the-proc ,proc))
(if the-proc (-> the-proc ppointer))
)
)
(defmacro ppointer->handle (pproc)
"convert a ppointer to a handle. assumes the ppointer is valid."
`(let ((the-process (the-as (pointer process) ,pproc)))
(new 'static 'handle :process the-process :pid (-> the-process 0 pid))
)
)
(defmacro process->handle (proc)
"convert a process to a handle. if proc is #f, returns a #f handle."
`(ppointer->handle (process->ppointer ,proc))
)
(defmethod print handle ((obj handle))
(if (nonzero? obj)
(format #t "#<handle :process ~A :pid ~D>" (handle->process obj) (-> obj pid))
(format #t "#<handle :process 0 :pid 0>")
)
obj
)
;; A "state" defines functions that a process should run when it is in that state.
;; the "code" function is executed by the main thread and can suspend/resume.
;; the "trans" function is executed before code is resumed
;; the "post" function is executed after code is suspended
;; the "enter" function is executed when the process first transitions to the state
;; the "exit" function is executed when the process exits the state (or dies)
;; the "event" function is executed when the process receives an event.
;; See gstate.gc for a lot more details on how this all works.
;; This type is just a container to hold those functions.
(deftype state (protect-frame)
((code function :offset-assert 16)
(trans (function none) :offset-assert 20)
(post function :offset-assert 24)
(enter function :offset-assert 28)
(event (function process int symbol event-message-block object) :offset-assert 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
(:methods
(new (symbol
type
symbol
function
(function none)
function
(function none)
(function process int symbol event-message-block object))
_type_ 0)
)
)
;; data contained in an "event" sent from one process to another
;; in jak2, the events may be queued and sent at a later time, so the block
;; contains handles, to see if the to/from processes are still alive.
(deftype event-message-block (structure)
((to-handle handle :offset-assert 0) ;; who to send to
(to (pointer process) :offset 0)
(form-handle handle :offset-assert 8) ;; who is doing the sending
(from (pointer process) :offset 8)
(param uint64 6 :offset-assert 16) ;; the data being sent
(message symbol :offset-assert 64) ;; the message name
(num-params int32 :offset-assert 68)
)
:method-count-assert 9
:size-assert #x48
:flag-assert #x900000048
)
;; a queue of messages.
(deftype event-message-block-array (inline-array-class)
((data event-message-block :inline :dynamic :offset-assert 16)
)
:method-count-assert 10
:size-assert #x10
:flag-assert #xa00000010
(:methods
(send-all! (_type_) none 9)
)
)
(set! (-> event-message-block-array heap-base) (the-as uint 80))
;; the type returned by the C Kernel, contains the result of a SQL Query.
(deftype sql-result (basic)
((len int32 :offset-assert 4)
(allocated-length uint32 :offset-assert 8)
(error symbol :offset-assert 12)
(data symbol :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type uint) _type_ 0)
)
)
(defmethod new sql-result ((allocation symbol) (type-to-make type) (arg0 uint))
"Allocate a new sql-result with enough room for arg0 entries in data."
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* arg0 4))))))
(set! (-> v0-0 allocated-length) arg0)
(set! (-> v0-0 error) 'error)
v0-0
)
)
(defmethod print sql-result ((obj sql-result))
"Print a sql-result as an array of symbols."
(format #t "#(~A" (-> obj error))
(dotimes (s5-0 (-> obj len))
(format #t " ~A" (-> obj data s5-0))
)
(format #t ")")
obj
)
;; the result that the C Kernel will send us.
(define *sql-result* (the-as sql-result #f))
(defmacro defbehavior (name process-type bindings &rest body)
"define a new behavior. This is simply a function where self is bound to the process register,
which is assumed to have type process-type."
(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 :behavior ,process-type ,bindings ,@(cdr body)))
;; otherwise don't ignore it.
`(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body))
)
)
(defmacro process-stack-used (proc)
;; get how much stack the top thread of a process has used.
`(- (the int (-> ,proc top-thread stack-top))
(the int (-> ,proc top-thread sp))
)
)
(defmacro process-stack-size (proc)
;; get how much stack the top thread of a process has
`(-> ,proc top-thread stack-size)
)
(defmacro process-heap-used (proc)
;; get how much heap a process has used.
`(- (-> ,proc allocated-length)
(- (the int (-> ,proc heap-top))
(the int (-> ,proc heap-cur))
)
)
)
(defmacro process-heap-size (proc)
;; get how much heap a process has
`(the int (-> ,proc allocated-length))
)
(defmacro break ()
`(/ 0 0)
)
(defmacro with-pp (&rest body)
"execute the body with pp bound to the current process register."
`(rlet ((pp :reg r13 :reset-here #t :type process))
,@body)
)
(defmacro process-mask? (mask enum-value)
`(!= 0 (logand ,mask (process-mask ,enum-value)))
)
(defmacro process-mask-set! (mask &rest enum-value)
;; sets the given bits in the process mask (with or)
`(set! ,mask (logior ,mask (process-mask ,@enum-value)))
)
(defmacro process-mask-clear! (mask &rest enum-value)
;; sets the given bits in the process mask (with or)
`(set! ,mask (logand ,mask (lognot (process-mask ,@enum-value))))
)
(defmacro suspend ()
"suspend the current process, to be resumed on the next frame."
`(rlet ((pp :reg r13 :reset-here #t))
;; debug check for stack overflow here, where we can easily print the process name.
(#when (or KERNEL_DEBUG)
(rlet ((sp :reg rsp :reset-here #t :type int)
(off :reg r15 :type uint))
(let* ((sp-goal (- sp off))
(stack-top-goal (-> (the process pp) top-thread stack-top))
(stack-used (&- stack-top-goal sp-goal))
(stack-size (-> (the process pp) top-thread stack-size))
)
(when (> stack-used stack-size)
(format 0 "ERROR: suspend called without enough stack in proc:~%~A~%Stack: ~D/~D~%" pp stack-used stack-size)
)
)
)
)
;; set to the current thread
(set! pp (-> (the process pp) top-thread))
;; call the suspend hook (put nothing as the argument)
((-> (the cpu-thread pp) suspend-hook) (the cpu-thread 0))
;; the kernel will set pp (possibly to a new value, if we've been relocated) on resume.
)
)
goal_src/jak2/kernel/gkernel.gc
+2428 -2
View File
File diff suppressed because it is too large Load Diff
goal_src/jak2/kernel/gstate.gc
+505 -1
View File
@@ -1,7 +1,511 @@
;;-*-Lisp-*-
;-*-Lisp-*-
(in-package goal)
;; name: gstate.gc
;; name in dgo: gstate
;; dgos: KERNEL
#|
Summary of state system:
A process can be put into a state, using enter-state, or the go macro.
This will set up the process to run the appropriate handler functions defined by the state.
The state handlers are:
- enter : gets run before trans on the first time the state is used. Can be #f. Must return.
- trans : gets run before code each time the code is run. Can be #f. Must return.
- code : main thread. Can suspend. If it returns, the process dies
- exit : gets run when leaving a state. must return.
- event : not sure of the details here yet.
You can use "go" to change the state of a process. This causes the process main thread execution to be abandoned.
If the main thread has exits/protects on the stack frame, they will be run first to clean up.
There are several ways to "go"
- go during init: when a process is being initialized with run-function-in-process, you can "go".
this causes the run-function-in-process to return immediately, and the next time the process is dispatched
it will go into the other state. This will automatically set the process to waiting-to-run,
and shrink the process heap, if appropriate
- go from outside the process. You can temporarily set pp to another process, and have that
process go to another state. The actual go will occur the next time the process is scheduled.
Use the go-process macro to do this.
- go from a non-main thread in the right process. You can do a go from a temporary thread, like trans or post.
If you do it from post, the go returns and the rest of the post runs. If you do it from any other thread, the temporary thread
is immediately abandonded. Like the previous two, it will defer the actual go until the next time the
process runs.
- go from the main thread of the main process. This causes the (-> pp state) to change, the stack frames
to be cleaned up, and the old state's exit to be called. It will reset the stack, then run the code.
Unlike the others, this means you "go" immediately.
The compiler has two special hooks related to states: go-hook and define-state-hook.
These take care of doing a go and a state definition and properly checking types.
The define-state-hook takes a state object and handlers and defines a global symbol
with the appropriate state type.
The go-hook calls enter state and sets (-> proc next-state) for the given process.
It type checks the arguments for the entry function.
|#
(defmacro go (next-state &rest args)
"Change the state of the current process.
This will only return if this is called within the post thread.
Otherwise, execution stops here and the kernel will run the next state next time."
`(with-pp
(go-hook pp ,next-state ,@args)
)
)
(defmacro go-virtual (state-name &key (proc self) &rest args)
"Same as go, but use a virtual state."
`(go (method-of-object ,proc ,state-name) ,@args)
)
(defmacro go-process (proc next-state &rest args)
"Make another process go."
`(with-pp
(protect (pp)
(set! pp ,proc)
(go-hook pp ,next-state ,@args)
)
)
)
;; run the given function in a process right now.
;; will return to here when:
;; - you return
;; - you deactivate
;; - you go
;; - you throw to 'initialize
(defmacro run-now-in-process (proc func &rest args)
"Run a function in another process right now."
`((the (function _varargs_ object) run-function-in-process)
,proc ,func ,@args
)
)
;; sets the main thread of the given process to run the given thing.
;; this resets the main thread stack back to the top
(defmacro run-next-time-in-process (proc func &rest args)
"Set up a process to run a function the next time it is scheduled."
`((the (function _varargs_ object) set-to-run)
(-> ,proc main-thread) ,func ,@args
)
)
(defmacro process-spawn-function (proc-type func &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args)
"Start a new process that runs a function on its main thread.
Returns a pointer to the new process (or #f? on error)."
(with-gensyms (new-proc)
`(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size))))
(when ,new-proc
((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name (symbol->string proc-type)) ,stack)
(run-next-time-in-process ,new-proc ,func ,@args)
(the (pointer ,proc-type) (-> ,new-proc ppointer))
)
)
)
)
(defmacro process-spawn (proc-type &key (init #f) &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args)
"Start a new process and run an init function on it.
Returns a pointer to the new process, or #f (or is it 0?) if something goes wrong."
(with-gensyms (new-proc)
`(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size))))
(when ,new-proc
((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name `(quote ,proc-type)) ,stack)
(run-now-in-process ,new-proc ,(if init init (string->symbol (fmt #f "{}-init-by-other" proc-type))) ,@args)
(the (pointer ,proc-type) (-> ,new-proc ppointer))
)
)
)
)
;; display a listing of active processes.
(defmacro ps (&key (detail #f))
`(inspect-process-tree *active-pool* 0 0 ,detail)
)
;; use a compile-time list to keep track of the type of an anonymous behavior.
(seval (define *defstate-type-stack* '()))
(desfun def-state-check-behavior (beh-form beh-type)
"check if code block is an anonymous behavior. needed for anonymous behaviors on defstate."
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
(push! *defstate-type-stack* beh-type)
)
)
(defmacro clear-def-state-stack ()
(set! *defstate-type-stack* '())
`(none)
)
;; *no-state* is just used for the compiler to know whether a handler was actually set or not
(defmacro defstate (state-name parents
&key (virtual #f)
&key (event *no-state*)
&key (enter *no-state*)
&key (trans *no-state*)
&key (exit *no-state*)
&key (code *no-state*)
&key (post *no-state*)
)
"Define a new state!"
(with-gensyms (new-state)
(let ((defstate-type (first parents)))
(when (not (null? *defstate-type-stack*))
(fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}"
*defstate-type-stack*)
)
(set! *defstate-type-stack* '())
;; check for default handlers
(let ((default-handlers (assoc defstate-type *default-state-handlers*)))
(when (not (null? default-handlers))
;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers)
;; event
(set! default-handlers (cadr default-handlers))
(when (and (eq? event '*no-state*) (car default-handlers))
(set! event (car default-handlers)))
;; enter
(set! default-handlers (cdr default-handlers))
(when (and (eq? enter '*no-state*) (car default-handlers))
(set! enter (car default-handlers)))
;; trans
(set! default-handlers (cdr default-handlers))
(when (and (eq? trans '*no-state*) (car default-handlers))
(set! trans (car default-handlers)))
;; exit
(set! default-handlers (cdr default-handlers))
(when (and (eq? exit '*no-state*) (car default-handlers))
(set! exit (car default-handlers)))
;; code
(set! default-handlers (cdr default-handlers))
(when (and (eq? code '*no-state*) (car default-handlers))
(set! code (car default-handlers)))
;; post
(set! default-handlers (cdr default-handlers))
(when (and (eq? post '*no-state*) (car default-handlers))
(set! post (car default-handlers)))
(set! default-handlers (cdr default-handlers))
)
)
(def-state-check-behavior event defstate-type)
(def-state-check-behavior enter defstate-type)
(def-state-check-behavior trans defstate-type)
(def-state-check-behavior exit defstate-type)
(def-state-check-behavior code defstate-type)
(def-state-check-behavior post defstate-type)
`(let ((,new-state (new 'static 'state
:name (quote ,state-name)
:next #f
:exit #f
:code #f
:trans #f
:post #f
:enter #f
:event #f
)
))
;; the compiler will set the fields of the given state and define the symbol.
;; This way it can check the individual function types, make sure they make sense, and create
;; a state with the appropriate type.
,(if virtual
`(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
`(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
)
)
)
)
)
(defmacro behavior (bindings &rest body)
"Define an anonymous behavior for a process state. This may only be used inside a defstate!"
(let ((behavior-type (first *defstate-type-stack*)))
(pop! *defstate-type-stack*)
`(lambda :behavior ,behavior-type ,bindings ,@body)
)
)
;; set the default handler functions for a process's state handlers
(seval (define *default-state-handlers* '()))
(defmacro defstatehandler (proc
&key (event #f)
&key (enter #f)
&key (trans #f)
&key (exit #f)
&key (code #f)
&key (post #f))
(let ((old (assoc proc *default-state-handlers*))
(new (list proc (list event enter trans exit code post))))
(if (null? old)
(append!! *default-state-handlers* new) ;; add new set of default handlers
(dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones
(when (eq? (car hnd) old)
(set-car! hnd new)
)
)
)
)
`(none)
)
(defmethod new state
((allocation symbol)
(type-to-make type)
(name symbol)
(code function)
(trans (function none))
(enter function)
(exit (function none))
(event (function process int symbol event-message-block object)))
"Allocate a new state. It seems like this isn't really used much and most states are
statically allocated and as a result don't have the constructor called."
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> obj name) name)
(set! (-> obj next) #f)
(set! (-> obj exit) exit)
(set! (-> obj code) code)
(set! (-> obj trans) trans)
(set! (-> obj post) #f)
(set! (-> obj enter) enter)
(set! (-> obj event) event)
obj
)
)
(defun inherit-state ((child state) (parent state))
"Copy handler functions from parent to child"
(cond
((nonzero? parent)
(set! (-> child exit) (-> parent exit))
(set! (-> child code) (-> parent code))
(set! (-> child trans) (-> parent trans))
(set! (-> child post) (-> parent post))
(set! (-> child enter) (-> parent enter))
(set! (-> child event) (-> parent event))
)
(else
;; Note: this is added to let us defstate on a child before the parent.
;; The child won't be usable like this, but it will prevent a crash.
(format 0 "[STATE ERROR] inherit-state got a null parent state. Child is ~A~%" (-> child name))
)
)
child
)
(defmethod print state ((obj state))
"Print a state."
(format '#t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
obj
)
(define-extern enter-state (function object object object object object object object))
(defun enter-state (arg0 arg1 arg2 arg3 arg4 arg5)
"Make the process stored in pp enter the state in pp next-state"
(with-pp
;; unsleep us
(process-mask-clear! (-> pp mask) sleep sleep-code)
;; mark as going
(process-mask-set! (-> pp mask) going)
(cond
((= (-> pp status) 'initialize)
;; did a go during initialize.
;; remove the old trans hook, if there was one
(set! (-> pp trans-hook) #f)
;; set us up to run enter-state again, the next time we're scheduled.
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
;; tell the kernel that we did a go during init
(set! (-> pp status) 'initialize-go)
;; abandon this thread, go back to what initialized us!
(throw 'initialize #t)
#t
)
((!= (-> *kernel-context* current-process) pp)
;; we aren't actually in process pp right now.
;; so set us up to go in the next run
(let ((status-backup (-> pp status)))
(set! (-> pp trans-hook) #f)
;; will set waiting-to-run
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
;; restore the old status.
(set! (-> pp status) status-backup)
#t
)
)
((= (-> pp main-thread) (-> pp top-thread))
;; we are in the right process, and in the main thread!
;; we will do a nonlocal control transfer to the new state's code.
;; the new state can then suspend and get back to the kernel dispatcher lambda
;; like normal.
;; change state!
(set! (-> pp state) (-> pp next-state))
;; do exits
(let ((frame (-> pp stack-frame-top)))
(while frame
(case (-> frame type)
((protect-frame state)
((-> (the-as protect-frame frame) exit))
)
)
(set! frame (-> frame next))
)
)
;; done with going, clear the mask
(process-mask-clear! (-> pp mask) going)
;; now, update the process:
(let ((new-state (-> pp state)))
;; event hook from the current state
(set! (-> pp event-hook) (-> new-state event))
;; if we have an exit, push it onto the stack frame
;; and also blow away the old stack frame
(if (-> new-state exit)
(set! (-> pp stack-frame-top) new-state)
(set! (-> pp stack-frame-top) #f)
)
(set! (-> pp post-hook) (-> new-state post))
(set! (-> pp trans-hook) (-> new-state trans))
;; start up the new state. First run the enter function
(let ((enter-func (-> new-state enter)))
(if enter-func
((the (function _varargs_ none) enter-func) arg0 arg1 arg2 arg3 arg4 arg5)
)
)
;; run the trans function before the code.
(let ((trans-func (-> new-state trans)))
(if trans-func
(trans-func)
)
)
;; now we run the code, but in a tricky way.
;; we need to:
;; - make sure that when this code returns, we do a deactivate
;; - reset the stack to the top, so we can't just call the code.
(rlet ((temp)
(func)
(sp :reg rsp :type uint)
(off :reg r15 :type uint)
(carg0 :reg rdi)
(carg1 :reg rsi)
(carg2 :reg rdx)
(carg3 :reg rcx))
;; prepare args
;; compiler will likely have these on the stack, we need to get them in regs
;; before messing with the stack.
(.mov carg0 arg0)
(.mov carg1 arg1)
(.mov carg2 arg2)
(.mov carg3 arg3)
;; get the main code as an x86-64 pointer
(.mov func (-> new-state code))
(.add func off)
;; reset the stack (scary)
(.mov sp (-> pp main-thread stack-top))
(.add sp off)
;; push the return trampoline for when code returns.
(.mov temp return-from-thread-dead) ;; will deactivate
(.add temp off)
(.push temp)
;; and call!
(.jr func)
;; stupid hack so the compiler doesn't throw away these registers.
(.add carg0 carg1)
(.add carg2 carg3)
#f ;; can't get here
)
)
)
(else
;; not in the main-thread.
;; so we set up the main thread to try again.
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread)
enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(when (!= (-> pp top-thread name) 'post)
;; abandon this one too.
;; NOTE - this is different from GOAL.
;; GOAL installs this as the return address for this function and returns normally.
;; but we don't because I don't have an easy way to find where to stick this.
;; I can't see how this makes a difference, as all non-main threads seem
;; temporary, but if this turns out to be false, we will need to change this.
(rlet ((temp)
(off :reg r15 :type uint :reset-here #t))
(.mov temp return-from-thread) ;; could probably just call this...
(.add temp off)
(.push temp)
(.ret)
#f ;; can't get here
)
)
)
)
)
)
(kmemopen global "event-queue")
(let ((v1-3 (new 'global 'event-message-block-array 64)))
(set! (-> v1-3 length) 0)
(define *event-queue* v1-3)
)
(kmemclose)
(defun send-event-function ((arg0 process-tree) (arg1 event-message-block))
"Send an event block to a process."
(with-pp
(when (and arg0 (!= (-> arg0 type) process-tree) (-> (the-as process arg0) event-hook) (-> arg1 from))
(let ((gp-0 pp))
(set! pp (the-as process arg0))
(let ((v0-0 ((-> (the-as process arg0) event-hook) (-> arg1 from 0) (-> arg1 num-params) (-> arg1 message) arg1)))
(set! pp gp-0)
v0-0
)
)
)
)
)
(defmethod send-all! event-message-block-array ((obj event-message-block-array))
"Send all pending messages. Will only do the send if both the sender and receiver are still alive."
(dotimes (s5-0 (-> obj length))
(let* ((a1-0 (-> obj data s5-0))
(a0-2 (handle->process (-> a1-0 to-handle)))
)
(if (and a0-2 (handle->process (-> a1-0 form-handle)))
(send-event-function a0-2 a1-0)
)
)
)
(set! (-> obj length) 0)
0
(none)
)
(defun looping-code ()
"Function which calls suspend in a loop. Can be used to create a thread that does nothing."
(until #f
(suspend)
)
#f
)
goal_src/jak2/kernel/gstring-h.gc
+7
View File
@@ -5,3 +5,10 @@
;; name in dgo: gstring-h
;; dgos: KERNEL
(define-extern *string-tmp-str* string)
(define-extern *temp-string* string)
(define-extern *stdcon0* string)
(define-extern *stdcon1* string)
(define-extern *stdcon* string)
(define-extern *debug-draw-pauseable* symbol)
(define-extern string= (function string string symbol))
goal_src/jak2/kernel/gstring.gc
+782
View File
@@ -5,3 +5,785 @@
;; name in dgo: gstring
;; dgos: KERNEL
(defmethod length string ((obj string))
"Get the length of a string. Like strlen"
(let ((v1-0 (-> obj data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(&- v1-0 (the-as uint (-> obj data)))
)
)
(defmethod asize-of string ((obj string))
"get the size in bytes of a string."
(+ (-> obj allocated-length) 1 (-> string size))
)
(defun copy-string<-string ((arg0 string) (arg1 string))
"Copy data from one string to another, like strcpy"
(let ((v1-0 (-> arg0 data)))
(let ((a1-1 (-> arg1 data)))
(while (nonzero? (-> a1-1 0))
(set! (-> v1-0 0) (-> a1-1 0))
(set! v1-0 (&-> v1-0 1))
(set! a1-1 (&-> a1-1 1))
)
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
"Create a new string of the given size. If other is not #f, copy data from it."
(cond
(arg1
(let* ((s2-1 (max (length arg1) arg0))
(a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size))))
)
(set! (-> a0-4 allocated-length) s2-1)
(copy-string<-string a0-4 arg1)
)
)
(else
(let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size)))))
(set! (-> v0-2 allocated-length) arg0)
v0-2
)
)
)
)
(defun string= ((arg0 string) (arg1 string))
"Does str-a hold the same data as str-b?.
If either string is null, returns #f."
(let ((a2-0 (-> arg0 data))
(v1-0 (-> arg1 data))
)
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0)))
(if (!= (-> a2-0 0) (-> v1-0 0))
(return #f)
)
(set! a2-0 (&-> a2-0 1))
(set! v1-0 (&-> v1-0 1))
)
(and (zero? (-> a2-0 0)) (zero? (-> v1-0 0)))
)
)
(defun string-prefix= ((arg0 string) (arg1 string))
"Is the first string a prefix of the second? (string-prefix= 'foo' 'foobar') = #t"
(let ((v1-0 (-> arg0 data)))
(let ((a2-0 (-> arg1 data)))
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0)))
(if (!= (-> v1-0 0) (-> a2-0 0))
(return #f)
)
(set! v1-0 (&-> v1-0 1))
(set! a2-0 (&-> a2-0 1))
)
)
(zero? (-> v1-0 0))
)
)
(defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
"Is the first cstring a prefix of the second?"
(while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0)))
(if (!= (-> arg0 0) (-> arg1 0))
(return #f)
)
(set! arg0 (&-> arg0 1))
(set! arg1 (&-> arg1 1))
)
(zero? (-> arg0 0))
)
(defun string-suffix= ((arg0 string) (arg1 string))
"Is the _second_ string a suffix of the first?"
(let ((s5-0 (-> arg0 data))
(gp-0 (-> arg1 data))
)
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(let ((s4-0 (length arg0))
(v1-5 (length arg1))
)
(if (< s4-0 v1-5)
(return #f)
)
(let ((v1-7 (&+ s5-0 (- s4-0 v1-5))))
(while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0)))
(if (!= (-> v1-7 0) (-> gp-0 0))
(return #f)
)
(set! v1-7 (&-> v1-7 1))
(set! gp-0 (&-> gp-0 1))
)
(zero? (-> v1-7 0))
)
)
)
)
(defun string-position ((arg0 string) (arg1 string))
"Find the position of the first string in the second."
(let ((s5-0 0)
(s4-0 (-> arg1 data))
)
(while (nonzero? (-> s4-0 0))
(if (charp-prefix= (-> arg0 data) s4-0)
(return s5-0)
)
(+! s5-0 1)
(set! s4-0 (&-> s4-0 1))
)
)
-1
)
(defun string-charp= ((arg0 string) (arg1 (pointer uint8)))
"Is the data in str equal to the C string charp?"
(let ((v1-0 (-> arg0 data)))
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0)))
(if (!= (-> v1-0 0) (-> arg1 0))
(return #f)
)
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(and (zero? (-> v1-0 0)) (zero? (-> arg1 0)))
)
)
;; definition for function name=
;; ERROR: function was not converted to expressions. Cannot decompile.
(defun name= ((arg0 object) (arg1 object))
"Do arg0 and arg1 have the same name?
This can use either strings or symbols"
(cond
((= arg0 arg1)
;; Either same symbols, or same string objects, fast check pass!
#t)
((and (= (rtype-of arg0) string) (= (rtype-of arg1) string))
(string= (the-as string arg0) (the-as string arg1))
)
((and (= (rtype-of arg0) string) (= (rtype-of arg1) symbol))
(string= (the-as string arg0) (symbol->string arg1))
)
((and (= (rtype-of arg1) string) (= (rtype-of arg0) symbol))
(string= (the-as string arg1) (symbol->string arg0))
)
;; no need to check symbol - symbol, that would have passed the first check.
)
)
(defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
"Copy data from a charp to a GOAL string. Copies len chars, plus a null."
(let ((v1-0 (-> arg0 data)))
(dotimes (a3-0 arg2)
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun string<-charp ((arg0 string) (arg1 (pointer uint8)))
"Copy all chars from a char* to a GOAL string.
Does NO length checking."
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> arg1 0))
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun charp<-string ((arg0 (pointer uint8)) (arg1 string))
"Copy a GOAL string into a character array."
(let ((v1-0 (-> arg1 data)))
(while (nonzero? (-> v1-0 0))
(set! (-> arg0 0) (-> v1-0 0))
(set! arg0 (&-> arg0 1))
(set! v1-0 (&-> v1-0 1))
)
)
(set! (-> arg0 0) (the-as uint 0))
0
)
(defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int))
"Copy n chars from string to character array."
(let ((v1-0 (-> arg1 data)))
(while (and (nonzero? (-> v1-0 0)) (< 1 arg2))
(set! (-> arg0 0) (-> v1-0 0))
(set! arg0 (&-> arg0 1))
(set! v1-0 (&-> v1-0 1))
(set! arg2 (+ arg2 -1))
)
)
(while (> arg2 0)
(set! (-> arg0 0) (the-as uint 0))
(set! arg0 (&-> arg0 1))
(set! arg2 (+ arg2 -1))
)
0
(none)
)
(defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
"C string copy."
(while (nonzero? (-> arg1 0))
(set! (-> arg0 0) (-> arg1 0))
(set! arg0 (&-> arg0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> arg0 0) (the-as uint 0))
arg0
)
(defun cat-string<-string ((arg0 string) (arg1 string))
"Append b to a. No length checks"
(let ((v1-0 (-> arg0 data)))
(let ((a1-1 (-> arg1 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(while (nonzero? (-> a1-1 0))
(set! (-> v1-0 0) (-> a1-1 0))
(set! v1-0 (&-> v1-0 1))
(set! a1-1 (&-> a1-1 1))
)
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
"Append b to a, exactly len chars"
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(dotimes (a3-2 arg2)
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (pointer uint8)))
"Append b to a, using chars of b up to (and including) the one pointed to by end-ptr,
or, until the end of b, whichever comes first."
(let ((v1-0 (-> arg1 data))
(v0-0 (-> arg0 data))
)
(while (nonzero? (-> v0-0 0))
(nop!)
(nop!)
(nop!)
(set! v0-0 (&-> v0-0 1))
)
(while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0)))
(set! (-> v0-0 0) (-> v1-0 0))
(set! v0-0 (&-> v0-0 1))
(set! v1-0 (&-> v1-0 1))
)
(set! (-> v0-0 0) (the-as uint 0))
v0-0
)
)
(defun append-character-to-string ((arg0 string) (arg1 uint8))
"Append char to the end of the given string."
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(set! (-> v1-0 0) (the-as uint arg1))
(set! (-> v1-0 1) (the-as uint 0))
)
0
0
)
(defun charp-basename ((arg0 (pointer uint8)))
"Like basename in C"
(let ((v1-0 arg0))
(while (nonzero? (-> v1-0 0))
(set! v1-0 (&-> v1-0 1))
)
(while (< (the-as int arg0) (the-as int v1-0))
(set! v1-0 (&-> v1-0 -1))
(if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92))
(return (&-> v1-0 1))
)
)
)
arg0
)
(defun clear ((arg0 string))
"Make string empty"
(set! (-> arg0 data 0) (the-as uint 0))
arg0
)
;; NOTE: these string comparisons are a little broken.
;; ex: (string<? "asd" "asdf") = #f
;; (string<? "asdf" "asd") = #f
;; these comparisons do not properly order strings.
(defun string<? ((arg0 string) (arg1 string))
"In dictionary order, is a < b?"
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #t)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #f)
)
)
)
)
#f
)
(defun string>? ((arg0 string) (arg1 string))
"In dictionary order, is a > b?"
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #f)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #t)
)
)
)
)
#f
)
(defun string<=? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #t)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #f)
)
)
)
)
#t
)
(defun string>=? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #f)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #t)
)
)
)
)
#t
)
;; temporary string for argument functions
(define *string-tmp-str* (new 'global 'string 128 (the-as string #f)))
(defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint))
"Return pointer to first instance of char in C string, or to the null terminator if none"
(while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1))
(set! arg0 (&-> arg0 1))
)
arg0
)
(defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint))
"Append append-str to the end of base-str, up to the last occurance of char in append-str"
(let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3)))
(let ((v1-0 (string-skip-to-char (-> arg1 data) arg2)))
(when (= (-> v1-0 0) arg2)
(until (!= (-> v1-0 0) arg2)
(set! s4-0 v1-0)
(set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2))
)
)
)
(cat-string<-string_to_charp arg0 arg1 s4-0)
)
)
(defun string-skip-whitespace ((arg0 (pointer uint8)))
"Skip over spaces, tabs, r's and n's"
;; 32 = space
;; 9 = \t
;; 13 = \r
;; 10 = \n
(while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10)))
(set! arg0 (&-> arg0 1))
)
arg0
)
(defun string-suck-up! ((arg0 string) (arg1 (pointer uint8)))
"Remove character between the start of string and location.
The char pointed to by location is now the first."
(when (!= arg1 (-> arg0 data))
(let ((v1-2 (-> arg0 data)))
(while (nonzero? (-> arg1 0))
(set! (-> v1-2 0) (-> arg1 0))
(set! v1-2 (&-> v1-2 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-2 0) (the-as uint 0))
)
0
)
#f
)
(defun string-strip-leading-whitespace! ((arg0 string))
"Remove whitespace at the front of a string"
(let ((a1-0 (string-skip-whitespace (-> arg0 data))))
(string-suck-up! arg0 a1-0)
)
#f
)
(defun string-strip-trailing-whitespace! ((arg0 string))
"Remove whitespace at the end of a string"
(when (nonzero? (length arg0))
(let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1))))
(while (and (>= (the-as int v1-6) (the-as int (-> arg0 data)))
(or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10))
)
(set! v1-6 (&-> v1-6 -1))
)
(set! (-> v1-6 1) (the-as uint 0))
)
0
)
#f
)
(defun string-strip-whitespace! ((arg0 string))
"Remove whitespace at the beginning and end of a string"
(string-strip-trailing-whitespace! arg0)
(string-strip-leading-whitespace! arg0)
#f
)
(defun string-upcase ((arg0 string) (arg1 string))
"Uppercase the given string."
(let* ((a0-1 (-> arg0 data))
(a3-0 (-> a0-1 0))
(a2-0 1)
(v1-0 0)
)
(while (nonzero? a3-0)
(if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0))
(+! a3-0 -32)
)
(set! (-> arg1 data v1-0) a3-0)
(set! a3-0 (-> a0-1 a2-0))
(+! a2-0 1)
(+! v1-0 1)
)
(set! (-> arg1 data v1-0) (the-as uint 0))
)
0
(none)
)
(defun string-get-arg!! ((arg0 string) (arg1 string))
"Get the first argument from a whitespace separated list of arguments.
The arguments can be in quotes or not.
Removes argument from arg string, sucks up white space before the next one
Outputs argument to a-str."
(let ((s4-0 (string-skip-whitespace (-> arg1 data))))
(cond
((= (-> s4-0 0) 34)
(let ((s4-1 (&-> s4-0 1)))
(let ((v1-3 s4-1))
(while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34))
(set! s4-1 (&-> s4-1 1))
)
(copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3)))
)
(if (= (-> s4-1 0) 34)
(set! s4-1 (&-> s4-1 1))
)
(let ((a1-3 (string-skip-whitespace s4-1)))
(string-suck-up! arg1 a1-3)
)
)
(return #t)
)
((nonzero? (-> s4-0 0))
(let ((v1-11 s4-0))
(while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10))
(set! s4-0 (&-> s4-0 1))
)
(copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11)))
)
(let ((a1-9 (string-skip-whitespace s4-0)))
(string-suck-up! arg1 a1-9)
)
(return #t)
)
)
)
#f
)
(defun string->int ((arg0 string))
"String to int. Supports binary, hex, and decimal. Negative is implemented for decimal and hex
But I think it's broken?"
(let ((a0-1 (-> arg0 data))
(v0-0 0)
(v1-0 #f)
)
(cond
((= (-> a0-1 0) 35)
(let ((a0-2 (&-> a0-1 1)))
(cond
((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88))
(let ((a0-3 (&-> a0-2 1)))
(when (= (-> a0-3 1) 45)
(set! v1-0 #t)
(set! a0-3 (&-> a0-3 1))
)
(while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0)))
(and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
(and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
)
(cond
((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
(set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16))))
)
((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
(set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16))))
)
(else
(set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16))))
)
)
(set! a0-3 (&-> a0-3 1))
)
)
)
((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66))
(let ((a0-4 (&-> a0-2 1)))
(while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0)))
(set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2))))
(set! a0-4 (&-> a0-4 1))
)
)
)
)
)
)
(else
(when (= (-> a0-1 1) 45)
(set! v1-0 #t)
(set! a0-1 (&-> a0-1 1))
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0))))
(set! a0-1 (&-> a0-1 1))
)
)
)
(cond
(v1-0
(- v0-0)
)
(else
(empty)
v0-0
)
)
)
)
(defun string->float ((arg0 string))
"They implemented it!"
(let ((a0-1 (-> arg0 data))
(f0-0 0.0)
(v1-0 #f)
)
(when (= (-> a0-1 0) 45)
(set! v1-0 #t)
(set! a0-1 (&-> a0-1 1))
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48))))
(set! a0-1 (&-> a0-1 1))
)
(when (= (-> a0-1 0) 46)
(set! a0-1 (&-> a0-1 1))
(let ((a2-4 #xf4240)
(a1-12 0)
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4)))
(set! a2-4 (/ a2-4 10))
(set! a0-1 (&-> a0-1 1))
)
(+! f0-0 (* 0.0000001 (the float a1-12)))
)
)
(when (= (-> a0-1 0) 101)
(let ((a1-16 (&-> a0-1 1))
(f1-5 0.0)
(a0-2 #f)
)
(cond
((= (-> a1-16 0) 45)
(set! a0-2 #t)
(set! a1-16 (&-> a1-16 1))
)
((= (-> a1-16 0) 43)
(set! a1-16 (&-> a1-16 1))
)
)
(while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0)))
(set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48))))
(set! a1-16 (&-> a1-16 1))
)
(when (!= f1-5 0.0)
(let ((f2-6 1.0))
(cond
(a0-2
(dotimes (a0-3 (the int f1-5))
(set! f2-6 (* 0.1 f2-6))
(nop!)
(nop!)
)
)
(else
(dotimes (a0-6 (the int f1-5))
(set! f2-6 (* 10.0 f2-6))
(nop!)
(nop!)
)
)
)
(set! f0-0 (* f0-0 f2-6))
)
)
)
)
(if v1-0
(- f0-0)
f0-0
)
)
)
(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string))
"Get an int32 from a list of arguments"
(cond
((string-get-arg!! *string-tmp-str* arg1)
(set! (-> arg0 0) (string->int *string-tmp-str*))
#t
)
(else
#f
)
)
)
(defun string-get-float!! ((arg0 (pointer float)) (arg1 string))
"Get a float from a list of arguments."
(cond
((string-get-arg!! *string-tmp-str* arg1)
(set! (-> arg0 0) (string->float *string-tmp-str*))
#t
)
(else
#f
)
)
)
(defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string))
"Get a flag argument (either arg2 or arg3) from a list of arugments."
(cond
((string-get-arg!! *string-tmp-str* arg1)
(cond
((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3))
(set! (-> arg0 0) (string= *string-tmp-str* arg2))
#t
)
(else
#f
)
)
)
(else
#f
)
)
)
(kmemopen global "gstring-globals")
(define *debug-draw-pauseable* #f)
(define *stdcon0* (new 'global 'string #x4000 (the-as string #f)))
(define *stdcon1* (new 'global 'string #x4000 (the-as string #f)))
(define *stdcon* *stdcon0*)
;; up from 256 bytes in jak 1
(define *temp-string* (new 'global 'string 2048 (the-as string #f)))
(kmemclose)
goalc/compiler/Compiler.h
+1
View File
@@ -220,6 +220,7 @@ class Compiler {
bool is_structure(const TypeSpec& ts);
bool is_bitfield(const TypeSpec& ts);
bool is_pair(const TypeSpec& ts);
bool is_symbol(const TypeSpec& ts);
std::vector<goos::Object> get_list_as_vector(const goos::Object& o,
goos::Object* rest_out = nullptr,
int max_length = -1);
goalc/compiler/Util.cpp
+4
View File
@@ -336,6 +336,10 @@ bool Compiler::is_pair(const TypeSpec& ts) {
return m_ts.tc(m_ts.make_typespec("pair"), ts);
}
bool Compiler::is_symbol(const TypeSpec& ts) {
return m_ts.tc(m_ts.make_typespec("symbol"), ts);
}
bool Compiler::get_true_or_false(const goos::Object& form, const goos::Object& boolean) {
// todo try other things.
if (boolean.is_symbol()) {
goalc/compiler/compilation/Atoms.cpp
+1 -1
View File
@@ -380,7 +380,7 @@ Val* Compiler::compile_get_symbol_value(const goos::Object& form,
}
auto ts = existing_symbol->second;
auto sext = m_ts.lookup_type(ts)->get_load_signed();
auto sext = m_ts.lookup_type_allow_partial_def(ts)->get_load_signed();
auto fe = env->function_env();
auto sym = fe->alloc_val<SymbolVal>(name, m_ts.make_typespec("symbol"));
auto re = fe->alloc_val<SymbolValueVal>(sym, ts, sext);
goalc/compiler/compilation/Static.cpp
+8 -2
View File
@@ -139,7 +139,8 @@ void Compiler::compile_static_structure_inline(const goos::Object& form,
deref_info.sign_extend);
}
} else if (is_structure(field_info.type) || is_pair(field_info.type)) {
} else if (is_structure(field_info.type) || is_pair(field_info.type) ||
is_symbol(field_info.type)) {
if (is_pair(field_info.type)) {
ASSERT(!field_info.field.is_inline());
}
@@ -846,7 +847,12 @@ void Compiler::fill_static_array_inline(const goos::Object& form,
if (is_integer(content_type)) {
typecheck(form, TypeSpec("integer"), sr.typespec());
} else {
typecheck(form, content_type, sr.typespec());
if (sr.is_symbol() && sr.symbol_name() == "#f") {
// allow #f for any structure.
typecheck(form, TypeSpec("structure"), content_type);
} else {
typecheck(form, content_type, sr.typespec());
}
}
if (sr.is_symbol()) {
ASSERT(deref_info.stride == 4);
goalc/compiler/compilation/Type.cpp
+2 -1
View File
@@ -162,7 +162,8 @@ void Compiler::generate_field_description(const goos::Object& form,
format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(form, env));
} else if (m_ts.tc(m_ts.make_typespec("basic"), f.type()) ||
m_ts.tc(m_ts.make_typespec("binteger"), f.type()) ||
m_ts.tc(m_ts.make_typespec("pair"), f.type())) {
m_ts.tc(m_ts.make_typespec("pair"), f.type()) ||
m_ts.tc(m_ts.make_typespec("symbol"), f.type())) {
// basic, binteger, pair
str_template += fmt::format("{}{}: ~A~%", tabs, f.name());
format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(form, env));
test/decompiler/reference/jak2/decompiler-macros.gc
Generated Vendored
+557
View File
@@ -0,0 +1,557 @@
;; This file should contain an implementation for all macros that the decompiler uses in its output.
(defun ash ((value int) (shift-amount int))
"Arithmetic shift value by shift-amount.
A positive shift-amount will shift to the left and a negative will shift to the right.
"
;; OpenGOAL does not support ash in the compiler, so we implement it here as an inline function.
(declare (inline))
(if (> shift-amount 0)
(shl value shift-amount)
(sar value (- shift-amount))
)
)
(defmacro suspend ()
'(none)
)
(defmacro empty-form ()
'(none)
)
(defmacro .sync.l ()
`(none))
(defmacro make-u128 (upper lower)
`(rlet ((result :class i128)
(upper-xmm :class i128)
(lower-xmm :class i128))
(.mov upper-xmm ,upper)
(.mov lower-xmm ,lower)
(.pcpyld result upper-xmm lower-xmm)
(the uint result)
)
)
(defmacro init-vf0-vector ()
"Initializes the VF0 vector which is a constant vector in the VU set to <0,0,0,1>"
`(.lvf vf0 (new 'static 'vector :x 0.0 :y 0.0 :z 0.0 :w 1.0))
)
(defconstant SYM_TO_STRING_OFFSET #xff38)
(defmacro symbol->string (sym)
"Convert a symbol to a goal string."
`(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym))))
)
(defmacro new-stack-matrix0 ()
"Get a new matrix on the stack that's set to zero."
`(let ((mat (new 'stack-no-clear 'matrix)))
(set! (-> mat quad 0) (the-as uint128 0))
(set! (-> mat quad 1) (the-as uint128 0))
(set! (-> mat quad 2) (the-as uint128 0))
(set! (-> mat quad 3) (the-as uint128 0))
mat
)
)
(defmacro new-stack-vector0 ()
"Get a stack vector that's set to 0.
This is more efficient than (new 'stack 'vector) because
this doesn't call the constructor."
`(let ((vec (new 'stack-no-clear 'vector)))
(set! (-> vec quad) (the-as uint128 0))
vec
)
)
(defmacro new-stack-quaternion0 ()
"Get a stack quaternion that's set to 0.
This is more efficient than (new 'stack 'quaternion) because
this doesn't call the constructor."
`(let ((q (new 'stack-no-clear 'quaternion)))
(set! (-> q quad) (the-as uint128 0))
q
)
)
(defmacro with-pp (&rest body)
`(rlet ((pp :reg r13 :reset-here #t :type process))
,@body)
)
(defmacro fabs (x)
`(if (< (the float ,x) 0)
(- (the float ,x))
(the float ,x))
)
(defconstant PI (the-as float #x40490fda))
(defconstant MINUS_PI (the-as float #xc0490fda))
(defmacro handle->process (handle)
;; the actual implementation is more clever than this.
;; Checks PID.
`(let ((the-handle (the-as handle ,handle)))
(if (-> the-handle process)
(let ((proc (-> (-> the-handle process))))
(if (= (-> the-handle pid) (-> proc pid))
proc
)
)
)
)
)
(defmacro ppointer->process (ppointer)
;; convert a (pointer process) to a process.
;; this uses the self field, which seems to always just get set to the object.
;; perhaps when deleting a process you could have it set self to #f?
;; I don't see this happen anywhere though, so it's not clear.
`(let ((the-pp ,ppointer))
(the process-tree (if the-pp (-> the-pp 0 self)))
)
)
(defmacro process->ppointer (proc)
;"safely get a (pointer process) from a process, returning #f if invalid."
`(let ((the-proc ,proc))
(if the-proc (-> the-proc ppointer))
)
)
(defmacro ppointer->handle (pproc)
`(let ((the-process (the-as (pointer process) ,pproc)))
(new 'static 'handle :process the-process :pid (-> the-process 0 pid))
)
)
(defmacro process->handle (proc)
`(ppointer->handle (process->ppointer ,proc))
)
(defmacro defbehavior (name process-type 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 :behavior ,process-type ,bindings ,@(cdr body)))
;; otherwise don't ignore it.
`(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body))
)
)
(defmacro b! (pred destination &key (delay '()) &key (likely-delay '()))
"Branch!"
;; evaluate the predicate
`(let ((should-branch ,pred))
;; normal delay slot:
,delay
(when should-branch
,likely-delay
(goto ,destination)
)
)
)
;; meters are stored as (usually) a float, scaled by 4096.
;; this gives you reasonable accuracy as an integer.
(defglobalconstant METER_LENGTH 4096.0)
(defmacro meters (x)
"Convert number to meters.
If the input is a constant float or integer, the result will be a
compile time constant float. Otherwise, it will not be constant.
Returns float."
;; we don't have enough constant propagation for the compiler to figure this out.
(cond
((float? x)
(* METER_LENGTH x)
)
((integer? x)
(* METER_LENGTH x)
)
(#t
`(* METER_LENGTH ,x)
)
)
)
;; rotations are stored in 65,536ths of a full rotation.
;; like with meters, you get a reasonable accuracy as an integer.
;; additionally, it is a power-of-two, so wrapping rotations can be done
;; quickly by converting to an int, masking, and back to float
(defglobalconstant DEGREES_PER_ROT 65536.0)
;; this was deg in GOAL
(defmacro degrees (x)
"Convert number to degrees unit.
Will keep a constant float/int constant."
(cond
((or (float? x) (integer? x))
(* DEGREES_PER_ROT (/ (+ 0.0 x) 360.0))
)
(#t
`(* (/ (the float ,x) 360.0)
DEGREES_PER_ROT
)
)
)
)
;; times are stored in 300ths of a second.
;; this divides evenly into frames at both 50 and 60 fps.
;; typically these are stored as integers as more precision is not useful.
;; an unsigned 32-bit integer can store about 150 days
(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps
;; this was usec in GOAL
(defmacro seconds (x)
"Convert number to seconds unit.
Returns uint."
(cond
((integer? x)
(* TICKS_PER_SECOND x)
)
((float? x)
(* 1 (* 1.0 x TICKS_PER_SECOND))
)
(#t
`(the uint (* TICKS_PER_SECOND ,x))
)
)
)
(defmacro fsec (x)
"Convert number to seconds unit.
Returns float."
(cond
((or (integer? x) (float? x))
(* 1.0 TICKS_PER_SECOND x)
)
(#t
`(* 1.0 TICKS_PER_SECOND ,x)
)
)
)
(fake-asm .sync.l)
(fake-asm .sync.p)
(fake-asm .mfc0 dest src)
(fake-asm .mtc0 dest src)
(fake-asm .mtpc dest src)
(fake-asm .mfpc dest src)
(fake-asm .mtdab src)
(fake-asm .mtdabm src)
;; maybe rename to "velocity"?
(defmacro vel-tick (vel)
"turn a velocity value into a per-tick value"
`(* (/ 1.0 ,TICKS_PER_SECOND) ,vel)
)
(defmacro copy-and-set-field (original field-name field-value)
`(let ((temp-copy ,original))
(set! (-> temp-copy ,field-name) ,field-value)
temp-copy
)
)
(defmacro set-vector! (v xv yv zv wv)
"Set all fields in a vector"
(with-gensyms (vec)
`(let ((,vec ,v))
(set! (-> ,vec x) ,xv)
(set! (-> ,vec y) ,yv)
(set! (-> ,vec z) ,zv)
(set! (-> ,vec w) ,wv)
,vec
))
)
;; cause the current process to change state
(defmacro go (next-state &rest args)
`(with-pp
(go-hook pp ,next-state ,@args)
)
)
(defmacro go-virtual (state-name &key (proc self) &rest args)
"Change the current process to the virtual state of the given process."
`(go (method-of-object ,proc ,state-name) ,@args)
)
(defmacro static-sound-name (str)
"Convert a string constant to a static sound-name."
;; all this is done at compile-time so we can come up with 2
;; 64-bit constants to use
(when (> (string-length str) 16)
(error "static-sound-name got a string that is too long")
)
(let ((lo-val 0)
(hi-val 0)
)
(dotimes (i (string-length str))
(if (>= i 8)
(+! hi-val (ash (string-ref str i) (* 8 (- i 8))))
(+! lo-val (ash (string-ref str i) (* 8 i)))
)
)
`(new 'static 'sound-name :lo ,lo-val :hi ,hi-val)
)
)
(defmacro vftoi4.xyzw (dst src)
"convert to 28.4 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 16.0)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vftoi12.xyzw (dst src)
"convert to 20.12 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 4096.0)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vftoi15.xyzw (dst src)
"convert to 17.15 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 32768.0)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vitof4.xyzw (dst src)
"convert from a 28.4 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 0.0625)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vitof12.xyzw (dst src)
"convert from a 20.12 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 0.000244140625)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vitof15.xyzw (dst src)
"convert from a 17.15 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 0.000030517578125)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
;; use a compile-time list to keep track of the type of an anonymous behavior.
(seval (define *defstate-type-stack* '()))
(desfun def-state-check-behavior (beh-form beh-type)
"check if code block is an anonymous behavior. needed for anonymous behaviors on defstate."
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
(push! *defstate-type-stack* beh-type)
)
)
(defmacro clear-def-state-stack ()
(set! *defstate-type-stack* '())
`(none)
)
;; *no-state* is just used for the compiler to know whether a handler was actually set or not
(defmacro defstate (state-name parents
&key (virtual #f)
&key (event *no-state*)
&key (enter *no-state*)
&key (trans *no-state*)
&key (exit *no-state*)
&key (code *no-state*)
&key (post *no-state*)
)
"Define a new state!"
(with-gensyms (new-state)
(let ((defstate-type (first parents)))
(when (not (null? *defstate-type-stack*))
(fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}"
*defstate-type-stack*)
)
(set! *defstate-type-stack* '())
;; check for default handlers
(let ((default-handlers (assoc defstate-type *default-state-handlers*)))
(when (not (null? default-handlers))
;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers)
;; event
(set! default-handlers (cadr default-handlers))
(when (and (eq? event '*no-state*) (car default-handlers))
(set! event (car default-handlers)))
;; enter
(set! default-handlers (cdr default-handlers))
(when (and (eq? enter '*no-state*) (car default-handlers))
(set! enter (car default-handlers)))
;; trans
(set! default-handlers (cdr default-handlers))
(when (and (eq? trans '*no-state*) (car default-handlers))
(set! trans (car default-handlers)))
;; exit
(set! default-handlers (cdr default-handlers))
(when (and (eq? exit '*no-state*) (car default-handlers))
(set! exit (car default-handlers)))
;; code
(set! default-handlers (cdr default-handlers))
(when (and (eq? code '*no-state*) (car default-handlers))
(set! code (car default-handlers)))
;; post
(set! default-handlers (cdr default-handlers))
(when (and (eq? post '*no-state*) (car default-handlers))
(set! post (car default-handlers)))
(set! default-handlers (cdr default-handlers))
)
)
(def-state-check-behavior event defstate-type)
(def-state-check-behavior enter defstate-type)
(def-state-check-behavior trans defstate-type)
(def-state-check-behavior exit defstate-type)
(def-state-check-behavior code defstate-type)
(def-state-check-behavior post defstate-type)
`(let ((,new-state (new 'static 'state
:name (quote ,state-name)
:next #f
:exit #f
:code #f
:trans #f
:post #f
:enter #f
:event #f
)
))
;; the compiler will set the fields of the given state and define the symbol.
;; This way it can check the individual function types, make sure they make sense, and create
;; a state with the appropriate type.
,(if virtual
`(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
`(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
)
)
)
)
)
(defmacro behavior (bindings &rest body)
"Define an anonymous behavior for a process state. This may only be used inside a defstate!"
(let ((behavior-type (first *defstate-type-stack*)))
(pop! *defstate-type-stack*)
`(lambda :behavior ,behavior-type ,bindings ,@body)
)
)
;; set the default handler functions for a process's state handlers
(seval (define *default-state-handlers* '()))
(defmacro defstatehandler (proc
&key (event #f)
&key (enter #f)
&key (trans #f)
&key (exit #f)
&key (code #f)
&key (post #f))
(let ((old (assoc proc *default-state-handlers*))
(new (list proc (list event enter trans exit code post))))
(if (null? old)
(append!! *default-state-handlers* new) ;; add new set of default handlers
(dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones
(if (eq? (car hnd) old)
(set-car! hnd new)
)
)
)
)
`(none)
)
(defmacro sext32 (in)
`(sar (shl ,in 32) 32)
)
(defmacro .sra (result in sa)
`(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa)))
)
(defmacro .movn (result value check original)
`(if (!= ,check 0)
(set! ,result (the-as int ,value))
(set! ,result (the-as int ,original))
)
)
(defmacro .movz (result value check original)
`(if (= ,check 0)
(set! ,result (the-as int ,value))
(set! ,result (the-as int ,original))
)
)
(defmacro .mfc0 (&rest stuff)
`(empty)
)
test/decompiler/reference/jak2/kernel/dgo-h_REF.gc
Generated Vendored
+59
View File
@@ -0,0 +1,59 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type dgo-entry
(deftype dgo-entry (structure)
((offset uint32 :offset-assert 0)
(length uint32 :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition for method 3 of type dgo-entry
(defmethod inspect dgo-entry ((obj dgo-entry))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'dgo-entry)
(format #t "~1Toffset: ~D~%" (-> obj offset))
(format #t "~1Tlength: ~D~%" (-> obj length))
(label cfg-4)
obj
)
;; definition of type dgo-file
(deftype dgo-file (basic)
((num-go-files uint32 :offset-assert 4)
(total-length uint32 :offset-assert 8)
(rsvd uint32 :offset-assert 12)
(data uint8 :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition for method 3 of type dgo-file
(defmethod inspect dgo-file ((obj dgo-file))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tnum-go-files: ~D~%" (-> obj num-go-files))
(format #t "~1Ttotal-length: ~D~%" (-> obj total-length))
(format #t "~1Trsvd: ~D~%" (-> obj rsvd))
(format #t "~1Tdata[0] @ #x~X~%" (-> obj data))
(label cfg-4)
obj
)
;; failed to figure out what this is:
0
test/decompiler/reference/jak2/kernel/gcommon_REF.gc
Generated Vendored
+1190
View File
File diff suppressed because it is too large Load Diff
test/decompiler/reference/jak2/kernel/gkernel-h_REF.gc
Generated Vendored
+756
View File
@@ -0,0 +1,756 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type kernel-context
(deftype kernel-context (basic)
((prevent-from-run process-mask :offset-assert 4)
(require-for-run process-mask :offset-assert 8)
(allow-to-run process-mask :offset-assert 12)
(next-pid int32 :offset-assert 16)
(fast-stack-top pointer :offset-assert 20)
(current-process process :offset-assert 24)
(relocating-process basic :offset-assert 28)
(relocating-min int32 :offset-assert 32)
(relocating-max int32 :offset-assert 36)
(relocating-offset int32 :offset-assert 40)
(relocating-level level :offset-assert 44)
(low-memory-message symbol :offset-assert 48)
(login-object basic :offset-assert 52)
)
:method-count-assert 9
:size-assert #x38
:flag-assert #x900000038
)
;; definition for method 3 of type kernel-context
(defmethod inspect kernel-context ((obj kernel-context))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tprevent-from-run: ~D~%" (-> obj prevent-from-run))
(format #t "~1Trequire-for-run: ~D~%" (-> obj require-for-run))
(format #t "~1Tallow-to-run: ~D~%" (-> obj allow-to-run))
(format #t "~1Tnext-pid: ~D~%" (-> obj next-pid))
(format #t "~1Tfast-stack-top: #x~X~%" (-> obj fast-stack-top))
(format #t "~1Tcurrent-process: ~A~%" (-> obj current-process))
(format #t "~1Trelocating-process: ~A~%" (-> obj relocating-process))
(format #t "~1Trelocating-min: #x~X~%" (-> obj relocating-min))
(format #t "~1Trelocating-max: #x~X~%" (-> obj relocating-max))
(format #t "~1Trelocating-offset: ~D~%" (-> obj relocating-offset))
(format #t "~1Trelocating-level: ~A~%" (-> obj relocating-level))
(format #t "~1Tlow-memory-message: ~A~%" (-> obj low-memory-message))
(format #t "~1Tlogin-object: ~A~%" (-> obj login-object))
(label cfg-4)
obj
)
;; definition of type time-frame
(deftype time-frame (int64)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition of type clock
(deftype clock (basic)
((index int32 :offset-assert 4)
(mask process-mask :offset-assert 8)
(clock-ratio float :offset-assert 12)
(accum float :offset-assert 16)
(integral-accum float :offset-assert 20)
(frame-counter time-frame :offset-assert 24)
(old-frame-counter time-frame :offset-assert 32)
(integral-frame-counter uint64 :offset-assert 40)
(old-integral-frame-counter uint64 :offset-assert 48)
(sparticle-data vector :inline :offset-assert 64)
(seconds-per-frame float :offset-assert 80)
(frames-per-second float :offset-assert 84)
(time-adjust-ratio float :offset-assert 88)
)
:method-count-assert 15
:size-assert #x5c
:flag-assert #xf0000005c
(:methods
(new (symbol type int) _type_ 0)
(update-rates! (_type_ float) float 9)
(advance-by! (_type_ float) clock 10)
(tick! (_type_) clock 11)
(save! (_type_ (pointer uint64)) int 12)
(load! (_type_ (pointer uint64)) int 13)
(reset! (_type_) none 14)
)
)
;; definition for method 3 of type clock
(defmethod inspect clock ((obj clock))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tindex: ~D~%" (-> obj index))
(format #t "~1Tmask: ~D~%" (-> obj mask))
(format #t "~1Tclock-ratio: ~f~%" (-> obj clock-ratio))
(format #t "~1Taccum: ~f~%" (-> obj accum))
(format #t "~1Tintegral-accum: ~f~%" (-> obj integral-accum))
(format #t "~1Tframe-counter: ~D~%" (-> obj frame-counter))
(format #t "~1Told-frame-counter: ~D~%" (-> obj old-frame-counter))
(format #t "~1Tintegral-frame-counter: ~D~%" (-> obj integral-frame-counter))
(format #t "~1Told-integral-frame-counter: ~D~%" (-> obj old-integral-frame-counter))
(format #t "~1Tsparticle-data: ~`vector`P~%" (-> obj sparticle-data))
(format #t "~1Tseconds-per-frame: ~f~%" (-> obj seconds-per-frame))
(format #t "~1Tframes-per-second: ~f~%" (-> obj frames-per-second))
(format #t "~1Ttime-adjust-ratio: ~f~%" (-> obj time-adjust-ratio))
(label cfg-4)
obj
)
;; definition for method 0 of type clock
(defmethod new clock ((allocation symbol) (type-to-make type) (arg0 int))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 index) arg0)
(set! (-> gp-0 frame-counter) (seconds 1000))
(set! (-> gp-0 integral-frame-counter) (the-as uint #x493e0))
(set! (-> gp-0 old-frame-counter) (+ (-> gp-0 frame-counter) -1))
(set! (-> gp-0 old-integral-frame-counter) (+ (-> gp-0 integral-frame-counter) -1))
(update-rates! gp-0 1.0)
gp-0
)
)
;; definition of type thread
(deftype thread (basic)
((name symbol :offset-assert 4)
(process process :offset-assert 8)
(previous thread :offset-assert 12)
(suspend-hook (function cpu-thread none) :offset-assert 16)
(resume-hook (function cpu-thread none) :offset-assert 20)
(pc pointer :offset-assert 24)
(sp pointer :offset-assert 28)
(stack-top pointer :offset-assert 32)
(stack-size int32 :offset-assert 36)
)
:method-count-assert 12
:size-assert #x28
:flag-assert #xc00000028
(:methods
(stack-size-set! (_type_ int) none 9)
(thread-suspend (_type_) none 10)
(thread-resume (_type_) none 11)
)
)
;; definition for method 3 of type thread
(defmethod inspect thread ((obj thread))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tprocess: ~A~%" (-> obj process))
(format #t "~1Tprevious: ~A~%" (-> obj previous))
(format #t "~1Tsuspend-hook: ~A~%" (-> obj suspend-hook))
(format #t "~1Tresume-hook: ~A~%" (-> obj resume-hook))
(format #t "~1Tpc: #x~X~%" (-> obj pc))
(format #t "~1Tsp: #x~X~%" (-> obj sp))
(format #t "~1Tstack-top: #x~X~%" (-> obj stack-top))
(format #t "~1Tstack-size: ~D~%" (-> obj stack-size))
(label cfg-4)
obj
)
;; definition of type cpu-thread
(deftype cpu-thread (thread)
((rreg uint64 7 :offset-assert 40)
(freg float 8 :offset-assert 96)
(stack uint8 :dynamic :offset-assert 128)
)
:method-count-assert 12
:size-assert #x80
:flag-assert #xc00000080
(:methods
(new (symbol type process symbol int pointer) _type_ 0)
)
)
;; definition for method 3 of type cpu-thread
(defmethod inspect cpu-thread ((obj cpu-thread))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tprocess: ~A~%" (-> obj process))
(format #t "~1Tprevious: ~A~%" (-> obj previous))
(format #t "~1Tsuspend-hook: ~A~%" (-> obj suspend-hook))
(format #t "~1Tresume-hook: ~A~%" (-> obj resume-hook))
(format #t "~1Tpc: #x~X~%" (-> obj pc))
(format #t "~1Tsp: #x~X~%" (-> obj sp))
(format #t "~1Tstack-top: #x~X~%" (-> obj stack-top))
(format #t "~1Tstack-size: ~D~%" (-> obj stack-size))
(format #t "~1Trreg[8] @ #x~X~%" (-> obj rreg))
(format #t "~1Tfreg[6] @ #x~X~%" (&-> obj freg 2))
(format #t "~1Tstack[0] @ #x~X~%" (-> obj stack))
(label cfg-4)
obj
)
;; definition of type dead-pool
(deftype dead-pool (process-tree)
()
:method-count-assert 16
:size-assert #x24
:flag-assert #x1000000024
(:methods
(new (symbol type int int string) _type_ 0)
(get-process (_type_ type int) process 14)
(return-process (_type_ process) none 15)
)
)
;; definition for method 3 of type dead-pool
(defmethod inspect dead-pool ((obj dead-pool))
(when (not obj)
(set! obj obj)
(goto cfg-68)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tmask: #x~X : (process-mask " (-> obj mask))
(let ((s5-0 (-> obj mask)))
(if (= (logand s5-0 (process-mask process-tree)) (process-mask process-tree))
(format #t "process-tree ")
)
(if (= (logand s5-0 (process-mask target)) (process-mask target))
(format #t "target ")
)
(if (= (logand (process-mask collectable) s5-0) (process-mask collectable))
(format #t "attackable ")
)
(if (= (logand (process-mask bit18) s5-0) (process-mask bit18))
(format #t "collectable ")
)
(if (= (logand (process-mask projectile) s5-0) (process-mask projectile))
(format #t "projectile ")
)
(if (= (logand (process-mask no-track) s5-0) (process-mask no-track))
(format #t "no-track ")
)
(if (= (logand s5-0 (process-mask sleep-code)) (process-mask sleep-code))
(format #t "sleep-code ")
)
(if (= (logand s5-0 (process-mask actor-pause)) (process-mask actor-pause))
(format #t "actor-pause ")
)
(if (= (logand (process-mask bot) s5-0) (process-mask bot))
(format #t "bot ")
)
(if (= (logand (process-mask vehicle) s5-0) (process-mask vehicle))
(format #t "vehicle ")
)
(if (= (logand (process-mask enemy) s5-0) (process-mask enemy))
(format #t "enemy ")
)
(if (= (logand (process-mask entity) s5-0) (process-mask entity))
(format #t "entity ")
)
(if (= (logand s5-0 (process-mask heap-shrunk)) (process-mask heap-shrunk))
(format #t "heap-shrunk ")
)
(if (= (logand (process-mask sidekick) s5-0) (process-mask sidekick))
(format #t "sidekick ")
)
(if (= (logand s5-0 (process-mask going)) (process-mask going))
(format #t "going ")
)
(if (= (logand s5-0 (process-mask execute)) (process-mask execute))
(format #t "execute ")
)
(if (= (logand (process-mask civilian) s5-0) (shl #x8000 16))
(format #t "civilian ")
)
(if (= (logand (process-mask death) s5-0) (process-mask death))
(format #t "death ")
)
(if (= (logand (process-mask guard) s5-0) (process-mask guard))
(format #t "guard ")
)
(if (= (logand s5-0 (process-mask no-kill)) (process-mask no-kill))
(format #t "no-kill ")
)
(if (= (logand (process-mask platform) s5-0) (process-mask platform))
(format #t "platform ")
)
(if (= (logand s5-0 (process-mask freeze)) (process-mask freeze))
(format #t "freeze ")
)
(if (= (logand s5-0 (process-mask sleep)) (process-mask sleep))
(format #t "sleep ")
)
(if (= (logand s5-0 (process-mask progress)) (process-mask progress))
(format #t "progress ")
)
(if (= (logand s5-0 (process-mask menu)) (process-mask menu))
(format #t "menu ")
)
(if (= (logand (process-mask camera) s5-0) (process-mask camera))
(format #t "camera ")
)
(if (= (logand (process-mask ambient) s5-0) (process-mask ambient))
(format #t "ambient ")
)
(if (= (logand s5-0 (process-mask dark-effect)) (process-mask dark-effect))
(format #t "dark-effect ")
)
(if (= (logand (process-mask crate) s5-0) (process-mask crate))
(format #t "crate ")
)
(if (= (logand s5-0 (process-mask kernel-run)) (process-mask kernel-run))
(format #t "kernel-run ")
)
(if (= (logand s5-0 (process-mask movie)) (process-mask movie))
(format #t "movie ")
)
(if (= (logand s5-0 (process-mask pause)) (process-mask pause))
(format #t "pause ")
)
)
(format #t ")~%")
(format #t "~1Tclock: ~A~%" (-> obj clock))
(format #t "~1Tparent: #x~X~%" (-> obj parent))
(format #t "~1Tbrother: #x~X~%" (-> obj brother))
(format #t "~1Tchild: #x~X~%" (-> obj child))
(format #t "~1Tppointer: #x~X~%" (-> obj ppointer))
(format #t "~1Tself: ~A~%" (-> obj self))
(label cfg-68)
obj
)
;; definition of type dead-pool-heap-rec
(deftype dead-pool-heap-rec (structure)
((process process :offset-assert 0)
(prev dead-pool-heap-rec :offset-assert 4)
(next dead-pool-heap-rec :offset-assert 8)
)
:pack-me
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
;; definition for method 3 of type dead-pool-heap-rec
(defmethod inspect dead-pool-heap-rec ((obj dead-pool-heap-rec))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'dead-pool-heap-rec)
(format #t "~1Tprocess: ~A~%" (-> obj process))
(format #t "~1Tprev: #<dead-pool-heap-rec @ #x~X>~%" (-> obj prev))
(format #t "~1Tnext: #<dead-pool-heap-rec @ #x~X>~%" (-> obj next))
(label cfg-4)
obj
)
;; definition of type dead-pool-heap
(deftype dead-pool-heap (dead-pool)
((allocated-length int32 :offset-assert 36)
(compact-time uint32 :offset-assert 40)
(compact-count-targ uint32 :offset-assert 44)
(compact-count uint32 :offset-assert 48)
(fill-percent float :offset-assert 52)
(first-gap dead-pool-heap-rec :offset-assert 56)
(first-shrink dead-pool-heap-rec :offset-assert 60)
(heap kheap :inline :offset-assert 64)
(alive-list dead-pool-heap-rec :inline :offset-assert 80)
(last dead-pool-heap-rec :offset 84)
(dead-list dead-pool-heap-rec :inline :offset-assert 92)
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
)
:method-count-assert 28
:size-assert #x68
:flag-assert #x1c00000068
(:methods
(new (symbol type string int int) _type_ 0)
(init (_type_ symbol int) none 16)
(compact (dead-pool-heap int) none 17)
(shrink-heap (dead-pool-heap process) dead-pool-heap 18)
(churn (dead-pool-heap int) none 19)
(memory-used (_type_) int 20)
(memory-total (_type_) int 21)
(memory-free (dead-pool-heap) int 22)
(compact-time (dead-pool-heap) uint 23)
(gap-size (dead-pool-heap dead-pool-heap-rec) int 24)
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25)
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26)
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27)
)
)
;; definition for method 3 of type dead-pool-heap
;; INFO: this function exists in multiple non-identical object files
(defmethod inspect dead-pool-heap ((obj dead-pool-heap))
(when (not obj)
(set! obj obj)
(goto cfg-68)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tmask: #x~X : (process-mask " (-> obj mask))
(let ((s5-0 (-> obj mask)))
(if (= (logand s5-0 (process-mask process-tree)) (process-mask process-tree))
(format #t "process-tree ")
)
(if (= (logand s5-0 (process-mask target)) (process-mask target))
(format #t "target ")
)
(if (= (logand (process-mask collectable) s5-0) (process-mask collectable))
(format #t "attackable ")
)
(if (= (logand (process-mask bit18) s5-0) (process-mask bit18))
(format #t "collectable ")
)
(if (= (logand (process-mask projectile) s5-0) (process-mask projectile))
(format #t "projectile ")
)
(if (= (logand (process-mask no-track) s5-0) (process-mask no-track))
(format #t "no-track ")
)
(if (= (logand s5-0 (process-mask sleep-code)) (process-mask sleep-code))
(format #t "sleep-code ")
)
(if (= (logand s5-0 (process-mask actor-pause)) (process-mask actor-pause))
(format #t "actor-pause ")
)
(if (= (logand (process-mask bot) s5-0) (process-mask bot))
(format #t "bot ")
)
(if (= (logand (process-mask vehicle) s5-0) (process-mask vehicle))
(format #t "vehicle ")
)
(if (= (logand (process-mask enemy) s5-0) (process-mask enemy))
(format #t "enemy ")
)
(if (= (logand (process-mask entity) s5-0) (process-mask entity))
(format #t "entity ")
)
(if (= (logand s5-0 (process-mask heap-shrunk)) (process-mask heap-shrunk))
(format #t "heap-shrunk ")
)
(if (= (logand (process-mask sidekick) s5-0) (process-mask sidekick))
(format #t "sidekick ")
)
(if (= (logand s5-0 (process-mask going)) (process-mask going))
(format #t "going ")
)
(if (= (logand s5-0 (process-mask execute)) (process-mask execute))
(format #t "execute ")
)
(if (= (logand (process-mask civilian) s5-0) (shl #x8000 16))
(format #t "civilian ")
)
(if (= (logand (process-mask death) s5-0) (process-mask death))
(format #t "death ")
)
(if (= (logand (process-mask guard) s5-0) (process-mask guard))
(format #t "guard ")
)
(if (= (logand s5-0 (process-mask no-kill)) (process-mask no-kill))
(format #t "no-kill ")
)
(if (= (logand (process-mask platform) s5-0) (process-mask platform))
(format #t "platform ")
)
(if (= (logand s5-0 (process-mask freeze)) (process-mask freeze))
(format #t "freeze ")
)
(if (= (logand s5-0 (process-mask sleep)) (process-mask sleep))
(format #t "sleep ")
)
(if (= (logand s5-0 (process-mask progress)) (process-mask progress))
(format #t "progress ")
)
(if (= (logand s5-0 (process-mask menu)) (process-mask menu))
(format #t "menu ")
)
(if (= (logand (process-mask camera) s5-0) (process-mask camera))
(format #t "camera ")
)
(if (= (logand (process-mask ambient) s5-0) (process-mask ambient))
(format #t "ambient ")
)
(if (= (logand s5-0 (process-mask dark-effect)) (process-mask dark-effect))
(format #t "dark-effect ")
)
(if (= (logand (process-mask crate) s5-0) (process-mask crate))
(format #t "crate ")
)
(if (= (logand s5-0 (process-mask kernel-run)) (process-mask kernel-run))
(format #t "kernel-run ")
)
(if (= (logand s5-0 (process-mask movie)) (process-mask movie))
(format #t "movie ")
)
(if (= (logand s5-0 (process-mask pause)) (process-mask pause))
(format #t "pause ")
)
)
(format #t ")~%")
(format #t "~1Tclock: ~A~%" (-> obj clock))
(format #t "~1Tparent: #x~X~%" (-> obj parent))
(format #t "~1Tbrother: #x~X~%" (-> obj brother))
(format #t "~1Tchild: #x~X~%" (-> obj child))
(format #t "~1Tppointer: #x~X~%" (-> obj ppointer))
(format #t "~1Tself: ~A~%" (-> obj self))
(format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length))
(format #t "~1Tcompact-time: ~D~%" (-> obj compact-time))
(format #t "~1Tcompact-count-targ: ~D~%" (-> obj compact-count-targ))
(format #t "~1Tcompact-count: ~D~%" (-> obj compact-count))
(format #t "~1Tfill-percent: ~f~%" (-> obj fill-percent))
(format #t "~1Tfirst-gap: #<dead-pool-heap-rec @ #x~X>~%" (-> obj first-gap))
(format #t "~1Tfirst-shrink: #<dead-pool-heap-rec @ #x~X>~%" (-> obj first-shrink))
(format #t "~1Theap: #<kheap @ #x~X>~%" (-> obj heap))
(format #t "~1Talive-list: #<dead-pool-heap-rec @ #x~X>~%" (-> obj alive-list))
(format #t "~1Tlast: #<dead-pool-heap-rec @ #x~X>~%" (-> obj alive-list prev))
(format #t "~1Tdead-list: #<dead-pool-heap-rec @ #x~X>~%" (-> obj dead-list))
(format #t "~1Tprocess-list[0] @ #x~X~%" (-> obj process-list))
(label cfg-68)
obj
)
;; definition of type catch-frame
(deftype catch-frame (stack-frame)
((sp int32 :offset-assert 12)
(ra int32 :offset-assert 16)
(freg float 6 :offset-assert 20)
(rreg uint128 8 :offset-assert 48)
)
:method-count-assert 9
:size-assert #xb0
:flag-assert #x9000000b0
(:methods
(new (symbol type symbol function (pointer uint64)) object 0)
)
)
;; definition for method 3 of type catch-frame
(defmethod inspect catch-frame ((obj catch-frame))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tnext: ~A~%" (-> obj next))
(format #t "~1Tsp: #x~X~%" (-> obj sp))
(format #t "~1Tra: #x~X~%" (-> obj ra))
(format #t "~1Tfreg[6] @ #x~X~%" (-> obj freg))
(format #t "~1Trreg[8] @ #x~X~%" (-> obj rreg))
(label cfg-4)
obj
)
;; definition of type protect-frame
(deftype protect-frame (stack-frame)
((exit (function none) :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type (function none)) protect-frame 0)
)
)
;; definition for method 3 of type protect-frame
(defmethod inspect protect-frame ((obj protect-frame))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tnext: ~A~%" (-> obj next))
(format #t "~1Texit: ~A~%" (-> obj exit))
(label cfg-4)
obj
)
;; definition of type handle
(deftype handle (uint64)
((process (pointer process) :offset 0 :size 32)
(pid int32 :offset 32 :size 32)
(u64 uint64 :offset 0 :size 64)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; definition for method 3 of type handle
(defmethod inspect handle ((obj handle))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj 'handle)
(format #t "~1Tprocess: #x~X~%" (-> obj process))
(format #t "~1Tpid: ~D~%" (-> obj pid))
(label cfg-4)
obj
)
;; definition for method 2 of type handle
(defmethod print handle ((obj handle))
(if (nonzero? obj)
(format #t "#<handle :process ~A :pid ~D>" (handle->process obj) (-> obj pid))
(format #t "#<handle :process 0 :pid 0>")
)
obj
)
;; definition of type state
(deftype state (protect-frame)
((code function :offset-assert 16)
(trans (function none) :offset-assert 20)
(post function :offset-assert 24)
(enter function :offset-assert 28)
(event (function process int symbol event-message-block object) :offset-assert 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
(:methods
(new (symbol type symbol function (function none) function (function none) (function process int symbol event-message-block object)) _type_ 0)
)
)
;; definition for method 3 of type state
(defmethod inspect state ((obj state))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tname: ~A~%" (-> obj name))
(format #t "~1Tnext: ~A~%" (-> obj next))
(format #t "~1Texit: ~A~%" (-> obj exit))
(format #t "~1Tcode: ~A~%" (-> obj code))
(format #t "~1Ttrans: ~A~%" (-> obj trans))
(format #t "~1Tpost: ~A~%" (-> obj post))
(format #t "~1Tenter: ~A~%" (-> obj enter))
(format #t "~1Tevent: ~A~%" (-> obj event))
(label cfg-4)
obj
)
;; definition of type event-message-block
(deftype event-message-block (structure)
((to-handle handle :offset-assert 0)
(to (pointer process) :offset 0)
(form-handle handle :offset-assert 8)
(from (pointer process) :offset 8)
(param uint64 6 :offset-assert 16)
(message symbol :offset-assert 64)
(num-params int32 :offset-assert 68)
)
:method-count-assert 9
:size-assert #x48
:flag-assert #x900000048
)
;; definition for method 3 of type event-message-block
(defmethod inspect event-message-block ((obj event-message-block))
(when (not obj)
(set! obj obj)
(goto cfg-8)
)
(format #t "[~8x] ~A~%" obj 'event-message-block)
(format #t "~1Tto-handle: ~D~%" (-> obj to-handle))
(format #t "~1Tto: ~A~%" (ppointer->process (-> obj to)))
(format #t "~1Tfrom-handle: ~D~%" (-> obj form-handle))
(format #t "~1Tfrom: ~A~%" (ppointer->process (-> obj from)))
(format #t "~1Tparam[6] @ #x~X~%" (-> obj param))
(format #t "~1Tmessage: ~A~%" (-> obj message))
(format #t "~1Tnum-params: ~D~%" (-> obj num-params))
(label cfg-8)
obj
)
;; definition of type event-message-block-array
(deftype event-message-block-array (inline-array-class)
((data event-message-block :inline :dynamic :offset-assert 16)
)
:method-count-assert 10
:size-assert #x10
:flag-assert #xa00000010
(:methods
(send-all! (_type_) none 9)
)
)
;; definition for method 3 of type event-message-block-array
(defmethod inspect event-message-block-array ((obj event-message-block-array))
(when (not obj)
(set! obj obj)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tlength: ~D~%" (-> obj length))
(format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length))
(format #t "~1Tdata[0] @ #x~X~%" (-> obj data))
(label cfg-4)
obj
)
;; failed to figure out what this is:
(set! (-> event-message-block-array heap-base) (the-as uint 80))
;; definition of type sql-result
(deftype sql-result (basic)
((len int32 :offset-assert 4)
(allocated-length uint32 :offset-assert 8)
(error symbol :offset-assert 12)
(data symbol :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type uint) _type_ 0)
)
)
;; definition for method 0 of type sql-result
(defmethod new sql-result ((allocation symbol) (type-to-make type) (arg0 uint))
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* arg0 4))))))
(set! (-> v0-0 allocated-length) arg0)
(set! (-> v0-0 error) 'error)
v0-0
)
)
;; definition for method 2 of type sql-result
(defmethod print sql-result ((obj sql-result))
(format #t "#(~A" (-> obj error))
(dotimes (s5-0 (-> obj len))
(format #t " ~A" (-> obj data s5-0))
)
(format #t ")")
obj
)
;; definition for symbol *sql-result*, type sql-result
(define *sql-result* (the-as sql-result #f))
;; failed to figure out what this is:
0
test/decompiler/reference/jak2/kernel/gkernel_REF.gc
Generated Vendored
+1692
View File
File diff suppressed because it is too large Load Diff
test/decompiler/reference/jak2/kernel/gstate_REF.gc
Generated Vendored
+180
View File
@@ -0,0 +1,180 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for method 0 of type state
(defmethod new state ((allocation symbol)
(type-to-make type)
(arg0 symbol)
(arg1 function)
(arg2 (function none))
(arg3 function)
(arg4 (function none))
(arg5 (function process int symbol event-message-block object))
)
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> v0-0 name) arg0)
(set! (-> v0-0 next) #f)
(set! (-> v0-0 exit) arg4)
(set! (-> v0-0 code) arg1)
(set! (-> v0-0 trans) arg2)
(set! (-> v0-0 post) #f)
(set! (-> v0-0 enter) arg3)
(set! (-> v0-0 event) arg5)
v0-0
)
)
;; definition for function inherit-state
(defun inherit-state ((arg0 state) (arg1 state))
(set! (-> arg0 exit) (-> arg1 exit))
(set! (-> arg0 code) (-> arg1 code))
(set! (-> arg0 trans) (-> arg1 trans))
(set! (-> arg0 post) (-> arg1 post))
(set! (-> arg0 enter) (-> arg1 enter))
(set! (-> arg0 event) (-> arg1 event))
arg0
)
;; definition for method 2 of type state
(defmethod print state ((obj state))
(format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
obj
)
;; definition for function enter-state
;; WARN: Unsupported inline assembly instruction kind - [lwu sp, 28(v1)]
;; WARN: Unsupported inline assembly instruction kind - [lw ra, return-from-thread-dead(s7)]
;; WARN: Unsupported inline assembly instruction kind - [jr t9]
;; WARN: Unsupported inline assembly instruction kind - [sw v1, 0(sp)]
(defun enter-state ((arg0 object) (arg1 object) (arg2 object) (arg3 object) (arg4 object) (arg5 object))
(local-vars (s7-0 none) (sp-0 int) (ra-0 int) (sv-0 none))
(with-pp
(logclear! (-> pp mask) (process-mask sleep sleep-code))
(logior! (-> pp mask) (process-mask going))
(cond
((= (-> pp status) 'initialize)
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(set! (-> pp status) 'initialize-go)
(throw 'initialize #t)
#t
)
((!= (-> *kernel-context* current-process) pp)
(let ((s0-0 (-> pp status)))
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(set! (-> pp status) s0-0)
)
#t
)
((= (-> pp main-thread) (-> pp top-thread))
(set! (-> pp state) (-> pp next-state))
(let ((s0-1 (-> pp stack-frame-top)))
(while s0-1
(case (-> s0-1 type)
((protect-frame state)
((-> (the-as protect-frame s0-1) exit))
)
)
(set! s0-1 (-> s0-1 next))
)
)
(logclear! (-> pp mask) (process-mask going))
(let ((s0-2 (-> pp state)))
(set! (-> pp event-hook) (-> s0-2 event))
(if (-> s0-2 exit)
(set! (-> pp stack-frame-top) s0-2)
(set! (-> pp stack-frame-top) #f)
)
(set! (-> pp post-hook) (-> s0-2 post))
(set! (-> pp trans-hook) (-> s0-2 trans))
(let ((t9-4 (-> s0-2 enter)))
(if t9-4
((the-as (function object object object object object object none) t9-4) arg0 arg1 arg2 arg3 arg4 arg5)
)
)
(let ((t9-5 (-> s0-2 trans)))
(if t9-5
(t9-5)
)
)
(let ((v1-28 (-> pp main-thread)))
(.lwu sp-0 28 v1-28)
)
(let ((t9-6 (-> s0-2 code)))
(.lw ra-0 return-from-thread-dead s7-0)
(.jr t9-6)
)
)
arg4
)
(else
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(when (!= (-> pp top-thread name) 'post)
(let ((v1-31 return-from-thread))
(.sw v1-31 0 (the-as none sp-0))
)
)
#t
)
)
)
)
;; failed to figure out what this is:
(kmemopen global "event-queue")
;; failed to figure out what this is:
(let ((v1-3 (new 'global 'event-message-block-array 64)))
(set! (-> v1-3 length) 0)
(set! *event-queue* v1-3)
)
;; failed to figure out what this is:
(kmemclose)
;; definition for function send-event-function
(defun send-event-function ((arg0 process-tree) (arg1 event-message-block))
(with-pp
(when (and arg0 (!= (-> arg0 type) process-tree) (-> (the-as process arg0) event-hook) (-> arg1 from))
(let ((gp-0 pp))
(set! pp (the-as process arg0))
(let ((v0-0 ((-> (the-as process arg0) event-hook) (-> arg1 from 0) (-> arg1 num-params) (-> arg1 message) arg1)))
(set! pp gp-0)
v0-0
)
)
)
)
)
;; definition for method 9 of type event-message-block-array
;; INFO: Return type mismatch int vs none.
(defmethod send-all! event-message-block-array ((obj event-message-block-array))
(dotimes (s5-0 (-> obj length))
(let* ((a1-0 (-> obj data s5-0))
(a0-2 (handle->process (-> a1-0 to-handle)))
)
(if (and a0-2 (handle->process (-> a1-0 form-handle)))
(send-event-function a0-2 a1-0)
)
)
)
(set! (-> obj length) 0)
0
(none)
)
;; definition for function looping-code
;; WARN: new jak 2 until loop case, check carefully
(defun looping-code ()
(until #f
(suspend)
)
#f
)
test/decompiler/reference/jak2/kernel/gstring-h_REF.gc
Generated Vendored
+9
View File
@@ -0,0 +1,9 @@
;;-*-Lisp-*-
(in-package goal)
;; failed to figure out what this is:
0
test/decompiler/reference/jak2/kernel/gstring_REF.gc
Generated Vendored
+760
View File
@@ -0,0 +1,760 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for method 4 of type string
(defmethod length string ((obj string))
(let ((v1-0 (-> obj data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(&- v1-0 (the-as uint (-> obj data)))
)
)
;; definition for method 5 of type string
(defmethod asize-of string ((obj string))
(+ (-> obj allocated-length) 1 (-> string size))
)
;; definition for function copy-string<-string
(defun copy-string<-string ((arg0 string) (arg1 string))
(let ((v1-0 (-> arg0 data)))
(let ((a1-1 (-> arg1 data)))
(while (nonzero? (-> a1-1 0))
(set! (-> v1-0 0) (-> a1-1 0))
(set! v1-0 (&-> v1-0 1))
(set! a1-1 (&-> a1-1 1))
)
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
;; definition for method 0 of type string
(defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
(cond
(arg1
(let* ((s2-1 (max (length arg1) arg0))
(a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size))))
)
(set! (-> a0-4 allocated-length) s2-1)
(copy-string<-string a0-4 arg1)
)
)
(else
(let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size)))))
(set! (-> v0-2 allocated-length) arg0)
v0-2
)
)
)
)
;; definition for function string=
(defun string= ((arg0 string) (arg1 string))
(let ((a2-0 (-> arg0 data))
(v1-0 (-> arg1 data))
)
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0)))
(if (!= (-> a2-0 0) (-> v1-0 0))
(return #f)
)
(set! a2-0 (&-> a2-0 1))
(set! v1-0 (&-> v1-0 1))
)
(and (zero? (-> a2-0 0)) (zero? (-> v1-0 0)))
)
)
;; definition for function string-prefix=
(defun string-prefix= ((arg0 string) (arg1 string))
(let ((v1-0 (-> arg0 data)))
(let ((a2-0 (-> arg1 data)))
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0)))
(if (!= (-> v1-0 0) (-> a2-0 0))
(return #f)
)
(set! v1-0 (&-> v1-0 1))
(set! a2-0 (&-> a2-0 1))
)
)
(zero? (-> v1-0 0))
)
)
;; definition for function charp-prefix=
(defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
(while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0)))
(if (!= (-> arg0 0) (-> arg1 0))
(return #f)
)
(set! arg0 (&-> arg0 1))
(set! arg1 (&-> arg1 1))
)
(zero? (-> arg0 0))
)
;; definition for function string-suffix=
(defun string-suffix= ((arg0 string) (arg1 string))
(let ((s5-0 (-> arg0 data))
(gp-0 (-> arg1 data))
)
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(let ((s4-0 (length arg0))
(v1-5 (length arg1))
)
(if (< s4-0 v1-5)
(return #f)
)
(let ((v1-7 (&+ s5-0 (- s4-0 v1-5))))
(while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0)))
(if (!= (-> v1-7 0) (-> gp-0 0))
(return #f)
)
(set! v1-7 (&-> v1-7 1))
(set! gp-0 (&-> gp-0 1))
)
(zero? (-> v1-7 0))
)
)
)
)
;; definition for function string-position
(defun string-position ((arg0 string) (arg1 string))
(let ((s5-0 0)
(s4-0 (-> arg1 data))
)
(while (nonzero? (-> s4-0 0))
(if (charp-prefix= (-> arg0 data) s4-0)
(return s5-0)
)
(+! s5-0 1)
(set! s4-0 (&-> s4-0 1))
)
)
-1
)
;; definition for function string-charp=
(defun string-charp= ((arg0 string) (arg1 (pointer uint8)))
(let ((v1-0 (-> arg0 data)))
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0)))
(if (!= (-> v1-0 0) (-> arg1 0))
(return #f)
)
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(and (zero? (-> v1-0 0)) (zero? (-> arg1 0)))
)
)
;; definition for function name=
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function copyn-string<-charp
(defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
(let ((v1-0 (-> arg0 data)))
(dotimes (a3-0 arg2)
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
;; definition for function string<-charp
(defun string<-charp ((arg0 string) (arg1 (pointer uint8)))
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> arg1 0))
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
;; definition for function charp<-string
(defun charp<-string ((arg0 (pointer uint8)) (arg1 string))
(let ((v1-0 (-> arg1 data)))
(while (nonzero? (-> v1-0 0))
(set! (-> arg0 0) (-> v1-0 0))
(set! arg0 (&-> arg0 1))
(set! v1-0 (&-> v1-0 1))
)
)
(set! (-> arg0 0) (the-as uint 0))
0
)
;; definition for function copyn-charp<-string
;; INFO: Return type mismatch int vs none.
(defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int))
(let ((v1-0 (-> arg1 data)))
(while (and (nonzero? (-> v1-0 0)) (< 1 arg2))
(set! (-> arg0 0) (-> v1-0 0))
(set! arg0 (&-> arg0 1))
(set! v1-0 (&-> v1-0 1))
(set! arg2 (+ arg2 -1))
)
)
(while (> arg2 0)
(set! (-> arg0 0) (the-as uint 0))
(set! arg0 (&-> arg0 1))
(set! arg2 (+ arg2 -1))
)
0
(none)
)
;; definition for function copy-charp<-charp
(defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
(while (nonzero? (-> arg1 0))
(set! (-> arg0 0) (-> arg1 0))
(set! arg0 (&-> arg0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> arg0 0) (the-as uint 0))
arg0
)
;; definition for function cat-string<-string
(defun cat-string<-string ((arg0 string) (arg1 string))
(let ((v1-0 (-> arg0 data)))
(let ((a1-1 (-> arg1 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(while (nonzero? (-> a1-1 0))
(set! (-> v1-0 0) (-> a1-1 0))
(set! v1-0 (&-> v1-0 1))
(set! a1-1 (&-> a1-1 1))
)
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
;; definition for function catn-string<-charp
(defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(dotimes (a3-2 arg2)
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
;; definition for function cat-string<-string_to_charp
(defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (pointer uint8)))
(let ((v1-0 (-> arg1 data))
(v0-0 (-> arg0 data))
)
(while (nonzero? (-> v0-0 0))
(nop!)
(nop!)
(nop!)
(set! v0-0 (&-> v0-0 1))
)
(while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0)))
(set! (-> v0-0 0) (-> v1-0 0))
(set! v0-0 (&-> v0-0 1))
(set! v1-0 (&-> v1-0 1))
)
(set! (-> v0-0 0) (the-as uint 0))
v0-0
)
)
;; definition for function append-character-to-string
(defun append-character-to-string ((arg0 string) (arg1 uint8))
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(set! (-> v1-0 0) (the-as uint arg1))
(set! (-> v1-0 1) (the-as uint 0))
)
0
0
)
;; definition for function charp-basename
(defun charp-basename ((arg0 (pointer uint8)))
(let ((v1-0 arg0))
(while (nonzero? (-> v1-0 0))
(set! v1-0 (&-> v1-0 1))
)
(while (< (the-as int arg0) (the-as int v1-0))
(set! v1-0 (&-> v1-0 -1))
(if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92))
(return (&-> v1-0 1))
)
)
)
arg0
)
;; definition for function clear
(defun clear ((arg0 string))
(set! (-> arg0 data 0) (the-as uint 0))
arg0
)
;; definition for function string<?
(defun string<? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #t)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #f)
)
)
)
)
#f
)
;; definition for function string>?
(defun string>? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #f)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #t)
)
)
)
)
#f
)
;; definition for function string<=?
(defun string<=? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #t)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #f)
)
)
)
)
#t
)
;; definition for function string>=?
(defun string>=? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #f)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #t)
)
)
)
)
#t
)
;; definition for symbol *string-tmp-str*, type string
(define *string-tmp-str* (new 'global 'string 128 (the-as string #f)))
;; definition for function string-skip-to-char
(defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint))
(while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1))
(set! arg0 (&-> arg0 1))
)
arg0
)
;; definition for function string-cat-to-last-char
(defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint))
(let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3)))
(let ((v1-0 (string-skip-to-char (-> arg1 data) arg2)))
(when (= (-> v1-0 0) arg2)
(until (!= (-> v1-0 0) arg2)
(set! s4-0 v1-0)
(set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2))
)
)
)
(cat-string<-string_to_charp arg0 arg1 s4-0)
)
)
;; definition for function string-skip-whitespace
(defun string-skip-whitespace ((arg0 (pointer uint8)))
(while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10)))
(set! arg0 (&-> arg0 1))
)
arg0
)
;; definition for function string-suck-up!
(defun string-suck-up! ((arg0 string) (arg1 (pointer uint8)))
(when (!= arg1 (-> arg0 data))
(let ((v1-2 (-> arg0 data)))
(while (nonzero? (-> arg1 0))
(set! (-> v1-2 0) (-> arg1 0))
(set! v1-2 (&-> v1-2 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-2 0) (the-as uint 0))
)
0
)
#f
)
;; definition for function string-strip-leading-whitespace!
(defun string-strip-leading-whitespace! ((arg0 string))
(let ((a1-0 (string-skip-whitespace (-> arg0 data))))
(string-suck-up! arg0 a1-0)
)
#f
)
;; definition for function string-strip-trailing-whitespace!
(defun string-strip-trailing-whitespace! ((arg0 string))
(when (nonzero? (length arg0))
(let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1))))
(while (and (>= (the-as int v1-6) (the-as int (-> arg0 data)))
(or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10))
)
(set! v1-6 (&-> v1-6 -1))
)
(set! (-> v1-6 1) (the-as uint 0))
)
0
)
#f
)
;; definition for function string-strip-whitespace!
(defun string-strip-whitespace! ((arg0 string))
(string-strip-trailing-whitespace! arg0)
(string-strip-leading-whitespace! arg0)
#f
)
;; definition for function string-upcase
;; INFO: Return type mismatch int vs none.
(defun string-upcase ((arg0 string) (arg1 string))
(let* ((a0-1 (-> arg0 data))
(a3-0 (-> a0-1 0))
(a2-0 1)
(v1-0 0)
)
(while (nonzero? a3-0)
(if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0))
(+! a3-0 -32)
)
(set! (-> arg1 data v1-0) a3-0)
(set! a3-0 (-> a0-1 a2-0))
(+! a2-0 1)
(+! v1-0 1)
)
(set! (-> arg1 data v1-0) (the-as uint 0))
)
0
(none)
)
;; definition for function string-get-arg!!
(defun string-get-arg!! ((arg0 string) (arg1 string))
(let ((s4-0 (string-skip-whitespace (-> arg1 data))))
(cond
((= (-> s4-0 0) 34)
(let ((s4-1 (&-> s4-0 1)))
(let ((v1-3 s4-1))
(while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34))
(set! s4-1 (&-> s4-1 1))
)
(copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3)))
)
(if (= (-> s4-1 0) 34)
(set! s4-1 (&-> s4-1 1))
)
(let ((a1-3 (string-skip-whitespace s4-1)))
(string-suck-up! arg1 a1-3)
)
)
(return #t)
)
((nonzero? (-> s4-0 0))
(let ((v1-11 s4-0))
(while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10))
(set! s4-0 (&-> s4-0 1))
)
(copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11)))
)
(let ((a1-9 (string-skip-whitespace s4-0)))
(string-suck-up! arg1 a1-9)
)
(return #t)
)
)
)
#f
)
;; definition for function string->int
(defun string->int ((arg0 string))
(let ((a0-1 (-> arg0 data))
(v0-0 0)
(v1-0 #f)
)
(cond
((= (-> a0-1 0) 35)
(let ((a0-2 (&-> a0-1 1)))
(cond
((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88))
(let ((a0-3 (&-> a0-2 1)))
(when (= (-> a0-3 1) 45)
(set! v1-0 #t)
(set! a0-3 (&-> a0-3 1))
)
(while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0)))
(and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
(and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
)
(cond
((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
(set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16))))
)
((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
(set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16))))
)
(else
(set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16))))
)
)
(set! a0-3 (&-> a0-3 1))
)
)
)
((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66))
(let ((a0-4 (&-> a0-2 1)))
(while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0)))
(set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2))))
(set! a0-4 (&-> a0-4 1))
)
)
)
)
)
)
(else
(when (= (-> a0-1 1) 45)
(set! v1-0 #t)
(set! a0-1 (&-> a0-1 1))
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0))))
(set! a0-1 (&-> a0-1 1))
)
)
)
(cond
(v1-0
(- v0-0)
)
(else
(empty)
v0-0
)
)
)
)
;; definition for function string->float
(defun string->float ((arg0 string))
(let ((a0-1 (-> arg0 data))
(f0-0 0.0)
(v1-0 #f)
)
(when (= (-> a0-1 0) 45)
(set! v1-0 #t)
(set! a0-1 (&-> a0-1 1))
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48))))
(set! a0-1 (&-> a0-1 1))
)
(when (= (-> a0-1 0) 46)
(set! a0-1 (&-> a0-1 1))
(let ((a2-4 #xf4240)
(a1-12 0)
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4)))
(set! a2-4 (/ a2-4 10))
(set! a0-1 (&-> a0-1 1))
)
(+! f0-0 (* 0.0000001 (the float a1-12)))
)
)
(when (= (-> a0-1 0) 101)
(let ((a1-16 (&-> a0-1 1))
(f1-5 0.0)
(a0-2 #f)
)
(cond
((= (-> a1-16 0) 45)
(set! a0-2 #t)
(set! a1-16 (&-> a1-16 1))
)
((= (-> a1-16 0) 43)
(set! a1-16 (&-> a1-16 1))
)
)
(while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0)))
(set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48))))
(set! a1-16 (&-> a1-16 1))
)
(when (!= f1-5 0.0)
(let ((f2-6 1.0))
(cond
(a0-2
(dotimes (a0-3 (the int f1-5))
(set! f2-6 (* 0.1 f2-6))
(nop!)
(nop!)
)
)
(else
(dotimes (a0-6 (the int f1-5))
(set! f2-6 (* 10.0 f2-6))
(nop!)
(nop!)
)
)
)
(set! f0-0 (* f0-0 f2-6))
)
)
)
)
(if v1-0
(- f0-0)
f0-0
)
)
)
;; definition for function string-get-int32!!
(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string))
(cond
((string-get-arg!! *string-tmp-str* arg1)
(set! (-> arg0 0) (string->int *string-tmp-str*))
#t
)
(else
#f
)
)
)
;; definition for function string-get-float!!
(defun string-get-float!! ((arg0 (pointer float)) (arg1 string))
(cond
((string-get-arg!! *string-tmp-str* arg1)
(set! (-> arg0 0) (string->float *string-tmp-str*))
#t
)
(else
#f
)
)
)
;; definition for function string-get-flag!!
(defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string))
(cond
((string-get-arg!! *string-tmp-str* arg1)
(cond
((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3))
(set! (-> arg0 0) (string= *string-tmp-str* arg2))
#t
)
(else
#f
)
)
)
(else
#f
)
)
)
;; failed to figure out what this is:
(kmemopen global "gstring-globals")
;; definition for symbol *debug-draw-pauseable*, type symbol
(define *debug-draw-pauseable* #f)
;; definition for symbol *stdcon0*, type string
(define *stdcon0* (new 'global 'string #x4000 (the-as string #f)))
;; definition for symbol *stdcon1*, type string
(define *stdcon1* (new 'global 'string #x4000 (the-as string #f)))
;; definition for symbol *stdcon*, type string
(define *stdcon* *stdcon0*)
;; definition for symbol *temp-string*, type string
(define *temp-string* (new 'global 'string 2048 (the-as string #f)))
;; failed to figure out what this is:
(kmemclose)
test/goalc/test_with_game.cpp
+8
View File
@@ -961,6 +961,14 @@ TEST(Jak1TypeConsistency, TypeConsistency) {
compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc");
}
TEST(Jak2TypeConsistency, TypeConsistency) {
Compiler compiler(GameVersion::Jak2);
compiler.enable_throw_on_redefines();
add_expected_type_mismatches(compiler);
compiler.run_test_no_load("decompiler/config/jak2/all-types.gc");
compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc");
}
struct VectorFloatRegister {
float x = 0;
float y = 0;
test/offline/config/jak2/config.jsonc
+15 -2
View File
@@ -1,9 +1,22 @@
{
"dgos": [],
"dgos": [
"CGO/KERNEL.CGO",
"CGO/ENGINE.CGO"
],
"skip_compile_files": [],
"skip_compile_functions": [],
"skip_compile_functions": [
// GCOMMON
// inline assembly
"valid?",
/// GKERNEL
// asm
"(method 10 process)",
"(method 14 dead-pool)",
/// GSTATE
"enter-state" // stack pointer asm
],
"skip_compile_states": {}
}
test/offline/offline_test_main.cpp
+6 -2
View File
@@ -96,7 +96,7 @@ Decompiler setup_decompiler(const std::vector<DecompilerFile>& files,
}
if (db_files.size() != files.size() + art_files.size()) {
lg::error("DB file error.");
lg::error("DB file error: {} {} {}", db_files.size(), files.size(), art_files.size());
for (auto& f : files) {
if (!db_files.count(f.unique_name)) {
lg::error("didn't find {}\n", f.unique_name);
@@ -431,7 +431,11 @@ int main(int argc, char* argv[]) {
if (max_files > 0 && max_files < files.size()) {
files.erase(files.begin() + max_files, files.end());
}
auto art_files = find_art_files(game_name, config->dgos);
std::vector<DecompilerArtFile> art_files;
if (game_name == "jak1") {
art_files = find_art_files(game_name, config->dgos);
}
lg::info("Setting up decompiler and loading files...");
auto decompiler =