diff --git a/decompiler/Function/TypeAnalysis.cpp b/decompiler/Function/TypeAnalysis.cpp index b9ecd7d52..34677960d 100644 --- a/decompiler/Function/TypeAnalysis.cpp +++ b/decompiler/Function/TypeAnalysis.cpp @@ -144,7 +144,7 @@ bool Function::run_type_analysis_ir2( } catch (std::runtime_error& e) { lg::warn("Function {} failed type prop: {}", guessed_name.to_string(), e.what()); warnings.type_prop_warning("{}", e.what()); - ir2.env.set_types(block_init_types, op_types, *ir2.atomic_ops); + ir2.env.set_types(block_init_types, op_types, *ir2.atomic_ops, my_type); return false; } @@ -198,7 +198,7 @@ bool Function::run_type_analysis_ir2( } } - ir2.env.set_types(block_init_types, op_types, *ir2.atomic_ops); + ir2.env.set_types(block_init_types, op_types, *ir2.atomic_ops, my_type); return true; } diff --git a/decompiler/IR2/AtomicOpForm.cpp b/decompiler/IR2/AtomicOpForm.cpp index 92bc6df09..f69a33f53 100644 --- a/decompiler/IR2/AtomicOpForm.cpp +++ b/decompiler/IR2/AtomicOpForm.cpp @@ -107,6 +107,61 @@ FormElement* SetVarConditionOp::get_as_form(FormPool& pool, const Env& env) cons is_sequence_point(), TypeSpec("symbol")); } +namespace { +std::optional get_typecast_for_atom(const SimpleAtom& atom, + const Env& env, + const TypeSpec& expected_type, + int my_idx) { + auto type_info = env.dts->ts.lookup_type(expected_type); + switch (atom.get_kind()) { + case SimpleAtom::Kind::VARIABLE: { + auto src_type = env.get_types_before_op(my_idx).get(atom.var().reg()); + + if (src_type.requires_cast() || !env.dts->ts.tc(expected_type, src_type.typespec())) { + // we fail the typecheck for a normal set!, so add a cast. + return expected_type; + } else { + return {}; + } + + } break; + case SimpleAtom::Kind::INTEGER_CONSTANT: { + std::optional cast_for_set, cast_for_define; + bool sym_int_or_uint = env.dts->ts.tc(TypeSpec("integer"), expected_type); + bool sym_uint = env.dts->ts.tc(TypeSpec("uinteger"), expected_type); + bool sym_int = sym_int_or_uint && !sym_uint; + + if (sym_int) { + // do nothing for set. + return {}; + } else { + // for uint or other + return expected_type; + } + + } break; + + case SimpleAtom::Kind::SYMBOL_PTR: + case SimpleAtom::Kind::SYMBOL_VAL: { + assert(atom.get_str() == "#f"); + + if (expected_type != TypeSpec("symbol")) { + // explicitly cast if we're not using a reference type, including pointers. + // otherwise, we allow setting references to #f. + if (!type_info->is_reference()) { + return expected_type; + } + return {}; + } + } break; + + default: + assert(false); + } + return {}; +} +} // namespace + FormElement* StoreOp::get_as_form(FormPool& pool, const Env& env) const { if (env.has_type_analysis()) { if (m_addr.is_identity() && m_addr.get_arg(0).is_sym_val()) { @@ -248,8 +303,10 @@ FormElement* StoreOp::get_as_form(FormPool& pool, const Env& env) const { } assert(!rd.addr_of); auto addr = pool.alloc_element(source, rd.addr_of, tokens); - return pool.alloc_element(addr, m_value.as_expr(), m_my_idx, ro.var, - std::nullopt); + + return pool.alloc_element( + addr, m_value.as_expr(), m_my_idx, ro.var, std::nullopt, + get_typecast_for_atom(m_value, env, coerce_to_reg_type(rd.result_type), m_my_idx)); } std::string cast_type; @@ -285,7 +342,8 @@ FormElement* StoreOp::get_as_form(FormPool& pool, const Env& env) const { auto deref = pool.alloc_element(cast_source, false, std::vector()); return pool.alloc_element(deref, m_value.as_expr(), m_my_idx, ro.var, - TypeSpec("pointer", {TypeSpec(cast_type)})); + TypeSpec("pointer", {TypeSpec(cast_type)}), + std::nullopt); } } } @@ -412,7 +470,8 @@ FormElement* LoadVarOp::get_as_form(FormPool& pool, const Env& env) const { m_type.value_or(TypeSpec("object"))); } - if (input_type.typespec() == TypeSpec("pointer")) { + if (input_type.typespec() == TypeSpec("pointer") || + input_type.kind == TP_Type::Kind::OBJECT_PLUS_PRODUCT_WITH_CONSTANT) { std::string cast_type; switch (m_size) { case 1: diff --git a/decompiler/IR2/AtomicOpTypeAnalysis.cpp b/decompiler/IR2/AtomicOpTypeAnalysis.cpp index 171ccefde..104294842 100644 --- a/decompiler/IR2/AtomicOpTypeAnalysis.cpp +++ b/decompiler/IR2/AtomicOpTypeAnalysis.cpp @@ -672,7 +672,8 @@ TP_Type LoadVarOp::get_src_type(const TypeState& input, return TP_Type::make_from_ts(coerce_to_reg_type(rd.result_type)); } - if (input_type.typespec() == TypeSpec("pointer")) { + if (input_type.typespec() == TypeSpec("pointer") || + input_type.kind == TP_Type::Kind::OBJECT_PLUS_PRODUCT_WITH_CONSTANT) { // we got a plain pointer. let's just assume we're loading an integer. // perhaps we should disable this feature by default on 4-byte loads if we're getting // lots of false positives for loading pointers from plain pointers. diff --git a/decompiler/IR2/Env.cpp b/decompiler/IR2/Env.cpp index b5434c71a..e2f0497ef 100644 --- a/decompiler/IR2/Env.cpp +++ b/decompiler/IR2/Env.cpp @@ -168,6 +168,39 @@ goos::Object Env::get_variable_name_with_cast(Register reg, int atomic_idx, Acce } } +std::optional Env::get_user_cast_for_access(const RegisterAccess& access) const { + if (access.reg().get_kind() == Reg::FPR || access.reg().get_kind() == Reg::GPR) { + auto& var_info = m_var_names.lookup(access.reg(), access.idx(), access.mode()); + std::string original_name = var_info.name(); + + auto type_kv = m_typecasts.find(access.idx()); + if (type_kv != m_typecasts.end()) { + for (auto& x : type_kv->second) { + if (x.reg == access.reg()) { + // let's make sure the above claim is true + TypeSpec type_in_reg; + if (has_type_analysis() && access.mode() == AccessMode::READ) { + type_in_reg = + get_types_for_op_mode(access.idx(), AccessMode::READ).get(access.reg()).typespec(); + if (type_in_reg.print() != x.type_name) { + lg::error( + "Decompiler type consistency error. There was a typecast for reg {} at idx {} " + "(var {}) to type {}, but the actual type is {} ({})", + access.reg().to_charp(), access.idx(), original_name, x.type_name, + type_in_reg.print(), type_in_reg.print()); + assert(false); + } + } + + auto cast_type = dts->parse_type_spec(x.type_name); + return cast_type; + } + } + } + } + return {}; +} + std::string Env::get_variable_name(const RegisterAccess& access) const { if (access.reg().get_kind() == Reg::FPR || access.reg().get_kind() == Reg::GPR) { std::string lookup_name = m_var_names.lookup(access.reg(), access.idx(), access.mode()).name(); @@ -186,15 +219,17 @@ std::string Env::get_variable_name(const RegisterAccess& access) const { * NOTE: this is _NOT_ the most specific type known to the decompiler, but instead the type * of the variable. */ -TypeSpec Env::get_variable_type(const RegisterAccess& access) const { +TypeSpec Env::get_variable_type(const RegisterAccess& access, bool using_user_var_types) const { if (access.reg().get_kind() == Reg::FPR || access.reg().get_kind() == Reg::GPR) { auto& var_info = m_var_names.lookup(access.reg(), access.idx(), access.mode()); std::string original_name = var_info.name(); auto type_of_var = var_info.type.typespec(); - auto retype_kv = m_var_retype.find(original_name); - if (retype_kv != m_var_retype.end()) { - type_of_var = retype_kv->second; + if (using_user_var_types) { + auto retype_kv = m_var_retype.find(original_name); + if (retype_kv != m_var_retype.end()) { + type_of_var = retype_kv->second; + } } return type_of_var; @@ -208,7 +243,8 @@ TypeSpec Env::get_variable_type(const RegisterAccess& access) const { */ void Env::set_types(const std::vector& block_init_types, const std::vector& op_end_types, - const FunctionAtomicOps& atomic_ops) { + const FunctionAtomicOps& atomic_ops, + const TypeSpec& my_type) { m_block_init_types = block_init_types; m_op_end_types = op_end_types; @@ -230,6 +266,16 @@ void Env::set_types(const std::vector& block_init_types, } m_has_types = true; + + // check the actual return type: + if (my_type.last_arg() != TypeSpec("none")) { + auto as_end = dynamic_cast(atomic_ops.ops.back().get()); + if (as_end) { + m_type_analysis_return_type = get_types_before_op((int)atomic_ops.ops.size() - 1) + .get(Register(Reg::GPR, Reg::V0)) + .typespec(); + } + } } std::string Env::print_local_var_types(const Form* top_level_form) const { diff --git a/decompiler/IR2/Env.h b/decompiler/IR2/Env.h index e629ac18e..456263546 100644 --- a/decompiler/IR2/Env.h +++ b/decompiler/IR2/Env.h @@ -46,7 +46,8 @@ class Env { // TODO - remove this. goos::Object get_variable_name_with_cast(Register reg, int atomic_idx, AccessMode mode) const; std::string get_variable_name(const RegisterAccess& access) const; - TypeSpec get_variable_type(const RegisterAccess& access) const; + std::optional get_user_cast_for_access(const RegisterAccess& access) const; + TypeSpec get_variable_type(const RegisterAccess& access, bool using_user_var_types) const; /*! * Get the types in registers _after_ the given operation has completed. @@ -80,7 +81,8 @@ class Env { void set_types(const std::vector& block_init_types, const std::vector& op_end_types, - const FunctionAtomicOps& atomic_ops); + const FunctionAtomicOps& atomic_ops, + const TypeSpec& my_type); void set_local_vars(const VariableNames& names) { m_var_names = names; @@ -168,5 +170,6 @@ class Env { std::unordered_map m_label_types; std::unordered_set m_vars_defined_in_let; + std::optional m_type_analysis_return_type; }; } // namespace decompiler \ No newline at end of file diff --git a/decompiler/IR2/Form.cpp b/decompiler/IR2/Form.cpp index 9853d8248..6d9ec9974 100644 --- a/decompiler/IR2/Form.cpp +++ b/decompiler/IR2/Form.cpp @@ -1415,6 +1415,8 @@ std::string fixed_operator_to_string(FixedOperatorKind kind) { return "&+!"; case FixedOperatorKind::SUBTRACTION: return "-"; + case FixedOperatorKind::SUBTRACTION_PTR: + return "&-"; case FixedOperatorKind::MULTIPLICATION: return "*"; case FixedOperatorKind::SQRT: @@ -1481,6 +1483,8 @@ std::string fixed_operator_to_string(FixedOperatorKind kind) { return "null?"; case FixedOperatorKind::PAIRP: return "pair?"; + case FixedOperatorKind::NONE: + return "none"; default: assert(false); return ""; @@ -1950,22 +1954,35 @@ StorePlainDeref::StorePlainDeref(DerefElement* dst, SimpleExpression expr, int my_idx, RegisterAccess base_var, - std::optional cast_type) + std::optional dst_cast_type, + std::optional src_cast_type) : m_dst(dst), m_expr(std::move(expr)), m_my_idx(my_idx), - m_base_var(std::move(base_var)), - m_cast_type(cast_type) {} + m_base_var(base_var), + m_dst_cast_type(std::move(dst_cast_type)), + m_src_cast_type(std::move(src_cast_type)) {} + goos::Object StorePlainDeref::to_form_internal(const Env& env) const { - if (!m_cast_type.has_value()) { - return pretty_print::build_list("set!", m_dst->to_form(env), - m_expr.to_form(env.file->labels, env)); + std::vector lst = {pretty_print::to_symbol("set!")}; + + if (m_dst_cast_type) { + lst.push_back( + pretty_print::build_list("the-as", m_dst_cast_type->print(), m_dst->to_form(env))); } else { - return pretty_print::build_list( - "set!", pretty_print::build_list("the-as", m_cast_type->print(), m_dst->to_form(env)), - m_expr.to_form(env.file->labels, env)); + lst.push_back(m_dst->to_form(env)); } + + if (m_src_cast_type) { + lst.push_back(pretty_print::build_list("the-as", m_src_cast_type->print(), + m_expr.to_form(env.file->labels, env))); + } else { + lst.push_back(m_expr.to_form(env.file->labels, env)); + } + + return pretty_print::build_list(lst); } + void StorePlainDeref::apply(const std::function& f) { f(this); m_dst->apply(f); diff --git a/decompiler/IR2/Form.h b/decompiler/IR2/Form.h index ce4ba2e79..488caea10 100644 --- a/decompiler/IR2/Form.h +++ b/decompiler/IR2/Form.h @@ -1136,7 +1136,8 @@ class StorePlainDeref : public FormElement { SimpleExpression expr, int my_idx, RegisterAccess base_var, - std::optional cast_type); + std::optional dst_cast_type, + std::optional src_cast_type); goos::Object to_form_internal(const Env& env) const override; void apply(const std::function& f) override; @@ -1150,7 +1151,7 @@ class StorePlainDeref : public FormElement { SimpleExpression m_expr; int m_my_idx = -1; RegisterAccess m_base_var; - std::optional m_cast_type; + std::optional m_dst_cast_type, m_src_cast_type; }; class StoreArrayAccess : public FormElement { diff --git a/decompiler/IR2/FormExpressionAnalysis.cpp b/decompiler/IR2/FormExpressionAnalysis.cpp index 2a5b1a740..6e1fcb90e 100644 --- a/decompiler/IR2/FormExpressionAnalysis.cpp +++ b/decompiler/IR2/FormExpressionAnalysis.cpp @@ -228,6 +228,20 @@ std::vector pop_to_forms(const std::vector& vars, for (auto& x : forms_out) { forms.push_back(pool.alloc_sequence_form(nullptr, x)); } + + // add casts, if needed. + assert(vars.size() == forms.size()); + for (size_t i = 0; i < vars.size(); i++) { + auto atom = form_as_atom(forms[i]); + bool is_var = atom && atom->is_var(); + auto cast = env.get_user_cast_for_access(vars[i]); + // only cast if we didn't get a var (compacting expressions). + // there is a separate system for casting variables that will do a better job. + if (cast && !is_var) { + forms[i] = pool.alloc_single_element_form(nullptr, *cast, forms[i]); + } + } + return forms; } @@ -250,6 +264,11 @@ bool is_int_type(const Env& env, int my_idx, RegisterAccess var) { return type == TypeSpec("int"); } +bool is_pointer_type(const Env& env, int my_idx, RegisterAccess var) { + auto type = env.get_types_before_op(my_idx).get(var.reg()).typespec(); + return type.base_type() == "pointer"; +} + /*! * type == uint (exactly)? */ @@ -258,10 +277,19 @@ bool is_uint_type(const Env& env, int my_idx, RegisterAccess var) { return type == TypeSpec("uint"); } -bool is_ptr_or_child(const Env& env, int my_idx, RegisterAccess var) { - auto type = env.get_types_before_op(my_idx).get(var.reg()).typespec().base_type(); +bool is_ptr_or_child(const Env& env, int my_idx, RegisterAccess var, bool as_var) { + auto type = as_var ? env.get_variable_type(var, true).base_type() + : env.get_types_before_op(my_idx).get(var.reg()).typespec().base_type(); return type == "pointer"; } + +bool is_var(Form* form) { + auto atom = form_as_atom(form); + if (atom) { + return atom->is_var(); + } + return false; +} } // namespace /*! @@ -511,7 +539,6 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, bool allow_side_effects) { auto arg0_i = is_int_type(env, m_my_idx, m_expr.get_arg(0).var()); auto arg0_u = is_uint_type(env, m_my_idx, m_expr.get_arg(0).var()); - bool arg0_ptr = is_ptr_or_child(env, m_my_idx, m_expr.get_arg(0).var()); bool arg1_reg = m_expr.get_arg(1).is_var(); bool arg1_i = true; @@ -531,6 +558,8 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, args.push_back(pool.alloc_single_element_form(nullptr, m_expr.get_arg(1))); } + bool arg0_ptr = is_ptr_or_child(env, m_my_idx, m_expr.get_arg(0).var(), is_var(args.at(0))); + // Look for getting an address inside of an object. // (+ process). array style access with a stride of 1. // in the case, both are vars. @@ -802,6 +831,10 @@ void SimpleExpressionElement::update_from_stack_copy_first_int_2(const Env& env, } else { auto cast = pool.alloc_single_element_form( nullptr, TypeSpec(arg0_i ? "int" : "uint"), args.at(1)); + if (kind == FixedOperatorKind::SUBTRACTION && + is_pointer_type(env, m_my_idx, m_expr.get_arg(0).var())) { + kind = FixedOperatorKind::SUBTRACTION_PTR; + } auto new_form = pool.alloc_element(GenericOperator::make_fixed(kind), args.at(0), cast); result->push_back(new_form); @@ -1107,38 +1140,39 @@ void StoreInPairElement::push_to_stack(const Env& env, FormPool& pool, FormStack } } +namespace { +Form* make_optional_cast(const std::optional& cast_type, Form* in, FormPool& pool) { + if (cast_type) { + return pool.alloc_single_element_form(nullptr, *cast_type, in); + } else { + return in; + } +} +} // namespace + void StorePlainDeref::push_to_stack(const Env& env, FormPool& pool, FormStack& stack) { mark_popped(); if (m_expr.is_var()) { auto vars = std::vector({m_expr.var(), m_base_var}); auto popped = pop_to_forms(vars, env, pool, stack, true); - if (m_cast_type.has_value()) { - m_dst->set_base( - pool.alloc_single_element_form(nullptr, *m_cast_type, popped.at(1))); - } else { - m_dst->set_base(popped.at(1)); - } - + m_dst->set_base(make_optional_cast(m_dst_cast_type, popped.at(1), pool)); m_dst->mark_popped(); m_dst->inline_nested(); - auto fr = pool.alloc_element(pool.alloc_single_form(nullptr, m_dst), - popped.at(0)); + auto fr = pool.alloc_element( + pool.alloc_single_form(nullptr, m_dst), + make_optional_cast(m_src_cast_type, popped.at(0), pool)); fr->mark_popped(); stack.push_form_element(fr, true); } else { auto vars = std::vector({m_base_var}); auto popped = pop_to_forms(vars, env, pool, stack, true); - if (m_cast_type.has_value()) { - m_dst->set_base( - pool.alloc_single_element_form(nullptr, *m_cast_type, popped.at(1))); - } else { - m_dst->set_base(popped.at(0)); - } + m_dst->set_base(make_optional_cast(m_dst_cast_type, popped.at(0), pool)); m_dst->mark_popped(); m_dst->inline_nested(); auto val = pool.alloc_single_element_form(nullptr, m_expr, m_my_idx); val->mark_popped(); - auto fr = pool.alloc_element(pool.alloc_single_form(nullptr, m_dst), val); + auto fr = pool.alloc_element( + pool.alloc_single_form(nullptr, m_dst), make_optional_cast(m_src_cast_type, val, pool)); fr->mark_popped(); stack.push_form_element(fr, true); } @@ -1232,19 +1266,11 @@ void FunctionCallElement::update_from_stack(const Env& env, function_type = tp_type.typespec(); } - // assert(is_method == m_op->is_method()); if (is_virtual_method != m_op->is_method()) { lg::error("Disagreement on method!"); throw std::runtime_error("Disagreement on method"); } - // if method, don't pop the obj arg. - // Variable method_obj_var; - // if (is_method) { - // method_obj_var = all_pop_vars.at(1); - // all_pop_vars.erase(all_pop_vars.begin() + 1); - // } - if (tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD) { std::swap(all_pop_vars.at(0), all_pop_vars.at(1)); } @@ -1257,20 +1283,39 @@ void FunctionCallElement::update_from_stack(const Env& env, std::vector arg_forms; - for (size_t arg_id = 0; arg_id < nargs; arg_id++) { - auto val = unstacked.at(arg_id + 1); // first is the function itself. - auto& var = all_pop_vars.at(arg_id + 1); - if (env.has_type_analysis() && function_type.arg_count() == nargs + 1) { - auto actual_arg_type = env.get_types_before_op(var.idx()).get(var.reg()).typespec(); - auto desired_arg_type = function_type.get_arg(arg_id); - if (!env.dts->ts.tc(desired_arg_type, actual_arg_type)) { - arg_forms.push_back( - pool.alloc_single_element_form(nullptr, desired_arg_type, val)); + if (is_virtual_method) { + for (size_t arg_id = 0; arg_id < nargs; arg_id++) { + auto val = unstacked.at(arg_id + 1); // first is the function itself. + auto& var = all_pop_vars.at(arg_id + 1); + if (env.has_type_analysis() && function_type.arg_count() == nargs + 2) { + auto actual_arg_type = env.get_types_before_op(var.idx()).get(var.reg()).typespec(); + auto desired_arg_type = function_type.get_arg(arg_id + 1); + if (!env.dts->ts.tc(desired_arg_type, actual_arg_type)) { + arg_forms.push_back( + pool.alloc_single_element_form(nullptr, desired_arg_type, val)); + } else { + arg_forms.push_back(val); + } + } else { + arg_forms.push_back(val); + } + } + } else { + for (size_t arg_id = 0; arg_id < nargs; arg_id++) { + auto val = unstacked.at(arg_id + 1); // first is the function itself. + auto& var = all_pop_vars.at(arg_id + 1); + if (env.has_type_analysis() && function_type.arg_count() == nargs + 1) { + auto actual_arg_type = env.get_types_before_op(var.idx()).get(var.reg()).typespec(); + auto desired_arg_type = function_type.get_arg(arg_id); + if (!env.dts->ts.tc(desired_arg_type, actual_arg_type)) { + arg_forms.push_back( + pool.alloc_single_element_form(nullptr, desired_arg_type, val)); + } else { + arg_forms.push_back(val); + } } else { arg_forms.push_back(val); } - } else { - arg_forms.push_back(val); } } @@ -1650,7 +1695,7 @@ void CondNoElseElement::push_to_stack(const Env& env, FormPool& pool, FormStack& if (used_as_value) { // TODO - is this wrong? stack.push_value_to_reg(final_destination, pool.alloc_single_form(nullptr, this), true, - env.get_variable_type(final_destination)); + env.get_variable_type(final_destination, false)); } else { stack.push_form_element(this, true); } @@ -1775,7 +1820,7 @@ void CondWithElseElement::push_to_stack(const Env& env, FormPool& pool, FormStac stack.push_form_element(this, true); } else { stack.push_value_to_reg(*last_var, pool.alloc_single_form(nullptr, this), true, - env.get_variable_type(*last_var)); + env.get_variable_type(*last_var, false)); } } else { stack.push_form_element(this, true); @@ -1834,7 +1879,7 @@ void ShortCircuitElement::push_to_stack(const Env& env, FormPool& pool, FormStac assert(used_as_value.has_value()); stack.push_value_to_reg(final_result, pool.alloc_single_form(nullptr, this), true, - env.get_variable_type(final_result)); + env.get_variable_type(final_result, false)); already_rewritten = true; } } diff --git a/decompiler/IR2/FormStack.cpp b/decompiler/IR2/FormStack.cpp index d5cc96aab..d46503473 100644 --- a/decompiler/IR2/FormStack.cpp +++ b/decompiler/IR2/FormStack.cpp @@ -232,7 +232,7 @@ FormElement* FormStack::pop_back(FormPool& pool) { namespace { bool is_op_in_place(SetVarElement* elt, FixedOperatorKind op, - const Env&, + const Env& env, RegisterAccess* base_out, Form** val_out) { auto matcher = Matcher::op(GenericOpMatcher::fixed(op), {Matcher::any_reg(0), Matcher::any(1)}); @@ -240,6 +240,7 @@ bool is_op_in_place(SetVarElement* elt, if (result.matched) { auto first = result.maps.regs.at(0); assert(first.has_value()); + if (first->reg() != elt->dst().reg()) { return false; } @@ -248,6 +249,14 @@ bool is_op_in_place(SetVarElement* elt, return false; } + auto src_var = env.get_variable_name(*first); + auto dst_var = env.get_variable_name(elt->dst()); + if (src_var != dst_var) { + // something like daddu a1-1, a1-0, v0 isn't safe to turn into an in-place, but will pass + // the previous two checks. + return false; + } + *val_out = result.maps.forms.at(1); *base_out = first.value(); return true; diff --git a/decompiler/IR2/IR2_common.h b/decompiler/IR2/IR2_common.h index b5073c5bf..a6769d0fb 100644 --- a/decompiler/IR2/IR2_common.h +++ b/decompiler/IR2/IR2_common.h @@ -105,6 +105,7 @@ enum class FixedOperatorKind { ADDITION_IN_PLACE, ADDITION_PTR_IN_PLACE, SUBTRACTION, + SUBTRACTION_PTR, MULTIPLICATION, SQRT, ARITH_SHIFT, @@ -138,6 +139,7 @@ enum class FixedOperatorKind { METHOD_OF_OBJECT, NULLP, PAIRP, + NONE, INVALID }; diff --git a/decompiler/analysis/expression_build.cpp b/decompiler/analysis/expression_build.cpp index 426ec28df..3a4ae7760 100644 --- a/decompiler/analysis/expression_build.cpp +++ b/decompiler/analysis/expression_build.cpp @@ -19,6 +19,31 @@ bool convert_to_expressions( const DecompilerTypeSystem& dts) { assert(top_level_form); + // set argument names to some reasonable defaults. these will be used if the user doesn't + // give us anything more specific. + if (f.guessed_name.kind == FunctionName::FunctionKind::GLOBAL) { + f.ir2.env.set_remap_for_function(f.type.arg_count() - 1); + } else if (f.guessed_name.kind == FunctionName::FunctionKind::METHOD) { + if (f.guessed_name.method_id == GOAL_NEW_METHOD) { + f.ir2.env.set_remap_for_new_method(f.type.arg_count() - 1); + } else { + f.ir2.env.set_remap_for_method(f.type.arg_count() - 1); + } + } + + // get variable names from the user. + f.ir2.env.map_args_from_config(arg_names, var_override_map); + + // override variable types from the user. + + std::unordered_map retype; + for (auto& remap : var_override_map) { + if (remap.second.type) { + retype[remap.first] = dts.parse_type_spec(*remap.second.type); + } + } + f.ir2.env.set_retype_map(retype); + try { // create the root expression stack for the function FormStack stack(true); @@ -45,6 +70,8 @@ bool convert_to_expressions( } else { // or just get all the expressions new_entries = stack.rewrite(pool, f.ir2.env); + new_entries.push_back( + pool.alloc_element(GenericOperator::make_fixed(FixedOperatorKind::NONE))); } // if we are a totally empty function, insert a placeholder so we don't have to handle @@ -70,31 +97,6 @@ bool convert_to_expressions( return false; } - // set argument names to some reasonable defaults. these will be used if the user doesn't - // give us anything more specific. - if (f.guessed_name.kind == FunctionName::FunctionKind::GLOBAL) { - f.ir2.env.set_remap_for_function(f.type.arg_count() - 1); - } else if (f.guessed_name.kind == FunctionName::FunctionKind::METHOD) { - if (f.guessed_name.method_id == GOAL_NEW_METHOD) { - f.ir2.env.set_remap_for_new_method(f.type.arg_count() - 1); - } else { - f.ir2.env.set_remap_for_method(f.type.arg_count() - 1); - } - } - - // get variable names from the user. - f.ir2.env.map_args_from_config(arg_names, var_override_map); - - // override variable types from the user. - - std::unordered_map retype; - for (auto& remap : var_override_map) { - if (remap.second.type) { - retype[remap.first] = dts.parse_type_spec(*remap.second.type); - } - } - f.ir2.env.set_retype_map(retype); - return true; } } // namespace decompiler diff --git a/decompiler/analysis/insert_lets.cpp b/decompiler/analysis/insert_lets.cpp index 993376f4c..0e17c36de 100644 --- a/decompiler/analysis/insert_lets.cpp +++ b/decompiler/analysis/insert_lets.cpp @@ -222,7 +222,7 @@ Form* insert_cast_for_let(RegisterAccess dst, Form* src, FormPool& pool, const Env& env) { - auto dst_type = env.get_variable_type(dst); + auto dst_type = env.get_variable_type(dst, true); if (src_type != dst_type) { // fmt::print("inserting let cast because {} != {}\n", dst_type.print(), src_type.print()); diff --git a/decompiler/config/all-types.gc b/decompiler/config/all-types.gc index 64e5b46fc..599c9aedb 100644 --- a/decompiler/config/all-types.gc +++ b/decompiler/config/all-types.gc @@ -2507,7 +2507,7 @@ ;;(define-extern dma-sync object) ;; unknown type ;;(define-extern dma-packet-array object) ;; unknown type (define-extern dma-buffer-inplace-new (function dma-buffer int dma-buffer)) -(define-extern dma-buffer-length (function dma-buffer uint)) +(define-extern dma-buffer-length (function dma-buffer int)) (define-extern dma-buffer-free (function dma-buffer int)) ;;(define-extern dma-gif-packet object) ;; unknown type diff --git a/decompiler/config/jak1_ntsc_black_label.jsonc b/decompiler/config/jak1_ntsc_black_label.jsonc index a332a4d26..45a3ac7dc 100644 --- a/decompiler/config/jak1_ntsc_black_label.jsonc +++ b/decompiler/config/jak1_ntsc_black_label.jsonc @@ -111,6 +111,7 @@ "(method 0 catch-frame)", "throw-dispatch", "set-to-run-bootstrap", + "run-function-in-process", // not asm, but it uses the stack. // pskernel "return-from-exception", // F: eret diff --git a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc index 5d187a718..94f5f7fff 100644 --- a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc @@ -5,7 +5,13 @@ ], "gkernel": [ - ["L345", "_auto_", true] + ["L345", "_auto_", true], + ["L344", "_auto_", true], + ["L346", "float", true], + ["L347", "float", true], + ["L348", "float", true], + ["L289", "_auto_", true], + ["L282", "_auto_", true] ], "math": [ diff --git a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc index 1f7c507c1..0015910aa 100644 --- a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc @@ -64,7 +64,7 @@ "(method 0 dead-pool-heap)": [ [60, "v0", "int"], // a lie, actually the 115 is an align16 constant propagated on addr of heap start. - [63, "a0", "pointer"], + //[63, "a0", "pointer"], [[61, 73], "v0", "dead-pool-heap"] ], @@ -89,13 +89,13 @@ "(method 9 process)": [[43, "s5", "process"]], "(method 14 dead-pool)": [ - [[24, 26], "v1", "(pointer process-tree)"], + [[24, 25], "v1", "(pointer process-tree)"], [[30, 39], "s4", "(pointer process-tree)"] ], "inspect-process-heap": [ [[4, 11], "s5", "basic"], - [17, "s5", "int"] + [17, "s5", "pointer"] ], "name=": [ diff --git a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc index 7c026d1c0..5af972921 100644 --- a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc @@ -191,6 +191,16 @@ "vars":{"v1-1":"in-goal-mem"} }, + // GKERNEL + + "(method 0 cpu-thread)":{ + "vars":{"v0-0":["obj", "cpu-thread"]} + }, + + "inspect-process-heap":{ + "vars":{"s5-0":["obj", "pointer"]} + }, + "(method 23 dead-pool-heap)":{ "args":["this", "rec"] }, diff --git a/decompiler/util/TP_Type.cpp b/decompiler/util/TP_Type.cpp index 0d579086e..2c63b2a0b 100644 --- a/decompiler/util/TP_Type.cpp +++ b/decompiler/util/TP_Type.cpp @@ -130,10 +130,13 @@ TypeSpec TP_Type::typespec() const { case Kind::PRODUCT_WITH_CONSTANT: return m_ts; case Kind::OBJECT_PLUS_PRODUCT_WITH_CONSTANT: + if (m_ts.base_type() == "pointer") { + return TypeSpec("pointer"); + } // this can be part of an array access, so we don't really know the type. // probably not a good idea to try to do anything with this as a typespec // so let's be very vague - return TypeSpec("pointer"); + return TypeSpec("int"); case Kind::OBJECT_NEW_METHOD: // similar to previous case, being more vague than we need to be because we don't // want to assume the return type incorrectly and you shouldn't try to do anything with diff --git a/decompiler/util/TP_Type.h b/decompiler/util/TP_Type.h index a1764aff7..79872b832 100644 --- a/decompiler/util/TP_Type.h +++ b/decompiler/util/TP_Type.h @@ -40,6 +40,35 @@ class TP_Type { bool operator!=(const TP_Type& other) const; TypeSpec typespec() const; + /*! + * Returns true if the expression with this type should always be wrapped in a cast. + */ + bool requires_cast() const { + switch (kind) { + case Kind::TYPESPEC: + case Kind::TYPE_OF_TYPE_OR_CHILD: + case Kind::TYPE_OF_TYPE_NO_VIRTUAL: + case Kind::FALSE_AS_NULL: // if we want all #f's for references to be cast, move this. + case Kind::PRODUCT_WITH_CONSTANT: + case Kind::STRING_CONSTANT: + case Kind::FORMAT_STRING: + case Kind::INTEGER_CONSTANT: + case Kind::INTEGER_CONSTANT_PLUS_VAR: + case Kind::INTEGER_CONSTANT_PLUS_VAR_MULT: + case Kind::VIRTUAL_METHOD: + case Kind::NON_VIRTUAL_METHOD: + return false; + case Kind::UNINITIALIZED: + case Kind::OBJECT_PLUS_PRODUCT_WITH_CONSTANT: + case Kind::OBJECT_NEW_METHOD: + case Kind::DYNAMIC_METHOD_ACCESS: + return true; + case Kind::INVALID: + default: + assert(false); + } + } + bool is_constant_string() const { return kind == Kind::STRING_CONSTANT; } bool is_integer_constant() const { return kind == Kind::INTEGER_CONSTANT; } bool is_integer_constant(int64_t value) const { return is_integer_constant() && m_int == value; } diff --git a/decompiler/util/data_decompile.cpp b/decompiler/util/data_decompile.cpp index fcdd00226..18d840203 100644 --- a/decompiler/util/data_decompile.cpp +++ b/decompiler/util/data_decompile.cpp @@ -722,7 +722,7 @@ goos::Object decompile_pair(const DecompilerLabel& label, auto cdr_word = words.at(to_print.target_segment).at((to_print.offset + 2) / 4); // if empty if (cdr_word.kind == LinkedWord::EMPTY_PTR) { - return pretty_print::build_list(list_tokens); + return pretty_print::build_list("quote", pretty_print::build_list(list_tokens)); } // if pointer if (cdr_word.kind == LinkedWord::PTR) { @@ -736,7 +736,7 @@ goos::Object decompile_pair(const DecompilerLabel& label, "could not find a test case yet."); list_tokens.push_back(pretty_print::to_symbol(".")); list_tokens.push_back(decompile_pair_elt(cdr_word, labels, words, ts)); - return pretty_print::build_list(list_tokens); + return pretty_print::build_list("quote", pretty_print::build_list(list_tokens)); } else { if ((to_print.offset % 4) != 0) { throw std::runtime_error( @@ -755,7 +755,7 @@ goos::Object decompile_pair(const DecompilerLabel& label, list_tokens.push_back(pretty_print::to_symbol(".")); list_tokens.push_back(decompile_pair_elt( words.at(to_print.target_segment).at(to_print.offset / 4), labels, words, ts)); - return pretty_print::build_list(list_tokens); + return pretty_print::build_list("quote", pretty_print::build_list(list_tokens)); } } } diff --git a/goal_src/goal-lib.gc b/goal_src/goal-lib.gc index caadf79df..1764e8e50 100644 --- a/goal_src/goal-lib.gc +++ b/goal_src/goal-lib.gc @@ -172,6 +172,11 @@ `(/ 0 0) ) +(defmacro break! () + "A breakpoint. Todo - should we use int3 instead?" + `(/ 0 0) + ) + ;;;;;;;;;;;;;;;;;;; ;; GOAL Syntax ;;;;;;;;;;;;;;;;;;; @@ -379,7 +384,7 @@ ) (defmacro &- (a b) - `(- (the-as uint ,a) (the-as uint ,b)) + `(- (the-as int ,a) (the-as int ,b)) ) (defmacro &-> (&rest args) diff --git a/test/decompiler/reference/all_forward_declarations.gc b/test/decompiler/reference/all_forward_declarations.gc new file mode 100644 index 000000000..7bab130d2 --- /dev/null +++ b/test/decompiler/reference/all_forward_declarations.gc @@ -0,0 +1,71 @@ +;; GCOMMON +(define-extern name= (function basic basic symbol)) +(define-extern fact (function int int)) + +;; KERNEL +(declare-type process basic) +(declare-type stack-frame basic) +(declare-type state basic) +(declare-type cpu-thread basic) +(declare-type dead-pool basic) +(declare-type event-message-block structure) +(declare-type thread basic) + +(deftype process (process-tree) + ((pool dead-pool :offset-assert #x20) + (status basic :offset-assert #x24) + (pid int32 :offset-assert #x28) + (main-thread cpu-thread :offset-assert #x2c) + (top-thread thread :offset-assert #x30) + (entity basic :offset-assert #x34) + (state state :offset-assert #x38) + (trans-hook function :offset-assert #x3c) + (post-hook function :offset-assert #x40) + (event-hook (function basic int basic event-message-block object) :offset-assert #x44) + (allocated-length int32 :offset-assert #x48) + (next-state state :offset-assert #x4c) + (heap-base pointer :offset-assert #x50) + (heap-top pointer :offset-assert #x54) + (heap-cur pointer :offset-assert #x58) + (stack-frame-top stack-frame :offset-assert #x5c) + (connection-list connectable :inline :offset-assert #x60) + (stack uint8 :dynamic :offset-assert #x70) + ) + + (:methods + (new (symbol type basic int) _type_ 0) + (activate (_type_ process-tree basic pointer) process-tree 9) + (deactivate (process) none 10) + (dummy-method-11 () none 11) + (run-logic? (process) symbol 12) + (dummy-method () none 13) + ) + + :size-assert #x70 + :method-count-assert 14 + :no-runtime-type ;; already defined by kscheme. Don't do it again. + ) + +(declare-type dead-pool-heap basic) +(define-extern *debug-dead-pool* dead-pool-heap) +(define-extern change-parent (function process-tree process-tree process-tree)) +(define-extern *null-process* process) +(define-extern *vis-boot* basic) +(define-extern *stdcon* string) +(declare-type kernel-context basic) +(define-extern iterate-process-tree (function process-tree (function object object) kernel-context object)) +(define-extern execute-process-tree (function process-tree (function object object) kernel-context object)) +(define-extern search-process-tree (function process-tree (function process-tree object) process-tree)) + +(define-extern *listener-process* process) +(define-extern *active-pool* process-tree) +(define-extern reset-and-call (function thread function object)) +(define-extern ash (function int int int)) +(define-extern inspect-process-tree (function process-tree int int symbol process-tree)) +(define-extern set-to-run-bootstrap (function none)) +(define-extern dead-state state) +(define-extern *display-pool* process-tree) +(define-extern *camera-pool* process-tree) +(define-extern *target-pool* process-tree) +(define-extern *entity-pool* process-tree) +(define-extern *default-pool* process-tree) \ No newline at end of file diff --git a/test/decompiler/reference/gcommon_REF.gc b/test/decompiler/reference/gcommon_REF.gc index ffb8cd397..620317820 100644 --- a/test/decompiler/reference/gcommon_REF.gc +++ b/test/decompiler/reference/gcommon_REF.gc @@ -918,11 +918,12 @@ ;; WARN: Inline assembly instruction marked with TODO - [TODO.LQ] ;; WARN: Inline assembly instruction marked with TODO - [TODO.SQ] (defun qmem-copy->! ((dst pointer) (src pointer) (size int)) - (local-vars (src-ptr pointer) (dst-ptr pointer) (value int)) + (local-vars (value int)) (let ((result dst)) - (let ((qwc (sar (+ size 15) 4))) - (&+! dst (shl qwc 4)) - (&+! src (shl qwc 4)) + (let* ((qwc (sar (+ size 15) 4)) + (src-ptr (&+ dst (shl qwc 4))) + (dst-ptr (&+ src (shl qwc 4))) + ) (while (nonzero? qwc) (+! qwc -1) (&+! src-ptr -16) @@ -1317,4 +1318,7 @@ ;; failed to figure out what this is: (let ((v0-3 0)) - ) \ No newline at end of file + ) + +;; failed to figure out what this is: +(none) \ No newline at end of file diff --git a/test/decompiler/reference/gkernel-h_REF.gc b/test/decompiler/reference/gkernel-h_REF.gc index 2b34499f7..a00cb6cea 100644 --- a/test/decompiler/reference/gkernel-h_REF.gc +++ b/test/decompiler/reference/gkernel-h_REF.gc @@ -379,6 +379,5 @@ (let ((v0-11 0)) ) - - - +;; failed to figure out what this is: +(none) diff --git a/test/decompiler/reference/gkernel_REF.gc b/test/decompiler/reference/gkernel_REF.gc new file mode 100644 index 000000000..f8ae20461 --- /dev/null +++ b/test/decompiler/reference/gkernel_REF.gc @@ -0,0 +1,1913 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for symbol *kernel-version*, type binteger +(define *kernel-version* (the-as binteger #xa00000)) + +;; definition for symbol *irx-version*, type binteger +(define *irx-version* (the-as binteger #x100000)) + +;; definition for symbol *kernel-boot-mode*, type symbol +(define *kernel-boot-mode* 'listener) + +;; definition for symbol *kernel-boot-level*, type symbol +(define *kernel-boot-level* #f) + +;; definition for symbol *deci-count*, type int +(define *deci-count* 0) + +;; definition for symbol *last-loado-length*, type int +(define *last-loado-length* 0) + +;; definition for symbol *last-loado-global-usage*, type int +(define *last-loado-global-usage* 0) + +;; definition for symbol *last-loado-debug-usage*, type int +(define *last-loado-debug-usage* 0) + +;; definition for method 7 of type object +(defmethod relocate object ((obj object) (arg0 int)) + obj + ) + +;; definition for symbol *kernel-packages*, type pair +(define *kernel-packages* '()) + +;; definition for function load-package +(defun load-package ((arg0 string) (arg1 kheap)) + (when (not (nmember arg0 *kernel-packages*)) + (dgo-load arg0 arg1 15 #x200000) + (let ((v0-1 (cons arg0 *kernel-packages*))) + (set! *kernel-packages* v0-1) + v0-1 + ) + ) + ) + +;; definition for function unload-package +(defun unload-package ((arg0 string)) + (let ((v1-0 (nmember arg0 *kernel-packages*))) + (if v1-0 (set! *kernel-packages* (delete! (car v1-0) *kernel-packages*)) + ) + ) + *kernel-packages* + ) + +;; definition for symbol *kernel-context*, type kernel-context +(define + *kernel-context* + (new 'static 'kernel-context + :prevent-from-run #x41 + :next-pid 2 + :current-process #f + :relocating-process #f + :low-memory-message #t + ) + ) + +;; definition for symbol *dram-stack*, type (pointer uint8) +(define *dram-stack* (the-as (pointer uint8) (malloc 'global #x3800))) + +;; failed to figure out what this is: +(set! (-> *kernel-context* fast-stack-top) (the-as pointer #x70004000)) + +;; definition for symbol *null-kernel-context*, type kernel-context +(define *null-kernel-context* (new 'static 'kernel-context)) + +;; definition for method 1 of type thread +;; INFO: Return type mismatch thread vs none. +(defmethod delete thread ((obj thread)) + (when (= obj (-> obj process main-thread)) + (break!) + (let ((v1-3 0)) + ) + ) + (set! (-> obj process top-thread) (-> obj previous)) + (none) + ) + +;; definition for method 2 of type thread +(defmethod print thread ((obj thread)) + (format + #t + "#<~A ~S of ~S pc: #x~X @ #x~X>" + (-> obj type) + (-> obj name) + (-> obj process name) + (-> obj pc) + obj + ) + obj + ) + +;; definition for method 9 of type thread +;; INFO: Return type mismatch int vs none. +(defmethod stack-size-set! thread ((obj thread) (arg0 int)) + (let ((a2-0 (-> obj process))) + (cond + ((!= obj (-> a2-0 main-thread)) + (format + 0 + "ERROR: illegal attempt change stack size of ~A when the main-thread is not the top-thread.~%" + a2-0 + ) + ) + ((= (-> obj stack-size) arg0) + ) + ((= + (-> a2-0 heap-cur) + (+ + (+ (+ (-> obj stack-size) -4) (the-as int (-> obj type size))) + (the-as int obj) + ) + ) + (set! + (-> a2-0 heap-cur) + (the-as + pointer + (+ (+ (+ arg0 -4) (the-as int (-> obj type size))) (the-as int obj)) + ) + ) + (set! (-> obj stack-size) arg0) + ) + (else + (format + 0 + "ERROR: illegal attempt change stack size of ~A after more heap allocation has occured.~%" + a2-0 + ) + ) + ) + ) + (let ((v0-2 0)) + ) + (none) + ) + +;; definition for method 0 of type cpu-thread +;; INFO: Return type mismatch object vs cpu-thread. +(defmethod + new + cpu-thread + ((allocation symbol) + (type-to-make type) + (arg0 process) + (arg1 symbol) + (arg2 int) + (arg3 pointer) + ) + (let ((obj (the-as cpu-thread (if (-> arg0 top-thread) + (&+ arg3 -7164) + (let + ((v1-2 + (logand + -16 + (the-as int (&+ (-> arg0 heap-cur) 15)) + ) + ) + ) + (set! + (-> arg0 heap-cur) + (the-as + pointer + (+ + (+ + v1-2 + (the-as int (-> type-to-make size)) + ) + arg2 + ) + ) + ) + (+ v1-2 4) + ) + ) + ) + ) + ) + (set! (-> obj type) type-to-make) + (set! (-> obj name) arg1) + (set! (-> obj process) arg0) + (set! (-> obj sp) arg3) + (set! (-> obj stack-top) arg3) + (set! (-> obj previous) (-> arg0 top-thread)) + (set! (-> arg0 top-thread) obj) + (set! (-> obj suspend-hook) (method-of-object obj thread-suspend)) + (set! (-> obj resume-hook) (method-of-object obj thread-resume)) + (set! (-> obj stack-size) arg2) + (the-as cpu-thread (the-as object obj)) + ) + ) + +;; definition for method 5 of type cpu-thread +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of cpu-thread ((obj cpu-thread)) + (the-as int (+ (-> obj type size) (the-as uint (-> obj stack-size)))) + ) + +;; definition for function remove-exit +(defun remove-exit () (local-vars (pp process)) + (if (-> pp stack-frame-top) + (let ((v0-0 (-> pp stack-frame-top next))) + (set! (-> pp stack-frame-top) v0-0) + v0-0 + ) + ) + ) + +;; definition (debug) for function stream<-process-mask +;; INFO: Return type mismatch int vs object. +(defun-debug stream<-process-mask ((arg0 object) (arg1 int)) + (let ((s4-0 arg1)) + (if (= (logand #x1000000 s4-0) #x1000000) + (format arg0 "death ") + ) + (if (= (logand #x800000 s4-0) #x800000) + (format arg0 "attackable ") + ) + (if (= (logand #x400000 s4-0) #x400000) + (format arg0 "projectile ") + ) + (if (= (logand #x200000 s4-0) #x200000) + (format arg0 "entity ") + ) + (if (= (logand #x100000 s4-0) #x100000) + (format arg0 "ambient ") + ) + (if (= (logand #x80000 s4-0) #x80000) + (format arg0 "platform ") + ) + (if (= (logand #x40000 s4-0) #x40000) + (format arg0 "camera ") + ) + (if (= (logand #x20000 s4-0) #x20000) + (format arg0 "enemy ") + ) + (if (= (logand #x10000 s4-0) #x10000) + (format arg0 "collectable ") + ) + (if (= (logand s4-0 #x8000) #x8000) + (format arg0 "crate ") + ) + (if (= (logand s4-0 #x4000) #x4000) + (format arg0 "sidekick ") + ) + (if (= (logand s4-0 8192) 8192) + (format arg0 "target ") + ) + (if (= (logand s4-0 4096) 4096) + (format arg0 "movie-subject ") + ) + (if (= (logand s4-0 2048) 2048) + (format arg0 "movie ") + ) + (if (= (logand s4-0 1024) 1024) + (format arg0 "going ") + ) + (if (= (logand s4-0 512) 512) + (format arg0 "heap-shrunk ") + ) + (if (= (logand s4-0 256) 256) + (format arg0 "process-tree ") + ) + (if (= (logand s4-0 128) 128) + (format arg0 "sleep-code ") + ) + (if (= (logand s4-0 64) 64) + (format arg0 "sleep ") + ) + (if (= (logand s4-0 32) 32) + (format arg0 "actor-pause ") + ) + (if (= (logand s4-0 16) 16) + (format arg0 "progress ") + ) + (if (= (logand s4-0 8) 8) + (format arg0 "menu ") + ) + (if (= (logand s4-0 4) 4) + (format arg0 "pause ") + ) + (if (= (logand s4-0 2) 2) + (format arg0 "draw ") + ) + (if (= (logand s4-0 1) 1) + (format arg0 "execute ") + ) + ) + arg1 + ) + +;; definition for symbol *master-mode*, type symbol +(define *master-mode* 'game) + +;; definition for symbol *pause-lock*, type symbol +(define *pause-lock* #f) + +;; definition for method 0 of type process-tree +(defmethod + new + process-tree + ((allocation symbol) (type-to-make type) (arg0 basic)) + (let + ((v0-0 + (object-new allocation type-to-make (the-as int (-> type-to-make size))) + ) + ) + (set! (-> v0-0 name) arg0) + (set! (-> v0-0 mask) (the-as uint 256)) + (set! (-> v0-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 child) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 self) v0-0) + (set! (-> v0-0 ppointer) (&-> v0-0 self)) + v0-0 + ) + ) + +;; definition for method 3 of type process-tree +(defmethod inspect process-tree ((obj process-tree)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~S~%" (-> obj name)) + (format #t "~Tmask: #x~X~%" (-> obj mask)) + (let ((t9-3 format) + (a0-4 #t) + (a1-3 "~Tparent: ~A~%") + (v1-0 (-> obj parent)) + ) + (t9-3 a0-4 a1-3 (if v1-0 (-> v1-0 0 self) + ) + ) + ) + (let ((t9-4 format) + (a0-5 #t) + (a1-4 "~Tbrother: ~A~%") + (v1-2 (-> obj brother)) + ) + (t9-4 a0-5 a1-4 (if v1-2 (-> v1-2 0 self) + ) + ) + ) + (let ((t9-5 format) + (a0-6 #t) + (a1-5 "~Tchild: ~A~%") + (v1-4 (-> obj child)) + ) + (t9-5 a0-6 a1-5 (if v1-4 (-> v1-4 0 self) + ) + ) + ) + obj + ) + +;; definition for method 0 of type process +;; INFO: Return type mismatch object vs process. +(defmethod + new + process + ((allocation symbol) (type-to-make type) (arg0 basic) (arg1 int)) + (let ((v0-0 (if (= (-> allocation type) symbol) + (object-new + allocation + type-to-make + (the-as int (+ (-> process size) (the-as uint arg1))) + ) + (+ (the-as int allocation) 4) + ) + ) + ) + (set! (-> (the-as process v0-0) name) arg0) + (set! (-> (the-as process v0-0) status) 'dead) + (set! (-> (the-as process v0-0) pid) 0) + (set! (-> (the-as process v0-0) pool) #f) + (set! (-> (the-as process v0-0) allocated-length) arg1) + (set! (-> (the-as process v0-0) top-thread) #f) + (set! (-> (the-as process v0-0) main-thread) #f) + (let ((v1-5 (-> (the-as process v0-0) stack))) + (set! (-> (the-as process v0-0) heap-cur) v1-5) + (set! (-> (the-as process v0-0) heap-base) v1-5) + ) + (set! + (-> (the-as process v0-0) heap-top) + (&-> + (the-as process v0-0) + stack + (-> (the-as process v0-0) allocated-length) + ) + ) + (set! + (-> (the-as process v0-0) stack-frame-top) + (the-as stack-frame (-> (the-as process v0-0) heap-top)) + ) + (set! (-> (the-as process v0-0) stack-frame-top) #f) + (set! (-> (the-as process v0-0) state) #f) + (set! (-> (the-as process v0-0) next-state) #f) + (set! (-> (the-as process v0-0) entity) #f) + (set! (-> (the-as process v0-0) trans-hook) #f) + (set! (-> (the-as process v0-0) post-hook) #f) + (set! (-> (the-as process v0-0) event-hook) #f) + (set! (-> (the-as process v0-0) parent) (the-as (pointer process-tree) #f)) + (set! (-> (the-as process v0-0) brother) (the-as (pointer process-tree) #f)) + (set! (-> (the-as process v0-0) child) (the-as (pointer process-tree) #f)) + (set! (-> (the-as process v0-0) self) (the-as process v0-0)) + (set! (-> (the-as process v0-0) ppointer) (&-> (the-as process v0-0) self)) + (the-as process v0-0) + ) + ) + +;; definition for function inspect-process-heap +(defun inspect-process-heap ((arg0 process)) + (let ((obj (&+ (-> arg0 heap-base) 4))) + (while (< (the-as int obj) (the-as int (-> arg0 heap-cur))) + (inspect (the-as basic obj)) + (&+! obj (logand -16 (+ (asize-of (the-as basic obj)) 15))) + ) + ) + #f + ) + +;; definition for method 3 of type process +(defmethod inspect process ((obj process)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~S~%" (-> obj name)) + (format #t "~Tmask: #x~X~%" (-> obj mask)) + (format #t "~Tstatus: ~A~%" (-> obj status)) + (format #t "~Tmain-thread: ~A~%" (-> obj main-thread)) + (format #t "~Ttop-thread: ~A~%" (-> obj top-thread)) + (format #t "~Tentity: ~A~%" (-> obj entity)) + (format #t "~Tstate: ~A~%" (-> obj state)) + (format #t "~Tnext-state: ~A~%" (-> obj next-state)) + (format #t "~Ttrans-hook: ~A~%" (-> obj trans-hook)) + (format #t "~Tpost-hook: ~A~%" (-> obj post-hook)) + (format #t "~Tevent-hook: ~A~%" (-> obj event-hook)) + (let ((t9-12 format) + (a0-13 #t) + (a1-12 "~Tparent: ~A~%") + (v1-0 (-> obj parent)) + ) + (t9-12 a0-13 a1-12 (if v1-0 (-> v1-0 0 self) + ) + ) + ) + (let ((t9-13 format) + (a0-14 #t) + (a1-13 "~Tbrother: ~A~%") + (v1-2 (-> obj brother)) + ) + (t9-13 a0-14 a1-13 (if v1-2 (-> v1-2 0 self) + ) + ) + ) + (let ((t9-14 format) + (a0-15 #t) + (a1-14 "~Tchild: ~A~%") + (v1-4 (-> obj child)) + ) + (t9-14 a0-15 a1-14 (if v1-4 (-> v1-4 0 self) + ) + ) + ) + (format #t "~Tconnection-list: ~`connectable`P~%" (-> obj connection-list)) + (format #t "~Tstack-frame-top: ~A~%" (-> obj stack-frame-top)) + (format #t "~Theap-base: #x~X~%" (-> obj heap-base)) + (format #t "~Theap-top: #x~X~%" (-> obj heap-top)) + (format #t "~Theap-cur: #x~X~%" (-> obj heap-cur)) + (let ((s5-0 *print-column*)) + (set! *print-column* (+ *print-column* (the-as uint 64))) + (format #t "----~%") + (inspect-process-heap obj) + (format #t "----~%") + (set! *print-column* s5-0) + ) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Tstack[~D] @ #x~X~%" (-> obj allocated-length) (-> obj stack)) + obj + ) + +;; definition for method 5 of type process +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of process ((obj process)) + (the-as int (+ (-> process size) (the-as uint (-> obj allocated-length)))) + ) + +;; definition for method 2 of type process +(defmethod print process ((obj process)) + (format + #t + "#<~A ~S ~A :state ~S " + (-> obj type) + (-> obj name) + (-> obj status) + (if (-> obj state) + (-> obj state name) + ) + ) + (format + #t + ":stack ~D/~D :heap ~D/~D @ #x~X>" + (&- (-> obj top-thread stack-top) (the-as uint (-> obj top-thread sp))) + (-> obj main-thread stack-size) + (- + (-> obj allocated-length) + (&- (-> obj heap-top) (the-as uint (-> obj heap-cur))) + ) + (-> obj allocated-length) + obj + ) + obj + ) + +;; definition for function return-from-thread +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function return-from-thread-dead +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function reset-and-call +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 10 of type cpu-thread +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 11 of type cpu-thread +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 0 of type dead-pool +(defmethod + new + dead-pool + ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int) (arg2 basic)) + (let + ((s3-0 + (object-new allocation type-to-make (the-as int (-> type-to-make size))) + ) + ) + (set! (-> s3-0 name) arg2) + (set! (-> s3-0 mask) (the-as uint 256)) + (set! (-> s3-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 child) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 self) s3-0) + (set! (-> s3-0 ppointer) (&-> s3-0 self)) + (dotimes (s2-1 arg0) + (let ((s1-0 (-> s3-0 child)) + (v1-5 ((method-of-type process new) allocation process 'dead arg1)) + ) + (let ((a0-3 v1-5)) + (set! (-> s3-0 child) (if a0-3 (-> a0-3 ppointer) + ) + ) + ) + (let ((a0-4 s3-0)) + (set! (-> v1-5 parent) (if a0-4 (-> a0-4 ppointer) + ) + ) + ) + (set! (-> v1-5 pool) s3-0) + (set! (-> v1-5 brother) s1-0) + ) + ) + s3-0 + ) + ) + +;; definition for method 14 of type dead-pool +;; INFO: Return type mismatch process-tree vs process. +(defmethod get-process dead-pool ((obj dead-pool) (arg0 type) (arg1 int)) + (let ((s4-0 (the-as object (-> obj child)))) + (when + (and + (not (the-as (pointer process-tree) s4-0)) + *debug-segment* + (!= obj *debug-dead-pool*) + ) + (set! s4-0 (get-process *debug-dead-pool* arg0 arg1)) + (if (the-as process s4-0) + (let ((t9-1 format) + (a0-2 0) + (a1-2 + "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" + ) + (a2-1 arg0) + (v1-6 (the-as process s4-0)) + ) + (t9-1 a0-2 a1-2 a2-1 (if (the-as process v1-6) + (-> (the-as (pointer process-tree) v1-6) 0 self) + ) + (-> obj name) + ) + ) + ) + ) + (the-as process (cond + (s4-0 + (set! + (-> (the-as (pointer process-tree) s4-0) 0 type) + arg0 + ) + (-> (the-as (pointer process-tree) s4-0) 0) + ) + (else + (format + 0 + "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" + arg0 + (if (the-as (pointer process-tree) s4-0) + (-> (the-as (pointer process-tree) s4-0) 0 self) + ) + (-> obj name) + ) + #f + ) + ) + ) + ) + ) + +;; definition for method 15 of type dead-pool +;; INFO: Return type mismatch process-tree vs none. +(defmethod return-process dead-pool ((obj dead-pool) (arg0 process)) + (change-parent arg0 obj) + (none) + ) + +;; definition for method 0 of type dead-pool-heap +(defmethod + new + dead-pool-heap + ((allocation symbol) (type-to-make type) (arg0 basic) (arg1 int) (arg2 int)) + (let + ((obj + (object-new + allocation + type-to-make + (the-as + int + (+ + (+ (-> type-to-make size) (the-as uint (logand -16 (+ (* 12 arg1) 15)))) + (the-as uint arg2) + ) + ) + ) + ) + ) + (set! (-> obj name) arg0) + (set! (-> obj mask) (the-as uint 256)) + (set! (-> obj allocated-length) arg1) + (set! (-> obj parent) (the-as (pointer process-tree) #f)) + (set! (-> obj brother) (the-as (pointer process-tree) #f)) + (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))) + ) + ) + ) + (set! + (-> obj dead-list next) + (the-as dead-pool-heap-rec (-> obj process-list)) + ) + (set! (-> obj alive-list process) #f) + (set! (-> obj process-list (+ arg1 -1) next) #f) + (set! (-> obj alive-list prev) (-> obj alive-list)) + (set! (-> obj alive-list next) #f) + (set! (-> obj alive-list process) #f) + (set! (-> obj first-gap) (-> obj alive-list)) + (set! (-> obj first-shrink) #f) + (set! + (-> obj heap base) + (the-as pointer (logand -16 (+ (+ (the-as int obj) 115) (* 12 arg1)))) + ) + (set! (-> obj heap current) (-> obj heap base)) + (set! (-> obj heap top) (&+ (-> obj heap base) arg2)) + (set! (-> obj heap top-base) (-> obj heap top)) + obj + ) + ) + +;; definition for method 22 of type dead-pool-heap +;; INFO: Return type mismatch object vs pointer. +(defmethod + gap-location + dead-pool-heap + ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + (the-as pointer (if (-> arg0 process) + (+ + (+ + (+ (-> arg0 process allocated-length) -4) + (the-as int (-> process size)) + ) + (the-as int (-> arg0 process)) + ) + (-> obj heap base) + ) + ) + ) + +;; definition for method 21 of type dead-pool-heap +(defmethod + gap-size + dead-pool-heap + ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + (if (-> arg0 process) + (let + ((v1-3 + (&+ + (&+ (the-as pointer (-> arg0 process)) (-> process size)) + (-> arg0 process allocated-length) + ) + ) + ) + (if (-> arg0 next) + (&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3)) + (&- (-> obj heap top) (the-as uint (&+ v1-3 4))) + ) + ) + (if (-> arg0 next) + (&- + (the-as pointer (-> arg0 next process)) + (the-as uint (&+ (-> obj heap base) 4)) + ) + (&- (-> obj heap top) (the-as uint (-> obj heap base))) + ) + ) + ) + +;; definition for method 23 of type dead-pool-heap +(defmethod + find-gap + dead-pool-heap + ((this dead-pool-heap) (rec dead-pool-heap-rec)) + (while (and (-> rec next) (zero? (gap-size this rec))) + (set! rec (-> rec next)) + ) + rec + ) + +;; definition for method 3 of type dead-pool-heap +;; INFO: this function exists in multiple non-identical object files +(defmethod inspect dead-pool-heap ((obj dead-pool-heap)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~A~%" (-> obj name)) + (format #t "~Tmask: ~D~%" (-> obj mask)) + (format #t "~Tparent: #x~X~%" (-> obj parent)) + (format #t "~Tbrother: #x~X~%" (-> obj brother)) + (format #t "~Tchild: #x~X~%" (-> obj child)) + (format #t "~Tppointer: #x~X~%" (-> obj ppointer)) + (format #t "~Tself: ~A~%" (-> obj self)) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Theap: #~%" (-> obj heap)) + (format #t "~Tfirst-gap: #~%" (-> obj first-gap)) + (format + #t + "~Tfirst-shrink: #~%" + (-> obj first-shrink) + ) + (format #t "~Talive-list: #~%" (-> obj alive-list)) + (format #t "~Tlast: #~%" (-> obj alive-list prev)) + (format #t "~Tdead-list: #~%" (-> obj dead-list)) + (let* ((s5-0 (&- (-> obj heap top) (the-as uint (-> obj heap base)))) + (v1-3 (if (-> obj alive-list prev) + (gap-size obj (-> obj alive-list prev)) + s5-0 + ) + ) + ) + (format + #t + "~Tprocess-list[0] @ #x~X ~D/~D bytes used~%" + (-> obj process-list) + (- s5-0 v1-3) + s5-0 + ) + ) + (let ((s5-1 (-> obj alive-list)) + (s4-0 0) + ) + (while s5-1 (if (-> s5-1 process) + (format + #t + "~T [~3D] # ~A~%" + s4-0 + s5-1 + (-> s5-1 process) + ) + ) + (let ((s3-0 (gap-size obj s5-1))) + (if (nonzero? s3-0) + (format #t "~T gap: ~D bytes @ #x~X~%" s3-0 (gap-location obj s5-1)) + ) + ) + (set! s5-1 (-> s5-1 next)) + (+! s4-0 1) + ) + ) + obj + ) + +;; definition for method 5 of type dead-pool-heap +(defmethod asize-of dead-pool-heap ((obj dead-pool-heap)) + (+ (the-as int (- -4 (the-as int obj))) (the-as int (-> obj heap top))) + ) + +;; definition for method 19 of type dead-pool-heap +(defmethod memory-used dead-pool-heap ((obj dead-pool-heap)) + (if (-> obj alive-list prev) + (- (memory-total obj) (gap-size obj (-> obj alive-list prev))) + 0 + ) + ) + +;; definition for method 20 of type dead-pool-heap +(defmethod memory-total dead-pool-heap ((obj dead-pool-heap)) + (&- (-> obj heap top) (the-as uint (-> obj heap base))) + ) + +;; definition for method 25 of type dead-pool-heap +(defmethod memory-free dead-pool-heap ((obj dead-pool-heap)) + (let ((v1-0 (-> obj heap top))) + (if (-> obj alive-list prev) + (gap-size obj (-> obj alive-list prev)) + (&- v1-0 (the-as uint (-> obj heap base))) + ) + ) + ) + +;; definition for method 26 of type dead-pool-heap +(defmethod compact-time dead-pool-heap ((obj dead-pool-heap)) + (-> obj compact-time) + ) + +;; definition for method 24 of type dead-pool-heap +(defmethod find-gap-by-size dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + (let ((gp-0 (-> obj first-gap))) + (while (and gp-0 (< (gap-size obj gp-0) arg0)) + (set! gp-0 (-> gp-0 next)) + ) + gp-0 + ) + ) + +;; definition for method 14 of type dead-pool-heap +(defmethod + get-process + dead-pool-heap + ((obj dead-pool-heap) (arg0 type) (arg1 int)) + (let ((s4-0 (-> obj dead-list next)) + (s3-0 (the-as process #f)) + ) + (let + ((s1-0 + (find-gap-by-size + obj + (the-as int (+ (-> process size) (the-as uint arg1))) + ) + ) + ) + (cond + ((and s4-0 s1-0) + (set! (-> obj dead-list next) (-> s4-0 next)) + (let ((v1-5 (-> s1-0 next))) + (set! (-> s1-0 next) s4-0) + (set! (-> s4-0 next) v1-5) + (when v1-5 (set! (-> v1-5 prev) s4-0) + (let ((v1-6 s4-0)) + ) + ) + ) + (set! (-> s4-0 prev) s1-0) + (when (= s1-0 (-> obj alive-list prev)) + (set! (-> obj alive-list prev) s4-0) + (let ((v1-9 s4-0)) + ) + ) + (let ((a0-4 (gap-location obj s1-0))) + (set! + s3-0 + ((method-of-type process new) + (the-as symbol a0-4) + process + 'process + arg1 + ) + ) + ) + (set! (-> s4-0 process) s3-0) + (set! (-> s3-0 ppointer) (&-> s4-0 process)) + (if (= (-> obj first-gap) s1-0) + (set! (-> obj first-gap) (find-gap obj s4-0)) + ) + (when + (or + (not (-> obj first-shrink)) + (< (the-as int s3-0) (the-as int (-> obj first-shrink process))) + ) + (set! (-> obj first-shrink) s4-0) + (let ((v1-22 s4-0)) + ) + ) + (set! (-> s3-0 parent) (-> obj ppointer)) + (set! (-> s3-0 pool) obj) + (set! (-> obj child) (&-> s4-0 process)) + ) + (else + (when (and *debug-segment* (!= obj *debug-dead-pool*)) + (set! s3-0 (get-process *debug-dead-pool* arg0 arg1)) + (if (and s3-0 *vis-boot*) + (format + 0 + "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" + arg0 + s3-0 + (-> obj name) + ) + ) + ) + ) + ) + ) + (if s3-0 (set! (-> s3-0 type) arg0) + (format + 0 + "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" + arg0 + s3-0 + (-> obj name) + ) + ) + s3-0 + ) + ) + +;; definition for method 15 of type dead-pool-heap +;; INFO: Return type mismatch int vs none. +(defmethod return-process dead-pool-heap ((obj dead-pool-heap) (arg0 process)) + (if (!= obj (-> arg0 pool)) + (format + 0 + "ERROR: process ~A does not belong to dead-pool-heap ~A.~%" + arg0 + obj + ) + ) + (change-parent arg0 obj) + (set! (-> obj child) (the-as (pointer process-tree) #f)) + (let ((s5-1 (-> arg0 ppointer))) + (if + (or + (= (-> obj first-gap) s5-1) + (< + (the-as int (gap-location obj (the-as dead-pool-heap-rec s5-1))) + (the-as int (gap-location obj (-> obj first-gap))) + ) + ) + (set! (-> obj first-gap) (the-as dead-pool-heap-rec (-> s5-1 1))) + ) + (when (= (-> obj first-shrink) s5-1) + (set! (-> obj first-shrink) (the-as dead-pool-heap-rec (-> s5-1 1))) + (when (not (-> obj first-shrink process)) + (set! (-> obj first-shrink) #f) + ) + ) + (set! (-> s5-1 1 parent) (the-as (pointer process-tree) (-> s5-1 2))) + (if (-> s5-1 2) + (set! (-> s5-1 2 mask) (the-as uint (-> s5-1 1))) + (set! (-> obj alive-list prev) (the-as dead-pool-heap-rec (-> s5-1 1))) + ) + (set! (-> s5-1 2) (the-as process-tree (-> obj dead-list next))) + (set! (-> obj dead-list next) (the-as dead-pool-heap-rec s5-1)) + (set! (-> s5-1 0) *null-process*) + ) + (let ((v0-4 0)) + ) + (none) + ) + +;; definition for method 17 of type dead-pool-heap +(defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (arg0 process)) + (if arg0 (let ((s5-0 (-> arg0 ppointer))) + (when + (not + (or + (nonzero? (logand (-> arg0 mask) 512)) + (and (not (-> arg0 next-state)) (not (-> arg0 state))) + ) + ) + (set! + (-> arg0 allocated-length) + (&- (-> arg0 heap-cur) (the-as uint (-> arg0 stack))) + ) + (set! + (-> arg0 heap-top) + (&-> arg0 stack (-> arg0 allocated-length)) + ) + (if + (< + (the-as int arg0) + (the-as int (gap-location obj (-> obj first-gap))) + ) + (set! + (-> obj first-gap) + (find-gap obj (the-as dead-pool-heap-rec s5-0)) + ) + ) + (set! (-> arg0 mask) (logior (-> arg0 mask) 512)) + ) + (if (= (-> obj first-shrink) s5-0) + (set! + (-> obj first-shrink) + (the-as dead-pool-heap-rec (-> s5-0 2)) + ) + ) + ) + ) + obj + ) + +;; definition for method 16 of type dead-pool-heap +;; INFO: Return type mismatch int vs none. +(defmethod compact dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + (local-vars (a2-0 none)) + (let* ((s4-0 (memory-free obj)) + (v1-2 (memory-total obj)) + (f0-2 (/ (the float s4-0) (the float v1-2))) + ) + (cond + ((< f0-2 0.1) + (set! arg0 1000) + (if (and *debug-segment* (-> *kernel-context* low-memory-message)) + (format *stdcon* "~3LLow Actor Memory~%~0L" a2-0) + ) + ) + ((< f0-2 0.2) + (set! arg0 (shl arg0 2)) + (let ((v1-10 arg0)) + ) + ) + ((< f0-2 0.3) + (set! arg0 (shl arg0 1)) + (let ((v1-12 arg0)) + ) + ) + ) + ) + (set! (-> obj compact-count-targ) (the-as uint arg0)) + (set! (-> obj compact-count) (the-as uint 0)) + (while (nonzero? arg0) + (+! arg0 -1) + (let ((v1-13 (-> obj first-shrink))) + (when (not v1-13) + (set! v1-13 (-> obj alive-list next)) + (set! (-> obj first-shrink) v1-13) + (let ((a0-5 v1-13)) + ) + ) + (if v1-13 (shrink-heap obj (-> v1-13 process)) + ) + ) + (let ((s4-1 (-> obj first-gap))) + (if (-> s4-1 next) + (let ((s3-0 (-> s4-1 next process)) + (s2-0 (gap-size obj s4-1)) + ) + (when (nonzero? s2-0) + (when (< s2-0 0) + (break!) + (let ((v1-20 0)) + ) + ) + (shrink-heap obj s3-0) + (relocate s3-0 (- s2-0)) + (set! (-> obj first-gap) (find-gap obj s4-1)) + (set! (-> obj compact-count) (+ (-> obj compact-count) 1)) + ) + ) + ) + ) + ) + (let ((v0-8 0)) + ) + (none) + ) + +;; definition for method 18 of type dead-pool-heap +;; INFO: Return type mismatch int vs none. +(defmethod churn dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + (while (nonzero? arg0) + (+! arg0 -1) + (let ((s4-0 (-> obj alive-list next))) + (when + s4-0 + (if + (or + (= (-> obj first-gap) s4-0) + (< + (the-as int (gap-location obj s4-0)) + (the-as int (gap-location obj (-> obj first-gap))) + ) + ) + (set! (-> obj first-gap) (-> s4-0 prev)) + ) + (when (= (-> obj first-shrink) s4-0) + (set! (-> obj first-shrink) (-> s4-0 prev)) + (when (not (-> obj first-shrink process)) + (set! (-> obj first-shrink) #f) + ) + ) + (set! (-> s4-0 prev next) (-> s4-0 next)) + (if (-> s4-0 next) + (set! (-> s4-0 next prev) (-> s4-0 prev)) + (set! (-> obj alive-list prev) (-> s4-0 prev)) + ) + (let ((a1-3 (-> obj alive-list prev))) + (let ((v1-19 (-> a1-3 next))) + (set! (-> a1-3 next) s4-0) + (set! (-> s4-0 next) v1-19) + (when v1-19 (set! (-> v1-19 prev) s4-0) + (let ((v1-20 s4-0)) + ) + ) + ) + (set! (-> s4-0 prev) a1-3) + (set! (-> obj alive-list prev) s4-0) + (set! + (-> s4-0 process) + (relocate + (-> s4-0 process) + (&- (gap-location obj a1-3) (the-as uint (&-> (-> s4-0 process) type))) + ) + ) + ) + ) + ) + ) + (let ((v0-4 0)) + ) + (none) + ) + +;; definition for symbol *global-search-name*, type basic +(define *global-search-name* (the-as basic #f)) + +;; definition for symbol *global-search-count*, type int +(define *global-search-count* 0) + +;; definition for function process-by-name +(defun process-by-name ((arg0 object) (arg1 process-tree)) + (set! *global-search-name* (the-as basic arg0)) + (search-process-tree arg1 (the-as (function process-tree object) L139)) + ) + +;; definition for function process-not-name +(defun process-not-name ((arg0 object) (arg1 process-tree)) + (set! *global-search-name* (the-as basic arg0)) + (search-process-tree arg1 (the-as (function process-tree object) L136)) + ) + +;; definition for function process-count +(defun process-count ((arg0 process-tree)) + (set! *global-search-count* 0) + (iterate-process-tree + arg0 + (the-as (function object object) L134) + *null-kernel-context* + ) + *global-search-count* + ) + +;; definition for function kill-by-name +(defun kill-by-name ((arg0 object) (arg1 process-tree)) + (local-vars (a0-1 process)) + (while (begin + (let ((v0-0 (process-by-name arg0 arg1))) + (set! a0-1 (the-as process v0-0)) + ) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +;; definition for function kill-by-type +(defun kill-by-type ((arg0 object) (arg1 process-tree)) + (local-vars (a0-1 process)) + (set! *global-search-name* (the-as basic arg0)) + (while (begin + (let + ((v0-0 + (search-process-tree + arg1 + (the-as (function process-tree object) L129) + ) + ) + ) + (set! a0-1 (the-as process v0-0)) + ) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +;; definition for function kill-not-name +(defun kill-not-name ((arg0 object) (arg1 process-tree)) + (local-vars (a0-1 process)) + (while (begin + (let ((v0-0 (process-not-name arg0 arg1))) + (set! a0-1 (the-as process v0-0)) + ) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +;; definition for function kill-not-type +(defun kill-not-type ((arg0 object) (arg1 process-tree)) + (local-vars (a0-1 process)) + (set! *global-search-name* (the-as basic arg0)) + (while (begin + (let + ((v0-0 + (search-process-tree + arg1 + (the-as (function process-tree object) L122) + ) + ) + ) + (set! a0-1 (the-as process v0-0)) + ) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +;; definition for method 12 of type process +(defmethod run-logic? process ((obj process)) + #t + ) + +;; definition for function iterate-process-tree +(defun + iterate-process-tree + ((arg0 process-tree) (arg1 (function object object)) (arg2 kernel-context)) + (let ((s4-0 (or (nonzero? (logand (-> arg0 mask) 256)) (arg1 arg0)))) + (cond + ((= s4-0 'dead) + ) + (else + (let ((v1-4 (-> arg0 child))) + (while v1-4 (let ((s3-1 (-> v1-4 0 brother))) + (iterate-process-tree (-> v1-4 0) arg1 arg2) + (set! v1-4 s3-1) + ) + (let ((a0-4 v1-4)) + ) + ) + ) + ) + ) + s4-0 + ) + ) + +;; definition for function execute-process-tree +(defun + execute-process-tree + ((arg0 process-tree) (arg1 (function object object)) (arg2 kernel-context)) + (let + ((s3-0 + (or + (nonzero? (logand (-> arg0 mask) 256)) + (not + (and + (zero? (logand (-> arg2 prevent-from-run) (-> arg0 mask))) + (run-logic? arg0) + ) + ) + (arg1 arg0) + ) + ) + ) + (cond + ((= s3-0 'dead) + ) + (else + (let ((v1-8 (-> arg0 child))) + (while v1-8 (let ((s4-1 (-> v1-8 0 brother))) + (execute-process-tree (-> v1-8 0) arg1 arg2) + (set! v1-8 s4-1) + ) + (let ((a0-6 v1-8)) + ) + ) + ) + ) + ) + s3-0 + ) + ) + +;; definition for function search-process-tree +;; INFO: Return type mismatch process-tree vs process. +(defun + search-process-tree + ((arg0 process-tree) (arg1 (function process-tree object))) + (if (zero? (logand (-> arg0 mask) 256)) + (if (arg1 arg0) + (return arg0) + ) + ) + (let ((v1-5 (-> arg0 child))) + (while v1-5 (let ((s5-1 (-> v1-5 0 brother))) + (let ((v1-6 (search-process-tree (-> v1-5 0) arg1))) + (if v1-6 (return v1-6) + ) + ) + (set! v1-5 s5-1) + ) + (let ((a0-5 v1-5)) + ) + ) + ) + (the-as process #f) + ) + +;; definition for function kernel-dispatcher +(defun + kernel-dispatcher + () + (when *listener-function* (set! *enable-method-set* (+ *enable-method-set* 1)) + (let + ((t1-0 + (reset-and-call (-> *listener-process* main-thread) *listener-function*) + ) + ) + (format #t "~D #x~X ~F ~A~%" t1-0 t1-0 t1-0 t1-0) + ) + (set! *listener-function* #f) + (set! *enable-method-set* (+ *enable-method-set* -1)) + (let ((v1-8 0)) + ) + ) + (execute-process-tree + *active-pool* + (the-as (function object object) L86) + *kernel-context* + ) + ) + +;; definition for function inspect-process-tree +(defun + inspect-process-tree + ((arg0 process-tree) (arg1 int) (arg2 int) (arg3 symbol)) + (print-tree-bitmask arg2 arg1) + (cond + (arg3 + (format #t "__________________~%") + (format #t "~S~A~%" (if (zero? arg1) + "" + "+---" + ) + arg0 + ) + (let ((s2-0 *print-column*)) + (set! *print-column* (the-as binteger (shl (shl arg1 2) 3))) + (inspect arg0) + (set! *print-column* s2-0) + ) + ) + (else + (format #t "~S~A~%" (if (zero? arg1) + "" + "+---" + ) + arg0 + ) + ) + ) + (let ((s2-1 (-> arg0 child))) + (while + s2-1 + (inspect-process-tree (-> s2-1 0) (+ arg1 1) (if (not (-> s2-1 0 brother)) + arg2 + (let* ((v1-7 1) + (a2-4 (+ arg1 1)) + (v1-8 (ash v1-7 a2-4)) + ) + (logior arg2 v1-8) + ) + ) + arg3 + ) + (set! s2-1 (-> s2-1 0 brother)) + ) + ) + arg0 + ) + +;; definition for method 0 of type catch-frame +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function throw-dispatch +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function throw +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 0 of type protect-frame +;; INFO: Return type mismatch int vs protect-frame. +(defmethod + new + protect-frame + ((allocation symbol) (type-to-make type) (arg0 (function object))) + (local-vars (pp process)) + (let ((v0-0 (the-as protect-frame (+ (the-as int allocation) 4)))) + (set! (-> (the-as protect-frame v0-0) type) type-to-make) + (set! (-> (the-as protect-frame v0-0) name) 'protect-frame) + (set! (-> (the-as protect-frame v0-0) exit) arg0) + (set! (-> (the-as protect-frame v0-0) next) (-> pp stack-frame-top)) + (set! (-> pp stack-frame-top) (the-as protect-frame v0-0)) + (the-as protect-frame (the-as int v0-0)) + ) + ) + +;; definition for function previous-brother +;; INFO: Return type mismatch (pointer process-tree) vs object. +(defun previous-brother ((proc process-tree)) + (let ((parent (-> proc parent))) + (when parent (let ((child (-> parent 0 child))) + (if (= child proc) + (return #f) + ) + (while child (if (= (-> child 0 brother) proc) + (return child) + ) + (set! child (-> child 0 brother)) + ) + ) + #f + ) + ) + ) + +;; definition for function change-parent +(defun change-parent ((arg0 process-tree) (arg1 process-tree)) + (let ((a2-0 (-> arg0 parent))) + (if a2-0 (let* ((v1-2 (-> a2-0 0 child)) + (a3-0 v1-2) + ) + (cond + ((= (if a3-0 (-> a3-0 0 self) + ) + arg0 + ) + (set! (-> a2-0 0 child) (-> arg0 brother)) + ) + (else + (while (let ((a2-2 (-> v1-2 0 brother))) + (!= (if a2-2 (-> a2-2 0 self) + ) + arg0 + ) + ) + (nop!) + (nop!) + (nop!) + (set! v1-2 (-> v1-2 0 brother)) + ) + (set! (-> v1-2 0 brother) (-> arg0 brother)) + ) + ) + ) + ) + ) + (set! (-> arg0 parent) (-> arg1 ppointer)) + (set! (-> arg0 brother) (-> arg1 child)) + (set! (-> arg1 child) (-> arg0 ppointer)) + arg0 + ) + +;; definition for function change-brother +(defun change-brother ((arg0 process-tree) (arg1 process-tree)) + (if (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1)) + (let ((a2-1 (-> arg0 parent))) + (if a2-1 (let ((t0-0 (-> a2-1 0 child)) + (a3-1 (the-as (pointer process-tree) #f)) + (v1-4 (the-as (pointer process-tree) #f)) + ) + (let ((t1-0 t0-0)) + (when (= (if t1-0 (-> t1-0 0 self) + ) + arg0 + ) + (set! a3-1 a2-1) + (let ((t1-3 a3-1)) + ) + ) + ) + (let ((t1-4 t0-0)) + (when (= (if t1-4 (-> t1-4 0 self) + ) + arg1 + ) + (set! v1-4 a2-1) + (let ((t1-7 v1-4)) + ) + ) + ) + (while (and (-> t0-0 0 brother) (or (not a3-1) (not v1-4))) + (let ((t1-8 t0-0)) + (when (= (-> (if t1-8 (-> t1-8 0 self) + ) + brother + ) + arg1 + ) + (set! v1-4 t0-0) + (let ((t1-12 v1-4)) + ) + ) + ) + (let ((t1-13 t0-0)) + (when (= (-> (if t1-13 (-> t1-13 0 self) + ) + brother + ) + arg0 + ) + (set! a3-1 t0-0) + (let ((t1-17 a3-1)) + ) + ) + ) + (set! t0-0 (-> t0-0 0 brother)) + ) + (if (or (not a3-1) (not v1-4)) + (return 0) + (if (= a3-1 a2-1) + (set! (-> a3-1 4) (the-as process-tree (-> arg0 brother))) + (set! (-> a3-1 3) (the-as process-tree (-> arg0 brother))) + ) + ) + (cond + ((= v1-4 a2-1) + (set! + (-> arg0 brother) + (the-as (pointer process-tree) (-> v1-4 4)) + ) + (set! (-> v1-4 4) (the-as process-tree (-> arg0 ppointer))) + ) + (else + (set! + (-> arg0 brother) + (the-as (pointer process-tree) (-> v1-4 3)) + ) + (set! (-> v1-4 3) (the-as process-tree (-> arg0 ppointer))) + ) + ) + ) + ) + ) + ) + arg0 + ) + +;; definition for function change-to-last-brother +(defun change-to-last-brother ((arg0 process-tree)) + (when (and (-> arg0 brother) (-> arg0 parent)) + (let* ((a1-0 (-> arg0 parent)) + (v1-4 (-> a1-0 0 child)) + ) + (cond + ((= (-> v1-4 0) arg0) + (set! (-> a1-0 0 child) (-> arg0 brother)) + ) + (else + (while (!= (-> v1-4 0 brother 0) arg0) + (nop!) + (nop!) + (nop!) + (nop!) + (set! v1-4 (-> v1-4 0 brother)) + ) + (set! (-> v1-4 0 brother) (-> arg0 brother)) + ) + ) + (while (-> v1-4 0 brother) + (nop!) + (nop!) + (nop!) + (nop!) + (set! v1-4 (-> v1-4 0 brother)) + ) + (set! (-> v1-4 0 brother) (-> arg0 ppointer)) + ) + (set! (-> arg0 brother) (the-as (pointer process-tree) #f)) + ) + arg0 + ) + +;; definition for method 9 of type process +(defmethod + activate + process + ((obj process) (arg0 process-tree) (arg1 basic) (arg2 pointer)) + (set! (-> obj mask) (logand -961 (the-as int (-> arg0 mask)))) + (set! (-> obj status) 'ready) + (let ((v1-4 (-> *kernel-context* next-pid))) + (set! (-> obj pid) v1-4) + (set! (-> *kernel-context* next-pid) (+ v1-4 1)) + ) + (set! (-> obj top-thread) #f) + (set! (-> obj main-thread) #f) + (set! (-> obj name) arg1) + (let ((v1-9 (&-> obj stack (-> obj type heap-base)))) + (set! (-> obj heap-cur) v1-9) + (set! (-> obj heap-base) v1-9) + ) + (set! (-> obj stack-frame-top) #f) + (mem-set32! (-> obj stack) (the-as int (shr (-> obj type heap-base) 2)) 0) + (set! (-> obj trans-hook) #f) + (set! (-> obj post-hook) #f) + (set! (-> obj event-hook) #f) + (set! (-> obj state) #f) + (set! (-> obj next-state) #f) + (cond + ((nonzero? (logand (-> arg0 mask) 256)) + (set! (-> obj entity) #f) + ) + (else + (set! (-> obj entity) (-> (the-as process arg0) entity)) + ) + ) + (set! (-> obj connection-list next1) #f) + (set! (-> obj connection-list prev1) #f) + (set! (-> obj main-thread) (new 'process 'cpu-thread obj 'code 256 arg2)) + (change-parent obj arg0) + ) + +;; definition for function run-function-in-process +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function set-to-run-bootstrap +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function set-to-run +(defun + set-to-run + ((arg0 cpu-thread) + (arg1 function) + (arg2 object) + (arg3 object) + (arg4 object) + (arg5 object) + (arg6 object) + (arg7 object) + ) + (let ((v1-0 (-> arg0 process))) + (set! (-> v1-0 status) 'waiting-to-run) + ) + (set! (-> arg0 rreg 0) (the-as uint arg2)) + (set! (-> arg0 rreg 1) (the-as uint arg3)) + (set! (-> arg0 rreg 2) (the-as uint arg4)) + (set! (-> arg0 rreg 3) (the-as uint arg5)) + (set! (-> arg0 rreg 4) (the-as uint arg6)) + (set! (-> arg0 rreg 5) (the-as uint arg7)) + (set! (-> arg0 rreg 6) (the-as uint arg1)) + (set! (-> arg0 pc) (the-as pointer set-to-run-bootstrap)) + (let ((v0-0 (-> arg0 stack-top))) + (set! (-> arg0 sp) v0-0) + v0-0 + ) + ) + +;; definition for method 10 of type process-tree +;; INFO: Return type mismatch symbol vs none. +(defmethod deactivate process-tree ((obj process-tree)) + (none) + ) + +;; failed to figure out what this is: +(let + ((a0-40 + (new 'static 'state + :name 'dead-state + :next #f + :exit #f + :code #f + :trans #f + :post #f + :enter #f + :event #f + ) + ) + ) + (set! dead-state a0-40) + (set! (-> a0-40 code) nothing) + ) + +;; definition for symbol entity-deactivate-handler, type (function process object none) +(define + entity-deactivate-handler + (the-as (function process object none) nothing) + ) + +;; definition for method 10 of type process +;; INFO: Return type mismatch int vs none. +;; WARN: Unsupported inline assembly instruction kind - [22] +;; WARN: Unsupported inline assembly instruction kind - [59] +(defmethod deactivate process ((obj process)) + (let ((v0-0 (when (!= (-> obj status) 'dead) + (set! (-> obj next-state) dead-state) + (if (-> obj entity) + (entity-deactivate-handler obj (-> obj entity)) + ) + (let ((s5-0 pp)) + ) + (let ((s4-0 (-> obj stack-frame-top))) + (while (the-as protect-frame s4-0) + (let ((v1-5 (-> s4-0 type))) + (if (or (= v1-5 protect-frame) (= v1-5 state)) + ((-> (the-as protect-frame s4-0) exit)) + ) + ) + (set! + (the-as protect-frame s4-0) + (-> (the-as protect-frame s4-0) next) + ) + ) + ) + (let ((v0-2 (process-disconnect obj)) + (v1-11 (-> obj child)) + ) + (while v1-11 (let ((s5-1 (-> v1-11 0 brother))) + (deactivate (-> v1-11 0)) + (let ((v1-13 v0-2)) + ) + (set! v1-11 s5-1) + ) + (let ((a0-8 v1-11)) + ) + ) + ) + (return-process (-> obj pool) obj) + (set! (-> obj state) #f) + (set! (-> obj next-state) #f) + (set! (-> obj entity) #f) + (set! (-> obj pid) 0) + (cond + ((= (-> *kernel-context* current-process) obj) + (set! (-> obj status) 'dead) + (.lw ra-0 return-from-thread s7-0) + (.jr ra-0) + (nop!) + (let ((v1-21 0)) + ) + ) + ((= (-> obj status) 'initialize) + (set! (-> obj status) 'dead) + (throw 'initialize #f) + ) + ) + (set! (-> obj status) 'dead) + 0 + ) + ) + ) + ) + (none) + ) + +;; failed to figure out what this is: +(let ((v0-1 (new 'global 'process 'listener 2048))) + (set! *listener-process* v0-1) + (let ((gp-0 v0-1)) + (set! (-> gp-0 status) 'ready) + (set! (-> gp-0 pid) 1) + (set! + (-> gp-0 main-thread) + (new 'process 'cpu-thread gp-0 'main 256 (&-> *dram-stack* 14336)) + ) + ) + ) + +;; definition for symbol *null-process*, type process +(define *null-process* (new 'global 'process 'listener 16)) + +;; definition for symbol *vis-boot*, type basic +(define *vis-boot* (the-as basic #f)) + +;; definition for symbol *16k-dead-pool*, type dead-pool +(define *16k-dead-pool* (new 'global 'dead-pool 1 #x4000 '*16k-dead-pool*)) + +;; definition for symbol *8k-dead-pool*, type dead-pool +(define *8k-dead-pool* (new 'global 'dead-pool 1 8192 '*8k-dead-pool*)) + +;; definition for symbol *4k-dead-pool*, type dead-pool +(define *4k-dead-pool* (new 'global 'dead-pool 4 4096 '*4k-dead-pool*)) + +;; definition for symbol *target-dead-pool*, type dead-pool +(define *target-dead-pool* (new 'global 'dead-pool 1 #xc000 '*target-dead-pool*)) + +;; definition for symbol *camera-dead-pool*, type dead-pool +(define *camera-dead-pool* (new 'global 'dead-pool 7 4096 '*camera-dead-pool*)) + +;; definition for symbol *camera-master-dead-pool*, type dead-pool +(define + *camera-master-dead-pool* + (new 'global 'dead-pool 1 8192 '*camera-master-dead-pool*) + ) + +;; failed to figure out what this is: +(if + *debug-segment* + (set! + *debug-dead-pool* + (new 'debug 'dead-pool-heap '*debug-dead-pool* 768 #x100000) + ) + ) + +;; definition for symbol *nk-dead-pool*, type dead-pool-heap +(define *nk-dead-pool* (new 'global 'dead-pool-heap '*nk-dead-pool* 768 #xf6000)) + +;; definition for symbol *default-dead-pool*, type dead-pool +(define *default-dead-pool* (the-as dead-pool *nk-dead-pool*)) + +;; definition for symbol *pickup-dead-pool*, type dead-pool +(define *pickup-dead-pool* (the-as dead-pool *nk-dead-pool*)) + +;; definition for symbol *dead-pool-list*, type pair +(define + *dead-pool-list* + (quote + ('*4k-dead-pool* + '*8k-dead-pool* + '*16k-dead-pool* + '*nk-dead-pool* + '*target-dead-pool* + '*camera-dead-pool* + '*camera-master-dead-pool* + ) + ) + ) + +;; definition for symbol *active-pool*, type process-tree +(define *active-pool* (new 'global 'process-tree 'active-pool)) + +;; failed to figure out what this is: +(let ((gp-1 change-parent) + (v0-13 (new 'global 'process-tree 'display-pool)) + ) + (set! *display-pool* v0-13) + (gp-1 v0-13 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-2 change-parent) + (a0-57 (new 'global 'process-tree 'camera-pool)) + ) + (set! (-> a0-57 mask) (the-as uint #x4011c)) + (set! *camera-pool* a0-57) + (gp-2 a0-57 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-3 change-parent) + (a0-59 (new 'global 'process-tree 'target-pool)) + ) + (set! (-> a0-59 mask) (the-as uint 284)) + (set! *target-pool* a0-59) + (gp-3 a0-59 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-4 change-parent) + (a0-61 (new 'global 'process-tree 'entity-pool)) + ) + (set! (-> a0-61 mask) (the-as uint #x20011c)) + (set! *entity-pool* a0-61) + (gp-4 a0-61 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-5 change-parent) + (a0-63 (new 'global 'process-tree 'default-pool)) + ) + (set! (-> a0-63 mask) (the-as uint 284)) + (set! *default-pool* a0-63) + (gp-5 a0-63 *active-pool*) + ) + +;; failed to figure out what this is: +(none) diff --git a/test/decompiler/reference/gstring-h_REF.gc b/test/decompiler/reference/gstring-h_REF.gc index d92736d4c..1b5fa192d 100644 --- a/test/decompiler/reference/gstring-h_REF.gc +++ b/test/decompiler/reference/gstring-h_REF.gc @@ -4,3 +4,6 @@ ;; failed to figure out what this is: (let ((v0-0 0)) ) + +;; failed to figure out what this is: +(none) \ No newline at end of file diff --git a/test/decompiler/test_DataParser.cpp b/test/decompiler/test_DataParser.cpp index 14c151974..882487f9a 100644 --- a/test/decompiler/test_DataParser.cpp +++ b/test/decompiler/test_DataParser.cpp @@ -315,7 +315,7 @@ TEST_F(DataDecompTest, ContinuePoint) { " -0.1328\n" " 0.5831\n" " )\n" - " :load-commands (('special \"citb-exit-plat-4\" #t))\n" + " :load-commands '('('special \"citb-exit-plat-4\" #t))\n" " :vis-nick 'fin\n" " :lev0 'finalboss\n" " :disp0 'display\n" diff --git a/test/decompiler/test_FormExpressionBuild.cpp b/test/decompiler/test_FormExpressionBuild.cpp index b8a2ee17f..78a0da4fb 100644 --- a/test/decompiler/test_FormExpressionBuild.cpp +++ b/test/decompiler/test_FormExpressionBuild.cpp @@ -2372,7 +2372,7 @@ TEST_F(FormRegressionTest, ExprCopyStringString) { " (set! a1-1 (&-> a1-1 1))\n" " )\n" " )\n" - " (set! (-> v1-0 0) 0)\n" + " (set! (-> v1-0 0) (the-as uint 0))\n" " )\n" " arg0\n" " )"; @@ -2575,4 +2575,54 @@ TEST_F(FormRegressionTest, MoveFalse) { std::string expected = "(nonzero? (logand (+ arg0 12) 1))"; test_with_expr(func, type, expected, false, "", {{"L17", "A ~A"}}); +} + +// Good for testing that in-place ops (+!) check the _variable_ is the same. +TEST_F(FormRegressionTest, QMemCpy) { + std::string func = + "sll r0, r0, 0\n" + "L78:\n" + " or v0, a0, r0\n" + " daddiu v1, a2, 15\n" + " dsra v1, v1, 4\n" + " dsll a2, v1, 4\n" + " daddu a0, a0, a2\n" + " dsll a2, v1, 4\n" + " daddu a1, a1, a2\n" + " beq r0, r0, L80\n" + " sll r0, r0, 0\n" + + "L79:\n" + " daddiu v1, v1, -1\n" + " daddiu a0, a0, -16\n" + " daddiu a1, a1, -16\n" + " lq a2, 0(a1)\n" + " sq a2, 0(a0)\n" + + "L80:\n" + " bne v1, r0, L79\n" + " sll r0, r0, 0\n" + + " or v1, s7, r0\n" + " or v1, s7, r0\n" + " jr ra\n" + " daddu sp, sp, r0\n"; + std::string type = "(function pointer pointer int pointer)"; + std::string expected = + "(let ((v0-0 arg0))\n" + " (let* ((v1-1 (sar (+ arg2 15) 4))\n" + " (a0-1 (&+ arg0 (shl v1-1 4)))\n" + " (a1-1 (&+ arg1 (shl v1-1 4)))\n" + " )\n" + " (while (nonzero? v1-1)\n" + " (+! v1-1 -1)\n" + " (&+! a0-1 -16)\n" + " (&+! a1-1 -16)\n" + " (.lq a2-3 0 a1-1)\n" + " (.sq a2-3 0 a0-1)\n" + " )\n" + " )\n" + " v0-0\n" + " )"; + test_with_expr(func, type, expected); } \ No newline at end of file diff --git a/test/decompiler/test_gkernel_decomp.cpp b/test/decompiler/test_gkernel_decomp.cpp index 82ef133c3..547503362 100644 --- a/test/decompiler/test_gkernel_decomp.cpp +++ b/test/decompiler/test_gkernel_decomp.cpp @@ -134,6 +134,7 @@ TEST_F(FormRegressionTest, ExprMethod1Thread) { "(begin\n" " (when (= arg0 (-> arg0 process main-thread)) (break!) (let ((v1-3 0))))\n" " (set! (-> arg0 process top-thread) (-> arg0 previous))\n" + " (none)\n" " )"; test_with_expr(func, type, expected, false); } @@ -257,11 +258,13 @@ TEST_F(FormRegressionTest, ExprMethod9Thread) { std::string type = "(function thread int none)"; std::string expected = "(begin\n" - " (let\n" - " ((a2-0 (-> arg0 process)))\n" + " (let ((a2-0 (-> arg0 process)))\n" " (cond\n" - " ((!= arg0 (-> a2-0 main-thread)) (format 0 \"1 ~A ~%\" a2-0))\n" - " ((= (-> arg0 stack-size) arg1))\n" + " ((!= arg0 (-> a2-0 main-thread))\n" + " (format 0 \"1 ~A ~%\" a2-0)\n" + " )\n" + " ((= (-> arg0 stack-size) arg1)\n" + " )\n" " ((=\n" " (-> a2-0 heap-cur)\n" " (+\n" @@ -271,14 +274,21 @@ TEST_F(FormRegressionTest, ExprMethod9Thread) { " )\n" " (set!\n" " (-> a2-0 heap-cur)\n" - " (+ (+ (+ arg1 -4) (the-as int (-> arg0 type size))) (the-as int arg0))\n" + " (the-as\n" + " pointer\n" + " (+ (+ (+ arg1 -4) (the-as int (-> arg0 type size))) (the-as int arg0))\n" + " )\n" " )\n" " (set! (-> arg0 stack-size) arg1)\n" " )\n" - " (else (format 0 \"2 ~A ~%\" a2-0))\n" + " (else\n" + " (format 0 \"2 ~A ~%\" a2-0)\n" + " )\n" " )\n" " )\n" - " (let ((v0-2 0)))\n" + " (let ((v0-2 0))\n" + " )\n" + " (none)\n" " )"; test_with_expr(func, type, expected, false, "", {{"L342", "1 ~A ~%"}, {"L341", "2 ~A ~%"}}); } @@ -325,35 +335,44 @@ TEST_F(FormRegressionTest, ExprMethod0Thread) { " daddu sp, sp, r0"; std::string type = "(function symbol type process symbol int pointer cpu-thread)"; std::string expected = - "(let\n" - " ((v0-0\n" - " (if\n" - " (-> arg2 top-thread)\n" - " (&+ arg5 -7164)\n" - " (let\n" - " ((v1-2 (logand -16 (the-as int (&+ (-> arg2 heap-cur) 15)))))\n" - " (set! (-> arg2 heap-cur) (+ (+ v1-2 (the-as int (-> arg1 size))) arg4))\n" - " (+ v1-2 4)\n" + "(let ((obj (the-as cpu-thread (if (-> arg2 top-thread)\n" + " (&+ arg5 -7164)\n" + " (let\n" + " ((v1-2\n" + " (logand\n" + " -16\n" + " (the-as int (&+ (-> arg2 heap-cur) 15))\n" + " )\n" + " )\n" + " )\n" + " (set!\n" + " (-> arg2 heap-cur)\n" + " (the-as\n" + " pointer\n" + " (+ (+ v1-2 (the-as int (-> arg1 size))) arg4)\n" + " )\n" + " )\n" + " (+ v1-2 4)\n" + " )\n" + " )\n" + " )\n" " )\n" " )\n" - " )\n" - " )\n" - " (set! (-> (the-as cpu-thread v0-0) type) arg1)\n" - " (set! (-> (the-as cpu-thread v0-0) name) arg3)\n" - " (set! (-> (the-as cpu-thread v0-0) process) arg2)\n" - " (set! (-> (the-as cpu-thread v0-0) sp) arg5)\n" - " (set! (-> (the-as cpu-thread v0-0) stack-top) arg5)\n" - " (set! (-> (the-as cpu-thread v0-0) previous) (-> arg2 top-thread))\n" - " (set! (-> arg2 top-thread) (the-as cpu-thread v0-0))\n" - " (set! (-> (the-as cpu-thread v0-0) suspend-hook) (method-of-object (the-as cpu-thread " - "v0-0) thread-suspend))\n" - " (set! (-> (the-as cpu-thread v0-0) resume-hook) (method-of-object (the-as cpu-thread " - "v0-0) thread-resume))\n" - " (set! (-> (the-as cpu-thread v0-0) stack-size) arg4)\n" - " (the-as cpu-thread v0-0)\n" + " (set! (-> obj type) arg1)\n" + " (set! (-> obj name) arg3)\n" + " (set! (-> obj process) arg2)\n" + " (set! (-> obj sp) arg5)\n" + " (set! (-> obj stack-top) arg5)\n" + " (set! (-> obj previous) (-> arg2 top-thread))\n" + " (set! (-> arg2 top-thread) obj)\n" + " (set! (-> obj suspend-hook) (method-of-object obj thread-suspend))\n" + " (set! (-> obj resume-hook) (method-of-object obj thread-resume))\n" + " (set! (-> obj stack-size) arg4)\n" + " (the-as cpu-thread (the-as object obj))\n" " )"; test_with_expr(func, type, expected, false, "cpu-thread", {}, - parse_cast_json("[[[13, 28], \"v0\", \"cpu-thread\"]]")); + parse_cast_json("[[[13, 28], \"v0\", \"cpu-thread\"]]"), + "{\"vars\":{\"v0-0\":[\"obj\", \"cpu-thread\"]}}"); } TEST_F(FormRegressionTest, ExprMethod5CpuThread) { @@ -433,10 +452,10 @@ TEST_F(FormRegressionTest, RemoveMethod0ProcessTree) { "(let\n" " ((v0-0 (object-new arg0 arg1 (the-as int (-> arg1 size)))))\n" " (set! (-> v0-0 name) arg2)\n" - " (set! (-> v0-0 mask) 256)\n" - " (set! (-> v0-0 parent) #f)\n" - " (set! (-> v0-0 brother) #f)\n" - " (set! (-> v0-0 child) #f)\n" + " (set! (-> v0-0 mask) (the-as uint 256))\n" + " (set! (-> v0-0 parent) (the-as (pointer process-tree) #f))\n" + " (set! (-> v0-0 brother) (the-as (pointer process-tree) #f))\n" + " (set! (-> v0-0 child) (the-as (pointer process-tree) #f))\n" " (set! (-> v0-0 self) v0-0)\n" " (set! (-> v0-0 ppointer) (&-> v0-0 self))\n" " v0-0\n" @@ -650,7 +669,8 @@ TEST_F(FormRegressionTest, ExprMethod0Process) { " )\n" " (set! (-> (the-as process v0-0) heap-top) (&-> (the-as process v0-0) stack (-> (the-as " "process v0-0) allocated-length)))\n" - " (set! (-> (the-as process v0-0) stack-frame-top) (-> (the-as process v0-0) heap-top))\n" + " (set! (-> (the-as process v0-0) stack-frame-top) (the-as stack-frame (-> (the-as process " + "v0-0) heap-top)))\n" " (set! (-> (the-as process v0-0) stack-frame-top) #f)\n" " (set! (-> (the-as process v0-0) state) #f)\n" " (set! (-> (the-as process v0-0) next-state) #f)\n" @@ -658,9 +678,9 @@ TEST_F(FormRegressionTest, ExprMethod0Process) { " (set! (-> (the-as process v0-0) trans-hook) #f)\n" " (set! (-> (the-as process v0-0) post-hook) #f)\n" " (set! (-> (the-as process v0-0) event-hook) #f)\n" - " (set! (-> (the-as process v0-0) parent) #f)\n" - " (set! (-> (the-as process v0-0) brother) #f)\n" - " (set! (-> (the-as process v0-0) child) #f)\n" + " (set! (-> (the-as process v0-0) parent) (the-as (pointer process-tree) #f))\n" + " (set! (-> (the-as process v0-0) brother) (the-as (pointer process-tree) #f))\n" + " (set! (-> (the-as process v0-0) child) (the-as (pointer process-tree) #f))\n" " (set! (-> (the-as process v0-0) self) (the-as process v0-0))\n" " (set! (-> (the-as process v0-0) ppointer) (&-> (the-as process v0-0) self))\n" " (the-as process v0-0)\n" @@ -722,20 +742,18 @@ TEST_F(FormRegressionTest, ExprInspectProcessHeap) { std::string type = "(function process symbol)"; std::string expected = "(begin\n" - " (let\n" - " ((obj (the-as basic (&+ (-> arg0 heap-base) 4))))\n" - " (while\n" - " (< (the-as int obj) (the-as int (-> arg0 heap-cur)))\n" - " (inspect obj)\n" - " (+! (the-as int obj) (logand -16 (+ (asize-of obj) 15)))\n" + " (let ((obj (&+ (-> arg0 heap-base) 4)))\n" + " (while (< (the-as int obj) (the-as int (-> arg0 heap-cur)))\n" + " (inspect (the-as basic obj))\n" + " (&+! obj (logand -16 (+ (asize-of (the-as basic obj)) 15)))\n" " )\n" " )\n" " #f\n" " )"; test_with_expr(func, type, expected, false, "", {}, parse_cast_json("[\t\t[[4,11], \"s5\", \"basic\"],\n" - "\t\t[[17,20], \"s5\", \"int\"]]"), - "{\"vars\":{\"s5-0\":[\"obj\", \"basic\"]}}"); + "\t\t[[17,20], \"s5\", \"pointer\"]]"), + "{\"vars\":{\"s5-0\":[\"obj\", \"pointer\"]}}"); } // note: skipped method 3 process @@ -822,11 +840,11 @@ TEST_F(FormRegressionTest, ExprMethod2Process) { " (format\n" " #t\n" " \":stack ~D/~D :heap ~D/~D @ #x~X>\"\n" - " (- (-> arg0 top-thread stack-top) (the-as uint (-> arg0 top-thread sp)))\n" + " (&- (-> arg0 top-thread stack-top) (the-as uint (-> arg0 top-thread sp)))\n" " (-> arg0 main-thread stack-size)\n" " (-\n" " (-> arg0 allocated-length)\n" - " (- (-> arg0 heap-top) (the-as uint (-> arg0 heap-cur)))\n" + " (&- (-> arg0 heap-top) (the-as uint (-> arg0 heap-cur)))\n" " )\n" " (-> arg0 allocated-length)\n" " arg0\n" @@ -930,10 +948,10 @@ TEST_F(FormRegressionTest, ExprMethod0DeadPool) { "(let\n" " ((s3-0 (object-new arg0 arg1 (the-as int (-> arg1 size)))))\n" " (set! (-> s3-0 name) arg4)\n" - " (set! (-> s3-0 mask) 256)\n" - " (set! (-> s3-0 parent) #f)\n" - " (set! (-> s3-0 brother) #f)\n" - " (set! (-> s3-0 child) #f)\n" + " (set! (-> s3-0 mask) (the-as uint 256))\n" + " (set! (-> s3-0 parent) (the-as (pointer process-tree) #f))\n" + " (set! (-> s3-0 brother) (the-as (pointer process-tree) #f))\n" + " (set! (-> s3-0 child) (the-as (pointer process-tree) #f))\n" " (set! (-> s3-0 self) s3-0)\n" " (set! (-> s3-0 ppointer) (&-> s3-0 self))\n" " (dotimes\n" @@ -1126,7 +1144,7 @@ TEST_F(FormRegressionTest, ExprMethod15DeadPool) { " jr ra\n" " daddiu sp, sp, 16"; std::string type = "(function dead-pool process none)"; - std::string expected = "(change-parent arg1 arg0)"; + std::string expected = "(begin (change-parent arg1 arg0) (none))"; test_with_expr(func, type, expected); } @@ -1245,11 +1263,11 @@ TEST_F(FormRegressionTest, ExprMethod0DeadPoolHeap) { " )\n" " )\n" " (set! (-> obj name) arg2)\n" - " (set! (-> obj mask) 256)\n" + " (set! (-> obj mask) (the-as uint 256))\n" " (set! (-> obj allocated-length) arg3)\n" - " (set! (-> obj parent) #f)\n" - " (set! (-> obj brother) #f)\n" - " (set! (-> obj child) #f)\n" + " (set! (-> obj parent) (the-as (pointer process-tree) #f))\n" + " (set! (-> obj brother) (the-as (pointer process-tree) #f))\n" + " (set! (-> obj child) (the-as (pointer process-tree) #f))\n" " (set! (-> obj self) obj)\n" " (set! (-> obj ppointer) (&-> obj self))\n" " (let\n" @@ -1264,7 +1282,7 @@ TEST_F(FormRegressionTest, ExprMethod0DeadPoolHeap) { " )\n" " )\n" " )\n" - " (set! (-> obj dead-list next) (-> obj process-list))\n" + " (set! (-> obj dead-list next) (the-as dead-pool-heap-rec (-> obj process-list)))\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" @@ -1274,7 +1292,7 @@ TEST_F(FormRegressionTest, ExprMethod0DeadPoolHeap) { " (set! (-> obj first-shrink) #f)\n" " (set!\n" " (-> obj heap base)\n" - " (logand -16 (+ (+ (the-as int obj) 115) (* 12 arg3)))\n" + " (the-as pointer (logand -16 (+ (+ (the-as int obj) 115) (* 12 arg3))))\n" " )\n" " (set! (-> obj heap current) (-> obj heap base))\n" " (set! (-> obj heap top) (&+ (-> obj heap base) arg4))\n" @@ -1314,13 +1332,16 @@ TEST_F(FormRegressionTest, ExprMethod22DeadPoolHeap) { " daddu sp, sp, r0"; std::string type = "(function dead-pool-heap dead-pool-heap-rec pointer)"; std::string expected = - "(if\n" - " (-> arg1 process)\n" - " (+\n" - " (+ (+ (-> arg1 process allocated-length) -4) (the-as int (-> process size)))\n" - " (the-as int (-> arg1 process))\n" - " )\n" - " (-> arg0 heap base)\n" + "(the-as pointer (if (-> arg1 process)\n" + " (+\n" + " (+\n" + " (+ (-> arg1 process allocated-length) -4)\n" + " (the-as int (-> process size))\n" + " )\n" + " (the-as int (-> arg1 process))\n" + " )\n" + " (-> arg0 heap base)\n" + " )\n" " )"; test_with_expr(func, type, expected); } @@ -1382,26 +1403,26 @@ TEST_F(FormRegressionTest, ExprMethod21DeadPoolHeap) { " daddu sp, sp, r0"; std::string type = "(function dead-pool-heap dead-pool-heap-rec int)"; std::string expected = - "(if\n" - " (-> arg1 process)\n" + "(if (-> arg1 process)\n" " (let\n" " ((v1-3\n" " (&+\n" - " (&+ (-> arg1 process) (-> process size))\n" + " (&+ (the-as pointer (-> arg1 process)) (-> process size))\n" " (-> arg1 process allocated-length)\n" " )\n" " )\n" " )\n" - " (if\n" - " (-> arg1 next)\n" - " (- (-> arg1 next process) (the-as uint v1-3))\n" - " (- (-> arg0 heap top) (the-as uint (&+ v1-3 4)))\n" + " (if (-> arg1 next)\n" + " (&- (the-as pointer (-> arg1 next process)) (the-as uint v1-3))\n" + " (&- (-> arg0 heap top) (the-as uint (&+ v1-3 4)))\n" " )\n" " )\n" - " (if\n" - " (-> arg1 next)\n" - " (- (-> arg1 next process) (the-as uint (&+ (-> arg0 heap base) 4)))\n" - " (- (-> arg0 heap top) (the-as uint (-> arg0 heap base)))\n" + " (if (-> arg1 next)\n" + " (&-\n" + " (the-as pointer (-> arg1 next process))\n" + " (the-as uint (&+ (-> arg0 heap base) 4))\n" + " )\n" + " (&- (-> arg0 heap top) (the-as uint (-> arg0 heap base)))\n" " )\n" " )"; test_with_expr(func, type, expected, false, "", {}, @@ -1539,7 +1560,7 @@ TEST_F(FormRegressionTest, ExprMethod3DeadPoolHeap) { std::string expected = "(begin\n" " (let*\n" - " ((s5-0 (- (-> arg0 heap top) (the-as uint (-> arg0 heap base))))\n" + " ((s5-0 (&- (-> arg0 heap top) (the-as uint (-> arg0 heap base))))\n" " (v1-3\n" " (if\n" " (-> arg0 alive-list prev)\n" @@ -1599,7 +1620,8 @@ TEST_F(FormRegressionTest, ExprMethod5DeadPoolHeap) { " jr ra\n" " daddu sp, sp, r0"; std::string type = "(function dead-pool-heap int)"; - std::string expected = "(+ (- -4 (the-as int arg0)) (-> arg0 heap top))"; + std::string expected = + "(+ (the-as int (- -4 (the-as int arg0))) (the-as int (-> arg0 heap top)))"; test_with_expr(func, type, expected, false, "", {}, parse_cast_json("[[3, \"v1\", \"int\"], [3, \"a0\", \"int\"]]")); } @@ -1665,7 +1687,7 @@ TEST_F(FormRegressionTest, ExprMethod20DeadPoolHeap) { " jr ra\n" " daddu sp, sp, r0"; std::string type = "(function dead-pool-heap int)"; - std::string expected = "(- (-> arg0 heap top) (the-as uint (-> arg0 heap base)))"; + std::string expected = "(&- (-> arg0 heap top) (the-as uint (-> arg0 heap base)))"; test_with_expr(func, type, expected); } @@ -1706,7 +1728,7 @@ TEST_F(FormRegressionTest, ExprMethod25DeadPoolHeap) { " (if\n" " (-> arg0 alive-list prev)\n" " (gap-size arg0 (-> arg0 alive-list prev))\n" - " (- v1-0 (the-as uint (-> arg0 heap base)))\n" + " (&- v1-0 (the-as uint (-> arg0 heap base)))\n" " )\n" " )"; test_with_expr(func, type, expected); @@ -1987,7 +2009,7 @@ TEST_F(FormRegressionTest, ExprMethod14DeadPoolHeap) { "(let\n" " ((s4-0 (-> arg0 dead-list next)) (s3-0 (the-as process #f)))\n" " (let\n" - " ((s1-0 (find-gap-by-size arg0 (+ (-> process size) (the-as uint arg2)))))\n" + " ((s1-0 (find-gap-by-size arg0 (the-as int (+ (-> process size) (the-as uint arg2))))))\n" " (cond\n" " ((and s4-0 s1-0)\n" " (set! (-> arg0 dead-list next) (-> s4-0 next))\n" @@ -2193,8 +2215,7 @@ TEST_F(FormRegressionTest, ExprMethod15DeadPoolHeap) { // NOTE: has wrong types for s5-1, but it's okay std::string expected = "(begin\n" - " (if\n" - " (!= arg0 (-> arg1 pool))\n" + " (if (!= arg0 (-> arg1 pool))\n" " (format\n" " 0\n" " \"ERROR: process ~A does not belong to dead-pool-heap ~A.~%\"\n" @@ -2203,35 +2224,36 @@ TEST_F(FormRegressionTest, ExprMethod15DeadPoolHeap) { " )\n" " )\n" " (change-parent arg1 arg0)\n" - " (set! (-> arg0 child) #f)\n" - " (let\n" - " ((s5-1 (-> arg1 ppointer)))\n" + " (set! (-> arg0 child) (the-as (pointer process-tree) #f))\n" + " (let ((s5-1 (-> arg1 ppointer)))\n" " (if\n" " (or\n" " (= (-> arg0 first-gap) s5-1)\n" " (<\n" - " (the-as int (gap-location arg0 s5-1))\n" + " (the-as int (gap-location arg0 (the-as dead-pool-heap-rec s5-1)))\n" " (the-as int (gap-location arg0 (-> arg0 first-gap)))\n" " )\n" " )\n" - " (set! (-> arg0 first-gap) (-> s5-1 1))\n" + " (set! (-> arg0 first-gap) (the-as dead-pool-heap-rec (-> s5-1 1)))\n" " )\n" - " (when\n" - " (= (-> arg0 first-shrink) s5-1)\n" - " (set! (-> arg0 first-shrink) (-> s5-1 1))\n" - " (when (not (-> arg0 first-shrink process)) (set! (-> arg0 first-shrink) #f))\n" + " (when (= (-> arg0 first-shrink) s5-1)\n" + " (set! (-> arg0 first-shrink) (the-as dead-pool-heap-rec (-> s5-1 1)))\n" + " (when (not (-> arg0 first-shrink process))\n" + " (set! (-> arg0 first-shrink) #f)\n" + " )\n" " )\n" - " (set! (-> s5-1 1 parent) (-> s5-1 2))\n" - " (if\n" - " (-> s5-1 2)\n" - " (set! (-> s5-1 2 mask) (-> s5-1 1))\n" - " (set! (-> arg0 alive-list prev) (-> s5-1 1))\n" + " (set! (-> s5-1 1 parent) (the-as (pointer process-tree) (-> s5-1 2)))\n" + " (if (-> s5-1 2)\n" + " (set! (-> s5-1 2 mask) (the-as uint (-> s5-1 1)))\n" + " (set! (-> arg0 alive-list prev) (the-as dead-pool-heap-rec (-> s5-1 1)))\n" " )\n" - " (set! (-> s5-1 2) (-> arg0 dead-list next))\n" - " (set! (-> arg0 dead-list next) s5-1)\n" + " (set! (-> s5-1 2) (the-as process-tree (-> arg0 dead-list next)))\n" + " (set! (-> arg0 dead-list next) (the-as dead-pool-heap-rec s5-1))\n" " (set! (-> s5-1 0) *null-process*)\n" " )\n" - " (let ((v0-4 0)))\n" + " (let ((v0-4 0))\n" + " )\n" + " (none)\n" " )"; test_with_expr(func, type, expected, false, "", {{"L297", "ERROR: process ~A does not belong to dead-pool-heap ~A.~%"}}); @@ -2326,35 +2348,41 @@ TEST_F(FormRegressionTest, ExprMethod17DeadPoolHeap) { " daddiu sp, sp, 64"; std::string type = "(function dead-pool-heap process dead-pool-heap)"; + // NOTE - this has bad types. std::string expected = "(begin\n" - " (if\n" - " arg1\n" - " (let\n" - " ((s5-0 (-> arg1 ppointer)))\n" - " (when\n" - " (not\n" - " (or\n" - " (nonzero? (logand (-> arg1 mask) 512))\n" - " (and (not (-> arg1 next-state)) (not (-> arg1 state)))\n" - " )\n" - " )\n" - " (set!\n" - " (-> arg1 allocated-length)\n" - " (- (-> arg1 heap-cur) (the-as uint (-> arg1 stack)))\n" - " )\n" - " (set! (-> arg1 heap-top) (&-> arg1 stack (-> arg1 allocated-length)))\n" - " (if\n" - " (< (the-as int arg1) (the-as int (gap-location arg0 (-> arg0 first-gap))))\n" - " (set! (-> arg0 first-gap) (find-gap arg0 s5-0))\n" - " )\n" - " (set! (-> arg1 mask) (logior (-> arg1 mask) 512))\n" - " )\n" - " (if\n" - " (= (-> arg0 first-shrink) s5-0)\n" - " (set! (-> arg0 first-shrink) (-> s5-0 2))\n" - " )\n" - " )\n" + " (if arg1 (let ((s5-0 (-> arg1 ppointer)))\n" + " (when\n" + " (not\n" + " (or\n" + " (nonzero? (logand (-> arg1 mask) 512))\n" + " (and (not (-> arg1 next-state)) (not (-> arg1 state)))\n" + " )\n" + " )\n" + " (set!\n" + " (-> arg1 allocated-length)\n" + " (&- (-> arg1 heap-cur) (the-as uint (-> arg1 stack)))\n" + " )\n" + " (set!\n" + " (-> arg1 heap-top)\n" + " (&-> arg1 stack (-> arg1 allocated-length))\n" + " )\n" + " (if\n" + " (<\n" + " (the-as int arg1)\n" + " (the-as int (gap-location arg0 (-> arg0 first-gap)))\n" + " )\n" + " (set! (-> arg0 first-gap) (find-gap arg0 (the-as dead-pool-heap-rec s5-0)))\n" + " )\n" + " (set! (-> arg1 mask) (logior (-> arg1 mask) 512))\n" + " )\n" + " (if (= (-> arg0 first-shrink) s5-0)\n" + " (set!\n" + " (-> arg0 first-shrink)\n" + " (the-as dead-pool-heap-rec (-> s5-0 2))\n" + " )\n" + " )\n" + " )\n" " )\n" " arg0\n" " )"; @@ -2570,8 +2598,8 @@ TEST_F(FormRegressionTest, ExprMethod16DeadPoolHeap) { " ((< f0-2 (l.f L348)) (set! arg1 (shl arg1 1)) (let ((v1-12 arg1))))\n" " )\n" " )\n" - " (set! (-> arg0 compact-count-targ) arg1)\n" - " (set! (-> arg0 compact-count) 0)\n" + " (set! (-> arg0 compact-count-targ) (the-as uint arg1))\n" + " (set! (-> arg0 compact-count) (the-as uint 0))\n" " (while\n" " (nonzero? arg1)\n" " (+! arg1 -1)\n" @@ -2604,6 +2632,7 @@ TEST_F(FormRegressionTest, ExprMethod16DeadPoolHeap) { " )\n" " )\n" " (let ((v0-8 0)))\n" + " (none)\n" " )"; test_with_expr(func, type, expected, false, "", {{"L296", "~3LLow Actor Memory~%~0L"}}); } @@ -2798,7 +2827,7 @@ TEST_F(FormRegressionTest, ExprMethod18DeadPoolHeap) { " (-> s4-0 process)\n" " (relocate\n" " (-> s4-0 process)\n" - " (- (gap-location arg0 a1-3) (the-as uint (&-> (-> s4-0 process) type)))\n" + " (&- (gap-location arg0 a1-3) (the-as uint (&-> (-> s4-0 process) type)))\n" " )\n" " )\n" " )\n" @@ -2806,6 +2835,7 @@ TEST_F(FormRegressionTest, ExprMethod18DeadPoolHeap) { " )\n" " )\n" " (let ((v0-4 0)))\n" + " (none)\n" " )"; test_with_expr(func, type, expected); } \ No newline at end of file diff --git a/test/offline/offline_test_main.cpp b/test/offline/offline_test_main.cpp index 2c6b07a2c..dedf8894a 100644 --- a/test/offline/offline_test_main.cpp +++ b/test/offline/offline_test_main.cpp @@ -15,8 +15,7 @@ const std::unordered_set g_object_files_to_decompile = {"gcommon", // the object files to check against a reference in test/decompiler/reference const std::vector g_object_files_to_check_against_reference = { "gcommon", // NOTE: this file needs work, but adding it for now just to test the framework. - "gstring-h", "gkernel-h", - /*"gkernel"*/}; + "gstring-h", "gkernel-h", "gkernel"}; // the functions we expect the decompiler to skip const std::unordered_set expected_skip_in_decompiler = { @@ -47,25 +46,15 @@ const std::unordered_set skip_in_compiling = { ////////////////////// // these functions are not implemented by the compiler in OpenGOAL, but are in GOAL. - "abs", - "ash", - "min", - "max", - "lognor", + "abs", "ash", "min", "max", "lognor", // weird PS2 specific debug registers: "breakpoint-range-set!", // these require 128-bit integers. We want these eventually, but disabling for now to focus // on more important issues. - "(method 3 vec4s)", - "(method 2 vec4s)", - "qmem-copy<-!", - "qmem-copy->!", - "(method 2 array)", + "(method 3 vec4s)", "(method 2 vec4s)", "qmem-copy<-!", "qmem-copy->!", "(method 2 array)", "(method 3 array)", // does weird stuff with the type system. - "print", - "printl", - "inspect", + "print", "printl", "inspect", // inline assembly "valid?", @@ -74,23 +63,18 @@ const std::unordered_set skip_in_compiling = { ////////////////////// // bitfields, possibly inline assembly "(method 2 handle)", -}; -// The decompiler does not attempt to insert forward definitions, as this would be part of an -// unimplemented full-program type analysis pass. For now, we manually specify all functions -// that should have a forward definition here. -const std::string g_forward_type_defs = - // used out of order - "(define-extern name= (function basic basic symbol))\n" - // recursive - "(define-extern fact (function int int))\n" - // gkernel-h - "(declare-type process basic)\n" - "(declare-type stack-frame basic)\n" - "(declare-type state basic)\n" - "(declare-type cpu-thread basic)\n" - "(declare-type dead-pool basic)\n" - "(declare-type event-message-block structure)\n"; + ////////////////////// + // GKERNEL + ////////////////////// + // these refer to anonymous functions, which aren't yet implemented. + "process-by-name", "process-not-name", "process-count", "kill-by-type", "kill-not-type", + "kill-by-name", "kill-not-name", "kernel-dispatcher", + + // asm + "(method 10 process)" + +}; // default location for the data. It can be changed with a command line argument. std::string g_iso_data_path = ""; @@ -358,6 +342,10 @@ TEST_F(OfflineDecompilation, Reference) { std::string src = db->ir2_final_out(obj_l.at(0)); + // if (file == "gkernel") { + // fmt::print("{}\n", src); + // } + auto reference = file_util::read_text_file(file_util::get_file_path( {"test", "decompiler", "reference", fmt::format("{}_REF.gc", file)})); @@ -371,7 +359,8 @@ TEST_F(OfflineDecompilation, Reference) { TEST_F(OfflineDecompilation, Compile) { Compiler compiler; - compiler.run_front_end_on_string(g_forward_type_defs); + compiler.run_front_end_on_string(file_util::read_text_file(file_util::get_file_path( + {"test", "decompiler", "reference", "all_forward_declarations.gc"}))); for (auto& file : g_object_files_to_check_against_reference) { auto& obj_l = db->obj_files_by_name.at(file);