diff --git a/common/goos/PrettyPrinter.cpp b/common/goos/PrettyPrinter.cpp index 796273ab8c..f0ccb5afd5 100644 --- a/common/goos/PrettyPrinter.cpp +++ b/common/goos/PrettyPrinter.cpp @@ -572,9 +572,8 @@ void breakList(NodePool& pool, PrettyPrinterNode* leftParen, PrettyPrinterNode* } namespace { -const std::unordered_set control_flow_start_forms = { - "while", "dotimes", "until", "if", "when", -}; +const std::unordered_set control_flow_start_forms = {"while", "dotimes", "until", + "if", "when", "countdown"}; } PrettyPrinterNode* seek_to_next_non_whitespace(PrettyPrinterNode* in) { diff --git a/common/type_system/TypeSystem.cpp b/common/type_system/TypeSystem.cpp index 764db60043..82c2b2ab94 100644 --- a/common/type_system/TypeSystem.cpp +++ b/common/type_system/TypeSystem.cpp @@ -22,7 +22,8 @@ template fmt::print(fg(fmt::color::yellow), str + '\n', std::forward(args)...); } - throw std::runtime_error("Type Error"); + throw std::runtime_error( + fmt::format("Type Error: {}", fmt::format(str, std::forward(args)...))); } } // namespace @@ -1293,9 +1294,8 @@ bool TypeSystem::typecheck_and_throw(const TypeSpec& expected, */ bool TypeSystem::typecheck_base_types(const std::string& expected, const std::string& actual) const { - // just to make sure it exists. (note - could there be a case when it just has to be forward - // declared, but not defined?) - lookup_type(expected); + // just to make sure it exists. + lookup_type_allow_partial_def(expected); if (expected == actual || expected == lookup_type_allow_partial_def(actual)->get_name()) { lookup_type_allow_partial_def(actual); // make sure it exists diff --git a/decompiler/Function/CfgVtx.cpp b/decompiler/Function/CfgVtx.cpp index 3f17a98536..fed54285bd 100644 --- a/decompiler/Function/CfgVtx.cpp +++ b/decompiler/Function/CfgVtx.cpp @@ -577,6 +577,19 @@ bool ControlFlowGraph::is_goto_not_end_and_unreachable(CfgVtx* b0, CfgVtx* b1) { return true; // match! } +bool ControlFlowGraph::is_infinite_continue(CfgVtx* b0) { + if (!b0) { + return false; + } + + // end branch always. + if (!b0->end_branch.has_branch || !b0->end_branch.branch_always || b0->end_branch.branch_likely) { + return false; + } + + return true; +} + bool ControlFlowGraph::is_goto_end_and_unreachable(CfgVtx* b0, CfgVtx* b1) { if (!b0 || !b1) { return false; @@ -848,6 +861,98 @@ bool ControlFlowGraph::find_goto_end() { return replaced; } +int get_prev_count(CfgVtx* start, CfgVtx* to_find) { + int result = 0; + while (start && start != to_find) { + result++; + start = start->prev; + } + + if (start == to_find) { + return result; + } + return -1; +} + +bool ControlFlowGraph::find_infinite_continue() { + bool replaced = false; + + for_each_top_level_vtx([&](CfgVtx* vtx) { + auto* b0 = vtx; + if (is_infinite_continue(b0)) { + int my_block = b0->get_first_block_id(); + int dest_block = b0->succ_branch->get_first_block_id(); + + fmt::print("Considering {} as an infinite continue:\n", b0->to_string()); + + if (dest_block >= my_block) { + fmt::print(" Rejecting because destination block {} comes after me {}\n", dest_block, + my_block); + return true; + } else { + fmt::print(" Order OK {} -> {}\n", my_block, dest_block); + } + + int prev_count = get_prev_count(b0, b0->succ_branch); + if (prev_count == -1) { + fmt::print( + " Rejecting because we can't find the destination in the current ungrouped sequence."); + return true; + } else { + fmt::print(" Sequencing OK: {} prev's\n", prev_count); + } + replaced = true; + + auto* new_goto = alloc(); + m_has_break = true; + new_goto->body = b0; + new_goto->unreachable_block = nullptr; + new_goto->dest_block_id = b0->succ_branch->get_first_block_id(); + m_blocks.at(new_goto->dest_block_id)->needs_label = true; + + // patch up thing -> goto branches + for (auto* new_pred : b0->pred) { + new_pred->replace_succ_and_check(b0, new_goto); + } + new_goto->pred = b0->pred; + + assert(b0->succs().size() == 1 && b0->succs().front() == b0->succ_branch); + + // patch up next and prev. + new_goto->next = b0->next; + if (new_goto->next) { + assert(new_goto->next->prev == b0); + new_goto->next->prev = new_goto; + } + new_goto->prev = b0->prev; + if (new_goto->prev) { + assert(new_goto->prev->next == b0); + new_goto->prev->next = new_goto; + } + + // now we want to make it look like the goto will fall through to next. + if (new_goto->next) { + // now we will fall through + new_goto->succ_ft = b0->next; + assert(!new_goto->succ_ft->has_pred(new_goto)); + new_goto->succ_ft->pred.push_back(new_goto); + assert(!new_goto->succ_branch); + } + + // break goto preds. + b0->succ_branch->replace_preds_with_and_check({b0}, nullptr); + + b0->parent_claim(new_goto); + return false; + } + + // keep looking + return true; + }); + + return replaced; +} + bool ControlFlowGraph::find_goto_not_end() { bool replaced = false; @@ -912,7 +1017,7 @@ bool ControlFlowGraph::find_goto_not_end() { return replaced; } -bool ControlFlowGraph::is_sequence(CfgVtx* b0, CfgVtx* b1) { +bool ControlFlowGraph::is_sequence(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops) { if (!b0 || !b1) return false; @@ -939,40 +1044,49 @@ bool ControlFlowGraph::is_sequence(CfgVtx* b0, CfgVtx* b1) { return false; if (!b1->has_pred(b0)) return false; - if (b1->succ_branch == b0) + + if (!allow_self_loops && b1->succ_branch == b0) return false; + return true; } -bool ControlFlowGraph::is_sequence_of_non_sequences(CfgVtx* b0, CfgVtx* b1) { +bool ControlFlowGraph::is_sequence_of_non_sequences(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops) { if (!b0 || !b1) return false; if (dynamic_cast(b0) || dynamic_cast(b1)) return false; - return is_sequence(b0, b1); + + return is_sequence(b0, b1, allow_self_loops); } -bool ControlFlowGraph::is_sequence_of_sequence_and_non_sequence(CfgVtx* b0, CfgVtx* b1) { +bool ControlFlowGraph::is_sequence_of_sequence_and_non_sequence(CfgVtx* b0, + CfgVtx* b1, + bool allow_self_loops) { if (!b0 || !b1) return false; if (!dynamic_cast(b0)) return false; if (dynamic_cast(b1)) return false; - return is_sequence(b0, b1); + return is_sequence(b0, b1, allow_self_loops); } -bool ControlFlowGraph::is_sequence_of_sequence_and_sequence(CfgVtx* b0, CfgVtx* b1) { +bool ControlFlowGraph::is_sequence_of_sequence_and_sequence(CfgVtx* b0, + CfgVtx* b1, + bool allow_self_loops) { if (!b0 || !b1) return false; if (!dynamic_cast(b0)) return false; if (!dynamic_cast(b1)) return false; - return is_sequence(b0, b1); + return is_sequence(b0, b1, allow_self_loops); } -bool ControlFlowGraph::is_sequence_of_non_sequence_and_sequence(CfgVtx* b0, CfgVtx* b1) { +bool ControlFlowGraph::is_sequence_of_non_sequence_and_sequence(CfgVtx* b0, + CfgVtx* b1, + bool allow_self_loops) { if (!b0 || !b1) { return false; } @@ -981,7 +1095,7 @@ bool ControlFlowGraph::is_sequence_of_non_sequence_and_sequence(CfgVtx* b0, CfgV return false; if (!dynamic_cast(b1)) return false; - return is_sequence(b0, b1); + return is_sequence(b0, b1, allow_self_loops); } /*! @@ -989,13 +1103,13 @@ bool ControlFlowGraph::is_sequence_of_non_sequence_and_sequence(CfgVtx* b0, CfgV * To generate more readable debug output, we should aim to run this as infrequent and as * late as possible, to avoid condition vertices with tons of extra junk packed in. */ -bool ControlFlowGraph::find_seq_top_level() { +bool ControlFlowGraph::find_seq_top_level(bool allow_self_loops) { bool replaced = false; for_each_top_level_vtx([&](CfgVtx* vtx) { auto* b0 = vtx; auto* b1 = vtx->next; - if (is_sequence_of_non_sequences(b0, b1)) { // todo, avoid nesting sequences. + if (is_sequence_of_non_sequences(b0, b1, allow_self_loops)) { // todo, avoid nesting sequences. replaced = true; auto* new_seq = alloc(); @@ -1028,7 +1142,7 @@ bool ControlFlowGraph::find_seq_top_level() { return false; } - if (is_sequence_of_sequence_and_non_sequence(b0, b1)) { + if (is_sequence_of_sequence_and_non_sequence(b0, b1, allow_self_loops)) { // printf("make seq type 2 %s %s\n", b0->to_string().c_str(), b1->to_string().c_str()); replaced = true; auto* seq = dynamic_cast(b0); @@ -1051,7 +1165,7 @@ bool ControlFlowGraph::find_seq_top_level() { return false; } - if (is_sequence_of_non_sequence_and_sequence(b0, b1)) { + if (is_sequence_of_non_sequence_and_sequence(b0, b1, allow_self_loops)) { replaced = true; auto* seq = dynamic_cast(b1); assert(seq); @@ -1070,7 +1184,7 @@ bool ControlFlowGraph::find_seq_top_level() { return false; } - if (is_sequence_of_sequence_and_sequence(b0, b1)) { + if (is_sequence_of_sequence_and_sequence(b0, b1, allow_self_loops)) { // printf("make seq type 3 %s %s\n", b0->to_string().c_str(), b1->to_string().c_str()); replaced = true; auto* seq = dynamic_cast(b0); @@ -2123,6 +2237,7 @@ std::shared_ptr build_cfg(const LinkedObjectFile& file, cfg->flag_early_exit(func.basic_blocks); bool changed = true; + bool complained_about_weird_gotos = false; while (changed) { changed = false; // note - we should prioritize finding short-circuiting expressions. @@ -2134,7 +2249,7 @@ std::shared_ptr build_cfg(const LinkedObjectFile& file, changed = changed || cfg->find_cond_w_else(cond_with_else_hack); changed = changed || cfg->find_while_loop_top_level(); - changed = changed || cfg->find_seq_top_level(); + changed = changed || cfg->find_seq_top_level(false); changed = changed || cfg->find_short_circuits(); changed = changed || cfg->find_cond_n_else(); @@ -2145,13 +2260,24 @@ std::shared_ptr build_cfg(const LinkedObjectFile& file, changed = changed || cfg->find_infinite_loop(); }; + if (!changed) { + changed = changed || cfg->find_seq_top_level(true); + } + if (!changed) { changed = changed || cfg->find_goto_not_end(); } if (!changed) { changed = changed || cfg->find_cond_w_empty_else(); - if (changed) { + } + + if (!changed) { + changed = changed || cfg->find_infinite_continue(); + if (changed && !complained_about_weird_gotos) { + complained_about_weird_gotos = true; + func.warnings.general_warning( + "Found some very strange gotos. Check result carefully, this is not well tested."); } } } diff --git a/decompiler/Function/CfgVtx.h b/decompiler/Function/CfgVtx.h index 8f43ec0fdf..8e3ac8b3c2 100644 --- a/decompiler/Function/CfgVtx.h +++ b/decompiler/Function/CfgVtx.h @@ -110,7 +110,7 @@ class CfgVtx { /*! * Lazy function for getting all non-null succesors */ - std::vector succs() { + std::vector succs() const { std::vector result; if (succ_branch) { result.push_back(succ_branch); @@ -320,9 +320,10 @@ class ControlFlowGraph { bool find_cond_w_else(const CondWithElseLengthHack& hacks); bool find_cond_w_empty_else(); bool find_cond_n_else(); + bool find_infinite_continue(); // bool find_if_else_top_level(); - bool find_seq_top_level(); + bool find_seq_top_level(bool allow_self_loops); bool find_while_loop_top_level(); bool find_until_loop(); bool find_until1_loop(); @@ -363,15 +364,16 @@ class ControlFlowGraph { private: // bool compact_one_in_top_level(); // bool is_if_else(CfgVtx* b0, CfgVtx* b1, CfgVtx* b2, CfgVtx* b3); - bool is_sequence(CfgVtx* b0, CfgVtx* b1); - bool is_sequence_of_non_sequences(CfgVtx* b0, CfgVtx* b1); - bool is_sequence_of_sequence_and_non_sequence(CfgVtx* b0, CfgVtx* b1); - bool is_sequence_of_sequence_and_sequence(CfgVtx* b0, CfgVtx* b1); - bool is_sequence_of_non_sequence_and_sequence(CfgVtx* b0, CfgVtx* b1); + bool is_sequence(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops); + bool is_sequence_of_non_sequences(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops); + bool is_sequence_of_sequence_and_non_sequence(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops); + bool is_sequence_of_sequence_and_sequence(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops); + bool is_sequence_of_non_sequence_and_sequence(CfgVtx* b0, CfgVtx* b1, bool allow_self_loops); bool is_while_loop(CfgVtx* b0, CfgVtx* b1, CfgVtx* b2); bool is_until_loop(CfgVtx* b1, CfgVtx* b2); bool is_goto_end_and_unreachable(CfgVtx* b0, CfgVtx* b1); bool is_goto_not_end_and_unreachable(CfgVtx* b0, CfgVtx* b1); + bool is_infinite_continue(CfgVtx* b0); std::vector m_blocks; // all block nodes, in order. std::vector m_node_pool; // all nodes allocated EntryVtx* m_entry; // the entry vertex diff --git a/decompiler/IR2/AtomicOpTypeAnalysis.cpp b/decompiler/IR2/AtomicOpTypeAnalysis.cpp index 4761dfa57c..a0ce930fdc 100644 --- a/decompiler/IR2/AtomicOpTypeAnalysis.cpp +++ b/decompiler/IR2/AtomicOpTypeAnalysis.cpp @@ -454,7 +454,8 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input, } // special cases for non-integers - if ((arg0_type.typespec() == TypeSpec("object") || arg0_type.typespec() == TypeSpec("pair")) && + if ((arg0_type.typespec() == TypeSpec("object") || arg0_type.typespec() == TypeSpec("pair") || + tc(dts, TypeSpec("basic"), arg0_type)) && (arg1_type.is_integer_constant(62) || arg1_type.is_integer_constant(61))) { // boxed object tag trick. return TP_Type::make_from_ts("int"); @@ -772,11 +773,13 @@ TP_Type LoadVarOp::get_src_type(const TypeState& input, ro.offset >= 16 && (ro.offset & 3) == 0 && m_size == 4 && m_kind == Kind::UNSIGNED) { // method get of an unknown type. We assume the most general "object" type. auto method_id = (ro.offset - 16) / 4; - auto method_info = dts.ts.lookup_method("object", method_id); - if (method_id != GOAL_NEW_METHOD && method_id != GOAL_RELOC_METHOD) { - // this can get us the wrong thing for `new` methods. And maybe relocate? - return TP_Type::make_non_virtual_method( - method_info.type.substitute_for_method_call("object"), TypeSpec("object"), method_id); + if (method_id <= (int)GOAL_MEMUSAGE_METHOD) { + auto method_info = dts.ts.lookup_method("object", method_id); + if (method_id != GOAL_NEW_METHOD && method_id != GOAL_RELOC_METHOD) { + // this can get us the wrong thing for `new` methods. And maybe relocate? + return TP_Type::make_non_virtual_method( + method_info.type.substitute_for_method_call("object"), TypeSpec("object"), method_id); + } } } diff --git a/decompiler/IR2/Form.cpp b/decompiler/IR2/Form.cpp index 7acfc350e6..48f622246f 100644 --- a/decompiler/IR2/Form.cpp +++ b/decompiler/IR2/Form.cpp @@ -1798,6 +1798,7 @@ DerefElement::DerefElement(Form* base, bool is_addr_of, DerefToken token) x.expr()->parent_element = this; } } + inline_nested(); } DerefElement::DerefElement(Form* base, bool is_addr_of, std::vector tokens) @@ -1808,6 +1809,7 @@ DerefElement::DerefElement(Form* base, bool is_addr_of, std::vector x.expr()->parent_element = this; } } + inline_nested(); } goos::Object DerefElement::to_form_internal(const Env& env) const { @@ -2201,45 +2203,58 @@ void LetElement::set_body(Form* new_body) { } ///////////////////////////// -// DoTimesElement +// CounterLoopElement ///////////////////////////// -DoTimesElement::DoTimesElement(RegisterAccess var_init, - RegisterAccess var_check, - RegisterAccess var_inc, - Form* check_value, - Form* body) +CounterLoopElement::CounterLoopElement(Kind kind, + RegisterAccess var_init, + RegisterAccess var_check, + RegisterAccess var_inc, + Form* check_value, + Form* body) : m_var_init(var_init), m_var_check(var_check), m_var_inc(var_inc), m_check_value(check_value), - m_body(body) { + m_body(body), + m_kind(kind) { m_body->parent_element = this; m_check_value->parent_element = this; assert(m_var_inc.reg() == m_var_check.reg()); assert(m_var_init.reg() == m_var_inc.reg()); } -goos::Object DoTimesElement::to_form_internal(const Env& env) const { +goos::Object CounterLoopElement::to_form_internal(const Env& env) const { + std::string loop_name; + switch (m_kind) { + case Kind::DOTIMES: + loop_name = "dotimes"; + break; + case Kind::COUNTDOWN: + loop_name = "countdown"; + break; + default: + assert(false); + } std::vector outer = { - pretty_print::to_symbol("dotimes"), + pretty_print::to_symbol(loop_name), pretty_print::build_list(m_var_init.to_form(env), m_check_value->to_form(env))}; m_body->inline_forms(outer, env); return pretty_print::build_list(outer); } -void DoTimesElement::apply(const std::function& f) { +void CounterLoopElement::apply(const std::function& f) { f(this); m_check_value->apply(f); m_body->apply(f); } -void DoTimesElement::apply_form(const std::function& f) { +void CounterLoopElement::apply_form(const std::function& f) { m_check_value->apply_form(f); m_body->apply_form(f); } -void DoTimesElement::collect_vars(RegAccessSet& vars, bool recursive) const { +void CounterLoopElement::collect_vars(RegAccessSet& vars, bool recursive) const { vars.insert(m_var_init); vars.insert(m_var_check); vars.insert(m_var_inc); @@ -2249,7 +2264,7 @@ void DoTimesElement::collect_vars(RegAccessSet& vars, bool recursive) const { } } -void DoTimesElement::get_modified_regs(RegSet& regs) const { +void CounterLoopElement::get_modified_regs(RegSet& regs) const { regs.insert(m_var_inc.reg()); m_body->get_modified_regs(regs); m_check_value->get_modified_regs(regs); diff --git a/decompiler/IR2/Form.h b/decompiler/IR2/Form.h index 9c7c7a2553..cc9a368354 100644 --- a/decompiler/IR2/Form.h +++ b/decompiler/IR2/Form.h @@ -1288,13 +1288,15 @@ class LetElement : public FormElement { bool m_star = false; }; -class DoTimesElement : public FormElement { +class CounterLoopElement : public FormElement { public: - DoTimesElement(RegisterAccess var_init, - RegisterAccess var_check, - RegisterAccess var_inc, - Form* check_value, - Form* body); + enum class Kind { DOTIMES, COUNTDOWN, INVALID }; + CounterLoopElement(Kind kind, + RegisterAccess var_init, + RegisterAccess var_check, + RegisterAccess var_inc, + Form* check_value, + Form* body); goos::Object to_form_internal(const Env& env) const override; void apply(const std::function& f) override; void apply_form(const std::function& f) override; @@ -1306,6 +1308,7 @@ class DoTimesElement : public FormElement { RegisterAccess m_var_init, m_var_check, m_var_inc; Form* m_check_value = nullptr; Form* m_body = nullptr; + Kind m_kind = Kind::INVALID; }; class LambdaDefinitionElement : public FormElement { diff --git a/decompiler/IR2/FormExpressionAnalysis.cpp b/decompiler/IR2/FormExpressionAnalysis.cpp index 249554afca..0a874f6a0b 100644 --- a/decompiler/IR2/FormExpressionAnalysis.cpp +++ b/decompiler/IR2/FormExpressionAnalysis.cpp @@ -1846,7 +1846,8 @@ void FunctionCallElement::update_from_stack(const Env& env, function_type = tp_type.typespec(); } - bool swap_function = tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD && true; + bool swap_function = + tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD && all_pop_vars.size() >= 2; if (tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD) { // this is a hack to make some weird macro for calling res-lump methods work if (env.dts->ts.tc(TypeSpec("res-lump"), tp_type.method_from_type())) { @@ -2058,7 +2059,12 @@ void FunctionCallElement::update_from_stack(const Env& env, "type. Got {} instead.", tp_type.print())); } + } + auto type_source_form = match_result.maps.forms.at(type_source); + + // if the type is the exact type of the argument, we want to build it into a method call + if (type_source_form->to_string(env) == first_arg_type.base_type() && name != "new") { if (env.dts->ts.should_use_virtual_methods(tp_type.method_from_type(), tp_type.method_id())) { throw std::runtime_error(fmt::format( @@ -2066,12 +2072,6 @@ void FunctionCallElement::update_from_stack(const Env& env, ":final in the deftype to disable virtual method calls", tp_type.method_from_type().print(), tp_type.method_id())); } - } - - auto type_source_form = match_result.maps.forms.at(type_source); - - // if the type is the exact type of the argument, we want to build it into a method call - if (type_source_form->to_string(env) == first_arg_type.base_type() && name != "new") { auto method_op = pool.alloc_single_element_form(nullptr, name); auto gop = GenericOperator::make_function(method_op); @@ -3391,10 +3391,12 @@ void ArrayFieldAccess::update_with_val(Form* new_val, if (m_expected_stride == 1) { // reg0 is idx auto reg0_matcher = - Matcher::match_or({Matcher::cast("int", Matcher::any(0)), Matcher::any(0)}); + Matcher::match_or({Matcher::cast("int", Matcher::any(0)), + Matcher::cast("uint", Matcher::any(0)), Matcher::any(0)}); // reg1 is base auto reg1_matcher = - Matcher::match_or({Matcher::cast("int", Matcher::any(1)), Matcher::any(1)}); + Matcher::match_or({Matcher::cast("int", Matcher::any(1)), + Matcher::cast("uint", Matcher::any(1)), Matcher::any(1)}); auto matcher = Matcher::fixed_op(FixedOperatorKind::ADDITION, {reg0_matcher, reg1_matcher}); auto match_result = match(matcher, new_val); if (!match_result.matched) { diff --git a/decompiler/ObjectFile/ObjectFileDB_IR2.cpp b/decompiler/ObjectFile/ObjectFileDB_IR2.cpp index afd856c4bf..a4efe0c251 100644 --- a/decompiler/ObjectFile/ObjectFileDB_IR2.cpp +++ b/decompiler/ObjectFile/ObjectFileDB_IR2.cpp @@ -859,8 +859,8 @@ std::string ObjectFileDB::ir2_function_to_string(ObjectFileData& data, Function& auto& op = func.get_atomic_op_at_instr(instr_id); op_id = func.ir2.atomic_ops->instruction_to_atomic_op.at(instr_id); append_commented(line, printed_comment, - op.to_form(data.linked_data.labels, func.ir2.env).print() + "[" + - std::to_string(op_id) + "]"); + fmt::format("[{:3d}] {}", op_id, + op.to_form(data.linked_data.labels, func.ir2.env).print())); if (func.ir2.env.has_type_analysis()) { append_commented( diff --git a/decompiler/analysis/cfg_builder.cpp b/decompiler/analysis/cfg_builder.cpp index f8dd50d2e9..7274e6b672 100644 --- a/decompiler/analysis/cfg_builder.cpp +++ b/decompiler/analysis/cfg_builder.cpp @@ -193,6 +193,12 @@ void clean_up_break(FormPool& pool, BreakElement* ir) { } void clean_up_break_final(const Function& f, BreakElement* ir) { + EmptyElement* dead_empty = dynamic_cast(ir->dead_code->try_as_single_element()); + if (dead_empty) { + ir->dead_code = nullptr; + return; + } + SetVarElement* dead = dynamic_cast(ir->dead_code->try_as_single_element()); if (!dead) { dead = dynamic_cast(ir->dead_code->elts().front()); @@ -537,6 +543,13 @@ bool try_splitting_nested_sc(FormPool& pool, Function& func, ShortCircuitElement assert(ir->entries.front().branch_delay.has_value()); bool first_is_and = delay_slot_sets_false(first_branch.first, *ir->entries.front().branch_delay); bool first_is_or = delay_slot_sets_truthy(first_branch.first, *ir->entries.front().branch_delay); + + if (first_is_and == first_is_or) { + throw std::runtime_error(fmt::format( + "Failed to split nested sc. This may mean that abs/ash/type-of was misrecognized as " + "and/or:\n{}", + ir->to_string(func.ir2.env))); + } assert(first_is_and != first_is_or); // one or the other but not both! int first_different = -1; // the index of the first one that's different. @@ -1457,6 +1470,14 @@ void insert_cfg_into_list(FormPool& pool, } } +Form* cfg_to_ir_allow_null(FormPool& pool, Function& f, const CfgVtx* vtx) { + if (vtx) { + return cfg_to_ir(pool, f, vtx); + } else { + return pool.alloc_single_element_form(nullptr); + } +} + Form* cfg_to_ir_helper(FormPool& pool, Function& f, const CfgVtx* vtx) { if (dynamic_cast(vtx)) { auto* bv = dynamic_cast(vtx); @@ -1620,15 +1641,14 @@ Form* cfg_to_ir_helper(FormPool& pool, Function& f, const CfgVtx* vtx) { } else if (dynamic_cast(vtx)) { auto* cvtx = dynamic_cast(vtx); auto result = pool.alloc_single_element_form( - nullptr, cfg_to_ir(pool, f, cvtx->body), cfg_to_ir(pool, f, cvtx->unreachable_block), - cvtx->dest_block_id); + nullptr, cfg_to_ir(pool, f, cvtx->body), + cfg_to_ir_allow_null(pool, f, cvtx->unreachable_block), cvtx->dest_block_id); clean_up_break(pool, dynamic_cast(result->try_as_single_element())); return result; } else if (dynamic_cast(vtx)) { return pool.alloc_single_element_form(nullptr); } - throw std::runtime_error("not yet implemented IR conversion."); return nullptr; } diff --git a/decompiler/analysis/insert_lets.cpp b/decompiler/analysis/insert_lets.cpp index 702bd51da3..3e2a1cbb33 100644 --- a/decompiler/analysis/insert_lets.cpp +++ b/decompiler/analysis/insert_lets.cpp @@ -162,8 +162,82 @@ FormElement* rewrite_as_dotimes(LetElement* in, const Env& env, FormPool& pool) // first, remove the increment body->pop_back(); - return pool.alloc_element(in->entries().at(0).dest, *lt_var, *inc_var, - mr.maps.forms.at(1), body); + return pool.alloc_element(CounterLoopElement::Kind::DOTIMES, + in->entries().at(0).dest, *lt_var, *inc_var, + mr.maps.forms.at(1), body); +} + +FormElement* rewrite_as_countdown(LetElement* in, const Env& env, FormPool& pool) { + // dotimes OpenGOAL: + /* + (defmacro countdown (var &rest body) + "Loop like for (int i = end; i-- > 0)" + `(let ((,(first var) ,(second var))) + (while (!= ,(first var) 0) + (set! ,(first var) (- ,(first var) 1)) + ,@body + ) + ) + ) + */ + + // should have this anyway, but double check so we don't throw this away. + if (in->entries().size() != 1) { + return nullptr; + } + + // look for setting a var to the initial value. + auto ra = in->entries().at(0).dest; + auto idx_var = env.get_variable_name(ra); + + // still have to check body for the increment and have to check that the lt operates on the right + // thing. + Matcher while_matcher = Matcher::while_loop( + Matcher::op(GenericOpMatcher::condition(IR2_Condition::Kind::NONZERO), {Matcher::any_reg(0)}), + Matcher::any(2)); + + auto mr = match(while_matcher, in->body()); + if (!mr.matched) { + return nullptr; + } + + // check the zero operation: + auto lt_var = mr.maps.regs.at(0); + assert(lt_var); + if (env.get_variable_name(*lt_var) != idx_var) { + return nullptr; // wrong variable checked + } + + // check the body + auto body = mr.maps.forms.at(2); + auto first_in_body = body->elts().front(); + + // kind hacky + Form fake_form; + fake_form.elts().push_back(first_in_body); + Matcher increment_matcher = + Matcher::op(GenericOpMatcher::fixed(FixedOperatorKind::ADDITION_IN_PLACE), + {Matcher::any_reg(0), Matcher::integer(-1)}); + + auto int_mr = match(increment_matcher, &fake_form); + if (!int_mr.matched) { + return nullptr; + } + + auto inc_var = int_mr.maps.regs.at(0); + assert(inc_var); + if (env.get_variable_name(*inc_var) != idx_var) { + return nullptr; // wrong variable incremented + } + + // success! here we commit to modifying this: + + // first, remove the increment + body->elts().erase(body->elts().begin()); + + return pool.alloc_element(CounterLoopElement::Kind::COUNTDOWN, + in->entries().at(0).dest, *lt_var, *inc_var, + in->entries().at(0).src, body); } FormElement* fix_up_abs(LetElement* in, const Env& env, FormPool& pool) { @@ -365,6 +439,11 @@ FormElement* rewrite_let(LetElement* in, const Env& env, FormPool& pool) { return as_dotimes; } + auto as_countdown = rewrite_as_countdown(in, env, pool); + if (as_countdown) { + return as_countdown; + } + auto as_abs = fix_up_abs(in, env, pool); if (as_abs) { return as_abs; diff --git a/decompiler/analysis/stack_spill.cpp b/decompiler/analysis/stack_spill.cpp index dfbf4a650f..4db7b20257 100644 --- a/decompiler/analysis/stack_spill.cpp +++ b/decompiler/analysis/stack_spill.cpp @@ -78,6 +78,8 @@ struct StackInstrInfo { constexpr StackInstrInfo stack_instrs[] = {{InstructionKind::SQ, false, 16, false}, {InstructionKind::LQ, true, 16, false}, {InstructionKind::SW, false, 4, false}, + {InstructionKind::SB, false, 1, false}, + {InstructionKind::LBU, true, 1, false}, //{InstructionKind::LWU, true, 4, false} {InstructionKind::SD, false, 8, false}, {InstructionKind::SWC1, false, 4, false}, diff --git a/decompiler/analysis/type_analysis.cpp b/decompiler/analysis/type_analysis.cpp index 4eafcca2f3..4eeab9fa81 100644 --- a/decompiler/analysis/type_analysis.cpp +++ b/decompiler/analysis/type_analysis.cpp @@ -126,7 +126,8 @@ bool run_type_analysis_ir2(const TypeSpec& my_type, DecompilerTypeSystem& dts, F } catch (std::runtime_error& e) { lg::warn("Function {} failed type prop at op {}: {}", func.guessed_name.to_string(), op_id, e.what()); - func.warnings.type_prop_warning("{}", e.what()); + func.warnings.type_prop_warning("Failed type prop at op {} ({})\n:{}", op_id, + op->to_string(func.ir2.env), e.what()); func.ir2.env.set_types(block_init_types, op_types, *func.ir2.atomic_ops, my_type); return false; } diff --git a/decompiler/analysis/variable_naming.cpp b/decompiler/analysis/variable_naming.cpp index 791ce6a6c2..7de7e8e908 100644 --- a/decompiler/analysis/variable_naming.cpp +++ b/decompiler/analysis/variable_naming.cpp @@ -279,6 +279,16 @@ bool is_possible_coloring_move(Register dst, Register src) { return false; } +namespace { +int arg_count(const Function& f) { + if (f.type.arg_count() > 0) { + return f.type.arg_count() - 1; + } else { + return 0; + } +} +} // namespace + /*! * Create a "really crude" SSA, as described in * "Aycock and Horspool Simple Generation of Static Single-Assignment Form" @@ -310,6 +320,8 @@ SSA make_rc_ssa(const Function& function, const RegUsageInfo& rui, const Functio // local map: current register names at the current op. std::unordered_map current_regs; + // if we're block zero, write function arguments: + // initialize phis. this is only done on: // - variables live out at the first op // - variables read by the first op @@ -336,6 +348,19 @@ SSA make_rc_ssa(const Function& function, const RegUsageInfo& rui, const Functio } } + if (block_id == 0) { + SSA::Ins ins(-1); + for (int i = 0; i < arg_count(function); i++) { + auto dest_reg = Register::get_arg_reg(i); + auto it = current_regs.find(dest_reg); + if (it == current_regs.end()) { + current_regs.insert(std::make_pair(dest_reg, ssa.get_phi_dest(block_id, dest_reg))); + } + ins.src.push_back(current_regs.at(dest_reg)); + } + ssa.blocks.at(block_id).ins.push_back(ins); + } + // loop over ops, creating and reading from variables as needed. for (int op_id = start_op; op_id < end_op; op_id++) { const auto& op = ops.ops.at(op_id); @@ -546,7 +571,7 @@ void SSA::merge_all_phis() { * Remaps all SSA variable ids to final variable IDs. * This forces you to have all positive, consecutive IDs, with 0 being the entry value. */ -void SSA::remap() { +void SSA::remap(int) { // this keeps the order of variable assignments in the instruction order, not var_id order. struct VarIdRecord { std::unordered_set set; @@ -676,6 +701,9 @@ void SSA::make_vars(const Function& function, const DecompilerTypeSystem& dts) { const TypeState* init_types = &function.ir2.env.get_types_at_block_entry(block_id); for (auto& instr : block.ins) { auto op_id = instr.op_id; + if (op_id < 0) { + continue; + } const TypeState* end_types = &function.ir2.env.get_types_after_op(op_id); @@ -762,6 +790,9 @@ VariableNames SSA::get_vars() const { const auto& block = blocks.at(block_id); for (auto& instr : block.ins) { auto op_id = instr.op_id; + if (op_id < 0) { + continue; + } if (instr.dst.has_value()) { auto& ids = result.write_opid_to_varid[instr.dst->reg()]; if (int(ids.size()) <= op_id) { @@ -776,6 +807,9 @@ VariableNames SSA::get_vars() const { const auto& block = blocks.at(block_id); for (auto& instr : block.ins) { auto op_id = instr.op_id; + if (op_id < 0) { + continue; + } for (auto& src : instr.src) { auto& ids = result.read_opid_to_varid[src.reg()]; if (int(ids.size()) <= op_id) { @@ -944,7 +978,7 @@ std::optional run_variable_renaming(const Function& function, // merge same vars (decided this made things worse) // do rename - ssa.remap(); + ssa.remap(arg_count(function)); if (debug_prints) { fmt::print("{}", ssa.print()); } diff --git a/decompiler/analysis/variable_naming.h b/decompiler/analysis/variable_naming.h index a31fe15d95..548c33b5af 100644 --- a/decompiler/analysis/variable_naming.h +++ b/decompiler/analysis/variable_naming.h @@ -81,9 +81,10 @@ class VarMapSSA { private: int get_next_var_id(Register reg); + // var id's are per register. struct Entry { - int var_id = -1; - int entry_id = -1; + int var_id = -1; // our ID as a program variable (used for output) + int entry_id = -1; // our index in the entry list (used for remapping) Register reg; }; @@ -142,7 +143,7 @@ struct SSA { bool simplify(); void merge_all_phis(); - void remap(); + void remap(int nargs); void make_vars(const Function& function, const DecompilerTypeSystem& dts); std::unordered_map get_use_def_info( const RegAccessMap& ssa_info) const; diff --git a/decompiler/config/all-types.gc b/decompiler/config/all-types.gc index 762124dc6b..b64941c037 100644 --- a/decompiler/config/all-types.gc +++ b/decompiler/config/all-types.gc @@ -1526,7 +1526,7 @@ (deftype vertical-planes-array (basic) ((length uint32 :offset-assert 4) - (data vertical-planes :dynamic :offset 16) ;; todo, why is this here? + (data vertical-planes :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 @@ -4055,10 +4055,11 @@ ;; - Types +(declare-type art-group basic) (deftype load-dir (basic) ((unknown basic) (string-array (array string)) - (data-array (array basic))) + (data-array (array art-group))) :flag-assert #xb00000010 (:methods (new (symbol type int basic) _type_ 0) @@ -4067,10 +4068,11 @@ ) ) + (deftype load-dir-art-group (load-dir) () :flag-assert #xb00000010 - (:methods + (:methods (new (symbol type int basic) _type_ 0) ) ) @@ -4434,11 +4436,12 @@ :flag-assert #x900000074 ) +(declare-type drawable basic) (deftype login-state (basic) ((state int32 :offset-assert 4) (pos uint32 :offset-assert 8) (elts uint32 :offset-assert 12) - (elt uint32 16 :offset-assert 16) + (elt drawable 16 :offset-assert 16) ;; might be something more specific. ) :method-count-assert 9 :size-assert #x50 @@ -4520,7 +4523,7 @@ (dummy-25 () none 25) (dummy-26 () none 26) (dummy-27 () none 27) - (dummy-28 () none 28) + (dummy-28 (_type_ string) symbol 28) ) ) @@ -4553,7 +4556,7 @@ (:methods (dummy-9 (_type_ symbol) level 9) (dummy-10 (_type_ symbol) symbol 10) - (dummy-11 (_type_ symbol symbol) _type_ 11) + (dummy-11 (_type_ symbol symbol) level 11) (dummy-12 (_type_) none 12) (dummy-13 () none 13) (dummy-14 () none 14) @@ -4563,7 +4566,7 @@ (dummy-18 (_type_ symbol) none 18) (dummy-19 (_type_ pair) none 19) (dummy-20 () none 20) - (dummy-21 () none 21) + (dummy-21 (_type_ level-group int) pair 21) (dummy-22 () none 22) (dummy-23 () none 23) (dummy-24 () none 24) @@ -6174,7 +6177,7 @@ ) (deftype ocean-mid-masks (basic) - ((data uint32 :offset-assert 4) + ((data uint32 :offset-assert 4) ) :pack-me :method-count-assert 9 @@ -6242,10 +6245,10 @@ (far-color vector :inline :offset-assert 32) (ocean-spheres ocean-spheres :offset-assert 48) (ocean-colors ocean-colors :offset-assert 52) - (ocean-mid-indices basic :offset-assert 56) - (ocean-trans-indices basic :offset-assert 60) - (ocean-near-indices basic :offset-assert 64) - (ocean-mid-masks basic :offset-assert 68) + (ocean-mid-indices basic :offset-assert 56) + (ocean-trans-indices basic :offset-assert 60) + (ocean-near-indices basic :offset-assert 64) + (ocean-mid-masks basic :offset-assert 68) ) :method-count-assert 9 :size-assert #x48 @@ -8666,7 +8669,7 @@ ) (deftype proxy-prototype-array-tie (basic) - ((prototype-array-tie basic :offset-assert 4) + ((prototype-array-tie prototype-array-tie :offset-assert 4) (wind-vectors uint32 :offset-assert 8) ; likely a pointer ) :method-count-assert 9 @@ -11270,8 +11273,8 @@ (boxes box8s-array :offset-assert 148) (unk-data-3 uint32 :offset-assert 152) (ambients drawable-inline-array-ambient :offset-assert 156) - (unk-data-4 uint32 :offset-assert 160) - (unk-data-5 uint32 :offset-assert 164) + (unk-data-4 float :offset-assert 160) + (unk-data-5 float :offset-assert 164) (adgifs adgif-shader-array :offset-assert 168) (unk-data-6 pointer :offset-assert 172) (unk-data-7 pointer :offset-assert 176) @@ -11810,7 +11813,7 @@ ) (deftype drawable-tree-instance-tie (drawable-tree) - ((prototypes basic :offset 8) + ((prototypes proxy-prototype-array-tie :offset 8) ) :method-count-assert 18 :size-assert #x24 @@ -12610,7 +12613,8 @@ ;; - Functions -(define-extern entity-nav-login function) ;; only called in `level` in an asm function...tough, returns nothing +;; may be actor. +(define-extern entity-nav-login (function basic none)) ;; only called in `level` in an asm function...tough, returns nothing ;; - Symbols @@ -14494,7 +14498,7 @@ ;; - Unknowns -;;(define-extern *subdivide-settings* object) ;; unknown type +(define-extern *subdivide-settings* subdivide-settings) ;; unknown type ;;(define-extern *tfrag-work* object) ;; unknown type ;;(define-extern *perf-stats* object) ;; unknown type ;;(define-extern *merc-global-stats* object) ;; unknown type @@ -15817,9 +15821,10 @@ ;; - Functions -(define-extern entity-info-lookup function) +;; This is a terrible terrible function, here be dragons - https://github.com/water111/jak-project/pull/623! +(define-extern entity-info-lookup (function type entity-info)) -;; - Unknowns +;; - Symbols (define-extern *entity-info* (array entity-info)) @@ -16898,7 +16903,7 @@ (define-extern update-sound-banks function) (define-extern load-vis-info function) (define-extern on (function symbol process)) -(define-extern level-update-after-load function) +(define-extern level-update-after-load (function level login-state none)) (define-extern add-bsp-drawable function) (define-extern remap-level-name (function level-load-info object)) (define-extern bg (function symbol symbol)) @@ -20414,7 +20419,7 @@ ;; - Unknowns -;;(define-extern *ocean-map* object) ;; unknown type +(define-extern *ocean-map* ocean-map) ;; unknown type ;;(define-extern *swamp-low-ocean-marker* object) ;; unknown type @@ -20464,15 +20469,15 @@ (define-extern ocean-mid-add-constants function) (define-extern ocean-mid-add-call function) (define-extern ocean-mid-add-upload function) -(define-extern ocean-mid-add-call-flush function) -(define-extern draw-ocean-transition function) +(define-extern ocean-mid-add-call-flush (function dma-buffer uint none)) +(define-extern draw-ocean-transition (function dma-buffer none)) (define-extern draw-ocean-mid-seams function) (define-extern ocean-seams-add-constants function) (define-extern ocean-mid-add-upload-top function) (define-extern ocean-mid-add-upload-bottom function) (define-extern ocean-mid-add-upload-middle function) -(define-extern ocean-mid-camera-masks-bit? function) -(define-extern ocean-mid-mask-ptrs-bit? function) +(define-extern ocean-mid-camera-masks-bit? (function uint uint)) +(define-extern ocean-mid-mask-ptrs-bit? (function uint uint)) (define-extern ocean-mid-add-upload-table function) (define-extern ocean-mid-camera-masks-set! function) (define-extern ocean-mid-add-matrices function) @@ -20494,10 +20499,10 @@ ;; - Functions -(define-extern ocean-make-trans-camera-masks function) -(define-extern ocean-trans-add-upload-strip function) -(define-extern ocean-trans-add-constants function) -(define-extern draw-ocean-transition-seams function) +(define-extern ocean-make-trans-camera-masks (function uint uint uint uint none)) +(define-extern ocean-trans-add-upload-strip (function dma-buffer uint uint uint uint none)) +(define-extern ocean-trans-add-constants (function dma-buffer none)) +(define-extern draw-ocean-transition-seams (function dma-buffer none)) (define-extern ocean-trans-camera-masks-bit? function) (define-extern ocean-trans-add-upload function) (define-extern ocean-trans-mask-ptrs-bit? function) diff --git a/decompiler/config/jak1_ntsc_black_label/hacks.jsonc b/decompiler/config/jak1_ntsc_black_label/hacks.jsonc index 191a4d47d5..168afe9aad 100644 --- a/decompiler/config/jak1_ntsc_black_label/hacks.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/hacks.jsonc @@ -280,9 +280,6 @@ "render-boundary-quad", "draw-boundary-polygon", - // level BUG - "level-update-after-load", - // text BUG "load-game-text-info", @@ -468,6 +465,7 @@ "nassoc", "nassoce", "lookup-level-info", - "(method 21 level-group)" + "(method 21 level-group)", + "bg" ] } diff --git a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc index d814c87f33..c3e3b0e8c5 100644 --- a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc @@ -591,5 +591,9 @@ "main": [ ["L230", "_lambda_", true] + ], + + "geometry": [ + ["L125", "float", true] ] } diff --git a/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc b/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc index a972b8f582..c3719e0551 100644 --- a/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc @@ -376,5 +376,16 @@ "add-debug-curve": [[16, "vector"], [32, "vector"]], "add-debug-points": [[16, "vector"]], "add-debug-light": [[16, "vector"]], - "dma-timeout-cam": [[16, "vector"], [32, "matrix"]] + "dma-timeout-cam": [[16, "vector"], [32, "matrix"]], + + "(method 18 tracking-spline)": [ + [16, "tracking-spline-sampler"], + [32, "tracking-spline-sampler"] + ], + + "draw-ocean-transition": [ + [16, "sphere"] + ] + + } diff --git a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc index 013aed9be9..8de1d53d2e 100644 --- a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc @@ -701,5 +701,15 @@ ], "on": [ [33, "t9", "(function cpu-thread function none)"] + ], + + "bg": [ + [37, "a0", "symbol"] + ], + + "level-update-after-load": [ + [[29, 55], "s2", "drawable-tree-tfrag"], + [[121, 146], "s1", "drawable-inline-array-tfrag"], + [[150, 151], "s1", "drawable-tree-instance-tie"] ] } diff --git a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc index b774e793a5..47852f8f21 100644 --- a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc @@ -590,6 +590,22 @@ "args": ["dst", "src", "plane-normal"] }, + "vector-reflect!": { + "args": ["dst", "src", "plane-normal"] + }, + + "vector-reflect-flat!": { + "args": ["dst", "src", "plane-normal"] + }, + + "vector-reflect-true-flat!": { + "args": ["dst", "src", "plane-normal"] + }, + + "vector-reflect-flat-above!": { + "args": ["dst", "src", "plane-normal"] + }, + "deg-seek": { "args": ["in", "target", "max-diff"], "vars": { @@ -1847,31 +1863,35 @@ }, "entity-actor-lookup": { - "args":["lump", "name", "idx"] + "args": ["lump", "name", "idx"] }, - "(method 0 actor-link-info)" : { - "args":["allocation", "type-to-make", "proc"], - "vars": {"s5-0":"obj", "a0-1":"ent"} + "(method 0 actor-link-info)": { + "args": ["allocation", "type-to-make", "proc"], + "vars": { "s5-0": "obj", "a0-1": "ent" } }, - "(method 25 actor-link-info)" : { - "vars": {"s5-0":"actor", "gp-0":"count"} + "(method 25 actor-link-info)": { + "vars": { "s5-0": "actor", "gp-0": "count" } }, - "(method 9 actor-link-info)" : { + "(method 9 actor-link-info)": { "args": ["obj", "matching-type"], - "vars": {"s3-0":"actor", "s5-0":"mask", "s4-0":"current-bit"} + "vars": { "s3-0": "actor", "s5-0": "mask", "s4-0": "current-bit" } }, - "(method 10 actor-link-info)" : { - "vars" : {"s5-0":"this-actor", "s4-0":"actor", "gp-0":"count"} + "(method 10 actor-link-info)": { + "vars": { "s5-0": "this-actor", "s4-0": "actor", "gp-0": "count" } }, "alt-actor-list-subtask-incomplete-count": { - "vars":{"s4-0":"alt-actor-count", "gp-0":"incomplete-count", "s3-0":"alt-actor-idx"} + "vars": { + "s4-0": "alt-actor-count", + "gp-0": "incomplete-count", + "s3-0": "alt-actor-idx" + } }, - + "check-irx-version": { "vars": { "gp-0": ["cmd", "sound-rpc-get-irx-version"] } }, @@ -1906,12 +1926,19 @@ "vars": { "gp-0": ["cmd", "sound-rpc-set-ear-trans"] } }, "sound-play-by-name": { - "args": [ "name", "id", "vol", "pitch", "bend", "group", "trans" ], - "vars": { "s5-0": ["cmd", "sound-rpc-play"], "s3-1": ["proc", "process-drawable"], "s4-0": "sound-trans" } + "args": ["name", "id", "vol", "pitch", "bend", "group", "trans"], + "vars": { + "s5-0": ["cmd", "sound-rpc-play"], + "s3-1": ["proc", "process-drawable"], + "s4-0": "sound-trans" + } }, "sound-play-by-spec": { - "args": [ "spec", "id", "trans" ], - "vars": { "s5-0": ["cmd", "sound-rpc-play"], "s3-1": ["proc", "process-drawable"] } + "args": ["spec", "id", "trans"], + "vars": { + "s5-0": ["cmd", "sound-rpc-play"], + "s3-1": ["proc", "process-drawable"] + } }, "sound-pause": { "vars": { "v1-0": ["cmd", "sound-rpc-pause-sound"] } @@ -1957,87 +1984,116 @@ }, "(method 0 path-control)": { - "args":["allocation", "type-to-make", "proc", "name", "time"], - "vars": {"gp-0":["obj", "path-control"], "s3-1":"ent", "v1-7":"lookup-entity", "sv-16":"tag", "v1-9":"data"} + "args": ["allocation", "type-to-make", "proc", "name", "time"], + "vars": { + "gp-0": ["obj", "path-control"], + "s3-1": "ent", + "v1-7": "lookup-entity", + "sv-16": "tag", + "v1-9": "data" + } }, "(method 0 curve-control)": { - "args":["allocation", "type-to-make", "proc", "name", "time"], - "vars": {"gp-0":"obj", "s3-1":"ent", "v1-3":"lookup-entity"} + "args": ["allocation", "type-to-make", "proc", "name", "time"], + "vars": { "gp-0": "obj", "s3-1": "ent", "v1-3": "lookup-entity" } }, "nav-mesh-connect": { - "args":["proc", "trans", "nav-cont"], - "vars": {"s2-0":"ent", "v0-0":"lookup-entity", "s3-0":"entity-nav-mesh"} + "args": ["proc", "trans", "nav-cont"], + "vars": { + "s2-0": "ent", + "v0-0": "lookup-entity", + "s3-0": "entity-nav-mesh" + } }, "(method 0 nav-control)": { - "args":["allocation", "type-to-make", "shape", "sphere-count", "nearest-y-threshold-default"], - "vars": {"s5-0":["obj", "nav-control"], "a0-3":"ent"} + "args": [ + "allocation", + "type-to-make", + "shape", + "sphere-count", + "nearest-y-threshold-default" + ], + "vars": { "s5-0": ["obj", "nav-control"], "a0-3": "ent" } }, - + "add-debug-point": { "vars": { - "a0-6":["a0-6", "(pointer uint64)"], - "a0-7":["a0-7", "dma-packet"], - "a3-0":["a3-0", "dma-packet"], - "a3-2":["a3-2", "gs-gif-tag"], - "a3-4":["a3-4", "vector4w-2"], - "a3-6":["a3-6", "vector4w-2"], - "a3-8":["a3-8", "vector4w-2"], - "a1-30":["a1-30", "vector4w-2"] + "a0-6": ["a0-6", "(pointer uint64)"], + "a0-7": ["a0-7", "dma-packet"], + "a3-0": ["a3-0", "dma-packet"], + "a3-2": ["a3-2", "gs-gif-tag"], + "a3-4": ["a3-4", "vector4w-2"], + "a3-6": ["a3-6", "vector4w-2"], + "a3-8": ["a3-8", "vector4w-2"], + "a1-30": ["a1-30", "vector4w-2"] } }, "internal-draw-debug-line": { "vars": { - "s2-0":["s2-0", "rgba"], - "s5-0":["s5-0", "rgba"], - "a3-1":["a3-1", "dma-packet"], - "a3-3":["a3-3", "gs-gif-tag"], - "a1-43":["a1-43", "(inline-array vector4w-2)"], - "a0-31":["a0-31", "(pointer uint64)"], - "a0-32":["a0-32", "dma-packet"] + "s2-0": ["s2-0", "rgba"], + "s5-0": ["s5-0", "rgba"], + "a3-1": ["a3-1", "dma-packet"], + "a3-3": ["a3-3", "gs-gif-tag"], + "a1-43": ["a1-43", "(inline-array vector4w-2)"], + "a0-31": ["a0-31", "(pointer uint64)"], + "a0-32": ["a0-32", "dma-packet"] } }, "add-debug-flat-triangle": { "vars": { - "a3-1":["a3-1", "dma-packet"], - "a3-3":["a3-3", "gs-gif-tag"], - "a3-5":["a3-5", "(inline-array vector4w-3)"], - "a0-9":["a0-9", "(pointer uint64)"], - "a0-10":["a0-10", "dma-packet"] + "a3-1": ["a3-1", "dma-packet"], + "a3-3": ["a3-3", "gs-gif-tag"], + "a3-5": ["a3-5", "(inline-array vector4w-3)"], + "a0-9": ["a0-9", "(pointer uint64)"], + "a0-10": ["a0-10", "dma-packet"] } }, "add-debug-line2d": { "vars": { - "a2-3":["a2-3", "dma-packet"], - "a2-5":["a2-5", "gs-gif-tag"], - "a2-7":["a2-7", "(inline-array vector4w)"], - "a2-9":["a2-9", "(inline-array vector4w)"], - "a0-20":["a0-20", "(pointer uint64)"], - "v1-10":["v1-10", "dma-packet"] + "a2-3": ["a2-3", "dma-packet"], + "a2-5": ["a2-5", "gs-gif-tag"], + "a2-7": ["a2-7", "(inline-array vector4w)"], + "a2-9": ["a2-9", "(inline-array vector4w)"], + "a0-20": ["a0-20", "(pointer uint64)"], + "v1-10": ["v1-10", "dma-packet"] } }, "debug-percent-bar": { "vars": { - "v1-5":["v1-5", "dma-packet"] + "v1-5": ["v1-5", "dma-packet"] } }, "debug-pad-display": { "vars": { - "v1-12":["v1-12", "dma-packet"] + "v1-12": ["v1-12", "dma-packet"] } }, "internal-draw-debug-text-3d": { "vars": { - "v1-11":["v1-11", "dma-packet"] + "v1-11": ["v1-11", "dma-packet"] } }, - "add-debug-light": { "vars": { "s1-0":["s1-0", "rgba"]} }, - + "add-debug-light": { "vars": { "s1-0": ["s1-0", "rgba"] } }, + "generic-init-buffers": { "vars": { "v1-8": ["packet", "dma-packet"] } + }, + + "level-update-after-load": { + "args": ["loaded-level", "level-login-state"], + "vars": { + "s3-0":"level-drawable-trees", + "s5-0":"initial-timer", + "v1-4":"current-timer", + "v1-5":"elapsed-timer", + "s2-0":"current-login-pos", + "s2-1":"current-drawable", + "s1-0":"idx-in-drawable" + } } } diff --git a/decompiler/util/DecompilerTypeSystem.cpp b/decompiler/util/DecompilerTypeSystem.cpp index 03738de7c2..c9e50b7d11 100644 --- a/decompiler/util/DecompilerTypeSystem.cpp +++ b/decompiler/util/DecompilerTypeSystem.cpp @@ -400,10 +400,15 @@ int DecompilerTypeSystem::get_format_arg_count(const std::string& str) const { continue; } - // ~3L, ~0L do'nt seem to take arguments either. + // ~3L, ~0L don't seem to take arguments either. if (i + 1 < str.length() && (str.at(i) == '0' || str.at(i) == '3') && str.at(i + 1) == 'L') { continue; } + + // ~1K + if (i + 1 < str.length() && (str.at(i) == '1') && str.at(i + 1) == 'K') { + continue; + } arg_count++; } } diff --git a/docs/markdown/progress-notes/changelog.md b/docs/markdown/progress-notes/changelog.md index 1ff8a89df9..c6b8fab8d5 100644 --- a/docs/markdown/progress-notes/changelog.md +++ b/docs/markdown/progress-notes/changelog.md @@ -165,4 +165,7 @@ - Fixed a bug where saved xmm registers might be clobbered when calling a C++ function that wasn't `format`. - The `declare-type` form now supports any parent type. The type system will do a better job of trying to make things work out when only part of the type hierarchy is defined, and you can now chain type forward declarations. The compiler is stricter and will not accept forward declarations that are possibly incompatible. Instead, forward declare enough types and their parents for the compiler to be able to figure it out. - The `deftype` form is more strict and will throw an error if the type definition is in any way incompatible with existing forward declarations of types. -- Added a `type-ref` form to insert a reference to a type into a static structure and optionally forward declare the number of methods \ No newline at end of file +- Added a `type-ref` form to insert a reference to a type into a static structure and optionally forward declare the number of methods +- The `method-of-type` form will now accept an expression returning a type instead of just a type name. In this case, it will only allow you to access method of `object`. +- Added a `defun-recursive` to make it easier to define recursive functions +- Forward declared basics can be used in more places \ No newline at end of file diff --git a/game/graphics/gfx.cpp b/game/graphics/gfx.cpp index 9a8b963fea..0ca929041a 100644 --- a/game/graphics/gfx.cpp +++ b/game/graphics/gfx.cpp @@ -4,6 +4,7 @@ */ #include "gfx.h" +#include #include "common/log/log.h" #include "game/runtime.h" #include "display.h" @@ -35,6 +36,30 @@ u32 Init() { return 0; } +void Loop(std::function f) { + while (f()) { + // run display-specific things + if (Display::display) { + // lg::debug("run display"); + glfwMakeContextCurrent(Display::display); + + // render graphics + glClear(GL_COLOR_BUFFER_BIT); + + glfwSwapBuffers(Display::display); + + // poll events TODO integrate input with cpad + glfwPollEvents(); + + // exit if display window was closed + if (glfwWindowShouldClose(Display::display)) { + // Display::KillDisplay(Display::display); + MasterExit = 1; + } + } + } +} + u32 Exit() { lg::debug("gfx exit"); Display::KillDisplay(Display::display); diff --git a/game/graphics/gfx.h b/game/graphics/gfx.h index 0192430663..abc1171fee 100644 --- a/game/graphics/gfx.h +++ b/game/graphics/gfx.h @@ -8,6 +8,7 @@ #ifndef RUNTIME_GFX_H #define RUNTIME_GFX_H +#include #include "common/common_types.h" #include "display.h" #include "game/kernel/kboot.h" @@ -15,33 +16,9 @@ namespace Gfx { u32 Init(); +void Loop(std::function f); u32 Exit(); -template -void Loop(T f) { - while (f()) { - // run display-specific things - if (Display::display) { - // lg::debug("run display"); - glfwMakeContextCurrent(Display::display); - - // render graphics - glClear(GL_COLOR_BUFFER_BIT); - - glfwSwapBuffers(Display::display); - - // poll events TODO integrate input with cpad - glfwPollEvents(); - - // exit if display window was closed - if (glfwWindowShouldClose(Display::display)) { - // Display::KillDisplay(Display::display); - MasterExit = 1; - } - } - } -} - } // namespace Gfx #endif // RUNTIME_GFX_H diff --git a/game/runtime.cpp b/game/runtime.cpp index a9d23c9117..44880fb727 100644 --- a/game/runtime.cpp +++ b/game/runtime.cpp @@ -320,7 +320,7 @@ u32 exec_runtime(int argc, char** argv) { // TODO also sync this up with how the game actually renders things (this is just a placeholder) if (enable_display) { Gfx::Init(); - Gfx::Loop([&tm] { return !tm.all_threads_exiting(); }); + Gfx::Loop([&tm]() { return !tm.all_threads_exiting(); }); Gfx::Exit(); } diff --git a/goal_src/engine/collide/collide-touch-h.gc b/goal_src/engine/collide/collide-touch-h.gc index 3694e64bfe..2854368bfc 100644 --- a/goal_src/engine/collide/collide-touch-h.gc +++ b/goal_src/engine/collide/collide-touch-h.gc @@ -52,26 +52,21 @@ (defmethod init-list! touching-prims-entry-pool ((obj touching-prims-entry-pool)) "Initialize all entries to be not allocated and in a linked list." - (local-vars - (prev touching-prims-entry) - (idx int) - (current (inline-array touching-prims-entry)) - (next touching-prims-entry) - ) - (set! prev #f) - (set! current (-> obj nodes)) - (set! (-> obj head) (-> current 0)) - (set! idx 64) - (while (nonzero? idx) - (+! idx -1) - (set! (-> current 0 prev) prev) - (set! next (-> current 1)) - (set! (-> current 0 next) next) - (set! (-> current 0 allocated?) #f) - (set! prev (-> current 0)) - (set! current (the (inline-array touching-prims-entry) next)) + (let ((prev (the-as touching-prims-entry #f))) + (let ((current (the-as touching-prims-entry (-> obj nodes)))) + (set! (-> obj head) current) + (countdown (a0-1 64) + (set! (-> current prev) prev) + (let ((next (&+ current 240))) + (set! (-> current next) (the-as touching-prims-entry next)) + (set! (-> current allocated?) #f) + (set! prev current) + (set! current (the-as touching-prims-entry next)) + ) + ) + ) + (set! (-> prev next) #f) ) - (set! (-> prev next) #f) (none) ) diff --git a/goal_src/engine/entity/entity-h.gc b/goal_src/engine/entity/entity-h.gc index 53e347fc32..0b2b42ad08 100644 --- a/goal_src/engine/entity/entity-h.gc +++ b/goal_src/engine/entity/entity-h.gc @@ -191,9 +191,9 @@ ;; NOTE - this is a strange pattern...this symbol isn't defined until a later file 'navigate' ;; But this seems to be setting the symbol to nothing if it's not found, but of course, our compiler freaks out -(define-extern entity-nav-login function) +(define-extern entity-nav-login (function basic none)) (if (zero? entity-nav-login) - (set! entity-nav-login nothing) + (set! entity-nav-login (the-as (function basic none) nothing)) ) ;; definition of type actor-bank diff --git a/goal_src/engine/entity/entity-table.gc b/goal_src/engine/entity/entity-table.gc index 19c7c168d4..67543495b5 100644 --- a/goal_src/engine/entity/entity-table.gc +++ b/goal_src/engine/entity/entity-table.gc @@ -5,3 +5,182 @@ ;; name in dgo: entity-table ;; dgos: GAME, ENGINE +;; definition for symbol *entity-info*, type (array entity-info) +(define + *entity-info* + (the-as (array entity-info) + (new + 'static + 'boxed-array + :type entity-info :length 19 :allocated-length 19 + (new 'static 'entity-info + :ptype + (type-ref sage-finalboss :method-count 53) + :package "l1" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x8000 + ) + (new 'static 'entity-info + :ptype (type-ref robotboss :method-count 21) + :package "l1" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x8000 + ) + (new 'static 'entity-info + :ptype + (type-ref assistant-levitator :method-count 53) + :package "l1" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x8000 + ) + (new 'static 'entity-info + :ptype (type-ref babak :method-count 76) + :package "l1" + :art-group '("babak") + :pool '*16k-dead-pool* + :heap-size #x2800 + ) + (new 'static 'entity-info + :ptype (type-ref racer :method-count 24) + :package "game" + :art-group '("racer") + :pool '*16k-dead-pool* + :heap-size #x4000 + ) + (new 'static 'entity-info + :ptype (type-ref springbox :method-count 20) + :package "game" + :art-group '("bounceytarp") + :pool '*16k-dead-pool* + :heap-size #x1400 + ) + (new 'static 'entity-info + :ptype (type-ref launcher :method-count 20) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x400 + ) + (new 'static 'entity-info + :ptype + (type-ref pickup-spawner :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype (type-ref bucket :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype (type-ref barrel :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype (type-ref crate :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype + (type-ref orb-cache-top :method-count 29) + :package "game" + :art-group '("orb-cache-top") + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref eco :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref ecovent :method-count 21) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref fuel-cell :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1400 + ) + (new 'static 'entity-info + :ptype (type-ref buzzer :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref money :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x800 + ) + (new 'static 'entity-info + :ptype (type-ref water-vol :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype + (type-ref target-start :method-count 15) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x400 + ) + ) + ) + ) + +;; definition for function entity-info-lookup +;; INFO: Return type mismatch basic vs entity-info. +(defun entity-info-lookup ((arg0 type)) + (the-as entity-info (cond + ((nonzero? (-> arg0 method-table 13)) + (-> arg0 method-table 13) + ) + (else + (let ((v1-1 *entity-info*)) + (dotimes (a1-0 (-> v1-1 length)) + (if (= arg0 (-> v1-1 a1-0 ptype)) + (return (begin + (set! + (-> arg0 method-table 13) + (the-as function (-> v1-1 a1-0)) + ) + (-> v1-1 a1-0) + ) + ) + ) + ) + ) + (set! (-> arg0 method-table 13) #f) + #f + ) + ) + ) + ) + diff --git a/goal_src/engine/geometry/geometry.gc b/goal_src/engine/geometry/geometry.gc index 8f47bf449b..415901542d 100644 --- a/goal_src/engine/geometry/geometry.gc +++ b/goal_src/engine/geometry/geometry.gc @@ -5,6 +5,129 @@ ;; name in dgo: geometry ;; dgos: GAME, ENGINE +(defun vector-flatten! ((dst vector) (src vector) (plane-normal vector)) + "Get the projection of src onto a plane with the given normal + The normal should have magnitude 1.0." + (rlet ((acc :class vf) + (vf0 :class vf) + (vf1 :class vf) ;; src + (vf2 :class vf) ;; normal + (vf3 :class vf) + ) + (init-vf0-vector) + (.lvf vf1 (&-> src quad)) + (.lvf vf2 (&-> plane-normal quad)) + (.mov.vf vf3 vf0 :mask #b1000) + (.outer.product.vf vf3 vf1 vf2) ;; has the right magnitude, but rotation is off by 90 degrees + (.outer.product.vf vf3 vf2 vf3) ;; rotate by 90 about normal of plane + (.svf (&-> dst quad) vf3) + dst + ) + ) + +(defun vector-reflect! ((dst vector) (src vector) (plane-normal vector)) + "Reflect a vector off of a plane." + (rlet ((acc :class vf) + (vf0 :class vf) + (vf1 :class vf) + (vf2 :class vf) + (vf3 :class vf) + ) + ;; we want to split the vector into normal / tangent components. + ;; let src = T + N, where T dot plane-normal = 0. + ;; then the reflection is T - N = 2 * T - src. + ;; we can compute T from vector-flatten!'s trick + (init-vf0-vector) + (.lvf vf1 (&-> src quad)) + (.lvf vf2 (&-> plane-normal quad)) + (.mov.vf vf3 vf0 :mask #b1000) + (.outer.product.vf vf3 vf1 vf2) + (.outer.product.vf vf3 vf2 vf3) ;; vf3 is the projection on the plane + (.add.vf acc vf3 vf3 :mask #b111) ;; double that part + (.sub.mul.w.vf vf3 vf1 vf0 acc :mask #b111) ;; and subtract the original + (.svf (&-> dst quad) vf3) + dst + ) + ) + +(defun vector-reflect-flat! ((dst vector) (src vector) (plane-normal vector)) + "This is a weird one. It doesn't care about the value of src dot normal + and it effectively replaces the component of src normal to the plane with + the plane's normal. I think this requires src/normal to both be unit vectors + in order to make sense. + NOTE: src should point from positive halfspace to negative otherwise it + doesn't work." + (rlet ((acc :class vf) + (vf0 :class vf) + (vf1 :class vf) + (vf2 :class vf) + (vf3 :class vf) + ) + (init-vf0-vector) + (.lvf vf1 (&-> src quad)) + (.lvf vf2 (&-> plane-normal quad)) + (.mov.vf vf3 vf0 :mask #b1000) + (.outer.product.vf vf3 vf1 vf2) + (.outer.product.vf vf3 vf2 vf3) ;; part on the plane (requires normal to be unit) + (.add.vf vf3 vf3 vf2 :mask #b111) ;; add normal to that. + (.svf (&-> dst quad) vf3) + dst + ) + ) + +(defun vector-reflect-true-flat! ((dst vector) (src vector) (plane-normal vector)) + "Not really a reflect. Same as flatten" + (rlet ((acc :class vf) + (vf0 :class vf) + (vf1 :class vf) + (vf2 :class vf) + (vf3 :class vf) + ) + (init-vf0-vector) + (.lvf vf1 (&-> src quad)) + (.lvf vf2 (&-> plane-normal quad)) + (.mov.vf vf3 vf0 :mask #b1000) + (.outer.product.vf vf3 vf1 vf2) + (.outer.product.vf vf3 vf2 vf3) + (.svf (&-> dst quad) vf3) + dst + ) + ) + +(defun vector-reflect-flat-above! ((dst vector) (src vector) (plane-normal vector)) + "A hacked up version of reflect, probably to make their collision system work. + It is a less aggressive version of reflect that also has a limit to the output + normal component" + (rlet ((acc :class vf) + (vf0 :class vf) + (vf1 :class vf) + (vf2 :class vf) + (vf3 :class vf) + ) + (init-vf0-vector) + (.lvf vf1 (&-> src quad)) + (.lvf vf2 (&-> plane-normal quad)) + (.mov.vf vf3 vf0 :mask #b1000) + (.outer.product.vf vf3 vf1 vf2) + (.outer.product.vf vf3 vf2 vf3) + (.svf (&-> dst quad) vf3) + + ;; dst is now the normal part of src + (let ((f0-0 (vector-length dst)) ;; length of normal + (f1-1 (vector-dot dst plane-normal))) ;; ?? this is always zero. + (let* ((f1-2 f1-1) + ;; f1-3 = .02 * length of normal. f1-2 is always zero here + (f1-3 (- (* 0.02 f0-0) f1-2)) + ) + ;; scale down and limit the normal component + (vector+float*! dst dst plane-normal (fmin 16384.0 (* 16.0 f1-3))) + ) + ) + ) + ) + +;; TODO vector-segment-distance-point! + ;; TODO - temporary for lights.gc (define-extern vector-deg-slerp (function vector vector vector float vector)) ;; TODO - temporary for transformq.gc @@ -14,4 +137,4 @@ ;; TODO (define-extern vector-3pt-cross! (function vector vector vector vector vector)) -(define-extern curve-evaluate! (function vector float int int vector int int)) \ No newline at end of file +(define-extern curve-evaluate! (function vector float int int vector int int)) diff --git a/goal_src/engine/gfx/tie/prototype-h.gc b/goal_src/engine/gfx/tie/prototype-h.gc index 8c1a89fd8a..aeec235f65 100644 --- a/goal_src/engine/gfx/tie/prototype-h.gc +++ b/goal_src/engine/gfx/tie/prototype-h.gc @@ -105,7 +105,7 @@ ) (deftype proxy-prototype-array-tie (basic) - ((prototype-array-tie basic :offset-assert 4) + ((prototype-array-tie prototype-array-tie :offset-assert 4) (wind-vectors uint32 :offset-assert 8) ) :method-count-assert 9 diff --git a/goal_src/engine/gfx/tie/tie-h.gc b/goal_src/engine/gfx/tie/tie-h.gc index f1d748ec6a..3097177464 100644 --- a/goal_src/engine/gfx/tie/tie-h.gc +++ b/goal_src/engine/gfx/tie/tie-h.gc @@ -48,7 +48,7 @@ ) (deftype drawable-tree-instance-tie (drawable-tree) - ((prototypes basic :offset 8) + ((prototypes proxy-prototype-array-tie :offset 8) ) :method-count-assert 18 :size-assert #x24 diff --git a/goal_src/engine/gfx/vis/bsp-h.gc b/goal_src/engine/gfx/vis/bsp-h.gc index f42af51d8d..293773e3d0 100644 --- a/goal_src/engine/gfx/vis/bsp-h.gc +++ b/goal_src/engine/gfx/vis/bsp-h.gc @@ -42,8 +42,8 @@ (boxes box8s-array :offset-assert 148) (unk-data-3 uint32 :offset-assert 152) (ambients drawable-inline-array-ambient :offset-assert 156) - (unk-data-4 uint32 :offset-assert 160) - (unk-data-5 uint32 :offset-assert 164) + (unk-data-4 float :offset-assert 160) + (unk-data-5 float :offset-assert 164) (adgifs adgif-shader-array :offset-assert 168) (unk-data-6 pointer :offset-assert 172) (unk-data-7 pointer :offset-assert 176) diff --git a/goal_src/engine/level/level-h.gc b/goal_src/engine/level/level-h.gc index 65f99bdf26..8f2e4e7fb9 100644 --- a/goal_src/engine/level/level-h.gc +++ b/goal_src/engine/level/level-h.gc @@ -72,11 +72,12 @@ :flag-assert #x900000074 ) +(declare-type drawable basic) (deftype login-state (basic) ((state int32 :offset-assert 4) (pos uint32 :offset-assert 8) (elts uint32 :offset-assert 12) - (elt uint32 16 :offset-assert 16) + (elt drawable 16 :offset-assert 16) ;; might be more specific ) :method-count-assert 9 :size-assert #x50 @@ -159,7 +160,7 @@ (dummy-25 () none 25) (dummy-26 () none 26) (dummy-27 () none 27) - (dummy-28 () none 28) + (dummy-28 (_type_ string) symbol 28) ) ) @@ -197,7 +198,7 @@ (:methods (dummy-9 (_type_ symbol) level 9) (dummy-10 (_type_ symbol) symbol 10) - (dummy-11 (_type_ symbol symbol) _type_ 11) + (dummy-11 (_type_ symbol symbol) level 11) (dummy-12 (_type_) none 12) (dummy-13 () none 13) (dummy-14 () none 14) @@ -207,7 +208,7 @@ (dummy-18 (_type_ symbol) none 18) (dummy-19 (_type_ pair) none 19) (dummy-20 () none 20) - (dummy-21 () none 21) + (dummy-21 (_type_ level-group int) pair 21) (dummy-22 () none 22) (dummy-23 () none 23) (dummy-24 () none 24) diff --git a/goal_src/engine/load/loader-h.gc b/goal_src/engine/load/loader-h.gc index 25634414de..6c11422445 100644 --- a/goal_src/engine/load/loader-h.gc +++ b/goal_src/engine/load/loader-h.gc @@ -5,13 +5,12 @@ ;; name in dgo: loader-h ;; dgos: GAME, ENGINE -(define-extern art-group type) - ;; This type didn't have an inspect method, so these field names are made up. +(declare-type art-group basic) (deftype load-dir (basic) ((unknown basic) (string-array (array string)) ;; these are the names - (data-array (array basic)) ;; this is the file data. + (data-array (array art-group)) ;; this is the file data. ) :flag-assert #xb00000010 (:methods @@ -44,7 +43,7 @@ (set! (-> obj string-array length) 0) ;; create the data array (set! (-> obj data-array) - (the-as (array basic) + (the-as (array art-group) ((method-of-type array new) allocation array basic length) )) (set! (-> obj data-array length) 0) diff --git a/goal_src/engine/math/math.gc b/goal_src/engine/math/math.gc index 77dada6210..8a62fd311b 100644 --- a/goal_src/engine/math/math.gc +++ b/goal_src/engine/math/math.gc @@ -11,11 +11,13 @@ ;;;; float macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; at some point, this could be more optimized. -;; MIPS has an explicit abs.s instruction, but x86-64 doesn't. -;; modern clang on O3 does a comiss/branch and this is probably pretty close. (defmacro fabs (x) + "Floating point absolute value" + ;; in GOAL this was implemented by the compiler. + ;; at some point, this could be more optimized. + ;; MIPS has an explicit abs.s instruction, but x86-64 doesn't. + ;; modern clang on O3 does a comiss/branch and this is probably pretty close. `(if (< (the float ,x) 0) (- (the float ,x)) (the float ,x)) @@ -159,10 +161,12 @@ ;;;; random vu hardware ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; added in OpenGOAL +;; in the PS2 there is a R register for generating random numbers +;; it is a "32-bit" register, but the upper bits are fixed so it always +;; represents a float in (1, 2). +;; we don't have this register on x86, so we add a special global: *_vu-reg-R_* (define *_vu-reg-R_* 0) -;; TODO (defun rand-vu-init ((seed float)) "Initialize the VU0 random generator" ;; (.ctc2.i R arg0) @@ -173,6 +177,7 @@ (the-as float *_vu-reg-R_*) ) +;; this is _almost_ sqrt(2) = 1.414 (rand-vu-init 1.418091058731079) ;; rand-vu diff --git a/goal_src/engine/math/matrix-h.gc b/goal_src/engine/math/matrix-h.gc index 599748123b..a6a532e492 100644 --- a/goal_src/engine/math/matrix-h.gc +++ b/goal_src/engine/math/matrix-h.gc @@ -44,6 +44,7 @@ ) (defun matrix-copy! ((dst matrix) (src matrix)) + "Copy src to dst" (let ((v1-0 (-> src vector 0 quad)) (a2-0 (-> src vector 1 quad)) (a3-0 (-> src vector 2 quad)) diff --git a/goal_src/engine/math/transform-h.gc b/goal_src/engine/math/transform-h.gc index f773cffd5e..5205f6600b 100644 --- a/goal_src/engine/math/transform-h.gc +++ b/goal_src/engine/math/transform-h.gc @@ -5,11 +5,11 @@ ;; name in dgo: transform-h ;; dgos: GAME, ENGINE - +;; Transformation. w components of vectors should be 1.0 (deftype transform (structure) - ((trans vector :inline :offset-assert 0) - (rot vector :inline :offset-assert 16) - (scale vector :inline :offset-assert 32) + ((trans vector :inline :offset-assert 0) ;; translation + (rot vector :inline :offset-assert 16) ;; rotation (rotation vector) + (scale vector :inline :offset-assert 32) ;; scale (xyz components) ) :method-count-assert 9 :size-assert #x30 @@ -17,6 +17,7 @@ ) +;; Like transform, but it's a basic. (deftype trs (basic) ((trans vector :inline :offset-assert 16) (rot vector :inline :offset-assert 32) diff --git a/goal_src/engine/math/vector-h.gc b/goal_src/engine/math/vector-h.gc index 761d343543..d5a6f52394 100644 --- a/goal_src/engine/math/vector-h.gc +++ b/goal_src/engine/math/vector-h.gc @@ -9,6 +9,8 @@ ;; bit array ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the bit-array is a dynamically sized array that is bit addressable + (deftype bit-array (basic) ((length int32 :offset-assert 4) (allocated-length int32 :offset-assert 8) @@ -91,22 +93,20 @@ (defmethod clear bit-array ((obj bit-array)) "Set all bits to zero." - (local-vars (idx int)) - (let ((idx (sar (logand -8 (+ (-> obj allocated-length) 7)) 3))) - (while (nonzero? idx) - (set! idx (+ idx -1)) - (nop!) - (nop!) - (set! (-> obj bytes idx) 0) - ) - obj + (countdown (idx (/ (logand -8 (+ (-> obj allocated-length) 7)) 8)) + (nop!) + (nop!) + (set! (-> obj bytes idx) (the-as uint 0)) ) + obj ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; vector types (integer) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the GOAL vector types are structures, storing values in memory. + ;; Vector of 4 unsigned bytes. (deftype vector4ub (structure) ((data uint8 4 :offset-assert 0) @@ -367,6 +367,7 @@ :flag-assert #x900000010 ) +;; ax + by + cz = d form (deftype plane (vector) ((a float :offset 0) (b float :offset 4) @@ -378,15 +379,15 @@ :flag-assert #x900000010 ) +;; x, y, z are the origin, replaces w with r, the radius (deftype sphere (vector) - ((r float :offset 12) + ((r float :offset 12 :score 10) ;; prefer over w ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) - (deftype isphere (vec4s) () :method-count-assert 9 @@ -456,7 +457,7 @@ (deftype vertical-planes-array (basic) ((length uint32 :offset-assert 4) - (data vertical-planes :dynamic :offset 16) ;; todo, why is this here? + (data vertical-planes :inline :dynamic :offset-assert 16) ;; likely inline based on alignment ) :method-count-assert 9 :size-assert #x10 @@ -489,7 +490,14 @@ :flag-assert #x90000000c ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Macros and inline functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defmacro set-vector! (v xv yv zv wv) + "Set all fields in a vector" (with-gensyms (vec) `(let ((vec ,v)) (set! (-> vec x) ,xv) @@ -549,6 +557,7 @@ ) (defmacro print-vf (vf &key (name #f)) + "Print out a vf register as a vector." `(let ((temp (new 'stack 'vector))) (.svf temp ,vf) ,(if name @@ -559,6 +568,7 @@ ) (defmacro print-vf-hex (vf) + "Print out a vf register as 4x 32-bit hexadecimal integers" `(let ((temp (new 'stack 'vector4w))) (.svf temp ,vf) (format #t "~`vector4w`P~%" temp) diff --git a/goal_src/engine/ps2/vu1-macros.gc b/goal_src/engine/ps2/vu1-macros.gc index 41210e2624..c36dcf8db7 100644 --- a/goal_src/engine/ps2/vu1-macros.gc +++ b/goal_src/engine/ps2/vu1-macros.gc @@ -5,7 +5,10 @@ ;; name in dgo: vu1-macros ;; dgos: GAME, ENGINE -;; this file has no code! +;; this file has no code, just macros for vector-unit stuff. + +;; in OpenGOAL we're also using this for VU0 macros to help with VU0 operations that are not +;; directly implemented by the OpenGOAL compiler (defmacro vu-clip (vfr cf) "Returns the result of VCLIP. diff --git a/goal_src/engine/util/types-h.gc b/goal_src/engine/util/types-h.gc index 85a13655d0..f06852e601 100644 --- a/goal_src/engine/util/types-h.gc +++ b/goal_src/engine/util/types-h.gc @@ -18,12 +18,24 @@ :flag-assert #x900000004 ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Common Units +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; in-game durations, distances, and rotations are stored in special formats. +;; these macros/constants convert from literals to the correct format. +;; for example, (meters 4.0) will give you a distance representing 4 in-game meters. + +;; 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." + + ;; we don't have enough constant propagation for the compiler to figure this out. (cond ((float? x) (* METER_LENGTH x) @@ -37,6 +49,10 @@ ) ) +;; 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) (defmacro degrees (x) @@ -54,6 +70,10 @@ ) ) +;; 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 (defmacro seconds (x) @@ -75,4 +95,4 @@ (defmacro vel-tick (vel) "turn a velocity value into a per-tick value" `(* (/ 1.0 ,TICKS_PER_SECOND) ,vel) - ) \ No newline at end of file + ) diff --git a/goal_src/goal-lib.gc b/goal_src/goal-lib.gc index b4ff571e76..09edeb085f 100644 --- a/goal_src/goal-lib.gc +++ b/goal_src/goal-lib.gc @@ -217,6 +217,23 @@ ) ) +;; the compiler can't figure out types of a recursive function without +;; first knowing the return type, so we use this form to forward declare +;; and define a function. +(defmacro defun-recursive (name return-type bindings &rest body) + `(begin + (define-extern ,name + (function ,@(apply (lambda (x) + (if (pair? x) + (second x) + 'object) + ) + bindings) + ,return-type)) + (defun ,name ,bindings ,@body) + ) + ) + (defmacro defun-extern (function-name &rest type-info) `(define-extern ,function-name (function ,@type-info)) ) diff --git a/goal_src/goos-lib.gs b/goal_src/goos-lib.gs index 4379caf486..e774c8c220 100644 --- a/goal_src/goos-lib.gs +++ b/goal_src/goos-lib.gs @@ -157,6 +157,10 @@ `(type? 'integer ,x) ) +(defsmacro pair? (x) + `(type? 'pair ,x) + ) + (defsmacro ferror (&rest args) `(error (fmt #f ,@args)) ) diff --git a/goal_src/kernel/gcommon.gc b/goal_src/kernel/gcommon.gc index a3f6131324..223ac5d24e 100644 --- a/goal_src/kernel/gcommon.gc +++ b/goal_src/kernel/gcommon.gc @@ -6,26 +6,22 @@ ;; dgos: KERNEL ;; gcommon is the first file compiled and loaded. -;; it's expected that this function will mostly be hand-decompiled +;; it implements some features of built-in types +;; and language constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Game constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; CONSTANTS -(defconstant NEW_METHOD_ID 0) -(defconstant DELETE_METHOD_ID 1) -(defconstant PRINT_METHOD_ID 2) -(defconstant INSPECT_METHOD_ID 3) -(defconstant LENGTH_METHOD_ID 4) -(defconstant ASIZE_METHOD_ID 5) -(defconstant COPY_METHOD_ID 6) -(defconstant RELOC_METHOD_ID 7) ;; or login? -(defconstant MEM_USAGE_METHOD_ID 8) - +;; disable PS2 only code and enable PC-specific code (defglobalconstant PC_PORT #t) + +;; redirects access to EE memory mapped registers through get-vm-ptr to valid addresses that +;; are monitored in the runtime for debugging. (defglobalconstant USE_VM #t) (defmacro get-vm-ptr (ptr) "Turn an EE register address into a valid PS2 VM address" - `(#cond (USE_VM (vm-ptr ,ptr) @@ -36,6 +32,21 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; GOAL language constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; GOAL built-in method IDs +(defconstant NEW_METHOD_ID 0) +(defconstant DELETE_METHOD_ID 1) +(defconstant PRINT_METHOD_ID 2) +(defconstant INSPECT_METHOD_ID 3) +(defconstant LENGTH_METHOD_ID 4) +(defconstant ASIZE_METHOD_ID 5) +(defconstant COPY_METHOD_ID 6) +(defconstant RELOC_METHOD_ID 7) ;; or login? +(defconstant MEM_USAGE_METHOD_ID 8) + ;; distance from a symbol pointer to a (pointer string) ;; this relies on the memory layout of the symbol table ;; this must match SYM_INFO_OFFSET in goal_constants.h + offset of the str field in struct SymUpper. @@ -44,33 +55,42 @@ ;; pointers larger than this are invalid by valid? (defconstant END_OF_MEMORY #x8000000) -;; boxed object offset (16-byte alignement offsets) +;; GOAL boxed offsets use the lower three bits to indicate if they are +;; an integer (binteger), a pair, or a strucutre with type info (basic) (defconstant BINTEGER_OFFSET 0) (defconstant PAIR_OFFSET 2) (defconstant BASIC_OFFSET 4) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; GOAL language macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defmacro symbol->string (sym) "Convert a symbol to a goal string." `(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym)))) ) -;; forward declarations. -(define-extern name= (function basic basic symbol)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Function versions of built-in forms +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; basic operations like +, - are handled by the compiler. +;; these provide actual functions that wrap these common operations. (defun identity ((x object)) - "Function which returns its input. The first function of the game!" + "Function which returns its input. The first function of the game! + This will not preserve the upper 64-bits of a 128-bit value." x ) (defun 1/ ((x float)) "Reciprocal floating point" - ;; likely inlined? nothing calls this. (declare (inline)) (/ 1. x) ) -;; these next 4 functions are just function wrappers around the build in add/subtract/multiply/divide. -;; this will let you use + as an operation on integers and also as a function pointer. (defun + ((x int) (y int)) "Compute the sum of two integers" (+ x y) @@ -196,6 +216,10 @@ '#t ) +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; format +;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; The C Kernel implements the format function and creates a trampoline function in the GOAL heap which jumps to ;; format. (In OpenGOAL, there's actually two trampoline functions, to make the 8 arguments all work.) ;; For some reason, the C Kernel names this trampoline function _format. We need to set the value of format @@ -205,8 +229,12 @@ ;; or 128-bit arguments (unimplemented in C Kernel), but both of these were never finished. (define format _format) -;; vec4s - this is present in the game as a 128-bit integer with 4 packed floats. -;; this isn't used very much. +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; numeric types +;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; vec4s packs 4 floats into a single 128-bit integer register. +;; This is not used very often. (deftype vec4s (uint128) ((x float :offset 0) (y float :offset 32) @@ -244,6 +272,17 @@ ) ) +(defmacro make-u128 (upper lower) + "Make a i128 from two 64-bit values." + `(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-as uint result) + ) + ) ;; A "boxed float" type. Simply a float with type information. (deftype bfloat (basic) ((data float :offset-assert 4)) @@ -272,100 +311,99 @@ (align16 (+ 28 (* 4 (-> type allocated-length)))) ) - - (defun basic-type? ((obj basic) (parent-type type)) "Is obj of type parent-type? Note: this will return #f if you put a parent-type of object. Only use this with types that are fully defined." - (local-vars (obj-type type) (end-type type)) - - ;; note - this was likely a "do" loop. - (set! obj-type (-> obj type)) - (set! end-type object) - (until (begin - (set! obj-type (-> obj-type parent)) - (= obj-type end-type) - ) - (if (= obj-type parent-type) - (return '#t) + (let ((obj-type (-> obj type)) + (end-type object) ) + (until (begin + (set! obj-type (-> obj-type parent)) + (= obj-type end-type) + ) + (if (= obj-type parent-type) + (return #t) + ) + ) ) - '#f + #f ) (defun type-type? ((child-type type) (parent-type type)) "Is child-type a child (or equal to) parent-type? It is safe to use this on a type that is not fully set up, but in this case it will return #f." - (local-vars (end-type type)) - (set! end-type object) - (until (begin - (set! child-type (-> child-type parent)) - (or (= child-type end-type) (zero? child-type)) + (let ((end-type object)) + (until (begin + (set! child-type (-> child-type parent)) + (or (= child-type end-type) (zero? child-type)) + ) + (if (= child-type parent-type) + (return #t) ) - (if (= child-type parent-type) - (return '#t) - ) + ) ) - '#f + #f ) - (defun find-parent-method ((child-type type) (method-id int)) "Search the type tree for a parent type with a different method from the child, for the given method ID. DANGER: only call this if you expect to find something. - There are method-table range checks, so it may run off the end + There are no method-table range checks, so it may run off the end of a method table and return junk" - (local-vars - (current-method function) - (original-method function) - ) - (set! original-method (-> child-type method-table method-id)) - (until (!= current-method original-method) - (if (= child-type object) - (return nothing) - ) - (set! child-type (-> child-type parent)) - (set! current-method (-> child-type method-table method-id)) - (if (zero? current-method) - (return nothing) - ) + (local-vars (current-method function)) + (let ((original-method (-> child-type method-table method-id))) + (until (!= current-method original-method) + (if (= child-type object) + (return nothing) + ) + (set! child-type (-> child-type parent)) + (set! current-method (-> child-type method-table method-id)) + (if (zero? current-method) + (return nothing) + ) + ) ) current-method ) +(defmacro as-type (obj type) + "Macro to _safely_ convert to a different type, returning #f if the type doesn't match. + Does a runtime type check so it's expensive." + `(if (and (nonzero? ,obj) (type-type? (-> ,obj type) ,type)) + (the-as ,type ,obj) + ) + ) +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; pairs, lists, etc +;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun ref ((lst object) (index int)) "Get an entry in a proper list by index" - (let ((count 0)) - (while (< count index) - ;; inserted by GOAL compiler for EE loop bug (short loop) - (nop!) - (nop!) - (set! lst (cdr lst)) - (set! count (+ count 1)) - ) - (car lst) + (dotimes (count index) + (nop!) + (nop!) + (set! lst (cdr lst)) ) + (car lst) ) (defmethod length pair ((obj pair)) "Get the length of a proper list" - (local-vars (result int) (iter object)) + (local-vars (result int)) (cond - ((= obj '()) - ;; length of empty list is 0 + ((null? obj) (set! result 0) ) (else - (set! iter (cdr obj)) - (set! result 1) - (while (and (!= iter '()) - (pair? iter) ;; manually replaced. - ) - (set! result (+ result 1)) - (set! iter (cdr iter)) + (let ((iter (cdr obj))) + (set! result 1) + (while (and (not (null? iter)) (pair? iter)) + (+! result 1) + (set! iter (cdr iter)) + ) ) ) ) @@ -382,43 +420,34 @@ (defun last ((lst object)) "Get the last element in a proper list" - (local-vars (iter object)) - (set! iter lst) - (while (!= (cdr iter) '()) - ;; for EE loop bug. - (nop!) - (nop!) - (set! iter (cdr iter)) + (let ((iter lst)) + (while (not (null? (cdr iter))) + (nop!) + (nop!) + (set! iter (cdr iter)) + ) + iter ) - iter ) (defun member ((obj object) (lst object)) "Is obj in the list lst? Returns pair with obj as its car, or #f if not found." - (local-vars (iter object)) - (set! iter lst) - ;; loop until we reach the end or the object - (while (not (or (= iter '()) - (= (car iter) obj) - ) - ) - (set! iter (cdr iter)) - ) - - (if (!= iter '()) - ;; return the pair containing obj as its car. - iter - ;; #f is returned in the other case. + (let ((iter lst)) + (while (not (or (null? iter) (= (car iter) obj))) + (set! iter (cdr iter)) ) + (if (not (null? iter)) + iter + ) + ) ) +;; need to forward declare this, we haven't loaded the string library yet. +(define-extern name= (function basic basic symbol)) (defun nmember ((obj basic) (lst object)) "Is obj in the list lst? Check with the name= function." - (while (not (or (= lst '()) - (name= (the-as basic (car lst)) obj) - ) - ) + (while (not (or (= lst '()) (name= (the-as basic (car lst)) obj))) (set! lst (cdr lst)) ) (if (!= lst '()) @@ -429,17 +458,14 @@ (defun assoc ((item object) (alist object)) "Is item in the association list alist? Returns the key-value pair." - (local-vars (iter object)) - (set! iter alist) - (while (not (or (= iter '()) - (= (car (car iter)) item) - ) - ) - (set! iter (cdr iter)) - ) - (if (!= iter '()) - (car iter) + (let ((iter alist)) + (while (not (or (null? iter) (= (car (car iter)) item))) + (set! iter (cdr iter)) ) + (if (not (null? iter)) + (car iter) + ) + ) ) @@ -447,41 +473,34 @@ "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" - (local-vars (iter object)) - (set! iter alist) - (while (not (or (= iter '()) - (= (car (car iter)) item) - (= (car (car iter)) 'else) - ) - ) - (set! iter (cdr iter)) - ) - (if (!= iter '()) - (car iter) + (let ((iter alist)) + (while (not (or (null? iter) + (= (car (car iter)) item) + (= (car (car iter)) 'else))) + (set! iter (cdr iter)) ) + (if (not (null? iter)) + (car iter) + ) + ) ) (defun nassoc ((item-name string) (alist 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." - (local-vars (key object)) - (while (not (or - (= alist '()) - (begin - (set! key (car (car alist))) - (if (pair? key) - ;; multiple keys - (nmember item-name key) - ;; only one key - (name= (the-as basic key) item-name) + (while (not (or (null? alist) + (let ((key (car (car alist)))) + (if (pair? key) + (nmember item-name key) + (name= (the-as basic key) item-name) + ) ) - ) - ) + ) ) (set! alist (cdr alist)) ) - (if (!= alist '()) + (if (not (null? alist)) (car alist) ) ) @@ -490,49 +509,42 @@ "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" - (local-vars (key object)) - (while (not (or - (= alist '()) - (begin - (set! key (car (car alist))) - (if (pair? key) - ;; multiple keys - (nmember item-name key) - ;; single key, try match or accept else. - (or (name= (the-as basic key) item-name) - (= key 'else) + (while (not (or (null? alist) + (let ((key (car (car alist)))) + (if (pair? key) + (nmember item-name key) + (or + (name= (the-as basic key) item-name) + (= key 'else) + ) ) ) - ) - ) + ) ) (set! alist (cdr alist)) ) - (if (!= alist '()) + (if (not (null? alist)) (car alist) ) ) (defun append! ((front object) (back object)) - (local-vars (iter object)) + "Append back to front, return the combined list." (cond - ((= front '()) - ;; the first list was empty, just return the second one + ((null? front) + ;; can't append to '(), just return back. back ) (else - ;; get to the back of the front list - (set! iter front) - (while (!= (cdr iter) '()) - ;; for EE short loop bug. - (nop!) - (nop!) - (set! iter (cdr iter)) - ) - - ;; this check seems not needed? - (when (!= iter '()) - (set! (cdr iter) back) + (let ((iter front)) + (while (not (null? (cdr iter))) + (nop!) + (nop!) + (set! iter (cdr iter)) + ) + (if (not (null? iter)) + (set! (cdr iter) back) + ) ) front ) @@ -541,27 +553,23 @@ (defun delete! ((item object) (lst object)) "Remove the first occurance of item from lst (where item is actual a pair in the list)" - (local-vars (iter-prev object) (iter object)) (the-as pair (cond ((= item (car lst)) - ;; special case for lst starts with object. (cdr lst) ) (else - ;; iterate until (car iter) = item (or we reach the end) - (set! iter-prev lst) - (set! iter (cdr lst)) - (while (not (or (= iter '()) (= (car iter) item))) - (set! iter-prev iter) - (set! iter (cdr iter)) - ) - - ;; splice out the element to delete! - (if (!= iter '()) - (set! (cdr iter-prev) (cdr iter)) + (let ((iter-prev lst) + (iter (cdr lst)) + ) + (while (not (or (null? iter) (= (car iter) item))) + (set! iter-prev iter) + (set! iter (cdr iter)) ) - ;; return original list. + (if (not (null? iter)) + (set! (cdr iter-prev) (cdr iter)) + ) + ) lst ) ) @@ -570,37 +578,34 @@ (defun delete-car! ((item object) (lst object)) "Remove the first first occurance of an element from the list where (car elt) is item." - (local-vars (iter-prev object) (iter object)) - (cond ((= item (car (car lst))) - ;; special case for removing the first item. - (cdr lst) - ) - (else - ;; iterate until (car iter) is the thing we want to delete - (set! iter-prev lst) - (set! iter (cdr lst)) - (while (not (or (= iter '()) (= (car (car iter)) item))) - (set! iter-prev iter) - (set! iter (cdr iter)) + (cond + ((= item (car (car lst))) + (cdr lst) + ) + (else + (let ((iter-prev lst) + (iter (cdr lst)) ) - ;; splice out element to delete, if we got it. - (if (!= iter '()) - (set! (cdr iter-prev) (cdr iter)) - ) - lst + (while (not (or (null? iter) (= (car (car iter)) item))) + (set! iter-prev iter) + (set! iter (cdr iter)) ) - ) + (if (not (null? iter)) + (set! (cdr iter-prev) (cdr iter)) + ) + ) + lst + ) + ) ) (defun insert-cons! ((kv object) (alist 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." - (local-vars (updated-list object)) - ;; possibly remove an existing entry - (set! updated-list (delete-car! (car kv) alist)) - ;; and put a new one in! - (new 'global 'pair kv updated-list) + (let ((updated-list (delete-car! (car kv) alist))) + (cons kv updated-list) + ) ) (defun sort ((lst object) (compare-func (function object object object))) @@ -611,55 +616,48 @@ 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." - (local-vars - (compare-result object) - (second-elt object) - (first-elt object) - (iter object) - (unsorted-count int) - ) - - ;; number of out-of-orders encountered - (set! unsorted-count -1) - - ;; loop until we have nothing unsorted - (while (nonzero? unsorted-count) - ;; assume sorted - (set! unsorted-count 0) - (set! iter lst) - - ;; loop over list (excluding last element, so we can grab pairs of elements) - (while (not (or (= (cdr iter) '()) - ;; (>= (shl (the-as int (cdr iter)) 62) 0) - (not-pair? (cdr iter)) - ) - ) - - ;; get the two elements, and compare - (set! first-elt (car iter)) - (set! second-elt (car (cdr iter))) - (set! compare-result (compare-func first-elt second-elt)) - ;; the compare function can return a few possible things. - ;; we assume "unsorted" if compare-result is #f explicitly, or if it positive. - ;; HOWEVER, '#t itself is positive. So if we get #t, we assume sorted. - ;; there is possibly an ambiguity, if you happen to return a positive integer that - ;; happens to be a pointer to #t, - (when (and - (or (not compare-result) (> (the-as int compare-result) 0)) - (!= compare-result '#t) - ) - ;; remember we hit an unsorted sequence - (set! unsorted-count (+ unsorted-count 1)) - ;; swap! - (set! (car iter) second-elt) - (set! (car (cdr iter)) first-elt) + ;; the compare function can return a few possible things. + ;; we assume "unsorted" if compare-result is #f explicitly, or if it positive. + ;; HOWEVER, '#t itself is positive. So if we get #t, we assume sorted. + ;; there is possibly an ambiguity, if you happen to return a positive integer that + ;; happens to be a pointer to #t, + (let ((unsorted-count -1)) + ;; loop, until unsorted count goes to 0. + (while (nonzero? unsorted-count) + ;; search for unsorted things... + (set! unsorted-count 0) + (let ((iter lst)) + (while (not (or (null? (cdr iter)) (not (pair? (cdr iter))))) + (let* ((first-elt (car iter)) + (seoncd-elt (car (cdr iter))) + (compare-result (compare-func first-elt seoncd-elt)) + ) + ;; the compare function can return a few possible things. + ;; we assume "unsorted" if compare-result is #f explicitly, or if it positive. + ;; HOWEVER, '#t itself is positive. So if we get #t, we assume sorted. + ;; there is possibly an ambiguity, if you happen to return a positive integer that + ;; happens to be a pointer to #t, + (when (and + (or (not compare-result) (> (the-as int compare-result) 0)) + (!= compare-result #t) + ) + (+! unsorted-count 1) + (set! (car iter) seoncd-elt) + (set! (car (cdr iter)) first-elt) + ) + ) + (set! iter (cdr iter)) + ) ) - (set! iter (cdr iter)) ) ) lst ) +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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. @@ -718,6 +716,18 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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) (content-type type) (len int)) "Allocate a new array to hold len elements of type content-type. The content should either be a numeric type (child of number) @@ -745,251 +755,200 @@ (defmethod print array ((obj array)) "Print array." - (local-vars - (content-type-sym symbol) - (i int) - ) - (format '#t "#(") + (format #t "#(") (cond ((type-type? (-> obj content-type) integer) - ;; PRINT INTEGER ARRAY - (set! content-type-sym (-> obj content-type symbol)) - (cond - ((= content-type-sym 'int32) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array int32) obj) i)) - (set! i (+ i 1)) + (let ((content-type-sym (-> obj content-type symbol))) + (cond + ((= content-type-sym 'int32) + (dotimes (s5-0 (-> obj length)) + (format #t (if (zero? s5-0) "~D" " ~D") + (-> (the-as (array int32) obj) s5-0) + ) + ) ) - ) - ((= content-type-sym 'uint32) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array uint32) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint32) + (dotimes (s5-1 (-> obj length)) + (format #t (if (zero? s5-1) "~D" " ~D") + (-> (the-as (array uint32) obj) s5-1) + ) + ) ) - ) - ((= content-type-sym 'int64) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array int64) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'int64) + (dotimes (s5-2 (-> obj length)) + (format #t (if (zero? s5-2) "~D" " ~D") + (-> (the-as (array int64) obj) s5-2) + ) + ) ) - ) - ((= content-type-sym 'uint64) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "#x~X" " #x~X") (-> (the-as (array uint64) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint64) + (dotimes (s5-3 (-> obj length)) + (format #t (if (zero? s5-3) "#x~X" " #x~X") + (-> (the-as (array uint64) obj) s5-3) + ) + ) ) - ) - ((= content-type-sym 'int8) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array int8) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'int8) + (dotimes (s5-4 (-> obj length)) + (format #t (if (zero? s5-4) "~D" " ~D") + (-> (the-as (array int8) obj) s5-4) + ) + ) ) - ) - ((= content-type-sym 'uint8) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array uint8) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint8) + (dotimes (s5-5 (-> obj length)) + (format #t (if (zero? s5-5) "~D" " ~D") + (-> (the-as (array uint8) obj) s5-5) + ) + ) ) - ) - ((= content-type-sym 'int16) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array int16) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'int16) + (dotimes (s5-6 (-> obj length)) + (format #t (if (zero? s5-6) "~D" " ~D") + (-> (the-as (array int16) obj) s5-6) + ) + ) ) - ) - ((= content-type-sym 'uint16) - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array uint16) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint16) + (dotimes (s5-7 (-> obj length)) + (format #t (if (zero? s5-7) "~D" " ~D") + (-> (the-as (array uint16) obj) s5-7) + ) + ) ) - ) - (else - ;; unhandled integer case. - ;; note, decompiler failed to put v1-40 here. I think condition "raising" happens at the wrong time. - (cond - ((or (= content-type-sym 'uint128) (= content-type-sym 'int128)) - (set! i 0) - ;; REMOVED. GOAL never uses these type of array (and can't even print int128s) - ;; if we need/want it later we'll have to do something more creative - (while (< i (-> obj length)) - (format #t (if (zero? i) "?" " ?")) - ;;(set! t9-10 format) - ;;(set! a0-21 '#t) - ;;(set! a1-11 (if (zero? i) "#x~X" " #x~X")) - ;;(set! v1-42 (+ (shl i 4) (the-as int (the-as (array uint128) obj)))) - ;;(.lq a2-8 12 v1-42) - ;;(t9-10 a0-21 a1-11 a2-8) - (set! i (+ i 1)) + (else + (cond + ((or (= content-type-sym 'uint128) (= content-type-sym 'int128)) + (dotimes (s5-8 (-> obj length)) + (format #t (if (zero? s5-8) "#x~X" " #x~X") + (-> (the-as (array uint128) obj) s5-8) + ) + ) ) - ) - (else - ;; unknown integer. treat as int32 - (set! i 0) - (while (< i (-> obj length)) - (format '#t (if (zero? i) "~D" " ~D") (-> (the-as (array int32) obj) i)) - (set! i (+ i 1)) + (else + (dotimes (s5-9 (-> obj length)) + (format #t (if (zero? s5-9) "~D" " ~D") + (-> (the-as (array int32) obj) s5-9) + ) + ) ) - ) + ) ) - ) + ) ) ) (else - ;; Not an integer cases. (cond ((= (-> obj content-type) float) - (set! i 0) - (while (< i (-> obj length)) - (if (zero? i) - (format '#t "~f" (-> (the-as (array float) obj) i)) - (format '#t " ~f" (-> (the-as (array float) obj) i)) + (dotimes (s5-10 (-> obj length)) + (if (zero? s5-10) + (format #t "~f" (-> (the-as (array float) obj) s5-10)) + (format #t " ~f" (-> (the-as (array float) obj) s5-10)) ) - (set! i (+ i 1)) ) ) (else - ;; totally unknown, try printing as boxed. - (set! i 0) - (while (< i (-> obj length)) - (if (zero? i) - (format '#t "~A" (-> (the-as (array basic) obj) i)) - (format '#t " ~A" (-> (the-as (array basic) obj) i)) + (dotimes (s5-11 (-> obj length)) + (if (zero? s5-11) + (format #t "~A" (-> (the-as (array basic) obj) s5-11)) + (format #t " ~A" (-> (the-as (array basic) obj) s5-11)) ) - (set! i (+ i 1)) ) ) ) ) ) - (format '#t ")") + (format #t ")") obj ) ;; definition for method of type array (defmethod inspect array ((obj array)) "Inspect an array" - (local-vars - (content-type-sym symbol) - (i int) - ) - (format '#t "[~8x] ~A~%" obj (-> obj type)) - (format '#t "~Tallocated-length: ~D~%" (-> obj allocated-length)) - (format '#t "~Tlength: ~D~%" (-> obj length)) - (format '#t "~Tcontent-type: ~A~%" (-> obj content-type)) - (format '#t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Tlength: ~D~%" (-> obj length)) + (format #t "~Tcontent-type: ~A~%" (-> obj content-type)) + (format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data)) (cond ((type-type? (-> obj content-type) integer) - (set! content-type-sym (-> obj content-type symbol)) - (cond - ((= content-type-sym 'int32) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array int32) obj) i)) - (set! i (+ i 1)) + (let ((content-type-sym (-> obj content-type symbol))) + (cond + ((= content-type-sym 'int32) + (dotimes (s5-0 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0)) + ) ) - ) - ((= content-type-sym 'uint32) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array uint32) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint32) + (dotimes (s5-1 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) obj) s5-1)) + ) ) - ) - ((= content-type-sym 'int64) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array int64) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'int64) + (dotimes (s5-2 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) obj) s5-2)) + ) ) - ) - ((= content-type-sym 'uint64) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] #x~X~%" i (-> (the-as (array uint64) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint64) + (dotimes (s5-3 (-> obj length)) + (format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) obj) s5-3)) + ) ) - ) - ((= content-type-sym 'int8) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array int8) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'int8) + (dotimes (s5-4 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) obj) s5-4)) + ) ) - ) - ((= content-type-sym 'uint8) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array int8) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint8) + (dotimes (s5-5 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) obj) s5-5)) + ) ) - ) - ((= content-type-sym 'int16) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array int16) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'int16) + (dotimes (s5-6 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) obj) s5-6)) + ) ) - ) - ((= content-type-sym 'uint16) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the-as (array uint16) obj) i)) - (set! i (+ i 1)) + ((= content-type-sym 'uint16) + (dotimes (s5-7 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) obj) s5-7)) + ) ) - ) - (else - ;; again, decompiler created a temp for the or here. - (cond - ((or (= content-type-sym 'int128) (= content-type-sym 'uint128)) - ;; REMOVED: GOAL doesn't print int128's anyway. - (set! i 0) - (while (< i (-> obj length)) - ;;(set! t9-14 format) - ;;(set! a0-25 '#t) - ;;(set! a1-15 "~T [~D] #x~X~%") - (format #t "~T [~D] ??~%" i) - ;;(set! a2-13 i) - ;;(set! v1-42 (+ (shl i 4) (the-as int obj))) - ;;(.lq a3-10 12 v1-42) - ;;(t9-14 a0-25 a1-15 a2-13 a3-10) - (set! i (+ i 1)) + (else + (cond + ((or (= content-type-sym 'int128) (= content-type-sym 'uint128)) + (dotimes (s5-8 (-> obj length)) + (format + #t + "~T [~D] #x~X~%" + s5-8 + (-> (the-as (array uint128) obj) s5-8) + ) + ) ) - ) - (else - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~D~%" i (-> (the (array int32) obj) i)) - (set! i (+ i 1)) + (else + (dotimes (s5-9 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) obj) s5-9)) + ) ) - ) + ) ) - ) + ) ) ) (else - (cond ((= (-> obj content-type) float) - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~f~%" i (-> (the (array float) obj) i)) - (set! i (+ i 1)) - ) - ) - (else - (set! i 0) - (while (< i (-> obj length)) - (format '#t "~T [~D] ~A~%" i (-> (the (array basic) obj) i)) - (set! i (+ i 1)) - ) - ) - ) + (cond + ((= (-> obj content-type) float) + (dotimes (s5-10 (-> obj length)) + (format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) obj) s5-10)) + ) + ) + (else + (dotimes (s5-11 (-> obj length)) + (format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) obj) s5-11)) + ) + ) + ) ) ) obj @@ -1013,21 +972,21 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;; +;; memory manipulation +;;;;;;;;;;;;;;;;;;;;;;;; + (defun mem-copy! ((dst pointer) (src pointer) (size int)) "Memory copy. Not a very efficient optimization, but has no restrictions. Increasing address copy." - (local-vars (result pointer) (i int) (v1-1 symbol) (v1-2 symbol)) - (set! result dst) - (set! i 0) - (while (< i size) - ;; copy - (set! (-> (the-as (pointer uint8) dst)) (-> (the-as (pointer uint8) src))) - ;; increment pointers and count - (set! dst (&+ dst (the-as uint 1))) - (set! src (&+ src (the-as uint 1))) - (set! i (+ i 1)) + (let ((result dst)) + (dotimes (i size) + (set! (-> (the-as (pointer uint8) dst)) (-> (the-as (pointer uint8) src))) + (&+! dst 1) + (&+! src 1) + ) + result ) - result ) (defun qmem-copy<-! ((dst pointer) (src pointer) (size int)) @@ -1035,21 +994,17 @@ - dst and src should be 16-byte aligned. - size in bytes will be rounded up to 16-bytes - Ascending address copy." - (local-vars (result pointer) (qwc int)) - (set! result dst) - - ;; round up to nearest quadword count. - (set! qwc (sar (+ size 15) 4)) - (while (nonzero? qwc) - (set! qwc (+ qwc -1)) - ;; Use 128-bit OpenGOAL integers to do copy by quadword. - (set! (-> (the (pointer uint128) dst)) - (-> (the (pointer uint128) src))) - - (set! dst (&+ dst 16)) - (set! src (&+ src 16)) + (let ((result dst)) + (countdown (qwc (/ (+ size 15) 16)) + (set! + (-> (the-as (pointer uint128) dst)) + (-> (the-as (pointer uint128) src)) + ) + (&+! dst 16) + (&+! src 16) + ) + result ) - result ) (defun qmem-copy->! ((dst pointer) (src pointer) (size int)) @@ -1057,61 +1012,56 @@ - dst and src should be 16-byte aligned. - size in bytes will be rounding up to nearest 16-bytes - Descending address copy" - (local-vars - (result pointer) - (qwc int) - (src-ptr pointer) - (dst-ptr pointer) - ) - - (set! result dst) - (set! qwc (sar (+ size 15) 4)) - ;; start at the end - (set! dst-ptr (&+ dst (the-as uint (shl qwc 4)))) - (set! src-ptr (&+ src (the-as uint (shl qwc 4)))) - (while (nonzero? qwc) - (set! qwc (+ qwc -1)) - (set! src-ptr (&+ src-ptr (the-as uint -16))) - (set! dst-ptr (&+ dst-ptr (the-as uint -16))) - - (set! (-> (the (pointer uint128) dst-ptr)) - (-> (the (pointer uint128) src-ptr))) + (let ((result dst)) + (let* ((qwc (/ (+ size 15) 16)) + (dst-ptr (&+ dst (* qwc 16))) + (src-ptr (&+ src (* qwc 16))) + ) + (while (nonzero? qwc) + (+! qwc -1) + (&+! dst-ptr -16) + (&+! src-ptr -16) + (set! + (-> (the-as (pointer uint128) dst-ptr)) + (-> (the-as (pointer uint128) src-ptr)) + ) + ) + ) + result ) - result ) (defun mem-set32! ((dst pointer) (size int) (value int)) "Normal memset, but by 32-bit word. NOTE: argument order is swapped from C" - (local-vars (result pointer) (i int)) - (set! result dst) - (set! i 0) - (while (< i size) - (set! (-> (the-as (pointer int32) dst)) value) - (set! dst (&+ dst 4)) - (nop!) - (set! i (+ i 1)) + (let ((result dst)) + (dotimes (i size) + (set! (-> (the-as (pointer int32) dst)) value) + (&+! dst 4) + (nop!) + ) + result ) - result ) (defun mem-or! ((dst pointer) (src pointer) (size int)) "Set the dst to (logior dst src) byte by byte. Not very efficient." - (local-vars (result pointer) (i int) (v1-1 symbol) (v1-2 symbol)) - (set! result dst) - (set! i 0) - (while (< i size) - (set! (-> (the-as (pointer uint8) dst)) - (logior (-> (the-as (pointer uint8) dst)) - (-> (the-as (pointer uint8) src))) - ) - (set! dst (&+ dst 1)) - (set! src (&+ src 1)) - (set! i (+ i 1)) + (let ((result dst)) + (dotimes (i size) + (set! + (-> (the-as (pointer uint8) dst)) + (logior + (-> (the-as (pointer uint8) dst)) + (-> (the-as (pointer uint8) src)) + ) + ) + (&+! dst 1) + (&+! src 1) + ) + result ) - result ) @@ -1121,56 +1071,55 @@ 0 ) -;; we need to forward declare recursive functions so the compiler -;; know their return type. -(define-extern fact (function int int)) -(defun fact ((x int)) +(defun-recursive fact int ((x int)) (if (= x 1) 1 (* x (fact (+ x -1)))) ) -;; Print utilities. +;;;;;;;;;;;;;;;;;;;;;;;; +;; printing +;;;;;;;;;;;;;;;;;;;;;;;; + +;; the column that will be printed to by format. (define *print-column* (the binteger 0)) -(defun print ((obj object)) +(defun print ((arg0 object)) "Print out any boxed object. Does NOT insert a newline." - (let ((print-method (-> (rtype-of obj) method-table PRINT_METHOD_ID))) - ((the (function object object) print-method) obj) - ) + ((method-of-type (rtype-of arg0) print) arg0) ) -(defun printl ((obj object)) +(defun printl ((arg0 object)) "Print out any boxed object and a newline at the end." - (let ((print-method (-> (rtype-of obj) method-table PRINT_METHOD_ID))) - ((the (function object object) print-method) obj) - (format #t "~%") - obj) + (let ((a0-1 arg0)) + ((method-of-type (rtype-of a0-1) print) a0-1) + ) + (format #t "~%") + arg0 ) -(defun inspect ((obj object)) +(defun inspect ((arg0 object)) "Inspect any boxed object." - (let ((inspect-method (-> (rtype-of obj) method-table INSPECT_METHOD_ID))) - ((the (function object object) inspect-method) obj) - ) + ((method-of-type (rtype-of arg0) inspect) arg0) ) +;;;;;;;;;;;;;;;;;;;;; +;; debug utils +;;;;;;;;;;;;;;;;;;;;; + (defun-debug mem-print ((data (pointer uint32)) (word-count int)) "Print memory to runtime stdout by quadword. Input count is in 32-bit words" - (local-vars (current-qword int)) - (set! current-qword 0) - (while (< current-qword (sar word-count 2)) + (dotimes (current-qword (/ word-count 4)) (format 0 "~X: ~X ~X ~X ~X~%" - (+ (+ (shl (shl current-qword 2) 2) 0) (the-as int data)) - (-> data (shl current-qword 2)) - (-> data (+ (shl current-qword 2) 1)) - (-> data (+ (shl current-qword 2) 2)) - (-> data (+ (shl current-qword 2) 3)) + (&-> data (* current-qword 4)) + (-> data (* current-qword 4)) + (-> data (+ (* current-qword 4) 1)) + (-> data (+ (* current-qword 4) 2)) + (-> data (+ (* current-qword 4) 3)) ) - (set! current-qword (+ current-qword 1)) ) - '#f + #f ) ;; not sure what this is. @@ -1178,25 +1127,26 @@ (defun print-tree-bitmask ((bits int) (count int)) "Print out a single entry for a process tree 'tree' diagram" - (local-vars (i int)) - (set! i 0) - (while (< i count) + (dotimes (i count) (if (zero? (logand bits 1)) - (format '#t " ") - (format '#t "| ") + (format #t " ") + (format #t "| ") ) (set! bits (shr bits 1)) - (set! i (+ i 1)) ) - '#f + #f ) (defun breakpoint-range-set! ((a0 uint) (a1 uint) (a2 uint)) - "Sets some debug register (COP0 Debug, dab, dabm)" + "Sets some debug register (COP0 Debug, dab, dabm) to break on memory access. + This is not supported in OpenGOAL." (format 0 "breakpoint-range-set! not supported in OpenGOAL~%") 0 ) +;;;;;;;;;;;;;;;;;;;;;;; +;; valid +;;;;;;;;;;;;;;;;;;;;;;; ;; these are not quite right, but it's close enough. (defmacro start-of-symbol-table () @@ -1237,6 +1187,7 @@ ) ;; first, check if we are even in valid memory. This is the start of the symbol table to the end of RAM. + ;; (note, this will fail stuff like the debug and global heap info objects, which aren't in GOAL heaps.) (set! in-goal-mem (and (>= (the-as uint obj) (start-of-symbol-table)) (< (the-as uint obj) END_OF_MEMORY) ) @@ -1266,7 +1217,7 @@ ((and allow-false (not obj)) ;; we got a false, but its allowed! ;; note that we don't reject falses otherwise, as false is a perfectly valid symbol. - '#t) + #t) (else (cond ((= expected-type structure) @@ -1401,6 +1352,9 @@ ) +;;;;;;;;;;;;;;;;;;;;;;; +;; 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 @@ -1411,22 +1365,3 @@ ;; Copies the contents of a gpr to a cop0 (system control) register (fake-asm .mtc0 dest src) ) - - -(defmacro make-u128 (upper lower) - "Make a i128 from two 64-bit values." - `(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-as uint result) - ) - ) - -(defmacro as-type (obj type) - `(if (and (nonzero? ,obj) (type-type? (-> ,obj type) ,type)) - (the-as ,type ,obj) - ) - ) diff --git a/goal_src/kernel/gkernel.gc b/goal_src/kernel/gkernel.gc index 49abb161eb..74cd3550af 100644 --- a/goal_src/kernel/gkernel.gc +++ b/goal_src/kernel/gkernel.gc @@ -98,7 +98,7 @@ ;; all user code (that I know of) runs using *dram-stack* (define *dram-stack* (new 'global 'array 'uint8 DPROCESS_STACK_SIZE)) ;; note - this name is a bit confusing. The kernel-dram-stack is not the stack that the kernel runs in. -;; I think it refers to the fact that it's _not_ the scratchpad stack (which wasn't used anyway) +;; I think it refers to the fact that it's _not_ the scratchpad stack (defconstant *kernel-dram-stack* (&+ *dram-stack* DPROCESS_STACK_SIZE)) ;; I don't think this stack is used, but I'm not sure. diff --git a/goal_src/kernel/gstring.gc b/goal_src/kernel/gstring.gc index 13ecdfa001..55d3410327 100644 --- a/goal_src/kernel/gstring.gc +++ b/goal_src/kernel/gstring.gc @@ -5,11 +5,20 @@ ;; name in dgo: gstring ;; dgos: KERNEL -;; Note on strings: -;; the allocated length does not include an extra byte on the end for the null terminator! + +;; The GOAL string type is like a C string plus a length field. +;; The number of bytes stored is the length + 1 for the null terminator. +;; Note that string is a bit of a special type, and the compiler assumes there is no +;; child type of string ever created. + + + +;;;;;;;;;;;;;;;;;;;;;;;;; +;; String methods +;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod length string ((obj string)) - ; Get the length of a string. Like strlen + "Get the length of a string. Like strlen" (let ((str-ptr (-> obj data))) (while (!= 0 (-> str-ptr 0)) (set! str-ptr (the (pointer uint8) (&+ str-ptr 1))) @@ -19,9 +28,7 @@ ) (defmethod asize-of string ((obj string)) - ;; get the size in bytes of a string. - ;; BUG - string should probably be (-> obj type), not that it matters, I don't think - ;; anybody makes a subclass of string. + "get the size in bytes of a string." (+ (-> obj allocated-length) 1 (-> string size)) ) @@ -60,39 +67,43 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;;; +;; String comparison +;;;;;;;;;;;;;;;;;;;;;;;;; + (defun string= ((str-a string) (str-b string)) "Does str-a hold the same data as str-b?. If either string is null, returns #f." - (local-vars (b-ptr (pointer uint8)) (a-ptr (pointer uint8))) - (set! a-ptr (-> str-a data)) - (set! b-ptr (-> str-b data)) - (if (or (zero? str-a) (zero? str-b)) - (return '#f) - ) - ;; loop until we reach the end of one string - (while (and (nonzero? (-> a-ptr 0)) (nonzero? (-> b-ptr 0))) - (if (!= (-> a-ptr 0) (-> b-ptr 0)) - (return '#f) + (let ((a-ptr (-> str-a data)) + (b-ptr (-> str-b data)) ) - (set! a-ptr (&-> a-ptr 1)) - (set! b-ptr (&-> b-ptr 1)) - ) - ;; only equal if both at the end. - (and (zero? (-> a-ptr 0)) (zero? (-> b-ptr 0))) + (if (or (zero? str-a) (zero? str-b)) + (return #f) + ) + (while (and (nonzero? (-> a-ptr 0)) (nonzero? (-> b-ptr 0))) + (if (!= (-> a-ptr 0) (-> b-ptr 0)) + (return #f) + ) + (set! a-ptr (&-> a-ptr 1)) + (set! b-ptr (&-> b-ptr 1)) + ) + ;; only equal if both end here. + (and (zero? (-> a-ptr 0)) (zero? (-> b-ptr 0))) + ) ) (defun string-charp= ((str string) (charp (pointer uint8))) "Is the data in str equal to the C string charp?" - (local-vars (str-ptr (pointer uint8))) - (set! str-ptr (-> str data)) - (while (and (nonzero? (-> str-ptr 0)) (nonzero? (-> charp 0))) - (if (!= (-> str-ptr 0) (-> charp 0)) - (return '#f) - ) - (set! str-ptr (&-> str-ptr 1)) - (set! charp (&-> charp 1)) - ) - (and (zero? (-> str-ptr 0)) (zero? (-> charp 0))) + (let ((str-ptr (-> str data))) + (while (and (nonzero? (-> str-ptr 0)) (nonzero? (-> charp 0))) + (if (!= (-> str-ptr 0) (-> charp 0)) + (return #f) + ) + (set! str-ptr (&-> str-ptr 1)) + (set! charp (&-> charp 1)) + ) + (and (zero? (-> str-ptr 0)) (zero? (-> charp 0))) + ) ) (defun name= ((arg0 basic) (arg1 basic)) @@ -100,8 +111,8 @@ This can use either strings or symbols" (cond ((= arg0 arg1) - "Either same symbols, or same string objects, fast check pass!" - '#t) + ;; Either same symbols, or same string objects, fast check pass! + #t) ((and (= (-> arg0 type) string) (= (-> arg1 type) string)) (string= (the-as string arg0) (the-as string arg1)) ) @@ -111,35 +122,38 @@ ((and (= (-> arg1 type) string) (= (-> arg0 type) symbol)) (string= (the-as string arg1) (symbol->string arg0)) ) + ;; no need to check symbol - symbol, that would have passed the first check. ) ) +;;;;;;;;;;;;;;;;;;;;;;;;; +;; String copying +;;;;;;;;;;;;;;;;;;;;;;;;; + (defun copyn-string<-charp ((str string) (charp (pointer uint8)) (len int)) "Copy data from a charp to a GOAL string. Copies len chars, plus a null." - (local-vars (str-ptr (pointer uint8)) (i int)) - (set! str-ptr (-> str data)) - (set! i 0) - (while (< i len) - (set! (-> str-ptr 0) (-> charp 0)) - (set! str-ptr (&-> str-ptr 1)) - (set! charp (&-> charp 1)) - (set! i (+ i 1)) + (let ((str-ptr (-> str data))) + (dotimes (i len) + (set! (-> str-ptr 0) (-> charp 0)) + (set! str-ptr (&-> str-ptr 1)) + (set! charp (&-> charp 1)) + ) + (set! (-> str-ptr 0) (the-as uint 0)) ) - (set! (-> str-ptr 0) 0) str ) (defun string<-charp ((str string) (charp (pointer uint8))) "Copy all chars from a char* to a GOAL string. Does NO length checking." - (local-vars (str-ptr (pointer uint8))) - (set! str-ptr (-> str data)) - (while (nonzero? (-> charp 0)) - (set! (-> str-ptr 0) (-> charp 0)) - (set! str-ptr (&-> str-ptr 1)) - (set! charp (&-> charp 1)) + (let ((str-ptr (-> str data))) + (while (nonzero? (-> charp 0)) + (set! (-> str-ptr 0) (-> charp 0)) + (set! str-ptr (&-> str-ptr 1)) + (set! charp (&-> charp 1)) + ) + (set! (-> str-ptr 0) (the-as uint 0)) ) - (set! (-> str-ptr 0) 0) str ) @@ -169,47 +183,38 @@ (defun cat-string<-string ((a string) (b string)) "Append b to a. No length checks" - (local-vars (a-ptr (pointer uint8)) (b-ptr (pointer uint8))) - (set! a-ptr (-> a data)) - (set! b-ptr (-> b data)) - ;; seek to the end of a - (while (nonzero? (-> a-ptr 0)) - (nop!) - (nop!) - (nop!) - (set! a-ptr (&-> a-ptr 1)) + (let ((a-ptr (-> a data))) + (let ((b-ptr (-> b data))) + (while (nonzero? (-> a-ptr 0)) + (nop!) + (nop!) + (nop!) + (set! a-ptr (&-> a-ptr 1)) + ) + (while (nonzero? (-> b-ptr 0)) + (set! (-> a-ptr 0) (-> b-ptr 0)) + (set! a-ptr (&-> a-ptr 1)) + (set! b-ptr (&-> b-ptr 1)) + ) + ) + (set! (-> a-ptr 0) (the-as uint 0)) ) - ;; append b - (while (nonzero? (-> b-ptr 0)) - (set! (-> a-ptr 0) (-> b-ptr 0)) - (set! a-ptr (&-> a-ptr 1)) - (set! b-ptr (&-> b-ptr 1)) - ) - ;; null terminate - (set! (-> a-ptr 0) 0) a ) (defun catn-string<-charp ((a string) (b (pointer uint8)) (len int)) "Append b to a, exactly len chars" - (local-vars (a-ptr (pointer uint8)) (i int) ) - (set! a-ptr (-> a data)) - ;; seek to end of a - (while (nonzero? (-> a-ptr 0)) - (nop!) - (nop!) - (nop!) - (set! a-ptr (&-> a-ptr 1)) + (let ((a-ptr (-> a data))) + (while (nonzero? (-> a-ptr 0)) + (set! a-ptr (&-> a-ptr 1)) + ) + (dotimes (i len) + (set! (-> a-ptr 0) (-> b 0)) + (set! a-ptr (&-> a-ptr 1)) + (set! b (&-> b 1)) + ) + (set! (-> a-ptr 0) (the-as uint 0)) ) - ;; append - (set! i 0) - (while (< i len) - (set! (-> a-ptr 0) (-> b 0)) - (set! a-ptr (&-> a-ptr 1)) - (set! b (&-> b 1)) - (set! i (+ i 1)) - ) - (set! (-> a-ptr 0) 0) a ) @@ -254,6 +259,10 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;;; +;; String utilities +;;;;;;;;;;;;;;;;;;;;;;;;; + (defun charp-basename ((charp (pointer uint8))) "Like basename in C" (let ((ptr charp)) @@ -282,6 +291,10 @@ ) +;;;;;;;;;;;;;;;;;;;;;;;;; +;; String ordering +;;;;;;;;;;;;;;;;;;;;;;;;; + ;; NOTE: these string comparisons are a little broken. ;; ex: (string a data i) (-> b data i)) + (return #t) + ) + ((< (-> b data i) (-> a data i)) + (return #f) + ) ) - - ;; loop through chars, up until the minimum length. - (set! i 0) - (while (< i len) - (cond - ((< (-> a data i) (-> b data i)) (return '#t)) - ((< (-> b data i) (-> a data i)) (return '#f)) + ) ) - (set! i (+ i 1)) - ) - '#f + #f ) (defun string>? ((a string) (b string)) "In dictionary order, is a > b?" - (local-vars (i int) (len int)) - (set! len (min ((method-of-type string length) a) - ((method-of-type string length) b)) + (let ((len (min (length a) (length b)))) + (dotimes (i len) + (cond + ((< (-> a data i) (-> b data i)) + (return #f) + ) + ((< (-> b data i) (-> a data i)) + (return #t) + ) ) - (set! i 0) - (while (< i len) - (cond - ((< (-> a data i) (-> b data i)) (return '#f)) - ((< (-> b data i) (-> a data i)) (return '#t)) ) - (set! i (+ i 1)) ) - '#f + #f ) (defun string<=? ((a string) (b string)) - (local-vars (i int) (len int)) - (set! len (min ((method-of-type string length) a) - ((method-of-type string length) b)) - ) - (set! i 0) - (while - (< i len) - (cond - ((< (-> a data i) (-> b data i)) (return '#t)) - ((< (-> b data i) (-> a data i)) (return '#f)) + (let ((len (min (length a) (length b)))) + (dotimes (i len) + (cond + ((< (-> a data i) (-> b data i)) + (return #t) + ) + ((< (-> b data i) (-> a data i)) + (return #f) + ) + ) + ) ) - (set! i (+ i 1)) - ) - '#t + #t ) (defun string>=? ((a string) (b string)) - (local-vars (i int) (len int)) - (set! len (min ((method-of-type string length) a) - ((method-of-type string length) b)) + (let ((len (min (length a) (length b)))) + (dotimes (i len) + (cond + ((< (-> a data i) (-> b data i)) + (return #f) + ) + ((< (-> b data i) (-> a data i)) + (return #t) + ) ) - (set! i 0) - (while (< i len) - (cond - ((< (-> a data i) (-> b data i)) (return '#f)) - ((< (-> b data i) (-> a data i)) (return '#t)) ) - (set! i (+ i 1)) ) - '#t + #t ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; String argument parsing +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; temporary string for argument functions (define *string-tmp-str* (new 'global 'string 128 (the string #f))) @@ -480,63 +490,56 @@ 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." - (local-vars - (arg-start (pointer uint8)) - (v1-11 (pointer uint8)) - (a0-6 symbol) - (a0-20 symbol) - (a1-3 (pointer uint8)) - (a1-9 (pointer uint8)) - (arg-word-start (pointer uint8)) - (arg-end (pointer uint8)) - ) - ;; seek up the beginning of a word. - (set! arg-word-start (string-skip-whitespace (-> arg data))) - (cond - ((= (-> arg-word-start 0) 34) ;; starts with quote - ;; seek past quote to first char of name - (set! arg-end (&-> arg-word-start 1)) - ;; now, find the end - (set! arg-start arg-end) - (while (and (nonzero? (-> arg-end 0)) - ;; (nonzero? (+ (-> arg-end 0) -34)) - (!= (-> arg-end 0) 34) ;; quote + + ;; seek to first arg + (let ((arg-word-start (string-skip-whitespace (-> arg data)))) + (cond + ((= (-> arg-word-start 0) 34) ;; starts with quote + ;; seek past quote + (let ((arg-end (&-> arg-word-start 1))) + ;; now find end + (let ((arg-start arg-end)) + (while (and (nonzero? (-> arg-end 0)) (!= (-> arg-end 0) 34)) ;; close quote + (set! arg-end (&-> arg-end 1)) + ) + ;; copy to output + (copyn-string<-charp a-str arg-start (&- arg-end (the-as uint arg-start))) + ) + + ;; if we got a close quote, seek past it. + (if (= (-> arg-end 0) 34) + (set! arg-end (&-> arg-end 1)) + ) + + ;; kill leading white space + (let ((a1-3 (string-skip-whitespace arg-end))) + (string-suck-up! arg a1-3) + ) + ) + (return #t) + ) + ((nonzero? (-> arg-word-start 0)) + (let ((v1-11 arg-word-start)) + ;; find end + (while (and + (nonzero? (-> arg-word-start 0)) + (!= (-> arg-word-start 0) 32) + (!= (-> arg-word-start 0) 9) + (!= (-> arg-word-start 0) 13) + (!= (-> arg-word-start 0) 10) ) - (set! arg-end (&-> arg-end 1)) + (set! arg-word-start (&-> arg-word-start 1)) + ) + (copyn-string<-charp a-str v1-11 (&- arg-word-start (the-as uint v1-11))) + ) + (let ((a1-9 (string-skip-whitespace arg-word-start))) + (string-suck-up! arg a1-9) + ) + (return #t) ) - - ;; copy to output. - (copyn-string<-charp a-str arg-start (- (the-as int arg-end) (the-as uint arg-start))) - - ;; if we got a close quote - (when (= (-> arg-end 0) 34) - ;; seek past it - (set! arg-end (&-> arg-end 1)) - ) - (set! a1-3 (string-skip-whitespace arg-end)) - (string-suck-up! arg a1-3) - (return '#t) - ) - ((nonzero? (-> arg-word-start 0)) - - (set! v1-11 arg-word-start) - (while - (and - (nonzero? (-> arg-word-start 0)) - (nonzero? (+ (-> arg-word-start 0) -32)) - (nonzero? (+ (-> arg-word-start 0) -9)) - (nonzero? (+ (-> arg-word-start 0) -13)) - (nonzero? (+ (-> arg-word-start 0) -10)) - ) - (set! arg-word-start (&-> arg-word-start 1)) - ) - (copyn-string<-charp a-str v1-11 (- (the-as int arg-word-start) (the-as uint v1-11))) - (set! a1-9 (string-skip-whitespace arg-word-start)) - (string-suck-up! arg a1-9) - (return '#t) - ) + ) ) - '#f + #f ) (defun string->int ((str string)) diff --git a/goalc/compiler/Compiler.h b/goalc/compiler/Compiler.h index 16069bf2be..fed49a3f09 100644 --- a/goalc/compiler/Compiler.h +++ b/goalc/compiler/Compiler.h @@ -285,7 +285,12 @@ class Compiler { StructureType* type); Val* generate_inspector_for_bitfield_type(const goos::Object& form, Env* env, BitFieldType* type); RegVal* compile_get_method_of_type(const goos::Object& form, - const TypeSpec& type, + const TypeSpec& compile_time_type, + RegVal* type_object, + const std::string& method_name, + Env* env); + RegVal* compile_get_method_of_type(const goos::Object& form, + const TypeSpec& compile_time_type, const std::string& method_name, Env* env); RegVal* compile_get_method_of_object(const goos::Object& form, diff --git a/goalc/compiler/compilation/Type.cpp b/goalc/compiler/compilation/Type.cpp index 93b49e65a9..aaf0ef931f 100644 --- a/goalc/compiler/compilation/Type.cpp +++ b/goalc/compiler/compilation/Type.cpp @@ -17,25 +17,28 @@ int get_offset_of_method(int id) { } // namespace /*! - * Given a type and method name (known at compile time), get the method. - * This can be used for method calls where the type is unknown at run time (non-virtual method call) + * Given a type and method name (known at compile time), get the method, from the given type object. + * To do method lookup, the given type must be the same as, or a child of, the given compile time + * type. */ -RegVal* Compiler::compile_get_method_of_type(const goos::Object& form, - const TypeSpec& type, +RegVal* Compiler::compile_get_method_of_type(const goos::Object& /*form*/, + const TypeSpec& compile_time_type, + RegVal* type, const std::string& method_name, Env* env) { - auto info = m_ts.lookup_method(type.base_type(), method_name); - info.type = info.type.substitute_for_method_call(type.base_type()); + auto info = m_ts.lookup_method(compile_time_type.base_type(), method_name); + info.type = info.type.substitute_for_method_call(compile_time_type.base_type()); auto offset_of_method = get_offset_of_method(info.id); + assert(type->type() == TypeSpec("type")); auto fe = get_parent_env_of_type(env); - auto typ = compile_get_symbol_value(form, type.base_type(), env)->to_gpr(env); + MemLoadInfo load_info; load_info.sign_extend = false; load_info.size = POINTER_SIZE; auto loc_type = m_ts.make_pointer_typespec(info.type); - auto loc = fe->alloc_val(loc_type, typ, offset_of_method); + auto loc = fe->alloc_val(loc_type, type, offset_of_method); auto di = m_ts.get_deref_info(loc_type); assert(di.can_deref); assert(di.mem_deref); @@ -46,6 +49,19 @@ RegVal* Compiler::compile_get_method_of_type(const goos::Object& form, return deref->to_reg(env); } +/*! + * Look up a method from the type, with the type specified at compile time. + * This can be used for method calls where the type can't be found at run time, but is known at + * compile time. (non-virtual method call) + */ +RegVal* Compiler::compile_get_method_of_type(const goos::Object& form, + const TypeSpec& compile_time_type, + const std::string& method_name, + Env* env) { + auto typ = compile_get_symbol_value(form, compile_time_type.base_type(), env)->to_gpr(env); + return compile_get_method_of_type(form, compile_time_type, typ, method_name, env); +} + /*! * Given an object, get a method. If at compile time we know it's a basic, we use its runtime * type to look up the method at runtime (virtual call). If we don't know it's a basic, we get the @@ -1091,6 +1107,8 @@ Val* Compiler::compile_method_of_type(const goos::Object& form, auto arg = args.unnamed.at(0); auto method_name = symbol_string(args.unnamed.at(1)); + // in order to do proper method lookup, we peek at the symbol that the user provided and see if + // its a type name if (arg.is_symbol()) { if (m_ts.fully_defined_type_exists(symbol_string(arg))) { return compile_get_method_of_type(form, m_ts.make_typespec(symbol_string(arg)), method_name, @@ -1101,6 +1119,15 @@ Val* Compiler::compile_method_of_type(const goos::Object& form, } } + // if the user didn't provide a symbol, but instead some expression that gives us a type, then use + // that, and do method lookup as if it was a plain object. + // this will let you do (method-of-type inspect) and get the inspect + // method, with the proper type, from the given type's method table. + auto user_type = compile_error_guard(arg, env)->to_gpr(env); + if (user_type->type() == TypeSpec("type")) { + return compile_get_method_of_type(form, TypeSpec("object"), user_type, method_name, env); + } + throw_compiler_error(form, "Cannot get method of type {}: the type is invalid", arg.print()); return get_none(); } diff --git a/test/decompiler/reference/engine/collide/collide-touch-h_REF.gc b/test/decompiler/reference/engine/collide/collide-touch-h_REF.gc index 1a2593bed1..bcdd28957c 100644 --- a/test/decompiler/reference/engine/collide/collide-touch-h_REF.gc +++ b/test/decompiler/reference/engine/collide/collide-touch-h_REF.gc @@ -84,16 +84,13 @@ (let ((prev (the-as touching-prims-entry #f))) (let ((current (the-as touching-prims-entry (-> obj nodes)))) (set! (-> obj head) current) - (let ((a0-1 64)) - (while (nonzero? a0-1) - (+! a0-1 -1) - (set! (-> current prev) prev) - (let ((next (&+ current 240))) - (set! (-> current next) (the-as touching-prims-entry next)) - (set! (-> current allocated?) #f) - (set! prev current) - (set! current (the-as touching-prims-entry next)) - ) + (countdown (a0-1 64) + (set! (-> current prev) prev) + (let ((next (&+ current 240))) + (set! (-> current next) (the-as touching-prims-entry next)) + (set! (-> current allocated?) #f) + (set! prev current) + (set! current (the-as touching-prims-entry next)) ) ) ) diff --git a/test/decompiler/reference/engine/entity/entity-h_REF.gc b/test/decompiler/reference/engine/entity/entity-h_REF.gc index 7f5cf4f99c..d0b3bbcaf6 100644 --- a/test/decompiler/reference/engine/entity/entity-h_REF.gc +++ b/test/decompiler/reference/engine/entity/entity-h_REF.gc @@ -276,7 +276,7 @@ ;; failed to figure out what this is: (if (zero? entity-nav-login) - (set! entity-nav-login nothing) + (set! entity-nav-login (the-as (function basic none) nothing)) ) ;; definition of type actor-bank diff --git a/test/decompiler/reference/engine/entity/entity-table_REF.gc b/test/decompiler/reference/engine/entity/entity-table_REF.gc new file mode 100644 index 0000000000..c2a02f75e7 --- /dev/null +++ b/test/decompiler/reference/engine/entity/entity-table_REF.gc @@ -0,0 +1,185 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for symbol *entity-info*, type (array entity-info) +(define + *entity-info* + (the-as (array entity-info) + (new + 'static + 'boxed-array + :type entity-info :length 19 :allocated-length 19 + (new 'static 'entity-info + :ptype + (type-ref sage-finalboss :method-count 53) + :package "l1" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x8000 + ) + (new 'static 'entity-info + :ptype (type-ref robotboss :method-count 21) + :package "l1" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x8000 + ) + (new 'static 'entity-info + :ptype + (type-ref assistant-levitator :method-count 53) + :package "l1" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x8000 + ) + (new 'static 'entity-info + :ptype (type-ref babak :method-count 76) + :package "l1" + :art-group '("babak") + :pool '*16k-dead-pool* + :heap-size #x2800 + ) + (new 'static 'entity-info + :ptype (type-ref racer :method-count 24) + :package "game" + :art-group '("racer") + :pool '*16k-dead-pool* + :heap-size #x4000 + ) + (new 'static 'entity-info + :ptype (type-ref springbox :method-count 20) + :package "game" + :art-group '("bounceytarp") + :pool '*16k-dead-pool* + :heap-size #x1400 + ) + (new 'static 'entity-info + :ptype (type-ref launcher :method-count 20) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x400 + ) + (new 'static 'entity-info + :ptype + (type-ref pickup-spawner :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype (type-ref bucket :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype (type-ref barrel :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype (type-ref crate :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype + (type-ref orb-cache-top :method-count 29) + :package "game" + :art-group '("orb-cache-top") + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref eco :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref ecovent :method-count 21) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref fuel-cell :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1400 + ) + (new 'static 'entity-info + :ptype (type-ref buzzer :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x1000 + ) + (new 'static 'entity-info + :ptype (type-ref money :method-count 31) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x800 + ) + (new 'static 'entity-info + :ptype (type-ref water-vol :method-count 30) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #xc00 + ) + (new 'static 'entity-info + :ptype + (type-ref target-start :method-count 15) + :package "game" + :art-group '() + :pool '*16k-dead-pool* + :heap-size #x400 + ) + ) + ) + ) + +;; definition for function entity-info-lookup +;; INFO: Return type mismatch basic vs entity-info. +(defun entity-info-lookup ((arg0 type)) + (the-as entity-info (cond + ((nonzero? (-> arg0 method-table 13)) + (-> arg0 method-table 13) + ) + (else + (let ((v1-1 *entity-info*)) + (dotimes (a1-0 (-> v1-1 length)) + (if (= arg0 (-> v1-1 a1-0 ptype)) + (return (begin + (set! + (-> arg0 method-table 13) + (the-as function (-> v1-1 a1-0)) + ) + (-> v1-1 a1-0) + ) + ) + ) + ) + ) + (set! (-> arg0 method-table 13) #f) + #f + ) + ) + ) + ) + + + + diff --git a/test/decompiler/reference/engine/geometry/vol-h_REF.gc b/test/decompiler/reference/engine/geometry/vol-h_REF.gc index 1dcb91648d..c17d34e827 100644 --- a/test/decompiler/reference/engine/geometry/vol-h_REF.gc +++ b/test/decompiler/reference/engine/geometry/vol-h_REF.gc @@ -115,11 +115,11 @@ ) (when (>= s4-0 0) (let ((s3-0 s4-0) - (s2-0 (-> (-> (the-as res-lump s5-1) tag) s4-0)) + (s2-0 (-> (the-as res-lump s5-1) tag s4-0)) ) (let ((v1-10 0)) ) - (while (= (-> s2-0 name) (-> (-> (the-as res-lump s5-1) tag) s4-0 name)) + (while (= (-> s2-0 name) (-> (the-as res-lump s5-1) tag s4-0 name)) (let ((v1-12 (make-property-data @@ -145,7 +145,7 @@ (+ (-> (the-as vol-control gp-0) pos-vol-count) 1) ) (+! s3-0 1) - (set! s2-0 (-> (-> (the-as res-lump s5-1) tag) s3-0)) + (set! s2-0 (-> (the-as res-lump s5-1) tag s3-0)) ) ) ) @@ -165,11 +165,11 @@ ) (when (>= s4-1 0) (let ((s3-1 s4-1) - (s2-1 (-> (-> (the-as res-lump s5-2) tag) s4-1)) + (s2-1 (-> (the-as res-lump s5-2) tag s4-1)) ) (let ((v1-29 0)) ) - (while (= (-> s2-1 name) (-> (-> (the-as res-lump s5-2) tag) s4-1 name)) + (while (= (-> s2-1 name) (-> (the-as res-lump s5-2) tag s4-1 name)) (let ((v1-31 (make-property-data @@ -195,7 +195,7 @@ (+ (-> (the-as vol-control gp-0) neg-vol-count) 1) ) (+! s3-1 1) - (set! s2-1 (-> (-> (the-as res-lump s5-2) tag) s3-1)) + (set! s2-1 (-> (the-as res-lump s5-2) tag s3-1)) ) ) ) diff --git a/test/decompiler/reference/engine/gfx/ripple_REF.gc b/test/decompiler/reference/engine/gfx/ripple_REF.gc index 61302f8f4e..f2c765633a 100644 --- a/test/decompiler/reference/engine/gfx/ripple_REF.gc +++ b/test/decompiler/reference/engine/gfx/ripple_REF.gc @@ -207,16 +207,16 @@ (local-vars (sv-16 float) (sv-32 float)) (let* ((f30-0 (-> arg0 root trans y)) (v1-1 (-> arg0 draw)) - (a1-4 (-> v1-1 lod-set lod (-> v1-1 cur-lod) geo effect)) + (a1-5 (-> v1-1 lod-set lod (-> v1-1 cur-lod) geo effect)) ) - (if (or (zero? (logand (-> a1-4 0 effect-bits) 4)) (not (-> v1-1 ripple))) + (if (or (zero? (logand (-> a1-5 0 effect-bits) 4)) (not (-> v1-1 ripple))) (return f30-0) ) - (let* ((a1-5 (-> a1-4 0 extra-info)) + (let* ((a1-6 (-> a1-5 0 extra-info)) (s4-0 (the-as mei-ripple - (+ (the-as uint a1-5) (the-as uint (* (-> a1-5 ripple-offset) 16))) + (+ (the-as uint a1-6) (the-as uint (* (-> a1-6 ripple-offset) 16))) ) ) (gp-0 (-> v1-1 ripple)) diff --git a/test/decompiler/reference/engine/gfx/tie/prototype-h_REF.gc b/test/decompiler/reference/engine/gfx/tie/prototype-h_REF.gc index e3bf406ab1..697322c158 100644 --- a/test/decompiler/reference/engine/gfx/tie/prototype-h_REF.gc +++ b/test/decompiler/reference/engine/gfx/tie/prototype-h_REF.gc @@ -226,8 +226,8 @@ ;; definition of type proxy-prototype-array-tie (deftype proxy-prototype-array-tie (basic) - ((prototype-array-tie basic :offset-assert 4) - (wind-vectors uint32 :offset-assert 8) + ((prototype-array-tie prototype-array-tie :offset-assert 4) + (wind-vectors uint32 :offset-assert 8) ) :method-count-assert 9 :size-assert #xc diff --git a/test/decompiler/reference/engine/gfx/tie/tie-h_REF.gc b/test/decompiler/reference/engine/gfx/tie/tie-h_REF.gc index 1c0db49012..240b8388b9 100644 --- a/test/decompiler/reference/engine/gfx/tie/tie-h_REF.gc +++ b/test/decompiler/reference/engine/gfx/tie/tie-h_REF.gc @@ -86,7 +86,7 @@ ;; definition of type drawable-tree-instance-tie (deftype drawable-tree-instance-tie (drawable-tree) - ((prototypes basic :offset 8) + ((prototypes proxy-prototype-array-tie :offset 8) ) :method-count-assert 18 :size-assert #x24 diff --git a/test/decompiler/reference/engine/gfx/vis/bsp-h_REF.gc b/test/decompiler/reference/engine/gfx/vis/bsp-h_REF.gc index c73ba6be99..1006f34903 100644 --- a/test/decompiler/reference/engine/gfx/vis/bsp-h_REF.gc +++ b/test/decompiler/reference/engine/gfx/vis/bsp-h_REF.gc @@ -49,8 +49,8 @@ (boxes box8s-array :offset-assert 148) (unk-data-3 uint32 :offset-assert 152) (ambients drawable-inline-array-ambient :offset-assert 156) - (unk-data-4 uint32 :offset-assert 160) - (unk-data-5 uint32 :offset-assert 164) + (unk-data-4 float :offset-assert 160) + (unk-data-5 float :offset-assert 164) (adgifs adgif-shader-array :offset-assert 168) (unk-data-6 pointer :offset-assert 172) (unk-data-7 pointer :offset-assert 176) diff --git a/test/decompiler/reference/engine/level/level-h_REF.gc b/test/decompiler/reference/engine/level/level-h_REF.gc index 5c8c52c821..aac9831dca 100644 --- a/test/decompiler/reference/engine/level/level-h_REF.gc +++ b/test/decompiler/reference/engine/level/level-h_REF.gc @@ -117,10 +117,10 @@ ;; definition of type login-state (deftype login-state (basic) - ((state int32 :offset-assert 4) - (pos uint32 :offset-assert 8) - (elts uint32 :offset-assert 12) - (elt uint32 16 :offset-assert 16) + ((state int32 :offset-assert 4) + (pos uint32 :offset-assert 8) + (elts uint32 :offset-assert 12) + (elt drawable 16 :offset-assert 16) ) :method-count-assert 9 :size-assert #x50 @@ -204,7 +204,7 @@ (dummy-25 () none 25) (dummy-26 () none 26) (dummy-27 () none 27) - (dummy-28 () none 28) + (dummy-28 (_type_ string) symbol 28) ) ) @@ -291,7 +291,7 @@ (:methods (dummy-9 (_type_ symbol) level 9) (dummy-10 (_type_ symbol) symbol 10) - (dummy-11 (_type_ symbol symbol) _type_ 11) + (dummy-11 (_type_ symbol symbol) level 11) (dummy-12 (_type_) none 12) (dummy-13 () none 13) (dummy-14 () none 14) @@ -301,7 +301,7 @@ (dummy-18 (_type_ symbol) none 18) (dummy-19 (_type_ pair) none 19) (dummy-20 () none 20) - (dummy-21 () none 21) + (dummy-21 (_type_ level-group int) pair 21) (dummy-22 () none 22) (dummy-23 () none 23) (dummy-24 () none 24) diff --git a/test/decompiler/reference/engine/load/loader-h_REF.gc b/test/decompiler/reference/engine/load/loader-h_REF.gc index 74b4ddb507..7116367d42 100644 --- a/test/decompiler/reference/engine/load/loader-h_REF.gc +++ b/test/decompiler/reference/engine/load/loader-h_REF.gc @@ -3,9 +3,9 @@ ;; definition of type load-dir (deftype load-dir (basic) - ((unknown basic :offset-assert 4) - (string-array (array string) :offset-assert 8) - (data-array (array basic) :offset-assert 12) + ((unknown basic :offset-assert 4) + (string-array (array string) :offset-assert 8) + (data-array (array art-group) :offset-assert 12) ) :method-count-assert 11 :size-assert #x10 @@ -50,7 +50,7 @@ (set! (-> obj data-array) (the-as - (array basic) + (array art-group) ((method-of-type array new) allocation array basic length) ) ) diff --git a/test/decompiler/reference/engine/math/vector-h_REF.gc b/test/decompiler/reference/engine/math/vector-h_REF.gc index 8ea121d595..b24ba71542 100644 --- a/test/decompiler/reference/engine/math/vector-h_REF.gc +++ b/test/decompiler/reference/engine/math/vector-h_REF.gc @@ -95,13 +95,10 @@ ;; definition for method 12 of type bit-array (defmethod clear bit-array ((obj bit-array)) - (let ((idx (/ (logand -8 (+ (-> obj allocated-length) 7)) 8))) - (while (nonzero? idx) - (+! idx -1) - (nop!) - (nop!) - (set! (-> obj bytes idx) (the-as uint 0)) - ) + (countdown (idx (/ (logand -8 (+ (-> obj allocated-length) 7)) 8)) + (nop!) + (nop!) + (set! (-> obj bytes idx) (the-as uint 0)) ) obj ) @@ -752,8 +749,8 @@ ;; definition of type vertical-planes-array (deftype vertical-planes-array (basic) - ((length uint32 :offset-assert 4) - (data vertical-planes :dynamic :offset 16) + ((length uint32 :offset-assert 4) + (data vertical-planes :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 diff --git a/test/decompiler/reference/engine/target/joint-mod-h_REF.gc b/test/decompiler/reference/engine/target/joint-mod-h_REF.gc index 42b0457fd2..6d62003c90 100644 --- a/test/decompiler/reference/engine/target/joint-mod-h_REF.gc +++ b/test/decompiler/reference/engine/target/joint-mod-h_REF.gc @@ -88,7 +88,7 @@ ) ) (set! (-> obj process) proc) - (set! (-> obj joint) (-> (-> proc node-list) data joint-idx)) + (set! (-> obj joint) (-> proc node-list data joint-idx)) (set-mode! obj mode) (let ((twist-max (-> obj twist-max))) (set! (-> twist-max x) 8192.0) @@ -398,7 +398,7 @@ ) (set! sv-52 - (vector-normalize! (-> (-> csp bone) transform vector (-> gp-0 nose)) 1.0) + (vector-normalize! (-> csp bone transform vector (-> gp-0 nose)) 1.0) ) (let ((t9-3 vector-normalize!) (a0-5 (new 'stack-no-clear 'vector)) @@ -974,7 +974,7 @@ (set! (-> v1-2 z) 0.0) (set! (-> v1-2 w) 1.0) ) - (let ((v1-5 (-> (-> arg0 node-list) data arg1))) + (let ((v1-5 (-> arg0 node-list data arg1))) (set! (-> v1-5 param0) joint-mod-wheel-callback) (set! (-> v1-5 param1) v0-0) ) @@ -1059,7 +1059,7 @@ (set! (-> v0-0 transform trans quad) (-> *null-vector* quad)) (set! (-> v0-0 transform rot quad) (-> *null-vector* quad)) (set! (-> v0-0 transform scale quad) (-> *identity-vector* quad)) - (let ((v1-8 (-> (-> arg0 node-list) data arg1))) + (let ((v1-8 (-> arg0 node-list data arg1))) (set! (-> v1-8 param0) joint-mod-set-local-callback) (set! (-> v1-8 param1) v0-0) ) @@ -1122,7 +1122,7 @@ (set! (-> v0-0 transform trans quad) (-> *null-vector* quad)) (set! (-> v0-0 transform rot quad) (-> *null-vector* quad)) (set! (-> v0-0 transform scale quad) (-> *identity-vector* quad)) - (let ((v1-7 (-> (-> arg0 node-list) data arg1))) + (let ((v1-7 (-> arg0 node-list data arg1))) (set! (-> v1-7 param0) joint-mod-set-world-callback) (set! (-> v1-7 param1) v0-0) ) @@ -1216,7 +1216,7 @@ (set! (-> v0-0 transform trans quad) (-> *null-vector* quad)) (set! (-> v0-0 transform rot quad) (-> *null-vector* quad)) (set! (-> v0-0 transform scale quad) (-> *identity-vector* quad)) - (let ((v1-7 (-> (-> arg0 node-list) data arg1))) + (let ((v1-7 (-> arg0 node-list data arg1))) (set! (-> v1-7 param0) joint-mod-blend-local-callback) (set! (-> v1-7 param1) v0-0) ) @@ -1301,7 +1301,7 @@ (set! (-> v0-0 spin-rate) arg3) (set! (-> v0-0 enable) #t) (set! (-> v0-0 angle) 0.0) - (let ((v1-6 (-> (-> arg0 node-list) data arg1))) + (let ((v1-6 (-> arg0 node-list data arg1))) (set! (-> v1-6 param0) joint-mod-spinner-callback) (set! (-> v1-6 param1) v0-0) ) diff --git a/test/decompiler/reference/kernel/gcommon_REF.gc b/test/decompiler/reference/kernel/gcommon_REF.gc index 7b528a0a2b..bd10892553 100644 --- a/test/decompiler/reference/kernel/gcommon_REF.gc +++ b/test/decompiler/reference/kernel/gcommon_REF.gc @@ -828,16 +828,13 @@ ;; Used lq/sq (defun qmem-copy<-! ((dst pointer) (src pointer) (size int)) (let ((result dst)) - (let ((qwc (/ (+ size 15) 16))) - (while (nonzero? qwc) - (+! qwc -1) - (set! - (-> (the-as (pointer uint128) dst)) - (-> (the-as (pointer uint128) src)) - ) - (&+! dst 16) - (&+! src 16) + (countdown (qwc (/ (+ size 15) 16)) + (set! + (-> (the-as (pointer uint128) dst)) + (-> (the-as (pointer uint128) src)) ) + (&+! dst 16) + (&+! src 16) ) result ) diff --git a/test/decompiler/reference/kernel/gkernel_REF.gc b/test/decompiler/reference/kernel/gkernel_REF.gc index 0589a5b2c4..660902ee3d 100644 --- a/test/decompiler/reference/kernel/gkernel_REF.gc +++ b/test/decompiler/reference/kernel/gkernel_REF.gc @@ -657,13 +657,10 @@ (set! (-> obj child) (the-as (pointer process-tree) #f)) (set! (-> obj self) obj) (set! (-> obj ppointer) (&-> obj self)) - (let ((v1-4 arg1)) - (while (nonzero? v1-4) - (+! v1-4 -1) - (let ((a0-4 (-> obj process-list v1-4))) - (set! (-> a0-4 process) *null-process*) - (set! (-> a0-4 next) (-> obj process-list (+ v1-4 1))) - ) + (countdown (v1-4 arg1) + (let ((a0-4 (-> obj process-list v1-4))) + (set! (-> a0-4 process) *null-process*) + (set! (-> a0-4 next) (-> obj process-list (+ v1-4 1))) ) ) (set! diff --git a/test/decompiler/test_FormExpressionBuildLong.cpp b/test/decompiler/test_FormExpressionBuildLong.cpp index 29c85b88de..5459e0b926 100644 --- a/test/decompiler/test_FormExpressionBuildLong.cpp +++ b/test/decompiler/test_FormExpressionBuildLong.cpp @@ -2836,7 +2836,7 @@ TEST_F(FormRegressionTest, Method19ResTag) { " (->\n" " (the-as\n" " (pointer uint64)\n" - " (-> (symbol->string (-> (-> arg0 tag) t5-2 name)) data)\n" + " (-> (symbol->string (-> arg0 tag t5-2 name)) data)\n" " )\n" " 0\n" " )\n" @@ -2873,7 +2873,7 @@ TEST_F(FormRegressionTest, Method19ResTag) { " (->\n" " (the-as\n" " (pointer uint64)\n" - " (-> (symbol->string (-> (-> arg0 tag) (+ t4-1 -1) name)) data)\n" + " (-> (symbol->string (-> arg0 tag (+ t4-1 -1) name)) data)\n" " )\n" " 0\n" " )\n" diff --git a/test/decompiler/test_gkernel_decomp.cpp b/test/decompiler/test_gkernel_decomp.cpp index 0c865e44e5..ff881ff3cb 100644 --- a/test/decompiler/test_gkernel_decomp.cpp +++ b/test/decompiler/test_gkernel_decomp.cpp @@ -1263,19 +1263,16 @@ TEST_F(FormRegressionTest, ExprMethod0DeadPoolHeap) { " (set! (-> obj child) (the-as (pointer process-tree) #f))\n" " (set! (-> obj self) obj)\n" " (set! (-> obj ppointer) (&-> obj self))\n" - " (let\n" - " ((v1-4 arg3))\n" - " (while\n" - " (nonzero? v1-4)\n" - " (+! v1-4 -1)\n" - " (let\n" - " ((a0-4 (-> obj process-list v1-4)))\n" - " (set! (-> a0-4 process) *null-process*)\n" - " (set! (-> a0-4 next) (-> obj process-list (+ v1-4 1)))\n" - " )\n" + " (countdown (v1-4 arg3)\n" + " (let ((a0-4 (-> obj process-list v1-4)))\n" + " (set! (-> a0-4 process) *null-process*)\n" + " (set! (-> a0-4 next) (-> obj process-list (+ v1-4 1)))\n" " )\n" " )\n" - " (set! (-> obj dead-list next) (the-as dead-pool-heap-rec (-> obj process-list)))\n" + " (set!\n" + " (-> obj dead-list next)\n" + " (the-as dead-pool-heap-rec (-> obj process-list))\n" + " )\n" " (set! (-> obj alive-list process) #f)\n" " (set! (-> obj process-list (+ arg3 -1) next) #f)\n" " (set! (-> obj alive-list prev) (-> obj alive-list))\n" diff --git a/test/offline/offline_test_main.cpp b/test/offline/offline_test_main.cpp index 1b3d71c514..170e1ca808 100644 --- a/test/offline/offline_test_main.cpp +++ b/test/offline/offline_test_main.cpp @@ -102,10 +102,6 @@ const std::unordered_set g_functions_to_skip_compiling = { "lognor", // weird PS2 specific debug registers: "breakpoint-range-set!", - // does weird stuff with the type system. - "print", - "printl", - "inspect", // inline assembly "valid?", diff --git a/tools/MemoryDumpTool/main.cpp b/tools/MemoryDumpTool/main.cpp index d20881aa31..f26825350f 100644 --- a/tools/MemoryDumpTool/main.cpp +++ b/tools/MemoryDumpTool/main.cpp @@ -225,7 +225,7 @@ void inspect_basics(const Ram& ram, auto type = dynamic_cast(type_system.lookup_type(name)); if (!type) { - fmt::print("Could not cast Type! Skipping!!"); + fmt::print("Could not cast Type! Skipping!!\n"); type_results["__metadata"]["failedToCast?"] = true; results[name] = type_results; continue; @@ -234,7 +234,8 @@ void inspect_basics(const Ram& ram, for (auto& field : type->fields()) { if (!field.is_inline() && !field.is_dynamic() && (field.type() == TypeSpec("basic") || field.type() == TypeSpec("object") || - field.type() == TypeSpec("uint32"))) { + field.type() == TypeSpec("uint32") || + field.type() == TypeSpec("array", {TypeSpec("basic")}))) { int array_size = field.is_array() ? field.array_size() : 1; fmt::print(" field {}\n", field.name()); @@ -245,34 +246,60 @@ void inspect_basics(const Ram& ram, field_results = {}; } + bool goal_array = field.type() == TypeSpec("array", {TypeSpec("basic")}); + std::unordered_map type_frequency; + int array_max_elts = 0; for (auto base_addr : basics.at(name)) { for (int elt_idx = 0; elt_idx < array_size; elt_idx++) { int field_addr = base_addr + field.offset() + 4 * elt_idx; if (ram.word_in_memory(field_addr)) { auto field_val = ram.word(field_addr); - if ((field_val & 0x7) == 4 && ram.word_in_memory(field_val - 4)) { - auto type_tag = ram.word(field_val - 4); - auto iter = types.find(type_tag); - if (iter != types.end()) { - if (iter->second == "symbol") { - auto sym_iter = symbols.addr_to_name.find(field_val); - if (sym_iter != symbols.addr_to_name.end()) { - type_frequency[fmt::format("(symbol {})", sym_iter->second)]++; + auto array_addr = field_val; + int goal_array_length = 1; + if (goal_array) { + if (ram.word_in_memory(field_val)) { + goal_array_length = ram.word(field_val); + } else { + array_addr = 0xBAADBEEF; + } + } + for (int arr_idx = 0; arr_idx < goal_array_length; ++arr_idx) { + if (goal_array) { + field_val = array_addr + 12 + arr_idx * 4; + if (ram.word_in_memory(field_val)) { + field_val = ram.word(field_val); + } else { + field_val = 0xBAADBEEF; + } + } + + if ((field_val & 0x7) == 4 && ram.word_in_memory(field_val - 4)) { + auto type_tag = ram.word(field_val - 4); + auto iter = types.find(type_tag); + if (iter != types.end()) { + if (iter->second == "symbol") { + auto sym_iter = symbols.addr_to_name.find(field_val); + if (sym_iter != symbols.addr_to_name.end()) { + type_frequency[fmt::format("(symbol {})", sym_iter->second)]++; + } else { + type_frequency[iter->second]++; + } } else { type_frequency[iter->second]++; } } else { - type_frequency[iter->second]++; + type_frequency["_bad-type"]++; } + } else if (field_val == 0) { + type_frequency["0"]++; } else { - type_frequency["_bad-type"]++; + type_frequency["_not-basic-ptr"]++; } - } else if (field_val == 0) { - type_frequency["0"]++; - } else { - type_frequency["_not-basic-ptr"]++; + + if (!goal_array) + break; } } else { type_frequency["_bad-field-memory"]++;