diff --git a/common/goos/PrettyPrinter.cpp b/common/goos/PrettyPrinter.cpp index 5e35b4edc8..a753a87e3c 100644 --- a/common/goos/PrettyPrinter.cpp +++ b/common/goos/PrettyPrinter.cpp @@ -596,12 +596,12 @@ void insertSpecialBreaks(NodePool& pool, PrettyPrinterNode* node) { } } - if (name == "begin") { + if (name == "begin" || name == "with-pp") { breakList(pool, node->paren); } if (name == "defun" || name == "defmethod" || name == "defun-debug" || name == "let" || - name == "let*" || name == "rlet" || name == "defbehavior") { + name == "let*" || name == "rlet" || name == "defbehavior" || name == "lambda") { auto* first_list = getNextListOrEmptyListOnLine(node); if (first_list) { if (first_list->tok->kind == FormToken::TokenKind::EMPTY_PAIR) { diff --git a/decompiler/Function/CfgVtx.cpp b/decompiler/Function/CfgVtx.cpp index 5fa13eddcb..4c7b6d1542 100644 --- a/decompiler/Function/CfgVtx.cpp +++ b/decompiler/Function/CfgVtx.cpp @@ -1462,6 +1462,10 @@ bool ControlFlowGraph::find_seq_top_level(bool allow_self_loops) { auto* b0 = vtx; auto* b1 = vtx->next; + // if (b1 && b1->end_branch.asm_branch) { + // return true; + // } + if (is_sequence_of_non_sequences(b0, b1, allow_self_loops)) { // todo, avoid nesting sequences. replaced = true; diff --git a/decompiler/IR2/AtomicOpForm.cpp b/decompiler/IR2/AtomicOpForm.cpp index 577a3fc8ec..dd441d6255 100644 --- a/decompiler/IR2/AtomicOpForm.cpp +++ b/decompiler/IR2/AtomicOpForm.cpp @@ -421,7 +421,8 @@ FormElement* StoreOp::get_as_form(FormPool& pool, const Env& env) const { 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, + pool.alloc_single_form(nullptr, 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), m_size); } @@ -466,9 +467,9 @@ FormElement* StoreOp::get_as_form(FormPool& pool, const Env& env) const { nullptr, TypeSpec("pointer", {TypeSpec(cast_type)}), source); 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)}), - std::nullopt, m_size); + return pool.alloc_element( + pool.alloc_single_form(nullptr, deref), m_value.as_expr(), m_my_idx, ro.var, + TypeSpec("pointer", {TypeSpec(cast_type)}), std::nullopt, m_size); } } } diff --git a/decompiler/IR2/AtomicOpTypeAnalysis.cpp b/decompiler/IR2/AtomicOpTypeAnalysis.cpp index 72c22fb753..4c7d073fbf 100644 --- a/decompiler/IR2/AtomicOpTypeAnalysis.cpp +++ b/decompiler/IR2/AtomicOpTypeAnalysis.cpp @@ -378,8 +378,13 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input, } break; case Kind::MUL_UNSIGNED: { - // unsigned multiply will always return a unsigned number. - return TP_Type::make_from_ts("uint"); + if (arg0_type.is_integer_constant() && is_int_or_uint(dts, arg1_type)) { + return TP_Type::make_from_product(arg0_type.get_integer_constant(), + is_signed(dts, arg0_type)); + } else if (is_int_or_uint(dts, arg0_type) && is_int_or_uint(dts, arg1_type)) { + // unsigned multiply will always return a unsigned number. + return TP_Type::make_from_ts("uint"); + } } break; case Kind::DIV_SIGNED: @@ -415,6 +420,9 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input, } break; + case Kind::MIN_SIGNED: + return TP_Type::make_from_ts("int"); + default: break; } diff --git a/decompiler/IR2/Form.cpp b/decompiler/IR2/Form.cpp index b5959f974d..8c56a3b8fc 100644 --- a/decompiler/IR2/Form.cpp +++ b/decompiler/IR2/Form.cpp @@ -528,6 +528,9 @@ void AtomicOpElement::get_modified_regs(RegSet& regs) const { AsmBranchElement::AsmBranchElement(AsmBranchOp* branch_op, Form* branch_delay, bool likely) : m_branch_op(branch_op), m_branch_delay(branch_delay), m_likely(likely) { m_branch_delay->parent_element = this; + for (auto& elt : m_branch_delay->elts()) { + assert(elt->parent_form == m_branch_delay); + } } goos::Object AsmBranchElement::to_form_internal(const Env& env) const { @@ -605,6 +608,12 @@ goos::Object TranslatedAsmBranch::to_form_internal(const Env& env) const { assert(block_id >= 0); if (m_branch_delay) { + if (m_branch_delay->parent_element != this) { + fmt::print("bad ptr. Parent is {}\n", m_branch_delay->parent_element->to_string(env)); + assert(false); + } + + assert(m_branch_delay->parent_element->parent_form); std::vector list = { pretty_print::to_symbol("b!"), m_branch_condition->to_form(env), pretty_print::to_symbol(fmt::format("cfg-{}", block_id)), @@ -640,6 +649,15 @@ void TranslatedAsmBranch::collect_vars(RegAccessSet& vars, bool recursive) const if (recursive) { m_branch_condition->collect_vars(vars, recursive); if (m_branch_delay) { + if (m_branch_delay->parent_element != this) { + fmt::print("bad ptr. Parent is {}\n", (void*)m_branch_delay->parent_element); + assert(false); + } + + for (auto& elt : m_branch_delay->elts()) { + assert(elt->parent_form == m_branch_delay); + } + m_branch_delay->collect_vars(vars, recursive); } } @@ -2162,7 +2180,7 @@ goos::Object ConstantFloatElement::to_form_internal(const Env&) const { // StorePlainDeref ///////////////////////////// -StorePlainDeref::StorePlainDeref(DerefElement* dst, +StorePlainDeref::StorePlainDeref(Form* dst, SimpleExpression expr, int my_idx, RegisterAccess base_var, @@ -2175,7 +2193,9 @@ StorePlainDeref::StorePlainDeref(DerefElement* dst, m_base_var(base_var), m_dst_cast_type(std::move(dst_cast_type)), m_src_cast_type(std::move(src_cast_type)), - m_size(size) {} + m_size(size) { + m_dst->parent_element = this; +} goos::Object StorePlainDeref::to_form_internal(const Env& env) const { std::vector lst = {pretty_print::to_symbol("set!")}; @@ -2202,7 +2222,9 @@ void StorePlainDeref::apply(const std::function& f) { m_dst->apply(f); } -void StorePlainDeref::apply_form(const std::function&) {} +void StorePlainDeref::apply_form(const std::function& f) { + m_dst->apply_form(f); +} void StorePlainDeref::collect_vars(RegAccessSet& vars, bool recursive) const { m_expr.collect_vars(vars); diff --git a/decompiler/IR2/Form.h b/decompiler/IR2/Form.h index 825be58966..0c8f2f8957 100644 --- a/decompiler/IR2/Form.h +++ b/decompiler/IR2/Form.h @@ -1260,7 +1260,7 @@ class ConstantFloatElement : public FormElement { class StorePlainDeref : public FormElement { public: - StorePlainDeref(DerefElement* dst, + StorePlainDeref(Form* dst, SimpleExpression expr, int my_idx, RegisterAccess base_var, @@ -1277,7 +1277,7 @@ class StorePlainDeref : public FormElement { int size() const { return m_size; } private: - DerefElement* m_dst = nullptr; + Form* m_dst = nullptr; SimpleExpression m_expr; int m_my_idx = -1; RegisterAccess m_base_var; diff --git a/decompiler/IR2/FormExpressionAnalysis.cpp b/decompiler/IR2/FormExpressionAnalysis.cpp index ae0b889f48..44689124a5 100644 --- a/decompiler/IR2/FormExpressionAnalysis.cpp +++ b/decompiler/IR2/FormExpressionAnalysis.cpp @@ -660,6 +660,7 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, } bool arg0_ptr = is_ptr_or_child(env, m_my_idx, m_expr.get_arg(0).var(), true); + bool arg1_ptr = false; // Look for getting an address inside of an object. // (+ process). array style access with a stride of 1. @@ -668,6 +669,7 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, // lookup types. auto arg1_type = env.get_types_before_op(m_my_idx).get(m_expr.get_arg(1).var().reg()); auto arg0_type = env.get_types_before_op(m_my_idx).get(m_expr.get_arg(0).var().reg()); + arg1_ptr = is_ptr_or_child(env, m_my_idx, m_expr.get_arg(1).var(), true); // try to find symbol to string stuff auto arg0_int = get_goal_integer_constant(args.at(0), env); @@ -753,11 +755,13 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, args.at(0)->to_string(env))); } } else { - auto arg0_matcher = - Matcher::op(addition_matcher, - {Matcher::op(GenericOpMatcher::fixed(FixedOperatorKind::MULTIPLICATION), - {Matcher::integer(input.stride), Matcher::any(0)}), - Matcher::integer(input.offset)}); + auto int_matcher = Matcher::integer(input.stride); + auto arg0_matcher = Matcher::op( + addition_matcher, + {Matcher::op(GenericOpMatcher::fixed(FixedOperatorKind::MULTIPLICATION), + {Matcher::match_or({Matcher::cast("uint", int_matcher), int_matcher}), + Matcher::any(0)}), + Matcher::integer(input.offset)}); auto match_result = match(arg0_matcher, args.at(0)); if (match_result.matched) { bool used_index = false; @@ -878,6 +882,7 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, } } + auto arg0_type = env.get_types_before_op(m_my_idx).get(m_expr.get_arg(0).var().reg()); if ((arg0_i && arg1_i) || (arg0_u && arg1_u)) { auto new_form = pool.alloc_element( GenericOperator::make_fixed(FixedOperatorKind::ADDITION), args.at(0), args.at(1)); @@ -886,10 +891,15 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, auto new_form = pool.alloc_element( GenericOperator::make_fixed(FixedOperatorKind::ADDITION_PTR), args.at(0), args.at(1)); result->push_back(new_form); + } else if (arg1_ptr && arg0_type.is_integer_constant()) { + // this is a bit weird, but (&+ thing ) sometimes becomes (&+ thing). + // in these cases, we flip the argument order. + auto new_form = pool.alloc_element( + GenericOperator::make_fixed(FixedOperatorKind::ADDITION_PTR), args.at(1), args.at(0)); + result->push_back(new_form); } else { auto casted0 = args.at(0); - auto arg0_type = env.get_types_before_op(m_my_idx).get(m_expr.get_arg(0).var().reg()); if (!arg0_i && !arg0_u && arg0_type.typespec() != TypeSpec("binteger")) { casted0 = pool.alloc_single_element_form( nullptr, TypeSpec(arg0_i ? "int" : "uint"), args.at(0)); @@ -1371,21 +1381,11 @@ void SimpleExpressionElement::update_from_stack_left_shift(const Env& env, 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()); if (!arg0_i && !arg0_u) { - auto bti = dynamic_cast(env.dts->ts.lookup_type(arg0_type)); - if (bti) { - auto new_form = pool.alloc_element( - GenericOperator::make_fixed(FixedOperatorKind::SHL), args.at(0), - cast_form( - pool.alloc_single_element_form(nullptr, m_expr.get_arg(1)), - arg0_type, pool, env)); - result->push_back(new_form); - } else { - auto new_form = pool.alloc_element( - GenericOperator::make_fixed(FixedOperatorKind::SHL), - pool.alloc_single_element_form(nullptr, TypeSpec("int"), args.at(0)), - pool.alloc_single_element_form(nullptr, m_expr.get_arg(1))); - result->push_back(new_form); - } + auto new_form = pool.alloc_element( + GenericOperator::make_fixed(FixedOperatorKind::SHL), + pool.alloc_single_element_form(nullptr, TypeSpec("int"), args.at(0)), + pool.alloc_single_element_form(nullptr, m_expr.get_arg(1))); + result->push_back(new_form); } else { auto new_form = pool.alloc_element( GenericOperator::make_fixed(FixedOperatorKind::SHL), args.at(0), @@ -1586,7 +1586,8 @@ void SimpleExpressionElement::update_from_stack_float_to_int(const Env& env, if (type == TypeSpec("float")) { result->push_back(pool.alloc_element(TypeSpec("int"), arg, true)); } else { - throw std::runtime_error("Used float to int on a " + type.print()); + throw std::runtime_error( + fmt::format("Used float to int on a {}: {}", type.print(), to_string(env))); } } @@ -2063,26 +2064,26 @@ void StorePlainDeref::push_to_stack(const Env& env, FormPool& pool, FormStack& s if (size() == 16) { std::swap(popped.at(0), popped.at(1)); } - m_dst->set_base(make_optional_cast(m_dst_cast_type, popped.at(1), pool, env)); + m_dst->try_as_element()->set_base( + make_optional_cast(m_dst_cast_type, popped.at(1), pool, env)); m_dst->mark_popped(); - m_dst->inline_nested(); + m_dst->try_as_element()->inline_nested(); auto fr = pool.alloc_element( - pool.alloc_single_form(nullptr, m_dst), - make_optional_cast(m_src_cast_type, popped.at(0), pool, env)); + m_dst, make_optional_cast(m_src_cast_type, popped.at(0), pool, env)); // so the bitfield set check can run fr->mark_popped(); fr->push_to_stack(env, pool, stack); } else { auto vars = std::vector({m_base_var}); auto popped = pop_to_forms(vars, env, pool, stack, true); - m_dst->set_base(make_optional_cast(m_dst_cast_type, popped.at(0), pool, env)); + m_dst->try_as_element()->set_base( + make_optional_cast(m_dst_cast_type, popped.at(0), pool, env)); m_dst->mark_popped(); - m_dst->inline_nested(); + m_dst->try_as_element()->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), - make_optional_cast(m_src_cast_type, val, pool, env)); + auto fr = pool.alloc_element( + m_dst, make_optional_cast(m_src_cast_type, val, pool, env)); fr->mark_popped(); stack.push_form_element(fr, true); } diff --git a/decompiler/IR2/bitfields.cpp b/decompiler/IR2/bitfields.cpp index be354be131..569f400e00 100644 --- a/decompiler/IR2/bitfields.cpp +++ b/decompiler/IR2/bitfields.cpp @@ -28,6 +28,7 @@ BitfieldStaticDefElement::BitfieldStaticDefElement( : m_type(type) { for (auto& x : field_defs) { m_field_defs.push_back(BitFieldDef::from_constant(x, pool)); + m_field_defs.back().value->parent_element = this; } } diff --git a/decompiler/analysis/atomic_op_builder.cpp b/decompiler/analysis/atomic_op_builder.cpp index b8802092c2..7fcbf3fdcf 100644 --- a/decompiler/analysis/atomic_op_builder.cpp +++ b/decompiler/analysis/atomic_op_builder.cpp @@ -443,6 +443,20 @@ std::unique_ptr make_asm_branch_no_delay(const IR2_Condition& conditio return std::make_unique(likely, condition, dest_label, nullptr, my_idx); } +std::unique_ptr make_asm_branch(const IR2_Condition& condition, + const Instruction& delay, + bool likely, + int dest_label, + int my_idx) { + assert(!likely); + auto delay_op = std::shared_ptr(convert_1_allow_asm(delay, my_idx)); + if (!delay_op) { + throw std::runtime_error( + fmt::format("Failed to convert branch delay slot instruction for branch at {}", my_idx)); + } + return std::make_unique(likely, condition, dest_label, delay_op, my_idx); +} + /////////////////////// // OP 1 Conversions ////////////////////// @@ -1090,6 +1104,22 @@ std::unique_ptr convert_slt_2(const Instruction& i0, return result; } +std::unique_ptr convert_bltz_2(const Instruction& i0, const Instruction& i1, int idx) { + // bltz is never emitted outside of inline asm. + auto dest = i0.get_src(1).get_label(); + return make_asm_branch(IR2_Condition(IR2_Condition::Kind::LESS_THAN_ZERO_SIGNED, + make_src_atom(i0.get_src(0).get_reg(), idx)), + i1, false, dest, idx); +} + +std::unique_ptr convert_bgez_2(const Instruction& i0, const Instruction& i1, int idx) { + // bgez is never emitted outside of inline asm. + auto dest = i0.get_src(1).get_label(); + return make_asm_branch(IR2_Condition(IR2_Condition::Kind::GEQ_ZERO_SIGNED, + make_src_atom(i0.get_src(0).get_reg(), idx)), + i1, false, dest, idx); +} + std::unique_ptr convert_2(const Instruction& i0, const Instruction& i1, int idx) { switch (i0.kind) { case InstructionKind::DIV: @@ -1112,6 +1142,10 @@ std::unique_ptr convert_2(const Instruction& i0, const Instruction& i1 return convert_slt_2(i0, i1, idx, false); case InstructionKind::CLTS: return convert_fp_branch_asm(i0, i1, IR2_Condition::Kind::FLOAT_LESS_THAN, idx); + case InstructionKind::BLTZ: + return convert_bltz_2(i0, i1, idx); + case InstructionKind::BGEZ: + return convert_bgez_2(i0, i1, idx); default: return nullptr; } diff --git a/decompiler/analysis/insert_lets.cpp b/decompiler/analysis/insert_lets.cpp index 67f5650f0d..aba26c6830 100644 --- a/decompiler/analysis/insert_lets.cpp +++ b/decompiler/analysis/insert_lets.cpp @@ -36,20 +36,20 @@ If the previous let variables appear in the definition of new one, make the let */ namespace { -std::vector path_up_tree(Form* in) { +std::vector path_up_tree(Form* in, const Env& env) { std::vector path; while (in) { path.push_back(in); - // lg::warn("In: {}", in->to_string(env)); + // lg::warn("In: {}", in->to_string(env)); if (in->parent_element) { - // lg::warn(" {}", in->parent_element->to_string(env)); + // lg::warn(" {}", in->parent_element->to_string(env)); in = in->parent_element->parent_form; } else { in = nullptr; } } - // lg::warn("DONE\n"); + // lg::warn("DONE\n"); return path; } @@ -58,12 +58,12 @@ Form* lca_form(Form* a, Form* b, const Env& env) { if (!a) { return b; } + // + // fmt::print("lca {} ({}) and {} ({})\n", a->to_string(env), (void*)a, b->to_string(env), + // (void*)b); - // fmt::print("lca {} ({}) and {} ({})\n", a->to_string(env), (void*)a, b->to_string(env), - // (void*)b); - - auto a_up = path_up_tree(a); - auto b_up = path_up_tree(b); + auto a_up = path_up_tree(a, env); + auto b_up = path_up_tree(b, env); int ai = a_up.size() - 1; int bi = b_up.size() - 1; @@ -78,6 +78,10 @@ Form* lca_form(Form* a, Form* b, const Env& env) { ai--; bi--; } + if (!result) { + auto* bad = b->parent_element; + fmt::print("bad form is {} {}\n", bad->to_string(env), (void*)bad); + } assert(result); // fmt::print("{}\n\n", result->to_string(env)); @@ -544,6 +548,20 @@ LetStats insert_lets(const Function& func, Env& env, FormPool& pool, Form* top_l RegAccessSet reg_accesses; elt->collect_vars(reg_accesses, false); + // if (!reg_accesses.empty()) { + // Form* f = elt->parent_form; + // while (f && f != top_level_form) { + // auto pe = f->parent_element; + // if (pe) { + // f = pe->parent_form; + // } else { + // f = nullptr; + // } + // } + // + // assert(f); + // } + // and add it. for (auto& access : reg_accesses) { if (register_can_hold_var(access.reg())) { diff --git a/decompiler/config/all-types.gc b/decompiler/config/all-types.gc index 43a13e8642..7e52a48b35 100644 --- a/decompiler/config/all-types.gc +++ b/decompiler/config/all-types.gc @@ -759,6 +759,7 @@ :type uint32 :bitfield #f (zero 0) + (pause #x109) (sfx-volume #x10a) (music-volume #x10b) (speech-volume #x10c) @@ -4255,7 +4256,7 @@ (define-extern set-display (function display int int int int int display)) (define-extern put-draw-env (function (pointer gif-tag) none)) (define-extern *pre-draw-hook* (function none)) ;; unknown type -(define-extern *post-draw-hook* (function none)) ;; unknown type +(define-extern *post-draw-hook* (function dma-buffer none)) ;; unknown type ;; ---------------------- @@ -4539,7 +4540,7 @@ (new (symbol type) _type_ 0) (initialize! (_type_) _type_ 9) (print-usage (_type_) _type_ 10) - (dummy-11 (_type_) none 11) + (setup-font-texture! (_type_) none 11) (allocate-defaults! (_type_) none 12) (login-level-textures (_type_ level int (pointer texture-id)) none 13) ;; loading level... (add-tex-to-dma! (_type_ level int) none 14) ;; very mysterious arg types. @@ -4548,7 +4549,7 @@ (dummy-17 () none 17) (dummy-18 () none 18) (dummy-19 () none 19) - (dummy-20 (_type_ texture-page) int 20) + (unload! (_type_ texture-page) int 20) (upload-one-common! (_type_) symbol 21) (lookup-boot-common-id (_type_ int) int 22) ) @@ -4556,7 +4557,9 @@ (deftype texture (basic) ((w int16 :offset-assert 4) + (wu uint16 :offset 4) (h int16 :offset-assert 6) + (hu uint16 :offset 6) (num-mips uint8 :offset-assert 8) (tex1-control uint8 :offset-assert 9) ;; each level has a dest and a width (psm gs-psm :offset-assert 10) @@ -4587,7 +4590,7 @@ ) (deftype texture-page (basic) - ((info basic :offset-assert 4) + ((info file-info :offset-assert 4) (name basic :offset-assert 8) (id uint32 :offset-assert 12) (length int32 :offset-assert 16) ;; number of texture @@ -4606,7 +4609,7 @@ (get-leftover-block-count (_type_ int int) int 10) (dummy-11 () none 11) (relocate-dests! (_type_ int int) none 12) - (add-to-dma-buffer (_type_ dma-buffer int) none 13) + (add-to-dma-buffer (_type_ dma-buffer int) int 13) (upload-now! (_type_ int) none 14) ) ) @@ -4644,7 +4647,7 @@ ) (:methods (relocate (_type_ kheap (pointer uint8)) none :replace 7) - (dummy-9 (_type_ kheap) int 9) + (unlink-textures-in-heap! (_type_ kheap) int 9) ) :flag-assert #xa00000014 ) @@ -4662,17 +4665,24 @@ :flag-assert #x90000001c ) +(defenum link-test-flags + :type uint32 + :bitfield #t + (needs-log-in 8) + (bit-9 9) + ) + (deftype adgif-shader (structure) - ((quad qword 5 :inline :offset 0) - (prims uint64 10 :offset 0) - (tex0 uint64 :offset 0) - (tex1 uint64 :offset 16) - (miptbp1 uint64 :offset 32) - (clamp uint64 :offset 48) - (clamp-reg uint64 :offset 56) - (alpha uint64 :offset 64) - (link-test uint32 :offset 8) - (texture-id uint32 :offset 24) + ((quad qword 5 :score -100 :inline :offset 0) + (prims gs-reg64 10 :score -100 :offset 0) + (tex0 gs-tex0 :offset 0) + (tex1 gs-tex1 :offset 16) + (miptbp1 gs-miptbp :offset 32) + (clamp gs-clamp :offset 48) + (clamp-reg gs-reg64 :offset 56) + (alpha gs-miptbp :offset 64) + (link-test link-test-flags :offset 8) + (texture-id texture-id :offset 24) (next shader-ptr :offset 40) ) :method-count-assert 9 @@ -4830,7 +4840,7 @@ (vis-self-index int32 :offset-assert 440) (vis-adj-index int32 :offset-assert 444) (vis-buffer uint8 2048 :offset-assert 448) - (mem-usage-block basic :offset-assert 2496) + (mem-usage-block memory-usage-block :offset-assert 2496) (mem-usage int32 :offset-assert 2500) (code-memory-start pointer :offset-assert 2504) (code-memory-end pointer :offset-assert 2508) ;; NOTE - usually a texture-page @@ -4844,10 +4854,10 @@ (:methods (deactivate (_type_) _type_ 9) (dummy-10 (_type_ int) symbol 10) - (dummy-11 (_type_) none 11) + (add-irq-to-tex-buckets! (_type_) none 11) (unload! (_type_) _type_ 12) (bsp-name (_type_) symbol 13) - (dummy-14 (_type_) none 14) + (dummy-14 (_type_ object) none 14) (dummy-15 (_type_ vector) symbol 15) (dummy-16 (_type_) none 16) (load-continue (_type_) _type_ 17) @@ -5507,7 +5517,7 @@ (:methods (reset! (_type_) _type_ 9) (calculate-total (_type_) int 10) - (dummy-11 () none 11) + (print-mem-usage (_type_ level object) none 11) ) ) @@ -5515,7 +5525,7 @@ (define-extern *mem-usage* memory-usage-block) (define-extern *dma-mem-usage* memory-usage-block) -(define-extern *temp-mem-usage* symbol) +(define-extern *temp-mem-usage* memory-usage-block) ;; ---------------------- @@ -5526,17 +5536,17 @@ ;; - Functions -(define-extern adgif-shader<-texture! function) -(define-extern adgif-shader<-texture-with-update! function) -(define-extern level-remap-texture function) -(define-extern link-texture-by-id (function adgif-shader texture-id int)) +(define-extern adgif-shader<-texture! (function adgif-shader texture adgif-shader)) +(define-extern adgif-shader<-texture-with-update! (function adgif-shader texture adgif-shader)) +(define-extern level-remap-texture (function texture-id texture-id)) +(define-extern link-texture-by-id (function texture-id adgif-shader texture-page-dir-entry)) (define-extern lookup-texture-by-id (function texture-id texture)) -(define-extern texture-page-login (function texture-id function kheap texture-page-dir-entry)) +(define-extern texture-page-login (function texture-id (function texture-pool texture-page kheap int texture-page) kheap texture-page-dir-entry)) ;; arg2 in these is not an int, but something else. Not sure what it is yet. ;; all these texture-page-segment might actually be texture-relocate-later! (define-extern texture-page-default-allocate (function texture-pool texture-page kheap int texture-page)) (define-extern loado (function string kheap object)) -(define-extern texture-relocate (function dma-buffer texture int int int int)) +(define-extern texture-relocate (function dma-buffer texture int gs-psm int dma-buffer)) (define-extern dma-buffer-add-ref-texture (function dma-buffer pointer int int gs-psm none)) (define-extern upload-vram-pages (function texture-pool texture-pool-segment texture-page int int int)) (define-extern upload-vram-pages-pris (function texture-pool texture-pool-segment texture-page int int int)) @@ -5561,13 +5571,13 @@ (define-extern texture-page-common-boot-allocate (function texture-pool texture-page kheap int texture-page)) (define-extern texture-page-level-allocate (function texture-pool texture-page kheap int texture-page)) (define-extern relocate-later (function symbol)) -(define-extern adgif-shader-update! (function int texture none)) ;; todo - unconfirmed -(define-extern adgif-shader-login (function adgif-shader none)) -(define-extern adgif-shader-login-no-remap (function adgif-shader none)) -(define-extern adgif-shader-login-fast function) -(define-extern adgif-shader-login-no-remap-fast function) +(define-extern adgif-shader-update! (function adgif-shader texture none)) ;; todo - unconfirmed +(define-extern adgif-shader-login (function adgif-shader texture)) +(define-extern adgif-shader-login-no-remap (function adgif-shader texture)) +(define-extern adgif-shader-login-fast (function adgif-shader texture)) +(define-extern adgif-shader-login-no-remap-fast (function adgif-shader texture)) ;;;; unknown type -(define-extern adgif-shader<-texture-simple! function) +(define-extern adgif-shader<-texture-simple! (function adgif-shader texture adgif-shader)) ;; - Symbols @@ -11531,7 +11541,7 @@ ) (deftype perf-stat-array (inline-array-class) - () + ((data perf-stat :inline :dynamic :offset-assert 16)) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 @@ -14816,12 +14826,12 @@ (define-extern *subdivide-settings* subdivide-settings) (define-extern *tfrag-work* tfrag-work) ;; unknown type -;;(define-extern *perf-stats* object) ;; unknown type +(define-extern *perf-stats* perf-stat-array) ;; unknown type ;;(define-extern *merc-global-stats* object) ;; unknown type ;;(define-extern *stat-string-tfrag-near* object) ;; unknown type ;;(define-extern *stat-string-tfrag* object) ;; unknown type ;;(define-extern *stat-string-total* object) ;; unknown type -;;(define-extern *terrain-context* object) ;; unknown type +(define-extern *terrain-context* terrain-context) ;; unknown type ;;(define-extern GSH_ENABLE object) ;; unknown type ;;(define-extern GSH_BUCKET object) ;; unknown type ;;(define-extern GSH_WHICH_STAT object) ;; unknown type @@ -15062,7 +15072,7 @@ (define-extern internal-draw-debug-text-3d (function bucket-id string vector rgba vector2h pointer)) (define-extern get-debug-line (function debug-line)) (define-extern internal-draw-debug-line (function bucket-id vector vector rgba symbol rgba object)) -(define-extern draw-string (function string dma-buffer font-context int)) +(define-extern draw-string (function string dma-buffer font-context float)) (define-extern transform-float-point (function vector vector vector)) (define-extern add-debug-point (function symbol bucket-id vector symbol)) ;; unused (define-extern add-debug-outline-triangle (function symbol bucket-id vector vector vector rgba symbol)) @@ -15174,11 +15184,11 @@ (define-extern setup-blerc-chains-for-one-fragment function) (define-extern setup-blerc-chains function) (define-extern blerc-stats-init function) -(define-extern blerc-init function) +(define-extern blerc-init (function none)) (define-extern blerc-a-fragment function) (define-extern dma-from-spr function) (define-extern merc-dma-chain-to-spr function) -(define-extern blerc-execute function) +(define-extern blerc-execute (function none)) (define-extern merc-blend-shape function) ;; - Unknowns @@ -15202,7 +15212,7 @@ (define-extern merc-stats-display function) (define-extern merc-stats function) (define-extern merc-edge-stats function) -(define-extern merc-vu1-init-buffers function) +(define-extern merc-vu1-init-buffers (function none)) ;; - Unknowns @@ -15330,7 +15340,7 @@ (define-extern dump-mem function) (define-extern bone-list-init function) (define-extern texscroll-make-request function) -(define-extern texscroll-execute function) +(define-extern texscroll-execute (function none)) (define-extern bones-set-sqwc function) (define-extern bones-reset-sqwc function) (define-extern bones-init function) @@ -15650,7 +15660,7 @@ (define-extern depth-cue-set-stencil function) (define-extern depth-cue-draw-depth function) (define-extern depth-cue-calc-z function) -(define-extern depth-cue function) +(define-extern depth-cue (function display none)) ;; - Unknowns @@ -15959,7 +15969,7 @@ ;; - Functions -(define-extern tie-init-buffers function) +(define-extern tie-init-buffers (function dma-buffer none)) (define-extern tie-debug-between function) (define-extern tie-debug-one function) (define-extern walk-tie-generic-prototypes function) @@ -16122,8 +16132,8 @@ (define-extern sp-orbiter function) (define-extern memcpy function) (define-extern kill-all-particles-in-level (function int)) -(define-extern set-particle-frame-time function) -(define-extern process-particles function) +(define-extern set-particle-frame-time (function int none)) +(define-extern process-particles (function none)) ;; - Unknowns @@ -16505,7 +16515,7 @@ (define-extern game-save-elt->string (function game-save-elt string)) (define-extern progress-level-index->string (function int string)) (define-extern auto-save-post function) -(define-extern auto-save-check function) +(define-extern auto-save-check (function none)) ;; - Unknowns @@ -16963,7 +16973,7 @@ (define-extern start-time-of-day (function int)) (define-extern time-of-day-setup (function symbol int none)) ;; not confirmed (define-extern set-time-of-day function) -(define-extern init-time-of-day-context function) +(define-extern init-time-of-day-context (function time-of-day-context none)) (define-extern update-time-of-day function) ;; - Unknowns @@ -17303,7 +17313,7 @@ (define-extern set-font-color-alpha function) (define-extern load-game-text-info function) -(define-extern load-level-text-files function) +(define-extern load-level-text-files (function int none)) (define-extern draw-debug-text-box function) (define-extern print-game-text-scaled function) (define-extern disable-level-text-file-loading function) @@ -17501,7 +17511,7 @@ ;; - Unknowns -;;(define-extern *collide-vif0-init* object) ;; unknown type +(define-extern *collide-vif0-init* (array uint32)) ;; unknown type ;; ---------------------- @@ -18005,7 +18015,7 @@ (define-extern update-visible function) (define-extern set-point function) (define-extern plane-from-points function) -(define-extern update-camera function) +(define-extern update-camera (function none)) ;; - Unknowns @@ -18498,7 +18508,7 @@ ;;(define-extern level-hint-ambient-sound object) ;; unknown type ;;(define-extern level-hint-sidekick object) ;; unknown type ;;(define-extern level-hint-normal object) ;; unknown type -;;(define-extern *execute-ambients* object) ;; unknown type +(define-extern *execute-ambients* symbol) ;; unknown type ;; ---------------------- @@ -19338,13 +19348,13 @@ ;; - Functions -(define-extern display-frame-finish function) -(define-extern display-sync function) -(define-extern determine-pause-mode function) -(define-extern display-frame-start function) +(define-extern display-frame-finish (function display object)) +(define-extern display-sync (function display none)) +(define-extern determine-pause-mode (function int)) +(define-extern display-frame-start (function display int int none)) (define-extern toggle-pause (function int)) -(define-extern deactivate-progress function) -(define-extern debug-init-buffer function) +(define-extern deactivate-progress (function none)) +(define-extern debug-init-buffer (function bucket-id uint uint none)) (define-extern real-main-draw-hook function) (define-extern error-sphere function) (define-extern draw-instance-info function) @@ -19357,7 +19367,7 @@ (define-extern foreground-engine-execute function) (define-extern main-debug-hook function) (define-extern main-draw-hook function) -(define-extern swap-display function) +(define-extern swap-display (function display object)) (define-extern marks-cam-restore function) (define-extern eddie-cam-restore function) (define-extern gregs-jungle-cam-restore function) @@ -19373,10 +19383,10 @@ ;; - Unknowns -;;(define-extern syncv object) ;; unknown type -;;(define-extern put-display-env object) ;; unknown type -;;(define-extern *surrogate-dma-buffer* object) ;; unknown type -;;(define-extern *screen-shot* object) ;; unknown type +(define-extern syncv (function int int)) ;; unknown type +(define-extern put-display-env (function object none)) ;; unknown type +(define-extern *surrogate-dma-buffer* dma-buffer) ;; unknown type +(define-extern *screen-shot* symbol) ;; unknown type ;;(define-extern *hud-lights* object) ;; unknown type ;;(define-extern *instance-mem-usage* object) ;; unknown type ;;(define-extern *add-sphere* object) ;; unknown type @@ -19535,7 +19545,7 @@ ;; - Unknowns -;;(define-extern *max-dma* object) ;; unknown type +(define-extern *max-dma* int) ;; ---------------------- @@ -20691,7 +20701,7 @@ (define-extern make-levels-with-tasks-available-to-progress function) (define-extern progress-init-by-other function) (define-extern init-game-options function) -(define-extern make-current-level-available-to-progress function) +(define-extern make-current-level-available-to-progress (function none)) ;; - Unknowns diff --git a/decompiler/config/jak1_ntsc_black_label/anonymous_function_types.jsonc b/decompiler/config/jak1_ntsc_black_label/anonymous_function_types.jsonc index a7c0442d27..1d9207344e 100644 --- a/decompiler/config/jak1_ntsc_black_label/anonymous_function_types.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/anonymous_function_types.jsonc @@ -568,5 +568,10 @@ [90, "(function debug-menu debug-menu symbol)"] // not 100% sure about the debug-menu, but it has a string at offset 0 ], + "memory-usage": [ + [3, "(function basic symbol)"], + [2, "(function process symbol)"] + ], + "placeholder-do-not-add-below": [] } diff --git a/decompiler/config/jak1_ntsc_black_label/hacks.jsonc b/decompiler/config/jak1_ntsc_black_label/hacks.jsonc index 8480cdc103..a9b3fb733e 100644 --- a/decompiler/config/jak1_ntsc_black_label/hacks.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/hacks.jsonc @@ -26,7 +26,8 @@ "aggressively_reject_cond_to_value_rewrite": [ "(method 10 res-lump)", "(method 11 res-lump)", - "(method 12 res-lump)" + "(method 12 res-lump)", + "(method 7 texture-page)" ], // this provides a hint to the decompiler that these functions will have a lot of inline assembly. @@ -97,8 +98,8 @@ "vector=", // asm branching // texture - "adgif-shader<-texture-with-update!", // F: asm branching - "(method 9 texture-page-dir)", + // "adgif-shader<-texture-with-update!", // F: asm branching + // "(method 9 texture-page-dir)", // collide-mesh-h "(method 11 collide-mesh-cache)", @@ -378,7 +379,7 @@ "(method 32 collide-cache)", // memory-usage BUG - "(method 14 level)", + //"(method 14 level)", // navigate BUG "(method 32 nav-control)", @@ -478,7 +479,8 @@ "debug-menu-context-select-new-item", "debug-menu-send-msg", "debug-menu-find-from-template", - "build-continue-menu" + "build-continue-menu", + "(method 8 process-tree)" ], // If format is used with the wrong number of arguments, @@ -488,17 +490,54 @@ "bad_format_strings": { "ERROR: dma tag has data in reserved bits ~X~%": 0, "#: value of symbol ~A in task-controls is not a task-control~%": 0 + "ERROR: value of symbol ~A in task-controls is not a task-control~%": 0, + "~0K~10,'-S--~5,'-DK-of-~5,'-DK--~5,'-DK-of-~5,'-DK--": 5, + " bsp ~192H~5DK ~280Hdebug~456H~5DK~%": 2, + " bsp-leaf-vis-iop ~192H~5DK~%": 1, + " bsp-leaf-vis-adj ~192H~5DK~%": 1, + " level-code ~192H~5DK~%": 1, + " tfrag ~192H~5DK ~280Htfragment~456H~5DK~%": 2, + " tie-proto ~192H~5DK ~280Hsky~456H~5DK~%": 2, + " tie-instance ~192H~5DK ~280Htie-fragment~456H~5DK~%": 2, + " shrub-proto ~192H~5DK ~280Htie-near~456H~5DK~%": 2, + " shrub-instance ~192H~5DK ~280Hshrubbery~456H~5DK~%": 2, + " collision ~192H~5DK ~280Htie-generic~456H~5DK~%": 2, + " pris-geo ~192H~5DK ~280Hpris-fragment~456H~5DK~%": 2, + " pris-anim ~192H~5DK ~280Hpris-generic~456H~5DK~%": 2, + " textures ~192H~5DK ~280Htextures~456H~5DK~%": 2, + " entity ~192H~5DK~%":2, + " misc ~192H~5DK ~280Hsprite~456H~5DK~%":2 }, "blocks_ending_in_asm_branch": { "closest-pt-in-triangle": [17], // this one is all asm branches - "circle-circle-xz-intersect": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14], + "circle-circle-xz-intersect": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10, + 11, + 12, + 13, + 14 + ], "find-knot-span": [0, 1, 2, 3, 5, 6, 7, 8, 9], - "curve-evaluate!": [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] + "curve-evaluate!": [0, 1, 2, 3, 4, 5, 6, 7, 8, 9], + + "(method 9 texture-page-dir)": [4, 5], + + "adgif-shader<-texture-with-update!": [0, 1], + + "display-loop": [44, 49, 66, 96] } } diff --git a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc index 7bc8a2b868..0c313ea2bd 100644 --- a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc @@ -257,7 +257,16 @@ ["L349", "_auto_", true], ["L369", "uint64", true], ["L373", "uint64", true], - ["L371", "uint64", true] + ["L371", "uint64", true], + ["L364", "float", true], + ["L372", "uint64", true], + ["L375", "uint64", true], + ["L374", "uint64", true], + ["L365", "uint64", true], + ["L366", "uint64", true], + ["L370", "uint64", true], + ["L367", "uint64", true], + ["L368", "uint64", true] ], "fact-h": [ @@ -549,7 +558,7 @@ "entity-table": [["L8", "(array entity-info)", true]], - "main": [["L230", "_lambda_", true]], + "main": [["L230", "_lambda_", true], ["L309", "float", true]], "geometry": [["L125", "float", true], ["L126", "float", true], ["L112", "(pointer float)", true, 4]], @@ -1150,12 +1159,13 @@ ["L45", "(array task-hint-control-group)", true], ["L100", "(array level-hint-control)", true] ], - "air": [ ["L38", "uint64", true], ["L39", "uint64", true] ], - + "memory-usage": [ + ["L15", "_lambda_", true] + ], // please do not add things after this entry! git is dumb. "object-file-that-doesnt-actually-exist-and-i-just-put-this-here-to-prevent-merge-conflicts-with-this-file": [] } diff --git a/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc b/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc index 926aed8c1d..bb1130a4e0 100644 --- a/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/stack_structures.jsonc @@ -521,5 +521,13 @@ [32, "vector"] ], + "mem-size": [ + [16, "memory-usage-block"] + ], + + "display-loop": [ + [16, "sphere"] + ], + "placeholder-do-not-add-below!": [] } diff --git a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc index 51468f2dd1..6a8048bbe5 100644 --- a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc @@ -341,6 +341,127 @@ [[47, 62], "a2", "dma-packet"] ], + "(method 11 level)": [ + [[13, 18], "a1", "dma-packet"], + //[19, "a0", "(pointer uint32)"], + [[20, 26], "a0", "dma-packet"], + + [[50, 55], "a1", "dma-packet"], + // [56, "a0", "(pointer uint32)"], + [[60, 63], "a0", "dma-packet"], + + [[87, 92], "a1", "dma-packet"], + // [93, "a0", "(pointer uint32)"], + [[97, 100], "a0", "dma-packet"], + + [[124, 129], "a1", "dma-packet"], + // [130, "a0", "(pointer uint32)"], + [[134, 137], "a0", "dma-packet"], + + [[162, 167], "a1", "dma-packet"], + // [168, "a0", "(pointer uint32)"], + [[172, 175], "a0", "dma-packet"], + + [[199, 204], "a1", "dma-packet"], + // [205, "a0", "(pointer uint32)"], + [[209, 212], "a0", "dma-packet"], + + [[236, 241], "a1", "dma-packet"], + // [242, "a0", "(pointer uint32)"], + [[246, 249], "a0", "dma-packet"], + + [[273, 278], "a1", "dma-packet"], + // [279, "a0", "(pointer uint32)"], + [[283, 286], "a0", "dma-packet"] + ], + + "(method 14 texture-page)": [ + [[18, 22], "a0", "dma-packet"], + [[28, 31], "a0", "gs-gif-tag"], + [36, "a0", "(pointer uint64)"], + [38, "a0", "(pointer gs-reg64)"], + [[44, 45], "a0", "dma-packet"], + [45, "a0", "(pointer uint64)"] + ], + + "(method 13 texture-page)": [ + [[45, 49], "a0", "dma-packet"], + [[55, 58], "a0", "gs-gif-tag"], + [67, "a0", "(pointer gs-bitbltbuf)"], + [69, "a0", "(pointer gs-reg64)"], + [70, "a0", "(pointer gs-trxpos)"], + [72, "a0", "(pointer gs-reg64)"], + [76, "a0", "(pointer gs-trxreg)"], + [78, "a0", "(pointer gs-reg64)"], + [79, "a0", "(pointer gs-trxdir)"], + [81, "a0", "(pointer gs-reg64)"] + ], + + "link-texture-by-id": [[51, "s5", "uint"]], + + "adgif-shader-login-fast": [[57, "gp", "uint"]], + + "adgif-shader-login-no-remap-fast": [[52, "a0", "uint"]], + + "(method 9 texture-page-dir)": [[[27, 31], "t3", "adgif-shader"]], + + "adgif-shader<-texture-simple!": [[5, "v1", "uint"]], + + "display-frame-start": [ + [4, "v1", "(pointer uint32)"] + ], + + "display-loop": [ + [152, "v1", "(pointer int32)"], + [157, "a0", "(pointer process-drawable)"] + ], + + "texture-relocate": [ + [[17, 21], "t4", "dma-packet"], + [[27, 30], "t4", "gs-gif-tag"], + [60, "t4", "(pointer gs-bitbltbuf)"], + [62, "t4", "(pointer gs-reg64)"], + [63, "t4", "(pointer gs-trxpos)"], + [65, "t4", "(pointer gs-reg64)"], + [71, "t4", "(pointer gs-trxreg)"], + [73, "t4", "(pointer gs-reg64)"], + [75, "t4", "(pointer gs-trxdir)"], + [77, "t4", "(pointer gs-reg64)"], + [[98, 102], "a2", "dma-packet"], + [[108, 111], "a2", "gs-gif-tag"], + + [132, "a2", "(pointer gs-bitbltbuf)"], + [134, "a2", "(pointer gs-reg64)"], + [135, "a2", "(pointer gs-trxpos)"], + [137, "a2", "(pointer gs-reg64)"], + [139, "a2", "(pointer gs-trxreg)"], + [141, "a2", "(pointer gs-reg64)"], + [143, "a2", "(pointer gs-trxdir)"], + [145, "a2", "(pointer gs-reg64)"], + + [[157, 161], "a2", "dma-packet"], + [[167, 170], "a2", "gs-gif-tag"], + [191, "a2", "(pointer gs-bitbltbuf)"], + [193, "a2", "(pointer gs-reg64)"], + [194, "a2", "(pointer gs-trxpos)"], + [196, "a2", "(pointer gs-reg64)"], + [198, "a2", "(pointer gs-trxreg)"], + [200, "a2", "(pointer gs-reg64)"], + [202, "a2", "(pointer gs-trxdir)"], + [204, "a2", "(pointer gs-reg64)"] + ], + + "(method 11 texture-pool)": [ + [[119, 123], "a0", "dma-packet"], + [[129, 132], "a0", "gs-gif-tag"], + [137, "a0", "(pointer uint64)"], + [139, "a0", "(pointer gs-reg64)"], + [145, "a0", "dma-packet"], + [146, "a0", "(pointer uint64)"] + ], + + "texture-page-login": [[[34, 45], "s2", "texture-page"]], + "upload-vram-data": [ [[9, 15], "a0", "dma-packet"], [[18, 24], "a0", "gs-gif-tag"], @@ -1023,5 +1144,15 @@ [[0, 60], "f1", "float"] ], + "(anon-function 2 memory-usage)": [ + [[171, 415], "s5", "process-drawable"], + [[212, 213], "v1", "collide-shape"] + ], + + "(method 8 process-tree)": [ + [31, "v1", "symbol"], + [6, "a3", "symbol"] + ], + "placeholder-do-not-add-below": [] } diff --git a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc index d9e5c76278..fb5d4f1bae 100644 --- a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc @@ -1313,6 +1313,108 @@ } }, + "(method 13 texture-page)": { + "args": ["obj", "dma-buff", "mode"], + "vars": { + "sv-16": "total-size", + "v1-7": "start-segment", + "s5-0": "chunk-count", + "s4-0": "current-dest", + "s3-0": "current-data", + "a3-1": "chunks-now", + "a0-1": ["pkt", "dma-packet"], + "a0-3": ["gs-tag", "gs-gif-tag"], + "a0-5": "gs-reg-data" + } + }, + + "texture-relocate": { + "args": ["dma-buff", "tex", "dest-loc", "dest-fmt", "clut-dst"], + "vars": { + "v1-0": "mip-level", + "t1-1": "mip-w", + "t2-3": "mip-h", + "t4-0": ["dma-pkt", "dma-packet"], + "t4-2": ["gs-pkt", "gs-gif-tag"] + } + }, + + "(method 11 texture-pool)": { + "vars": { + "s3-0": "font-clut", + "sv-16": "heap-before-font-tex", + "sv-20": "clut-dest-addr", + "s4-0": "dma-buff", + "s5-0": "main-font-tx", + "s2-0": "font-tx-1", + "s1-0": "font-tx-1-dest", + "s0-0": "font-tx-1-fmt", + "s2-1": "font-tx-0", + "s1-1": "font-tx-0-dest", + "s0-1": "font-tx-0-fmt", + "s2-2": "font-tx-3", + "s1-2": "font-tx-3-dest", + "s0-2": "font-tx-3-fmt", + "s2-3": "font-tx-2", + "s1-3": "font-tx-2-dest", + "s0-3": "font-tx-2-fmt" + } + }, + + "link-texture-by-id": { + "vars": { + "s4-0": "dir-entry" + } + }, + + "(method 9 texture-page-dir)": { + "args": ["obj", "heap"], + "vars": { + "v1-0": "mem-start", + "a1-1": "mem-end", + "a2-0": "entry-idx", + "t1-0": "entry", + "t0-0": "tex-page", + "a3-4": "link-arr", + "t0-3": "tex-count", + "t1-4": "tex-idx", + "t2-0": "link-slot", + "t3-2": ["shader", "adgif-shader"], + "t4-1": "dist-past-end" + } + }, + + "display-loop": { + "vars": { + + } + }, + + "adgif-shader-login": { + "args":"shader", + "vars": { + "s5-0":"tex" + } + }, + + "adgif-shader-login-fast": { + "args":["shader"], + "vars":{ + "v1-4":"tex-id", + "a0-9":"dir-entry", + "s5-0":"tex" + } + }, + + "texture-page-login": { + "args": ["id", "alloc-func", "heap"], + "vars": { + "s5-0": "dir-entry", + "s4-0": "old-alloc-func", + "s3-0": "file-name" + } + }, + "(method 9 __assert-info-private-struct)": { "args": ["obj", "filename", "line-num", "column-num"] }, @@ -2151,34 +2253,34 @@ "(method 10 game-info)": { "args": ["obj", "item", "amount", "source"], "vars": { - "v1-10":"proc", - "s4-1":"level-idx", - "a0-35":"buzz-task", - "s4-2":"buzz-index", - "f30-0":"buzz-count", - "s3-0":"ctrl", - "s5-2":"buzz-bits" + "v1-10": "proc", + "s4-1": "level-idx", + "a0-35": "buzz-task", + "s4-2": "buzz-index", + "f30-0": "buzz-count", + "s3-0": "ctrl", + "s5-2": "buzz-bits" } }, "(method 14 game-info)": { - "args":["obj", "lev"], + "args": ["obj", "lev"], "vars": { - "s5-0":"perms", - "s4-0":"lev-entities", - "s3-0":"lev-entity-idx", - "s2-0":"lev-entity-perm", - "v1-8":"info-entity-perm" + "s5-0": "perms", + "s4-0": "lev-entities", + "s3-0": "lev-entity-idx", + "s2-0": "lev-entity-perm", + "v1-8": "info-entity-perm" } }, "(method 15 game-info)": { - "args":["obj", "lev"], + "args": ["obj", "lev"], "vars": { - "s5-0":"lev-entities", - "s4-0":"lev-entity-idx", - "s3-0":"lev-entity-perm", - "v1-7":"info-entity-perm" + "s5-0": "lev-entities", + "s4-0": "lev-entity-idx", + "s3-0": "lev-entity-perm", + "v1-7": "info-entity-perm" } }, @@ -2206,11 +2308,11 @@ "vars": { "s4-0": ["tag", "game-save-tag"], "s3-0": "tag-idx", - "s2-1":"prog-lev-idx", - "a2-13":"lev-name" + "s2-1": "prog-lev-idx", + "a2-13": "lev-name" } }, - + "debug-menu-func-decode": { "vars": { "v0-0": ["ret-val", "symbol"] diff --git a/game/kernel/klink.cpp b/game/kernel/klink.cpp index ae18304d82..2c4ceb662e 100644 --- a/game/kernel/klink.cpp +++ b/game/kernel/klink.cpp @@ -876,25 +876,23 @@ uint64_t link_resume() { * but it may use the scratchpad. It is implemented in GOAL, and falls back to normal C memcpy * if GOAL isn't loaded, or if the alignment isn't good enough. */ -void* ultimate_memcpy(void* dst, void* src, uint32_t size) { +void ultimate_memcpy(void* dst, void* src, uint32_t size) { // only possible if alignment is good. if (!(u64(dst) & 0xf) && !(u64(src) & 0xf) && !(u64(size) & 0xf) && size > 0xfff) { if (!gfunc_774.offset) { // GOAL function is unknown, lets see if its loaded: auto sym = find_symbol_from_c("ultimate-memcpy"); if (sym->value == 0) { - return memmove(dst, src, size); + memmove(dst, src, size); } gfunc_774.offset = sym->value; } - printf("Replacing goal ultimate-memcpy! with memmove\n"); - return memmove(dst, src, size); - // return Ptr(call_goal(gfunc_774, make_u8_ptr(dst).offset, make_u8_ptr(src).offset, - // size, - // s7.offset, g_ee_main_mem)) - // .c(); + + Ptr(call_goal(gfunc_774, make_u8_ptr(dst).offset, make_u8_ptr(src).offset, size, s7.offset, + g_ee_main_mem)) + .c(); } else { - return memmove(dst, src, size); + memmove(dst, src, size); } } diff --git a/game/kernel/klink.h b/game/kernel/klink.h index 47c5b245b4..d337d15966 100644 --- a/game/kernel/klink.h +++ b/game/kernel/klink.h @@ -109,7 +109,7 @@ uint64_t link_begin(uint64_t object_data, uint32_t flags); uint64_t link_resume(); -void* ultimate_memcpy(void* dst, void* src, uint32_t size); +void ultimate_memcpy(void* dst, void* src, uint32_t size); extern link_control saved_link_control; diff --git a/game/kernel/kmachine.cpp b/game/kernel/kmachine.cpp index 00af109793..ec4f172c31 100644 --- a/game/kernel/kmachine.cpp +++ b/game/kernel/kmachine.cpp @@ -29,6 +29,7 @@ #include "game/sce/libpad.h" #include "common/symbols.h" #include "common/log/log.h" +#include "common/util/Timer.h" #include "game/system/vm/vm.h" using namespace ee; @@ -48,11 +49,14 @@ u8 pad_dma_buf[2 * SCE_PAD_DMA_BUFFER_SIZE]; const char* init_types[] = {"fakeiso", "deviso", "iso_cd"}; +Timer ee_clock_timer; + void kmachine_init_globals() { isodrv = iso_cd; modsrc = 1; reboot = 1; memset(pad_dma_buf, 0, sizeof(pad_dma_buf)); + ee_clock_timer = Timer(); } /*! @@ -564,6 +568,27 @@ void PutDisplayEnv() { assert(false); } +/*! + * PC Port function to get a 300MHz timer value. + */ +u64 read_ee_timer() { + u64 ns = ee_clock_timer.getNs(); + return (ns * 3) / 10; +} + +/*! + * PC Port function to do a fast memory copy. + */ +void c_memmove(u32 dst, u32 src, u32 size) { + memmove(Ptr(dst).c(), Ptr(src).c(), size); +} + +void InitMachine_PCPort() { + // PC Port added functions + make_function_symbol_from_c("__read-ee-timer", (void*)read_ee_timer); + make_function_symbol_from_c("__mem-move", (void*)c_memmove); +} + /*! * Final initialization of the system after the kernel is loaded. * This is called from InitHeapAndSymbol at the very end. @@ -602,6 +627,8 @@ void InitMachineScheme() { make_function_symbol_from_c("dma-to-iop", (void*)dma_to_iop); // unused make_function_symbol_from_c("kernel-shutdown", (void*)KernelShutdown); // used make_function_symbol_from_c("aybabtu", (void*)sceCdMmode); // used + + InitMachine_PCPort(); InitSoundScheme(); intern_from_c("*stack-top*")->value = 0x07ffc000; intern_from_c("*stack-base*")->value = 0x07ffffff; diff --git a/game/kernel/kscheme.cpp b/game/kernel/kscheme.cpp index b1e80f2c1e..825664432f 100644 --- a/game/kernel/kscheme.cpp +++ b/game/kernel/kscheme.cpp @@ -1720,11 +1720,9 @@ s32 InitHeapAndSymbol() { set_fixed_symbol(FIX_SYM_GLOBAL_HEAP, "global", kglobalheap.offset); set_fixed_symbol(FIX_SYM_DEBUG_HEAP, "debug", kdebugheap.offset); set_fixed_symbol(FIX_SYM_STATIC, "static", (s7 + FIX_SYM_STATIC).offset); - set_fixed_symbol(FIX_SYM_LOADING_LEVEL, "loading-level", (s7 + FIX_SYM_LOADING_LEVEL).offset); - set_fixed_symbol(FIX_SYM_LOADING_PACKAGE, "loading-package", - (s7 + FIX_SYM_LOADING_PACKAGE).offset); - set_fixed_symbol(FIX_SYM_PROCESS_LEVEL_HEAP, "process-level-heap", - (s7 + FIX_SYM_PROCESS_LEVEL_HEAP).offset); + set_fixed_symbol(FIX_SYM_LOADING_LEVEL, "loading-level", kglobalheap.offset); + set_fixed_symbol(FIX_SYM_LOADING_PACKAGE, "loading-package", kglobalheap.offset); + set_fixed_symbol(FIX_SYM_PROCESS_LEVEL_HEAP, "process-level-heap", kglobalheap.offset); set_fixed_symbol(FIX_SYM_STACK, "stack", (s7 + FIX_SYM_STACK).offset); set_fixed_symbol(FIX_SYM_SCRATCH, "scratch", (s7 + FIX_SYM_SCRATCH).offset); set_fixed_symbol(FIX_SYM_SCRATCH_TOP, "*scratch-top*", 0x70000000); diff --git a/goal_src/engine/debug/memory-usage-h.gc b/goal_src/engine/debug/memory-usage-h.gc index 9f8ee8a2c5..13ed8b18ce 100644 --- a/goal_src/engine/debug/memory-usage-h.gc +++ b/goal_src/engine/debug/memory-usage-h.gc @@ -27,13 +27,13 @@ (:methods (reset! (_type_) _type_ 9) (calculate-total (_type_) int 10) - (dummy-11 () none 11) + (print-mem-usage (_type_ level object) none 11) ) ) (define *mem-usage* (new 'debug 'memory-usage-block)) (define *dma-mem-usage* (new 'debug 'memory-usage-block)) -(define *temp-mem-usage* #f) +(define *temp-mem-usage* (the-as memory-usage-block #f)) ;; Memory usage stats are organized by the type of object. diff --git a/goal_src/engine/debug/stats-h.gc b/goal_src/engine/debug/stats-h.gc index 3df795f6b2..7df7622dc8 100644 --- a/goal_src/engine/debug/stats-h.gc +++ b/goal_src/engine/debug/stats-h.gc @@ -59,7 +59,7 @@ ;; definition of type perf-stat-array (deftype perf-stat-array (inline-array-class) - () + ((data perf-stat :inline :dynamic :offset-assert 16)) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 diff --git a/goal_src/engine/dma/dma-bucket.gc b/goal_src/engine/dma/dma-bucket.gc index e29e96dd59..9c6a39ccd2 100644 --- a/goal_src/engine/dma/dma-bucket.gc +++ b/goal_src/engine/dma/dma-bucket.gc @@ -13,6 +13,11 @@ ;; buckets live consecutively in the dma-buffer, and can mark the start of a DMA chain ;; location anywhere. +;; The bucket doesn't own the data, but rather is a beginning of a linked list of DMA data associated with that bucket +;; that's stored somewhere else. + +;; At the end, all the buckets are spliced together. + ;; The typical process is: ;; - empty buckets are allocated with add-buckets ;; - tags are put somewhere and added to the appropriate bucket with insert-tag, updating last as needed. diff --git a/goal_src/engine/dma/dma-buffer.gc b/goal_src/engine/dma/dma-buffer.gc index a84c66a76d..0c468aac09 100644 --- a/goal_src/engine/dma/dma-buffer.gc +++ b/goal_src/engine/dma/dma-buffer.gc @@ -164,7 +164,7 @@ (defun dma-buffer-send ((chan dma-bank) (buf dma-buffer)) - "Send the DMA buffer! DOES NOT TRANSFER TAG." + "Send the DMA buffer! DOES NOT TRANSFER TAG, you probably want dma-buffer-send-chain instead." (when (< (-> buf allocated-length) (&- (-> buf base) (-> buf data)) ) diff --git a/goal_src/engine/dma/dma-disasm.gc b/goal_src/engine/dma/dma-disasm.gc index 50e4358385..1cf639b61d 100644 --- a/goal_src/engine/dma/dma-disasm.gc +++ b/goal_src/engine/dma/dma-disasm.gc @@ -5,6 +5,8 @@ ;; name in dgo: dma-disasm ;; dgos: GAME, ENGINE +;; Debug tool to print out a DMA list. + (deftype vif-disasm-element (structure) ((mask uint32 :offset-assert 0) (tag vif-cmd-32 :offset-assert 4) @@ -400,6 +402,10 @@ ;; this is unused. (define *dma-disasm* #t) +(defmacro disasm-dma-buffer (buff) + `(disasm-dma-list (the dma-packet (-> ,buff data-buffer)) 'details #t #t 0) + ) + (defun disasm-dma-list ((data dma-packet) (mode symbol) (verbose symbol) (stream symbol) (expected-size int)) "Disassemble a dma list, starting from the given packet." (local-vars diff --git a/goal_src/engine/dma/dma-h.gc b/goal_src/engine/dma/dma-h.gc index eec49d8601..e210a9c51c 100644 --- a/goal_src/engine/dma/dma-h.gc +++ b/goal_src/engine/dma/dma-h.gc @@ -5,11 +5,16 @@ ;; name in dgo: dma-h ;; dgos: GAME, ENGINE -;; Constants/type for the PS2 DMA System. +;; Constants/type for the PS2 DMA hardware ;; There are a number of DMA channels. ;; The PS2 supports several types of DMA, including simple chunk transfer and more complicated ;; "chain" transfers, where the hardware can follow a linked data-structure. +;; The code is organized into dma, dma-buffer, and dma-bucket +;; - dma interacts with the hardware and actually sends the DMA data. +;; - dma-buffer is memory management for the data to be sent +;; - dma-bucket is organization of all the frame's DMA data in the correct order + ;; In OpenGOAL, "DMA" will be instant, meaning the game code will stop, wait until the ;; DMA is finished, and then continue. As a result, there is no need for DMA synchronization. ;; When this flag is set, all DMA syncs will be instantaneous. @@ -200,6 +205,10 @@ ) +;; DMA data is divided into buckets. +;; At the end of a frame, the buckets are all connected together and sent. +;; the buckets are organized by renderer. + (defenum bucket-id :type int32 :bitfield #f @@ -235,6 +244,7 @@ (water-tex1 60) ;; merc1 61 ;; generic1 62 + ;; common tex 65 ;; debug spheres? 67 (debug-draw0 67) ;; debug text 68 diff --git a/goal_src/engine/dma/dma.gc b/goal_src/engine/dma/dma.gc index e4350ae3a3..167f299f0f 100644 --- a/goal_src/engine/dma/dma.gc +++ b/goal_src/engine/dma/dma.gc @@ -222,9 +222,7 @@ "Due to a bug in the PS2 hardware, you must always disable the DMAtag mismatch error. This is done here." - ;; (declare (print-asm)) (#when PC_PORT - (format 0 "[dma.gc] skipping dma-initialize for PC port~%") (return 0) ) @@ -234,7 +232,8 @@ ) (defun clear-vu0-mem () - "Set the vu0 data memory to 0xabadbeef. This uses the slow EE mapping of VU memory." + "Set the vu0 data memory to 0xabadbeef. This uses the slow EE mapping of VU memory. + Will crash on PC Port." (let ((v1-0 VU0_DATA_MEM_MAP)) (dotimes (a0-0 1024) (set! (-> v1-0 a0-0) #xabadbeef) @@ -244,7 +243,8 @@ ) (defun clear-vu1-mem () - "Set the vu1 data memory to 0xabadbeef. This uses the slow EE mapping of VU memory." + "Set the vu1 data memory to 0xabadbeef. This uses the slow EE mapping of VU memory. + Will crash on PC Port." (let ((v1-0 VU1_DATA_MEM_MAP)) (dotimes (a0-0 4096) (set! (-> v1-0 a0-0) #xabadbeef) @@ -254,7 +254,8 @@ ) (defun dump-vu1-mem () - "Print VU1 memory to runtime stdout." + "Print VU1 memory to runtime stdout. + Will crash on PC Port." (local-vars (s5-0 int) (gp-0 (pointer uint32))) (set! gp-0 (the (pointer uint32) #x1100c000)) (set! s5-0 0) @@ -278,7 +279,8 @@ ) (defun dump-vu1-range ((start uint) (total-count uint)) - "Print part of VU1 memory to runtime stdout." + "Print part of VU1 memory to runtime stdout. + Will crash on PC Port." (local-vars (s3-0 int) (s2-0 int) (s4-0 (pointer uint32))) (set! s4-0 (the (pointer uint32) #x1100c000)) (set! s3-0 0) @@ -328,54 +330,63 @@ Memory is copied in ascending order, in 4 kB blocks. The size should be a multiple of 16 bytes." - ;; ultimate-memcpy works by DMAing to the scratchpad and back. - ;; surprisingly this seems to be the fastest memcpy on larger - ;; transfers. This is a nice example of how DMA is used from GOAL. - (let ((spr-to-bank (the-as dma-bank-spr #x1000d400)) - (spr-from-bank (the-as dma-bank-spr #x1000d000)) - (qwc-remaining (shr size-bytes 4)) - ) + (#cond + (PC_PORT + ;; on PC Port, just call C mem-move, it's the fastest. + (__mem-move dst src size-bytes) + ) + (else - ;; Flush all data in the dcache to main memory. DMA bypasses the dcache. - (flush-cache 0) - ;; Complete all pending DMA transfers using the spad. - ;; (this uses the Sony library DMA sync, which is bad) - (dma-sync (the-as pointer spr-to-bank) 0 0) - (dma-sync (the-as pointer spr-from-bank) 0 0) + ;; ultimate-memcpy works by DMAing to the scratchpad and back. + ;; surprisingly this seems to be the fastest memcpy on larger + ;; transfers. This is a nice example of how DMA is used from GOAL. + (let ((spr-to-bank (the-as dma-bank-spr #x1000d400)) + (spr-from-bank (the-as dma-bank-spr #x1000d000)) + (qwc-remaining (shr size-bytes 4)) + ) - ;; transfer loop - (while (> qwc-remaining 0) - ;; copy up to 1024 quadwords - limited by the 4kB spad size. - (let ((qwc-transferred-now (the-as int qwc-remaining))) - (if (< (the-as uint 1024) (the-as uint qwc-transferred-now)) - (set! qwc-transferred-now 1024) - ) - (set! qwc-remaining (- qwc-remaining (the-as uint qwc-transferred-now))) - ;; set up the "to spad" transfer - (.sync.l) - (set! (-> spr-to-bank madr) (the-as uint src)) - (set! (-> spr-to-bank sadr) (the-as uint 0)) - (set! (-> spr-to-bank qwc) (the-as uint qwc-transferred-now)) - (.sync.l) - ;; activate! - (set! (-> spr-to-bank chcr) (new 'static 'dma-chcr :str #x1)) - (.sync.l) - ;; wait for it to finish... - (dma-sync (the-as pointer spr-to-bank) 0 0) - (&+! src (shl qwc-transferred-now 4)) - ;; and copy back... - (set! (-> spr-from-bank madr) (the-as uint dst)) - (set! (-> spr-from-bank sadr) (the-as uint 0)) - (set! (-> spr-from-bank qwc) (the-as uint qwc-transferred-now)) - (.sync.l) - (set! (-> spr-from-bank chcr) (new 'static 'dma-chcr :str #x1)) - (.sync.l) - (dma-sync (the-as pointer spr-from-bank) 0 0) - (&+! dst (shl qwc-transferred-now 4)) - ) - ) - ) - (let ((v0-4 0)) + ;; Flush all data in the dcache to main memory. DMA bypasses the dcache. + (flush-cache 0) + ;; Complete all pending DMA transfers using the spad. + ;; (this uses the Sony library DMA sync, which is bad) + (dma-sync (the-as pointer spr-to-bank) 0 0) + (dma-sync (the-as pointer spr-from-bank) 0 0) + + ;; transfer loop + (while (> qwc-remaining 0) + ;; copy up to 1024 quadwords - limited by the 4kB spad size. + (let ((qwc-transferred-now (the-as int qwc-remaining))) + (if (< (the-as uint 1024) (the-as uint qwc-transferred-now)) + (set! qwc-transferred-now 1024) + ) + (set! qwc-remaining (- qwc-remaining (the-as uint qwc-transferred-now))) + ;; set up the "to spad" transfer + (.sync.l) + (set! (-> spr-to-bank madr) (the-as uint src)) + (set! (-> spr-to-bank sadr) (the-as uint 0)) + (set! (-> spr-to-bank qwc) (the-as uint qwc-transferred-now)) + (.sync.l) + ;; activate! + (set! (-> spr-to-bank chcr) (new 'static 'dma-chcr :str #x1)) + (.sync.l) + ;; wait for it to finish... + (dma-sync (the-as pointer spr-to-bank) 0 0) + (&+! src (shl qwc-transferred-now 4)) + ;; and copy back... + (set! (-> spr-from-bank madr) (the-as uint dst)) + (set! (-> spr-from-bank sadr) (the-as uint 0)) + (set! (-> spr-from-bank qwc) (the-as uint qwc-transferred-now)) + (.sync.l) + (set! (-> spr-from-bank chcr) (new 'static 'dma-chcr :str #x1)) + (.sync.l) + (dma-sync (the-as pointer spr-from-bank) 0 0) + (&+! dst (shl qwc-transferred-now 4)) + ) + ) + ) + (let ((v0-4 0)) + ) + ) ) (none) ) diff --git a/goal_src/engine/geometry/geometry.gc b/goal_src/engine/geometry/geometry.gc index 40ba57b42a..c4d479d81e 100644 --- a/goal_src/engine/geometry/geometry.gc +++ b/goal_src/engine/geometry/geometry.gc @@ -5,6 +5,9 @@ ;; name in dgo: geometry ;; dgos: GAME, ENGINE +;; Geometry functions are common vector/plane utilities + the "curve" stuff +;; The curves are likely bezier splines, but not 100% sure yet. + (defun vector-flatten! ((dst vector) (src vector) (plane-normal vector)) "Get the projection of src onto a plane with the given normal The normal should have magnitude 1.0." @@ -1036,7 +1039,6 @@ (let ((a2-3 (/ (+ a1-1 a0-1) 2))) (let ((t0-3 (&-> arg3 0 data a2-3))) - (print-type t0-3) (b! (>= arg2 (-> t0-3 0)) cfg-7) (b! #t cfg-5 :delay (set! a0-1 a2-3)) (label cfg-7) diff --git a/goal_src/engine/gfx/font-h.gc b/goal_src/engine/gfx/font-h.gc index b9534076c0..1f0510a0da 100644 --- a/goal_src/engine/gfx/font-h.gc +++ b/goal_src/engine/gfx/font-h.gc @@ -662,5 +662,5 @@ ) -(define-extern draw-string (function string dma-buffer font-context int)) +(define-extern draw-string (function string dma-buffer font-context float)) diff --git a/goal_src/engine/gfx/hw/display-h.gc b/goal_src/engine/gfx/hw/display-h.gc index d6c0973929..af0660fde0 100644 --- a/goal_src/engine/gfx/hw/display-h.gc +++ b/goal_src/engine/gfx/hw/display-h.gc @@ -5,6 +5,11 @@ ;; name in dgo: display-h ;; dgos: GAME, ENGINE +;; The display system takes care of managing the contexts for settings framebuffers/display settings +;; It also handles drawing the profile bars, game engine timing, and managing the two DMA buffers for +;; the double buffered rendering system. +;; The *display* global will hold the main display state, including the DMA buffers for each of the two frames + ;; display-env stores the GS settings for displaying a framebuffer on screen. ;; this is identical to the Sony sceGsDispEnv struct. ;; you can set one of these up with set-display-env, then use it with @@ -126,6 +131,7 @@ (none) ) +;; Per frame data that is used by the renderers. (deftype display-frame (basic) ((calc-buf dma-buffer :offset 8) (vu1-buf dma-buffer :offset 8) @@ -159,6 +165,7 @@ ) ) +;; unused? (deftype virtual-frame (structure) ((display display-env :offset-assert 0) (display-last display-env :offset-assert 4) @@ -174,7 +181,9 @@ ) +;; This tracks all of the display stuff in a single global (deftype display (basic) + ;; first, 3x environments. Not sure why we need 3. ((display-env0 display-env :inline :offset-assert 8) (display-env1 display-env :inline :offset-assert 48) (display-env2 display-env :inline :offset-assert 88) @@ -182,15 +191,19 @@ ;; the draw-env is actually just a+d data. (gif-tag0 gs-gif-tag :inline :offset-assert 128) (draw0 draw-env :inline :offset-assert 144) - (gif-tag1 gs-gif-tag :inline :offset-assert 272) (draw1 draw-env :inline :offset-assert 288) (gif-tag2 gs-gif-tag :inline :offset-assert 416) (draw2 draw-env :inline :offset-assert 432) + + ;; frame indices (on-screen int32 :offset-assert 560) (last-screen int32 :offset-assert 564) + ;; not sure why we have 6, it seems like only the first 2 actually + ;; have valid display-frames in them. (frames virtual-frame 6 :inline :offset-assert 568) (bg-clear-color rgba 4 :offset-assert 760) + ;; counters (why are there so many???) (real-frame-counter uint64 :offset-assert 776) (base-frame-counter uint64 :offset-assert 784) (game-frame-counter uint64 :offset-assert 792) @@ -199,6 +212,9 @@ (actual-frame-counter uint64 :offset-assert 816) (real-actual-frame-counter uint64 :offset-assert 824) (part-frame-counter uint64 :offset-assert 832) + + ;; the "old" counters are the values from the previous tick. + ;; the counters above may jump during a load. (old-real-frame-counter uint64 :offset-assert 840) (old-base-frame-counter uint64 :offset-assert 848) (old-game-frame-counter uint64 :offset-assert 856) @@ -207,11 +223,13 @@ (old-actual-frame-counter uint64 :offset-assert 880) (old-real-actual-frame-counter uint64 :offset-assert 888) (old-part-frame-counter uint64 :offset-assert 896) - (time-ratio float :offset-assert 904) - (seconds-per-frame float :offset-assert 908) - (frames-per-second float :offset-assert 912) - (time-factor float :offset-assert 916) - (time-adjust-ratio float :offset-assert 920) + + ;; timing stats for how fast the engine is currently running. + (time-ratio float :offset-assert 904) ;; engine speed, 1.0 = full speed + (seconds-per-frame float :offset-assert 908) ;; 1/fps + (frames-per-second float :offset-assert 912) ;; fps + (time-factor float :offset-assert 916) ;; 6 on PAL, 5 on NTSC, "ticks" / frame + (time-adjust-ratio float :offset-assert 920) ;; 1 on NTSC full speed, 1.2 PAL full speed. ) :method-count-assert 10 :size-assert #x39c @@ -229,7 +247,8 @@ (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size))))) ;; set the display size, texture format, zbuffer format, etc. (set-display obj psm w h ztest zpsm) - ;; set up frames. + ;; set up frames. for the most part only the first 2 make sense, and + ;; the rest have repeats. (set! (-> obj frames 0 display) (-> obj display-env0)) (set! (-> obj frames 1 display) (-> obj display-env1)) (set! (-> obj frames 2 display) (-> obj display-env2)) @@ -280,4 +299,4 @@ ) (define *pre-draw-hook* nothing) -(define *post-draw-hook* nothing) +(define *post-draw-hook* (the-as (function dma-buffer none) nothing)) diff --git a/goal_src/engine/gfx/hw/display.gc b/goal_src/engine/gfx/hw/display.gc index 26f2cb9919..51bfae64f7 100644 --- a/goal_src/engine/gfx/hw/display.gc +++ b/goal_src/engine/gfx/hw/display.gc @@ -86,7 +86,7 @@ (new 'static 'gs-display-fb :psm psm :fbw (sar width 6) :fbp fbp) ) - ;; set up the display area. + ;; set up the display area (obscure PS2 video output junk) (set! (-> env display) (new 'static 'gs-display :dw #x9ff @@ -150,12 +150,12 @@ (set! (-> env xyoffset1addr) (gs-reg64 xyoffset-1)) (set! (-> env xyoffset1) (new 'static 'gs-xy-offset - :ofx #x7000 + :ofx #x7000 ;; = 1792 px = 2048 - 256, this will make 2048 the center of the screen. :ofy (shl (-> *video-parms* screen-miny) 4) ;; 12.4 fixed point. ) ) - ;; scissor to the given width/height (in WCS) + ;; scissor to the given width/height (in WCS pixels) (set! (-> env scissor1addr) (gs-reg64 scissor-1)) ;; the lower bound is set to 0: the origin of the WCS which is the xyoffset (set! (-> env scissor1) @@ -174,9 +174,11 @@ (defun set-draw-env-offset ((env draw-env) (x int) (y int) (arg3 int)) "Set the drawing offset (origin of the WCS). - The input x and y should be in pixels to the _center_ of the window. + The input x and y should be in pixels to the _center_ of the scissoring area The width/height of the window are taken from the scissoring settings. - It is assumed that scax0 and scay0 are set to 0." + It is assumed that scax0 and scay0 are set to 0. + To center things in the usual way, call with 2048, 2048, even/odd + " (set! (-> env xyoffset1) (new 'static 'gs-xy-offset :ofx (shl (- x @@ -335,10 +337,9 @@ "Draw the bar! The bar pos shouldn't be changed." ;; recompute y stuff based on the current relative-y-scale. - ;; I don't know what would change it. (let ((height (the int (* 8.0 (-> *video-parms* relative-y-scale))))) - (set! *profile-y* (+ (-> *video-parms* screen-miny) height)) - (set! *profile-h* height) + (set! *profile-y* (+ (-> *video-parms* screen-miny) height)) ;; px + (set! *profile-h* height) ;; px ) (let ((block-idx 1) ;; block to draw (0 is 'start) (block-count (-> obj profile-frame-count)) ;; total number of blocks @@ -409,20 +410,20 @@ ) ;; draw sprite (alpha blend enable) (set! (-> (the-as (pointer gs-prim) t3-8) 0) - (new 'static 'gs-prim :prim (gs-prim-type sprite) :abe #x1) - ) + (new 'static 'gs-prim :prim (gs-prim-type sprite) :abe #x1) + ) ;; set color. (set! (-> (the-as (pointer uint64) t3-8) 1) - (the-as uint (-> block color)) - ) + (the-as uint (-> block color)) + ) ;; set vertex (left side) (set! (-> (the-as (pointer gs-xyzf) t3-8) 2) - (new 'static 'gs-xyzf - :z #x3fffff - :y (shl (+ *profile-y* screen-y) 4) ;; 12.4 - :x left ;; end of previous bar + (new 'static 'gs-xyzf + :z #x3fffff + :y (shl (+ *profile-y* screen-y) 4) ;; 12.4 + :x left ;; end of previous bar + ) ) - ) (set! (-> t2-4 base) (&+ t3-8 24)) ) @@ -449,12 +450,12 @@ (t2-8 (-> t1-8 base)) ) (set! (-> (the-as (pointer gs-xyzf) t2-8) 0) - (new 'static 'gs-xyzf - :z #x3fffff - :y (shl (+ (+ *profile-y* screen-y) *profile-h*) 4) ;; add height. - :x left ;; now the end of this bar. + (new 'static 'gs-xyzf + :z #x3fffff + :y (shl (+ (+ *profile-y* screen-y) *profile-h*) 4) ;; add height. + :x left ;; now the end of this bar. + ) ) - ) (set! (-> t1-8 base) (&+ t2-8 8)) ) @@ -486,6 +487,8 @@ (else ;; for some reason, they use 104% here. This means that when you see ;; 100%, it actually means ~96% of ticks-per-frame. + ;; this is possibly because there's some time in between reaching here + ;; and when the next one starts (in drawable.gc) (let ((f30-0 (/ (* 104.0 (the float (-> worst-time-cache (/ bar-pos 10)))) (the float *ticks-per-frame*) ) diff --git a/goal_src/engine/gfx/hw/gs.gc b/goal_src/engine/gfx/hw/gs.gc index e730b41e51..b820a88cab 100644 --- a/goal_src/engine/gfx/hw/gs.gc +++ b/goal_src/engine/gfx/hw/gs.gc @@ -5,6 +5,10 @@ ;; name in dgo: gs ;; dgos: GAME, ENGINE +;; Types for the GS - the PS2's GPU. +;; These are used when creating GS packets to be sent to the GIF +;; or for directly interfacing with the memory-mapped GS control registers. + ;; the GS's PMODE register makes various settings for the PCRTC. (deftype gs-pmode (uint64) ((en1 uint8 :offset 0 :size 1) @@ -27,13 +31,7 @@ :flag-assert #x900000008 ) -;; 19 = PSMT8 -;; 20 = PSMT4 -;; 2 = PSMCT24 -;; 10 = PSMCT16S -;; 50 = PSMZ16 -;; 58 = PSMZ16S - +;; texture formats (defenum gs-psm :bitfield #f :type uint8 @@ -169,7 +167,7 @@ :flag-assert #x900000008 ) -;; memory layout of the GS's privileged registers +;; memory layout of the GS's privileged registers (mapped to EE memory) ;; it is missing the SIGLBLID/LABELID register at 4224 (useless anyway?) (deftype gs-bank (structure) ((pmode gs-pmode :offset-assert 0) @@ -630,7 +628,34 @@ :flag-assert #x900000010 ) -;; Note - there was an inspect method for the uint128-based gif-tag, but it is being left out. +(defmethod inspect gif-tag ((obj gif-tag)) + (format #t "[~8x] gif-tag~%" obj) + (format #t "~Tnloop: ~4d~%" (-> obj nloop)) + (format #t "~Teop : ~4d~%" (-> obj eop)) + (format #t "~Tid : ~4d~%" (-> obj id)) + (format #t "~Tpre : ~4d~%" (-> obj pre)) + (format #t "~Tprim : ~4d~%" (-> obj prim)) + (format #t "~Tflg : ~4d~%" (-> obj flg)) + (format #t "~Tnreg : ~4d~%" (-> obj nreg)) + (format #t "~Tregs0 : ~4d~%" (-> obj regs0)) + (format #t "~Tregs1 : ~4d~%" (-> obj regs1)) + (format #t "~Tregs2 : ~4d~%" (-> obj regs2)) + (format #t "~Tregs3 : ~4d~%" (-> obj regs3)) + (format #t "~Tregs4 : ~4d~%" (-> obj regs4)) + (format #t "~Tregs5 : ~4d~%" (-> obj regs5)) + (format #t "~Tregs6 : ~4d~%" (-> obj regs6)) + (format #t "~Tregs7 : ~4d~%" (-> obj regs7)) + (format #t "~Tregs8 : ~4d~%" (-> obj regs8)) + (format #t "~Tregs9 : ~4d~%" (-> obj regs9)) + (format #t "~Tregs10: ~4d~%" (-> obj regs10)) + (format #t "~Tregs11: ~4d~%" (-> obj regs11)) + (format #t "~Tregs12: ~4d~%" (-> obj regs12)) + (format #t "~Tregs13: ~4d~%" (-> obj regs13)) + (format #t "~Tregs14: ~4d~%" (-> obj regs14)) + (format #t "~Tregs15: ~4d~%" (-> obj regs15)) + ;; original function failed to return this. + obj + ) ;; some nice blue. probably the same as the fog color for geyser/sandover/etc. (define *fog-color* #xc88029) diff --git a/goal_src/engine/gfx/hw/video-h.gc b/goal_src/engine/gfx/hw/video-h.gc index a86bb6620d..0fdc36e697 100644 --- a/goal_src/engine/gfx/hw/video-h.gc +++ b/goal_src/engine/gfx/hw/video-h.gc @@ -5,22 +5,31 @@ ;; name in dgo: video-h ;; dgos: GAME, ENGINE + +;; The "video" system manages PAL vs. NTSC and aspect ratio settings +;; (not including timing difference between PAL/NTSC) +;; These are stored in the *video-parms* global. + +;; The game is interlaced, meaning each framebuffer is half height. + +;; There are two + (deftype video-parms (structure) ((set-video-mode basic :offset-assert 0) (reset-video-mode basic :offset-assert 4) - (screen-sy int32 :offset-assert 8) - (screen-hy int32 :offset-assert 12) - (screen-miny int32 :offset-assert 16) - (screen-maxy int32 :offset-assert 20) - (screen-masky int32 :offset-assert 24) - (display-dx int32 :offset-assert 28) + (screen-sy int32 :offset-assert 8) ;; height of framebuffer (1/2 of output resolution) + (screen-hy int32 :offset-assert 12) ;; half of fb height (1/4 of output resolution) + (screen-miny int32 :offset-assert 16) ;; min y in WCS (pixels), centered around 2048 (1/2) + (screen-maxy int32 :offset-assert 20) ;; max y in WCS (pixels) + (screen-masky int32 :offset-assert 24) ;; mask of bits that actually change in height (sy -1) + (display-dx int32 :offset-assert 28) ;; offset for displaying framebuffer (display-dy int32 :offset-assert 32) - (screen-pages-high int32 :offset-assert 36) + (screen-pages-high int32 :offset-assert 36) ;; GS pages (_pad int64) - (relative-x-scale float :offset-assert 48) - (relative-y-scale float :offset-assert 52) + (relative-x-scale float :offset-assert 48) ;; x scale for 4x3 / 16x9 + (relative-y-scale float :offset-assert 52) ;; y scale for NTSC/PAL (_pad2 int64) - (relative-x-scale-reciprical float :offset-assert 64) + (relative-x-scale-reciprical float :offset-assert 64) ;; reciprocal of the above scales (relative-y-scale-reciprical float :offset-assert 68) ) :method-count-assert 9 @@ -28,6 +37,7 @@ :flag-assert #x900000048 ) +;; default to NTSC (define *video-parms* (new 'static 'video-parms :set-video-mode #f @@ -43,15 +53,12 @@ :relative-x-scale 1.0 :relative-y-scale 1.0 :relative-x-scale-reciprical 1.0 - :relative-y-scale-reciprical 0.0 ;; ?? + :relative-y-scale-reciprical 0.0 ;; wrong. ) ) (define-extern get-video-mode (function symbol)) -;; NOTE - Not in actual output, but the first function in video.gc calls it before it's defined (define-extern get-aspect-ratio (function symbol)) -;; TODO - for video, actually defined in hud-classes though! (define-extern set-hud-aspect-ratio (function symbol symbol none)) -;; TODO - for settings (define-extern set-aspect-ratio (function symbol none)) (define-extern set-video-mode (function symbol none)) diff --git a/goal_src/engine/gfx/texture-h.gc b/goal_src/engine/gfx/texture-h.gc index 90bd5e68bb..d62762957c 100644 --- a/goal_src/engine/gfx/texture-h.gc +++ b/goal_src/engine/gfx/texture-h.gc @@ -5,36 +5,54 @@ ;; name in dgo: texture-h ;; dgos: GAME, ENGINE +;; The texture system manages: +;; - VRAM allocation and uploads +;; - the texture page directory +;; - adgif shaders +;; There are a lot more details, see texture.gc for more info + + +;;;;;;;;;;;;;;;;;;;;;; +;; Texture Control +;;;;;;;;;;;;;;;;;;;;;; + +;; There are different kinds of texture pages for the different renderers (defenum tpage-kind :type uint32 :bitfield #f - (tfrag 0) - (pris 1) - (shrub 2) - (alpha 3) - (water 4) + (tfrag 0) ;; background + (pris 1) ;; foreground + (shrub 2) ;; shrubs/sprites + (alpha 3) ;; effects + (water 4) ;; non-ocean water (fj rivers, water near farmer) ) -;; mask for different texture things. -;; these are the ones that will be displayed in the menu +;; bitmask for enabled tpage-kinds (changed in debug menu) (define *texture-enable-user-menu* #x1f) -;; enabled textures. +;; enabled textures (drawable.gc updates this from reading *texture-enable-user-menu*) (define *texture-enable-user* 0) +;; Any individual texture can be uniquely identified with a texture-id. (deftype texture-id (uint32) - ((index uint16 :offset 8 :size 12) - (page uint16 :offset 20 :size 12) + ((index uint16 :offset 8 :size 12) ;; index of texture in its tpage + (page uint16 :offset 20 :size 12) ;; tpage number ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) + +;;;;;;;;;;;;;;;;;;; +;; Texture Pool +;;;;;;;;;;;;;;;;;;; + +;; A texture-pool-segment is a chunk of VRAM used to store textures (deftype texture-pool-segment (structure) - ((dest uint32 :offset-assert 0) - (size uint32 :offset-assert 4) + ((dest uint32 :offset-assert 0) ;; VRAM address (4-byte VRAM words) + (size uint32 :offset-assert 4) ;; size in 4-byte VRAM words ) :pack-me :method-count-assert 9 @@ -45,19 +63,28 @@ (declare-type texture-page basic) (declare-type level basic) +;; There is a single texture-pool which manages storing textures in VRAM (deftype texture-pool (basic) - ((top int32 :offset-assert 4) - (cur int32 :offset-assert 8) + ((top int32 :offset-assert 4) ;; seems be 0 always, start of VRAM managed by pool + (cur int32 :offset-assert 8) ;; highest address in use by the pool + + ;; the allocate function is used to add a texture-page to the pool. (allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12) - (font-palette int32 :offset-assert 16) ;; vram word idx + + ;; the location of the color look-up table for font texture (vram word idx) + (font-palette int32 :offset-assert 16) ;; these were reordered + ;; we have 4 segments, but only the near and common are used. (segment-near texture-pool-segment :inline :offset-assert 20) (segment-common texture-pool-segment :inline :offset-assert 28) (segment texture-pool-segment 4 :inline :offset 20) - + + ;; tpages that are not part of level textures are stored here. (common-page texture-page 32 :offset-assert 52) + ;; ?? (common-page-mask int32 :offset-assert 180) + ;; for each pool page, stores the id of the tpage which is currently loaded in VRAM. (ids uint32 126 :offset-assert 184) ) :method-count-assert 23 @@ -67,46 +94,60 @@ (new (symbol type) _type_ 0) (initialize! (_type_) _type_ 9) (print-usage (_type_) _type_ 10) - (dummy-11 (_type_) none 11) + (setup-font-texture! (_type_) none 11) (allocate-defaults! (_type_) none 12) - (login-level-textures (_type_ level int (pointer texture-id)) none 13) ;; loading level... - (add-tex-to-dma! (_type_ level int) none 14) ;; very mysterious arg types. + (login-level-textures (_type_ level int (pointer texture-id)) none 13) + (add-tex-to-dma! (_type_ level int) none 14) (allocate-vram-words! (_type_ int) int 15) (allocate-segment! (_type_ texture-pool-segment int) texture-pool-segment 16) (dummy-17 () none 17) (dummy-18 () none 18) (dummy-19 () none 19) - (dummy-20 (_type_ texture-page) int 20) + (unload! (_type_ texture-page) int 20) (upload-one-common! (_type_) symbol 21) (lookup-boot-common-id (_type_ int) int 22) ) ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Texture and Texture Page +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; A record for a texture. +;; The texture can contain multiple levels of detail and also a color lookup table (CLUT) +;; This refers to data stored elsewhere, either in the data of a tpage or VRAM. +;; After a tpage has been allocated, the dest will be the VRAM address of the texture. (deftype texture (basic) ((w int16 :offset-assert 4) + (wu uint16 :offset 4) ;; inline asm read this as u16 (h int16 :offset-assert 6) - (num-mips uint8 :offset-assert 8) - (tex1-control uint8 :offset-assert 9) - (psm gs-psm :offset-assert 10) + (hu uint16 :offset 6) + (num-mips uint8 :offset-assert 8) ;; number of mipmap levels + (tex1-control uint8 :offset-assert 9) ;; ? + (psm gs-psm :offset-assert 10) ;; texture format (mip-shift uint8 :offset-assert 11) - (clutpsm uint16 :offset-assert 12) - (dest uint16 7 :offset-assert 14) - (clutdest uint16 :offset-assert 28) - (width uint8 7 :offset-assert 30) + (clutpsm uint16 :offset-assert 12) ;; color look-up table format + (dest uint16 7 :offset-assert 14) ;; per mip VRAM address + (clutdest uint16 :offset-assert 28) ;; color look-up table location. + (width uint8 7 :offset-assert 30) ;; per mip (name string :offset-assert 40) (size uint32 :offset-assert 44) (uv-dist float :offset-assert 48) - (masks uint32 3 :offset-assert 52) + (masks uint32 3 :offset-assert 52) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) +;; tpages themselves are divided into segments. +;; some renderers may know ahead of time that they don't need all segments +;; and can skip uploading unused texture data. (deftype texture-page-segment (structure) - ((block-data pointer :offset-assert 0) - (size uint32 :offset-assert 4) - (dest uint32 :offset-assert 8) + ((block-data pointer :offset-assert 0) ;; location in EE memory of texture data. + (size uint32 :offset-assert 4) ;; ?? units + (dest uint32 :offset-assert 8) ;; VRAM destination where it will be loaded to. ) :pack-me :method-count-assert 9 @@ -115,16 +156,20 @@ ) (defun texture-mip->segment ((arg0 int) (arg1 int)) + "Unknown, not used." (if (>= 2 arg1) (+ (- -1 arg0) arg1) (max 0 (- 2 arg0))) ) +;; The actual texture-page header +;; After the dynamic array of texture is the actual texture data. +;; This may be thrown away if the texture is permanently in VRAM. (deftype texture-page (basic) - ((info basic :offset-assert 4) + ((info file-info :offset-assert 4) (name basic :offset-assert 8) (id uint32 :offset-assert 12) - (length int32 :offset-assert 16) + (length int32 :offset-assert 16) ;; number of textures. (mip0-size uint32 :offset-assert 20) - (size uint32 :offset-assert 24) + (size uint32 :offset-assert 24) ;; VRAM words (segment texture-page-segment 3 :inline :offset-assert 28) (pad uint32 16 :offset-assert 64) (data texture :dynamic :offset-assert 128) @@ -133,16 +178,28 @@ :size-assert #x80 :flag-assert #xf00000080 (:methods - (relocate (_type_ kheap (pointer uint8)) none :replace 7) - (remove-from-heap (_type_ kheap) _type_ 9) - (get-leftover-block-count (_type_ int int) int 10) - (dummy-11 () none 11) - (relocate-dests! (_type_ int int) none 12) - (add-to-dma-buffer (_type_ dma-buffer int) none 13) - (upload-now! (_type_ int) none 14) - ) + (relocate (_type_ kheap (pointer uint8)) none :replace 7) + (remove-from-heap (_type_ kheap) _type_ 9) + (get-leftover-block-count (_type_ int int) int 10) + (dummy-11 () none 11) + (relocate-dests! (_type_ int int) none 12) + (add-to-dma-buffer (_type_ dma-buffer int) int 13) + (upload-now! (_type_ int) none 14) + ) ) +;;;;;;;;;;;;;;;;;;;;;;; +;; Texture Shaders +;;;;;;;;;;;;;;;;;;;;;;; + +;; The "adgif-shader" is a block of data that can be included in a GS packet +;; to set up GS registers for texturing. +;; There is a linked-list of these per texture that uses the shader-ptr type below + +;; A shader-ptr is a reference to an adgif shader. +;; The trick here is that it can fit into unused space in the GS packet. +;; the A+D format only uses bits 0-72, this fits in 72-96. The use of 96-128 is unknown +;; the shader value must be multiplied by 16 first. (deftype shader-ptr (uint32) ((shader uint32 :offset 8 :size 24)) :method-count-assert 9 @@ -150,6 +207,9 @@ :flag-assert #x900000004 ) +;; This is a dynamic array of shader-ptrs +;; There will be one array per texture-page, and this array will have one entry per texture. +;; These arrays will be allocated by the texture system and stored in level heaps. (deftype texture-link (structure) ((next shader-ptr 1 :offset-assert 0) ) @@ -158,11 +218,12 @@ :flag-assert #x900000004 ) +;; Each texture-page will have a texture-page-dir-entry for it (deftype texture-page-dir-entry (structure) - ((length int16 :offset-assert 0) - (status uint16 :offset-assert 2) - (page texture-page :offset-assert 4) - (link texture-link :offset-assert 8) + ((length int16 :offset-assert 0) ;; number of textures + (status uint16 :offset-assert 2) ;; ?? + (page texture-page :offset-assert 4) ;; the actual texture page + (link texture-link :offset-assert 8) ;; the array of texture-links, per texture. #f if unallocated ) :pack-me :method-count-assert 9 @@ -170,46 +231,96 @@ :flag-assert #x90000000c ) +;; There is a single texture-page-dir with a slot for each texture-page. +;; It's stored on the DVD and loaded with the engine. (deftype texture-page-dir (basic) ((length int32) (entries texture-page-dir-entry 1 :inline) ) (:methods (relocate (_type_ kheap (pointer uint8)) none :replace 7) - (dummy-9 (_type_ kheap) int 9) + (unlink-textures-in-heap! (_type_ kheap) int 9) ) :flag-assert #xa00000014 ) + +;;;;;;;;;;;;;;;;;;;;;; +;; Relocate Later +;;;;;;;;;;;;;;;;;;;;;; + +;; Part of loading textures involves copying some data in EE RAM. +;; It seems to be too slow to as part of tpage login, so its deferred to a second frame. +;; The texture system will set this up, then the level system will do this when there's time. + (deftype texture-relocate-later (basic) - ((memcpy symbol :offset-assert 4) - (dest uint32 :offset-assert 8) - (source uint32 :offset-assert 12) - (move uint32 :offset-assert 16) - (entry texture-page-dir-entry :offset-assert 20) - (page texture-page :offset-assert 24) + ((memcpy symbol :offset-assert 4) ;; set to #t when there's a pending copy + (dest uint32 :offset-assert 8) ;; destination address + (source uint32 :offset-assert 12) ;; source address + (move uint32 :offset-assert 16) ;; size to move + (entry texture-page-dir-entry :offset-assert 20) ;; the entry for the page we're moving + (page texture-page :offset-assert 24) ;; the page header. ) :method-count-assert 9 :size-assert #x1c :flag-assert #x90000001c ) + +;; global relocate info (define *texture-relocate-later* (new 'global 'texture-relocate-later)) (set! (-> *texture-relocate-later* memcpy) #f) + +;; set to #f, will be set by texture-page-dir's relocate method on engine load. (define *texture-page-dir* (the texture-page-dir #f)) +;;;;;;;;;;;;;;;;;;;; +;; ADGIF Shader +;;;;;;;;;;;;;;;;;;;; + +(defenum link-test-flags + :type uint32 + :bitfield #t + ;; note that we start at bit 8 because [0-7] are in use. + + (needs-log-in 8) ;; set if we should attempt to log in, cleared on log-in + (bit-9 9) ;; cleared on log-in + ) + +;; The actual adgif-shader is a 5 quadwords of A+D for GIF PACKED mode. +;; there is some extra data snuck in. (deftype adgif-shader (structure) - ((quad qword 5 :inline :offset 0) - (prims uint64 10 :offset 0) - (tex0 uint64 :offset 0) - (tex1 uint64 :offset 16) - (miptbp1 uint64 :offset 32) - (clamp uint64 :offset 48) - (clamp-reg uint64 :offset 56) - (alpha uint64 :offset 64) - (link-test uint32 :offset 8) - (texture-id uint32 :offset 24) - (next shader-ptr :offset 40) + ((quad qword 5 :score -100 :inline :offset 0) + (prims gs-reg64 10 :score -100 :offset 0) + + ;; tex0, contains texture location, size, format, clut settings + (tex0 gs-tex0 :offset 0) + ;; prims 1 is the register id + ;; prims 1 is shared with the link-test bitfield. + + ;; tex1, more texture information (LOD/MIP setup) + (tex1 gs-tex1 :offset 16) + ;; prims 3 + ;; prims 3 is shared with texture-id + + ;; miptb1, mip addresses/widths (levels 1 - 3) + (miptbp1 gs-miptbp :offset 32) + ;; prims 5 + ;; prims 5 is shared with the next shader-ptr + + ;; clamp, used for texture wrapping + (clamp gs-clamp :offset 48) + (clamp-reg gs-reg64 :offset 56) ;; or prims 7 + + ;; alpha blending. NOTE: this can also be miptbp2 (mip 4+ settings) + (alpha gs-miptbp :offset 64) + ;; prims 9 + + + ;; sneaky overlays + (link-test link-test-flags :offset 8) ;; don't touch lower 8 bits of this + (texture-id texture-id :offset 24) ;; ok to touch all bits + (next shader-ptr :offset 40) ;; don't touch lower 8 bits of this ) :method-count-assert 9 :size-assert #x50 @@ -225,6 +336,13 @@ ) (set! (-> adgif-shader-array heap-base) 80) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; Fixed VRAM +;;;;;;;;;;;;;;;;;;;;;;;; + +;; These are pre-allocated and always in VRAM. + (define *sky-base-vram-word* 0) (define *sky-base-block* 0) (define *sky-base-page* 0) @@ -240,5 +358,9 @@ (defun-extern texture-page-default-allocate texture-pool texture-page kheap int texture-page) -(define-extern texture-page-login (function texture-id function kheap texture-page-dir-entry)) +(define-extern texture-page-login (function texture-id (function texture-pool texture-page kheap int texture-page) kheap texture-page-dir-entry)) (define-extern *texture-pool* texture-pool) +(define-extern lookup-texture-by-id (function texture-id texture)) +(define-extern adgif-shader<-texture-with-update! (function adgif-shader texture adgif-shader)) + +(define-extern level-remap-texture (function texture-id texture-id)) diff --git a/goal_src/engine/gfx/texture.gc b/goal_src/engine/gfx/texture.gc index a139aaabee..ad92c0556b 100644 --- a/goal_src/engine/gfx/texture.gc +++ b/goal_src/engine/gfx/texture.gc @@ -5,6 +5,20 @@ ;; name in dgo: texture ;; dgos: GAME, ENGINE +;; There are three things called pages: +;; - tpage: a collection of textures for a renderer. Different tpages have different sizes. +;; the actual type is named texture-page. +;; - GS hardware page: the actual size of a page in the GS hardware. +;; this is 2048 VRAM words. +;; - Pool page: the page size used by the texture-pool. This is 2x the size of a GS page. + + +;; The layout of VRAM (in 2048 * 4 byte word units) +;; 0 - 320 VRAM managed by texture.gc +;; 320 - 384 first frame buffer +;; 384 - 448 second frame buffer +;; 448 - 512 Z Buffer (+ some font textures in the upper 8 bits) + ;; VRAM can belong to the following categories: ;; - frame/depth buffer (not handled through this system at all) ;; - special "global" VRAM that doesn't use texture, but is allocated through the texture-pool @@ -77,8 +91,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; texture-page = file on DVD containing a bunch of textures. -;; they are designed so that you load the TFRAG page, do TFRAG rendering, -;; load the PRIS page, do PRIS rendering, etc. +;; they are designed so that you upload the TFRAG page, do TFRAG rendering, +;; upload the PRIS page, do PRIS rendering, etc. ;; they also contain records of textures. The texture system will update these records ;; to reflect where the textures are actually placed in VRAM. @@ -179,7 +193,7 @@ (defun dma-buffer-add-ref-texture ((buf dma-buffer) (data pointer) (tex-w int) (tex-h int) (tex-format gs-psm)) "Add texture data to a dma buffer. You must first set up the GS transfer to the correct destination. - This just sets IMAGE mode and sends data." + This just sets IMAGE mode and sends data. Doesn't copy the texture into the buffer." ;; get pointer and size (quadwords) (let ((data-ptr (physical-address data)) @@ -554,7 +568,8 @@ "Initialize (or maybe reinitialize) a texture pool." ;; reset allocator (set! (-> obj cur) 0) - ;; I think top is basically unused. + ;; I think top is basically unused, but seems to be the _lowest_ address. + ;; maybe it's the top when VRAM is viewed on the screen. (set! (-> obj top) (-> obj cur)) ;; by default, use the default allocator. (set! (-> obj allocate-func) texture-page-default-allocate) @@ -568,7 +583,7 @@ ) (set! (-> obj common-page-mask) 0) - ;; clear ids. This stores the texture ids that are stored at each "nd page", or 0 if there is junk. + ;; clear ids. This stores the texture ids that are stored at each "pool page", or 0 if there is junk. ;; it is used for the lazy loading system to see if the data is already there. (dotimes (v1-9 160) (set! (-> obj ids v1-9) (the-as uint 0)) @@ -577,8 +592,8 @@ ) (defmethod get-leftover-block-count texture-page ((obj texture-page) (segment-count int) (additional-size int)) - "This returns how many blocks are used in the last page nd-page. - It uses nd-pages, which are 64 blocks or 16 kB." + "This returns how many blocks are used in the last pool page. + It uses pool-pages, which are 64 blocks or 16 kB." (let ((v1-0 additional-size)) (dotimes (a2-1 segment-count) (+! v1-0 (the-as int (-> obj segment a2-1 size))) @@ -607,8 +622,11 @@ segment ) -(defconstant NEAR_SEGMENT_WORDS #x62000) ;; ~1.6 MB -(defconstant COMMON_SEGMENT_WORDS #x1c000) ;; ~0.5 MB +(defconstant COMMON_SEGMENT_WORDS #x1c000) ;; ~0.5 MB, 28 pool pages +(defconstant NEAR_SEGMENT_WORDS #x62000) ;; ~1.6 MB, 98 pool pages +;; total 126 pool pages, like the size of the IDs array +;; IDs 0-27 are common, 28-125 are near. + (defconstant SPECIAL_VRAM_WORDS #x7000) ;; for sky, eyes, ocean, and depth-cue effect rendering. (defmethod allocate-defaults! texture-pool ((obj texture-pool)) @@ -616,6 +634,8 @@ ;; allocate the common and near segments (allocate-segment! obj (-> obj segment-common) COMMON_SEGMENT_WORDS) ;; ~0.5 MB (allocate-segment! obj (-> obj segment-near) NEAR_SEGMENT_WORDS) ;; ~1.6 MB. + + ;; Allocate the random crap (set! *sky-base-vram-word* (allocate-vram-words! obj SPECIAL_VRAM_WORDS)) (set! *sky-base-block* (sar *sky-base-vram-word* 6)) (set! *sky-base-page* (sar *sky-base-vram-word* 11)) @@ -640,6 +660,8 @@ (defmethod remove-from-heap texture-page ((obj texture-page) (seg kheap)) "Remove the texture data from the heap. This can only safely be called immediately after the texture-page is loaded. This is used for textures that always live in VRAM." + + ;; this keeps around the texture objects themselves. (set! (-> seg current) (-> obj segment 0 block-data)) obj ) @@ -649,7 +671,9 @@ can never be reclaimed, and does it immediately. It modifies the texture to point to the allocated VRAM. It also kicks out the texture data (and any data after it) from the heap. - All three segments of the texture page will be be together." + All three segments of the texture page will be together." + + (tex-dbg "default allocate ~A~%" page) ;; loop over the semgments in the texture page. (dotimes (seg-id 3) @@ -667,10 +691,13 @@ ) -(defun texture-page-common-allocate ((pool texture-pool) (page texture-page) (seg kheap) (tpage-id int)) +(defun texture-page-common-allocate ((pool texture-pool) (page texture-page) (heap kheap) (tpage-id int)) "Set up an entire texture page for eventual upload to the common segment of the pool. + The texture will remain in EE memory and will share its slot in VRAM with other textures. All three segments will be together." + (tex-dbg "common allocate ~A~%" page) + ;; bump allocator, starting at the beginning of the common segment. ;; the common segment is reused, so its fine that this overlaps with other textures using common. (let ((s5-0 (-> pool segment-common dest))) @@ -687,15 +714,18 @@ "Allocator for textures at boot time. It will put boot-common textures in common. Once it gets a non-common texture, it will change the allocator to default." + (tex-dbg "boot allocate ~A...~%" page) + ;; see if we got a common texture. This will need to be reuploaded every time it is used. (let ((tex-id (lookup-boot-common-id pool tpage-id))) (cond ((>= tex-id 0) + (tex-dbg " boot allocator got known common-page ~D~%" tex-id) ;; let the common allocator deal with it. (texture-page-common-allocate pool page heap tpage-id) ;; textures that: - ;; - are in the common page (uploaded before use) + ;; - are in the common page (uploaded before use, shared VRAM) ;; - are in common memory (not level-specific) ;; have a record in this common-page array. ;; this helps other code find the appropriate tpage to upload. @@ -703,6 +733,7 @@ (set! (-> pool common-page tex-id) page) ) (else + (tex-dbg " boot allocator doesn't know this one, switching to default allocator~%") ;; textures that aren't on that special list are permanently allocated. ;; once we get one default, switch the allocator to default for the rest. (set! (-> *texture-pool* allocate-func) texture-page-default-allocate) @@ -720,6 +751,7 @@ ;; these functions generate DMA packets to configure the GS for upload ;; the dma-buffer-add-ref-textures function can then be used to actually send texture data. +;; all textures are pre-scrambled to be uploaded in 32-bit mode. (defun upload-vram-data ((buf dma-buffer) (dest int) (tex-data pointer) (tex-h int)) "Add DMA packet to prepare to upload a texture." @@ -1027,10 +1059,10 @@ 0 ) -(defun upload-vram-pages-pris ((pool texture-pool) (segment texture-pool-segment) (page texture-page) (bucket-idx int) (allow-cache-mask int)) - "Upload the entire texture page. If the allow-cache-mask is set for the chunk, it will not upload if there is already - the correct data. Upload will be added to the given bucket for on-screen. - The nth bit of the mask determines if the nth 16-kB chunk can safely use the existing data if the id check passes. +(defun upload-vram-pages-pris ((pool texture-pool) (segment texture-pool-segment) (page texture-page) (bucket-idx int) (needed-mask int)) + "Upload the entire texture page. If the needed-mask is not set, it will not upload those chunks. + Upload will be added to the given bucket for on-screen. + The nth bit of the mask determines if the nth 16-kB chunk is needed in this upload. A 64-bit mask is enough to address the entire common segment, which is the only destination for PRIS textures." (local-vars (tex-data pointer) @@ -1040,7 +1072,7 @@ (first-chunk-idx-to-upload int) (page-id uint) (current-dest-chunk uint) - (allow-cached symbol) + (need-tex symbol) ) (let ((total-upload-size 0)) (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) @@ -1063,19 +1095,19 @@ (+ tex-dest-base-chunk (the-as uint upload-chunk-idx)) ) ;; can we possibly use existing data in VRAM? - (set! allow-cached - (nonzero? (logand allow-cache-mask (ash 1 upload-chunk-idx))) + (set! need-tex + (nonzero? (logand needed-mask (ash 1 upload-chunk-idx))) ) ;; look for the start of a run of uploads. (if (zero? chunks-to-upload-count) - (when (and (!= (-> pool ids current-dest-chunk) page-id) allow-cached) + (when (and (!= (-> pool ids current-dest-chunk) page-id) need-tex) ;; start of run! (set! first-chunk-idx-to-upload upload-chunk-idx) (set! (-> pool ids current-dest-chunk) page-id) (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) ) (cond - ((or (= (-> pool ids current-dest-chunk) page-id) (not allow-cached)) + ((or (= (-> pool ids current-dest-chunk) page-id) (not need-tex)) ;; end of run. upload the run. (upload-vram-data dma-buf (the int (shl (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) 6)) @@ -1180,7 +1212,12 @@ ;; | level 0 private | shared | level 1 private | ;; ---------------------------------------------- -;; the textures for level 0 and level 1 may be as large as (sizeof private) + (sizeof shared). +(defconstant NEAR_PRIVATE_WORDS #x24000) +(defconstant NEAR_SHARED_WORDS #x1a000) +(defconstant NEAR_PER_LEV_WORDS #x3e000) + + +;; the textures for level 0 and level 1 may each be as large as (sizeof private) + (sizeof shared). ;; the private sections remain in VRAM while the level is loaded, but the shared part is ;; reuploaded for each level on each frame. @@ -1194,6 +1231,8 @@ This is used for level 0, which gets the first part of the NEAR segment as private texture memory." + (tex-dbg "near allocate 0 ~A~%" page) + ;; set up segment 2 to be in the near segment (relocate-dests! page (the-as int (-> pool segment-near dest)) 2) @@ -1206,6 +1245,9 @@ ) ;; upload near data, and update the upload cache stuff. + ;; Doesn't this upload more than is needed, and also the shared texture memory? + ;; How does this avoid overwriting the TFRAG textures that might be in use by the + ;; currently rendering frame? (upload-now! page 2) (update-vram-pages pool (-> pool segment-near) page 2) @@ -1221,10 +1263,11 @@ (let ((page-seg-2-size (logand -4096 (the-as int (+ (-> page segment 2 size) 4095))))) (cond - ((< (the-as uint #x24000) page-seg-2-size) + ((< (the-as uint NEAR_PRIVATE_WORDS) page-seg-2-size) ;; we use the shared memory of near. ;; this data should be kept in the heap + ;; 0x90000 = NEAR_PRIVATE * 4 (to convert to bytes) (let ((after-seg-2-data (+ #x90000 (the-as int (-> page segment 2 block-data))))) (let ((seg-2-data (-> page segment 2 block-data))) @@ -1232,13 +1275,16 @@ (set! (-> page segment 2 size) (+ -147456 (the-as int page-seg-2-size))) ;; adjust dest to upload past the "private" part, at the start of shared. - (set! (-> page segment 2 dest) (+ #x24000 (the-as int (-> pool segment-near dest)))) + (set! (-> page segment 2 dest) (+ NEAR_PRIVATE_WORDS (the-as int (-> pool segment-near dest)))) - ;; set the size of the heap as needed to hold only the unlocked texture data. + ;; set the size of the heap as needed to hold only the shared texture data. + ;; this is kinda dangerous. (set! (-> heap current) (&+ (-> page segment 2 block-data) (shl (-> page segment 2 size) 2)) ) + (tex-dbg " TEXTURE RELOCATE LATER dest #x~X src #x~X size #x~X bytes~%" seg-2-data after-seg-2-data + (shl (-> page segment 2 size) 2)) ;; inform the level loader it should do this on the next frame. (set! (-> *texture-relocate-later* memcpy) #t) ;; copy to the start of our data @@ -1251,6 +1297,7 @@ (set! (-> *texture-relocate-later* move) (shl (-> page segment 2 size) 2)) ) (else + (tex-dbg " TEXTURE no relocate later~%") ;; the whole thing fit in the locked near segment! ;; so we can just kick out segment 2 entirely and skip the memcpy stuff. (set! (-> page segment 2 size) (the-as uint 0)) @@ -1264,6 +1311,7 @@ (set! (-> *texture-pool* allocate-func) texture-page-common-allocate) ;; in the level data, there is always code, then TFRAG texture, ;; so mark the code memory end as the start of this page. + ;; (note: this may be wrong on levels with the zoomer hud texture) (set! (-> *level* unknown-level-2 code-memory-end) (the pointer page)) page ) @@ -1275,7 +1323,7 @@ ;; effective size of segment 2, will go in near. (let ((seg2-size (logand -4096 (the-as int (+ (-> page segment 2 size) 4095))))) ;; where to start our near data (somewhere in shared or level 1 private) - (let ((seg2-dest (+ (- #x62000 (the-as int seg2-size)) (-> pool segment-near dest)))) + (let ((seg2-dest (+ (- NEAR_SEGMENT_WORDS (the-as int seg2-size)) (-> pool segment-near dest)))) ;; relocate to point to this point. (relocate-dests! page (the-as int seg2-dest) 2) ) @@ -1294,7 +1342,7 @@ (update-vram-pages pool (-> pool segment-near) page 2) (cond - ((< (the-as uint #x24000) seg2-size) + ((< (the-as uint NEAR_PRIVATE_WORDS) seg2-size) ;; we use the shared part. Kick out only the non-shared texture. ;; it's on th end this time, so no mempcy like in near-allocate-0 (set! (-> page segment 2 size) (+ -147456 (the-as int seg2-size))) @@ -1316,7 +1364,7 @@ (defun texture-page-level-allocate ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) - "Allocator for level textures." + "Allocator for level textures, will pick the appropriate allocator (usually near0/near1)." (let ((common-id (lookup-boot-common-id pool mode))) (cond ((>= common-id 0) @@ -1345,16 +1393,18 @@ (defun texture-page-size-check ((pool texture-pool) (level level) (hide-prints symbol)) - "Check to see if any texture are oversize. Sets bits in the output flag if they are" - (let ((oversize 0)) + "Check to see if any textures in the level are oversize. Sets bits in the output flag if they are" + (let ((oversize 0)) ;; bitfield of oversize kinds (let* ((tfrag-page (-> level texture-page 0)) (tfrag-mip0-size (-> tfrag-page mip0-size)) ) (when tfrag-page - (if (< (the-as uint #x3e000) tfrag-mip0-size) + ;; check that mip0 fits in the per-level max size of the near segment + (if (< (the-as uint NEAR_PER_LEV_WORDS) tfrag-mip0-size) (set! oversize (logior oversize 1)) ) - (if (< (the-as uint #x1c000) (+ (-> tfrag-page segment 0 size) (-> tfrag-page segment 1 size))) + ;; check that the other two mips together fit into common + (if (< (the-as uint COMMON_SEGMENT_WORDS) (+ (-> tfrag-page segment 0 size) (-> tfrag-page segment 1 size))) (set! oversize (logior oversize 1)) ) (when (not hide-prints) @@ -1375,7 +1425,8 @@ ) (let ((pris-page (-> level texture-page 1))) (when pris-page - (if (< (the-as uint #x1c000) (-> pris-page size)) + ;; pris all goes in common. + (if (< (the-as uint COMMON_SEGMENT_WORDS) (-> pris-page size)) (set! oversize (logior oversize 2)) ) (if (not hide-prints) @@ -1390,7 +1441,8 @@ ) (let ((shrub-page (-> level texture-page 2))) (when shrub-page - (if (< (the-as uint #x1c000) (-> shrub-page size)) + ;; shrubs all go in common. + (if (< (the-as uint COMMON_SEGMENT_WORDS) (-> shrub-page size)) (set! oversize (logior oversize 4)) ) (if (not hide-prints) @@ -1405,7 +1457,8 @@ ) (let ((alpha-page (-> level texture-page 3))) (when alpha-page - (if (< (the-as uint #x1c000) (-> alpha-page size)) + ;; alpha's all go in common. + (if (< (the-as uint COMMON_SEGMENT_WORDS) (-> alpha-page size)) (set! oversize (logior oversize 8)) ) (if (not hide-prints) @@ -1420,7 +1473,8 @@ ) (let ((water-page (-> level texture-page 4))) (when water-page - (if (< (the-as uint #x1c000) (-> water-page size)) + ;; water all goes in common. + (if (< (the-as uint COMMON_SEGMENT_WORDS) (-> water-page size)) (set! oversize (logior oversize 16)) ) (if (not hide-prints) @@ -1438,9 +1492,20 @@ ) +;;;;;;;;;;;;;;;;;;; +;; Texture Login +;;;;;;;;;;;;;;;;;;; + +;; During loading/linking/relocation, permanent VRAM textures are uploaded and thrown out of main RAM. +;; But there's more! During level "login", you have to log-in the textures too. +;; The "login" process will check for textures that aren't loaded and try to load them over debug network. +;; It will also link the textures. +;; You _must_ login textures. + (defmethod login-level-textures texture-pool ((obj texture-pool) (level level) (max-page-kind int) (id-array (pointer texture-id))) "Login textures in a level. Only does up to max-page-kind. Set this to water (4) to do all of them. - Also checks sizes." + Also checks sizes. + This is called from level.gc as part of level loading." ;; mark any existing as not loaded. (dotimes (page-idx 9) @@ -1659,31 +1724,1489 @@ (none) ) -(define *texture-pool* (new 'global 'texture-pool)) +(defmethod upload-one-common! texture-pool ((obj texture-pool)) + "Upload the first common texture page that's in in the common-page-mask." + (dotimes (v1-0 32) + (let ((a2-0 (-> obj common-page v1-0))) + (when (and (nonzero? a2-0) ;; known common texture page + (nonzero? (logand (-> obj common-page-mask) (ash 1 v1-0))) ;; in the mask. + ) + ;; upload it! + (upload-vram-pages obj (-> obj segment-common) a2-0 -2 65) + (return #f) + ) + ) + ) + #f + ) -;; temp hack for loading: -(defmethod relocate texture-page ((obj texture-page) (heap kheap) (ptr (pointer uint8))) - (format #t "HACK! removing texture page ~A from level heap~%" (-> obj name)) - (remove-from-heap obj loading-level) +(defmethod add-irq-to-tex-buckets! level ((obj level)) + "Adds a packet that will cause a VIF interrupt to the end of all texture + buckets for a given level. This will trigger a VU1 profiler bar" + (cond + ((zero? (-> obj index)) + ;; use bucket numbers for the 0th level + (let* ((v1-4 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-0 (-> v1-4 base)) + ) + ;; packet macro + (let* ((a0-4 v1-4) + (a1-0 (the-as object (-> a0-4 base))) + ) + ;; continue packet. For some reason we don't put it on the next directly + (set! (-> (the-as dma-packet a1-0) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-0) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-0) vif1) (new 'static 'vif-tag :irq #x1)) ;; interrupt + (set! (-> a0-4 base) (&+ (the-as pointer a1-0) 16)) + ) + ;; a next packet, just to make the bucket linking work + (let ((a3-3 (-> v1-4 base))) + (let ((a0-5 (the-as object (-> v1-4 base)))) + (set! (-> (the-as dma-packet a0-5) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-5) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-5) vif1) (new 'static 'vif-tag)) + (set! (-> v1-4 base) (&+ (the-as pointer a0-5) 16)) + ) + ;; add it + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 5 + a2-0 + (the-as (pointer dma-tag) a3-3) + ) + ) + ) + ;; the rest are the same + (let* ((v1-12 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-1 (-> v1-12 base)) + ) + (let* ((a0-14 v1-12) + (a1-4 (the-as object (-> a0-14 base))) + ) + (set! + (-> (the-as dma-packet a1-4) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-4) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-4) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-14 base) (&+ (the-as pointer a1-4) 16)) + ) + (let ((a3-7 (-> v1-12 base))) + (let ((a0-15 (the-as object (-> v1-12 base)))) + (set! + (-> (the-as dma-packet a0-15) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-15) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-15) vif1) (new 'static 'vif-tag)) + (set! (-> v1-12 base) (&+ (the-as pointer a0-15) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 48 + a2-1 + (the-as (pointer dma-tag) a3-7) + ) + ) + ) + (let* + ((v1-20 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-2 (-> v1-20 base)) + ) + (let* ((a0-24 v1-20) + (a1-8 (the-as object (-> a0-24 base))) + ) + (set! + (-> (the-as dma-packet a1-8) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-8) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-8) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-24 base) (&+ (the-as pointer a1-8) 16)) + ) + (let ((a3-11 (-> v1-20 base))) + (let ((a0-25 (the-as object (-> v1-20 base)))) + (set! + (-> (the-as dma-packet a0-25) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-25) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-25) vif1) (new 'static 'vif-tag)) + (set! (-> v1-20 base) (&+ (the-as pointer a0-25) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 19 + a2-2 + (the-as (pointer dma-tag) a3-11) + ) + ) + ) + (let* + ((v1-28 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-3 (-> v1-28 base)) + ) + (let* ((a0-34 v1-28) + (a1-12 (the-as object (-> a0-34 base))) + ) + (set! + (-> (the-as dma-packet a1-12) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-12) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-12) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-34 base) (&+ (the-as pointer a1-12) 16)) + ) + (let ((a3-15 (-> v1-28 base))) + (let ((a0-35 (the-as object (-> v1-28 base)))) + (set! + (-> (the-as dma-packet a0-35) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-35) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-35) vif1) (new 'static 'vif-tag)) + (set! (-> v1-28 base) (&+ (the-as pointer a0-35) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 31 + a2-3 + (the-as (pointer dma-tag) a3-15) + ) + ) + ) + ) + (else + (let* + ((v1-36 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-4 (-> v1-36 base)) + ) + (let* ((a0-44 v1-36) + (a1-16 (the-as object (-> a0-44 base))) + ) + (set! + (-> (the-as dma-packet a1-16) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-16) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-16) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-44 base) (&+ (the-as pointer a1-16) 16)) + ) + (let ((a3-19 (-> v1-36 base))) + (let ((a0-45 (the-as object (-> v1-36 base)))) + (set! + (-> (the-as dma-packet a0-45) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-45) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-45) vif1) (new 'static 'vif-tag)) + (set! (-> v1-36 base) (&+ (the-as pointer a0-45) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 12 + a2-4 + (the-as (pointer dma-tag) a3-19) + ) + ) + ) + (let* + ((v1-44 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-5 (-> v1-44 base)) + ) + (let* ((a0-54 v1-44) + (a1-20 (the-as object (-> a0-54 base))) + ) + (set! + (-> (the-as dma-packet a1-20) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-20) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-20) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-54 base) (&+ (the-as pointer a1-20) 16)) + ) + (let ((a3-23 (-> v1-44 base))) + (let ((a0-55 (the-as object (-> v1-44 base)))) + (set! + (-> (the-as dma-packet a0-55) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-55) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-55) vif1) (new 'static 'vif-tag)) + (set! (-> v1-44 base) (&+ (the-as pointer a0-55) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 51 + a2-5 + (the-as (pointer dma-tag) a3-23) + ) + ) + ) + (let* + ((v1-52 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-6 (-> v1-52 base)) + ) + (let* ((a0-64 v1-52) + (a1-24 (the-as object (-> a0-64 base))) + ) + (set! + (-> (the-as dma-packet a1-24) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-24) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-24) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-64 base) (&+ (the-as pointer a1-24) 16)) + ) + (let ((a3-27 (-> v1-52 base))) + (let ((a0-65 (the-as object (-> v1-52 base)))) + (set! + (-> (the-as dma-packet a0-65) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-65) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-65) vif1) (new 'static 'vif-tag)) + (set! (-> v1-52 base) (&+ (the-as pointer a0-65) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 25 + a2-6 + (the-as (pointer dma-tag) a3-27) + ) + ) + ) + (let* + ((v1-60 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-7 (-> v1-60 base)) + ) + (let* ((a0-74 v1-60) + (a1-28 (the-as object (-> a0-74 base))) + ) + (set! + (-> (the-as dma-packet a1-28) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-28) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-28) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-74 base) (&+ (the-as pointer a1-28) 16)) + ) + (let ((a3-31 (-> v1-60 base))) + (let ((a0-75 (the-as object (-> v1-60 base)))) + (set! + (-> (the-as dma-packet a0-75) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-75) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-75) vif1) (new 'static 'vif-tag)) + (set! (-> v1-60 base) (&+ (the-as pointer a0-75) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 38 + a2-7 + (the-as (pointer dma-tag) a3-31) + ) + ) + ) + ) + ) + 0 (none) ) +;; A small DMA buffer for sending upload-now! textures. +;; These are uploaded outside of the main DMA list. +;; the actual texture data doesn't go in the buffer, just tags to set up the transfer +(define *txt-dma-list* (new 'global 'dma-buffer 4096)) + +(defmethod upload-now! texture-page ((obj texture-page) (arg0 int)) + "Immediately upload the texture-page to the given buffer, using arg0 mode." + (let ((gp-0 *txt-dma-list*)) + ;; Set up the DMA buffer + (let ((v1-0 gp-0)) + (set! (-> v1-0 base) (-> v1-0 data)) + (set! (-> v1-0 end) (&-> v1-0 data-buffer (-> v1-0 allocated-length))) + ) + ;; add the texture to the buffer + (add-to-dma-buffer obj gp-0 arg0) + + ;; DMA -> VIF (direct) -> GIF + (let* ((v1-3 gp-0) + (a0-1 (the-as object (-> v1-3 base))) + ) + (set! (-> (the-as dma-packet a0-1) dma) + (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a0-1) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-1) vif1) + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-3 base) (&+ (the-as pointer a0-1) 16)) + ) + ;; GIF regs (1) + (let* ((v1-4 gp-0) + (a0-3 (the-as object (-> v1-4 base))) + ) + (set! (-> (the-as gs-gif-tag a0-3) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1) + ) + (set! (-> (the-as gs-gif-tag a0-3) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-4 base) (&+ (the-as pointer a0-3) 16)) + ) + + ;; GIF texflush + (let* ((v1-5 gp-0) + (a0-5 (-> v1-5 base)) + ) + (set! (-> (the-as (pointer uint64) a0-5) 0) (the-as uint 1)) + (set! (-> (the-as (pointer gs-reg64) a0-5) 1) (gs-reg64 texflush)) + (set! (-> v1-5 base) (&+ a0-5 16)) + ) + + ;; DMA end (do it ourselves, no buckets here) + (let* ((v1-6 gp-0) + (a0-7 (the-as object (-> v1-6 base))) + ) + (set! + (-> (the-as dma-packet a0-7) dma) + (new 'static 'dma-tag :id (dma-tag-id end)) + ) + (set! (-> (the-as (pointer uint64) a0-7) 1) (the-as uint 0)) + (set! (-> v1-6 base) (&+ (the-as pointer a0-7) 16)) + ) + + ;; send now! + ;; we send this to the GIF, which will basically ignore the + ;; VIF tags (hopefully). + (#cond + (PC_PORT + (format 0 "Skipping upload-now! for ~A sz #x~X/#x~X bytes~%" + obj + (* 4 (-> obj segment 2 size)) + (* 4 NEAR_PRIVATE_WORDS) + ) + ) + (else + (dma-buffer-send-chain (the-as dma-bank-source #x1000a000) gp-0) + ) + ) + ) + ;; sync, wait for upload to complete + (dma-sync (the-as pointer #x1000a000) 0 0) + (none) + ) + +(defmethod add-to-dma-buffer texture-page ((obj texture-page) (dma-buff dma-buffer) (mode int)) + "Helper for upload-now! to upload texture-page to VRAM" + (local-vars (total-size int)) + (let ((v1-0 mode)) + (set! total-size + (cond + ((= v1-0 -3) + ;; upload none + 0 + ) + ((= v1-0 -2) + ;; segment 0, 1 only + (the-as int + (+ (-> obj segment 0 size) + (-> obj segment 1 size) + ) + ) + ) + ((= v1-0 -1) + ;; the whole thing. + (the-as int (-> obj size)) + ) + (else + ;; 0, 1, 2, just segment 0, 1, 2 + (the-as int (-> obj segment mode size)) + ) + ) + ) + ) + + ;; loop over chunks to load + (let* ((start-segment (max 0 mode)) + (chunk-count (* (/ (+ (/ total-size 64) 63) 64) 32)) + (current-dest (shr (-> obj segment start-segment dest) 6)) + (current-data (-> obj segment start-segment block-data)) + ) + (while (> chunk-count 0) + ;; do up to 2048 now + (let ((chunks-now (min 2048 chunk-count))) + ;; vif direct + (let* ((v1-11 dma-buff) + (pkt (the-as dma-packet (-> v1-11 base))) + ) + (set! (-> pkt dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt))) + (set! (-> pkt vif0) (new 'static 'vif-tag)) + (set! (-> pkt vif1) (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1)) + (set! (-> v1-11 base) (&+ (the-as pointer pkt) 16)) + ) + + ;; gs regs + (let* ((v1-12 dma-buff) + (gs-tag (the-as gs-gif-tag (-> v1-12 base))) + ) + (set! (-> gs-tag tag) (new 'static 'gif-tag64 :nloop #x4 :nreg #x1)) + (set! (-> gs-tag regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d))) + (set! (-> v1-12 base) (&+ (the-as pointer gs-tag) 16)) + ) + + ;; the actual regs + (let* ((v1-13 dma-buff) + (gs-reg-data (-> v1-13 base)) + ) + (set! (-> (the-as (pointer gs-bitbltbuf) gs-reg-data) 0) + (new 'static 'gs-bitbltbuf :dbw #x2 :dbp current-dest) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) gs-reg-data) 2) + (new 'static 'gs-trxpos) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 3) (gs-reg64 trxpos)) + (set! (-> (the-as (pointer gs-trxreg) gs-reg-data) 4) + (new 'static 'gs-trxreg :rrw #x80 :rrh chunks-now) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 5) (gs-reg64 trxreg)) + (set! (-> (the-as (pointer gs-trxdir) gs-reg-data) 6) + (new 'static 'gs-trxdir) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 7) (gs-reg64 trxdir)) + (set! (-> v1-13 base) (&+ gs-reg-data 64)) + ) + + ;; add data. + (dma-buffer-add-ref-texture dma-buff current-data 128 chunks-now (gs-psm ct32)) + ) + (+! current-dest 4096) + ;;(set! current-data (&+! #x100000 (the-as int current-data))) + (&+! current-data #x100000) + (+! chunk-count -2048) + ) + ) + total-size + ) + +(defun texture-relocate ((dma-buff dma-buffer) (tex texture) (dest-loc int) (dest-fmt gs-psm) (clut-dst int)) + "Move a texture in VRAM. Unrelated to the texture-relocate-later, which moves textures in RAM. + Will try to move the whole thing, including the clut, assuming you provide a destination for it. + Note that this uses the format/width stuff properly, so it will be slower, but won't scramble your texture." + + ;; loop over mips + (dotimes (mip-level (the-as int (-> tex num-mips))) + ;; size of the current mip. + (let ((mip-w (ash (-> tex w) (- mip-level))) + (mip-h (ash (-> tex h) (- mip-level))) + ) + ;; vif direct + (let* ((t3-2 dma-buff) + (dma-pkt (the-as dma-packet (-> t3-2 base))) + ) + (set! (-> dma-pkt dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt))) + (set! (-> dma-pkt vif0) (new 'static 'vif-tag)) + (set! (-> dma-pkt vif1) (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1)) + (set! (-> t3-2 base) (&+ (the-as pointer dma-pkt) 16)) + ) + + ;; gs reg setup + (let* ((t3-3 dma-buff) + (gs-pkt (the-as gs-gif-tag (-> t3-3 base))) + ) + (set! (-> gs-pkt tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4)) + (set! (-> gs-pkt regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> t3-3 base) (&+ (the-as pointer gs-pkt) 16)) + ) + + ;; regs (bitbltbuf) + (let* ((t3-4 dma-buff) + (t4-4 (-> t3-4 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) t4-4) 0) + (new 'static 'gs-bitbltbuf + :sbp (-> tex dest mip-level) ;; source VRAM addr + :sbw (-> tex width mip-level) ;; source width + :spsm (the-as int (-> tex psm)) ;; source format + :dbp (/ dest-loc 64) ;; dest location + :dbw (-> tex width mip-level) ;; dest width + :dpsm dest-fmt ;; dest format + ) + ) + (set! (-> (the-as (pointer gs-reg64) t4-4) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) t4-4) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) t4-4) 3) (gs-reg64 trxpos)) + (set! (-> (the-as (pointer gs-trxreg) t4-4) 4) (new 'static 'gs-trxreg :rrw mip-w :rrh mip-h)) + (set! (-> (the-as (pointer gs-reg64) t4-4) 5) (gs-reg64 trxreg)) + (set! (-> (the-as (pointer gs-trxdir) t4-4) 6) (new 'static 'gs-trxdir :xdir #x2)) + (set! (-> (the-as (pointer gs-reg64) t4-4) 7) (gs-reg64 trxdir)) + (set! (-> t3-4 base) (&+ t4-4 64)) + ) + ) + (set! (-> tex dest mip-level) (the-as uint (/ dest-loc 64))) + ) + + ;; transfer CLUT, if dst is given + (cond + ((< clut-dst 0) + ;; no dest, don't do anything + ) + ((= (-> tex psm) (gs-psm mt4)) + ;; case for mt4 format texture + (let* ((v1-7 dma-buff) + (a2-2 (the-as object (-> v1-7 base))) + ) + (set! (-> (the-as dma-packet a2-2) dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt))) + (set! (-> (the-as dma-packet a2-2) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a2-2) vif1) (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1)) + (set! (-> v1-7 base) (&+ (the-as pointer a2-2) 16)) + ) + (let* ((v1-8 dma-buff) + (a2-4 (the-as object (-> v1-8 base))) + ) + (set! (-> (the-as gs-gif-tag a2-4) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4)) + (set! + (-> (the-as gs-gif-tag a2-4) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-8 base) (&+ (the-as pointer a2-4) 16)) + ) + (let* ((v1-9 dma-buff) + (a2-6 (-> v1-9 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) a2-6) 0) + (new 'static 'gs-bitbltbuf + :sbw #x1 + :dbw #x1 + :dpsm (-> tex clutpsm) + :dbp (/ clut-dst 64) + :spsm (-> tex clutpsm) + :sbp (-> tex clutdest) + ) + ) + (set! (-> (the-as (pointer gs-reg64) a2-6) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) a2-6) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) a2-6) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) a2-6) 4) + (new 'static 'gs-trxreg :rrw #x8 :rrh #x2) + ) + (set! (-> (the-as (pointer gs-reg64) a2-6) 5) (gs-reg64 trxreg)) + (set! + (-> (the-as (pointer gs-trxdir) a2-6) 6) + (new 'static 'gs-trxdir :xdir #x2) + ) + (set! (-> (the-as (pointer gs-reg64) a2-6) 7) (gs-reg64 trxdir)) + (set! (-> v1-9 base) (&+ a2-6 64)) + ) + (set! (-> tex clutdest) (the-as uint (/ clut-dst 64))) + ) + ((= (-> tex psm) (gs-psm mt8)) + ;; 8-bit index + (let* ((v1-13 dma-buff) + (a2-9 (the-as object (-> v1-13 base))) + ) + (set! + (-> (the-as dma-packet a2-9) dma) + (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a2-9) vif0) (new 'static 'vif-tag)) + (set! + (-> (the-as dma-packet a2-9) vif1) + (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-13 base) (&+ (the-as pointer a2-9) 16)) + ) + (let* ((v1-14 dma-buff) + (a2-11 (the-as object (-> v1-14 base))) + ) + (set! + (-> (the-as gs-gif-tag a2-11) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4) + ) + (set! + (-> (the-as gs-gif-tag a2-11) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-14 base) (&+ (the-as pointer a2-11) 16)) + ) + (let* ((v1-15 dma-buff) + (a2-13 (-> v1-15 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) a2-13) 0) + (new 'static 'gs-bitbltbuf + :sbw #x2 + :dbw #x2 + :dpsm (-> tex clutpsm) + :dbp (/ clut-dst 64) + :spsm (-> tex clutpsm) + :sbp (-> tex clutdest) + ) + ) + (set! (-> (the-as (pointer gs-reg64) a2-13) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) a2-13) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) a2-13) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) a2-13) 4) + (new 'static 'gs-trxreg :rrw #x10 :rrh #x10) + ) + (set! (-> (the-as (pointer gs-reg64) a2-13) 5) (gs-reg64 trxreg)) + (set! + (-> (the-as (pointer gs-trxdir) a2-13) 6) + (new 'static 'gs-trxdir :xdir #x2) + ) + (set! (-> (the-as (pointer gs-reg64) a2-13) 7) (gs-reg64 trxdir)) + (set! (-> v1-15 base) (&+ a2-13 64)) + ) + (set! (-> tex clutdest) (the-as uint (/ clut-dst 64))) + ) + ) + + ;; update texture to have the new format. + (set! (-> tex psm) dest-fmt) + dma-buff + ) + +;; The font texture is a special case. +(define-perm *font-texture* texture #f) + +(defmethod setup-font-texture! texture-pool ((obj texture-pool)) + "Move the font textures to the upper 8-bits of the depth buffer." + (local-vars (heap-before-font-tex int) (clut-dest-addr int)) + ;; we reserved some space for the CLUT earlier. I guess it didn't fit in the depth buffer too + (let ((font-clut (-> obj font-palette))) + ;; we're going to try to find the font texture + (set! heap-before-font-tex (-> obj cur)) + (set! clut-dest-addr (/ font-clut 64)) + + ;; find the font texture. + (set! *font-texture* (lookup-texture-by-id (new 'static 'texture-id :index #x1 :page #x4fe))) + ;; log in the font texture. I believe the point of this is to get the start of the + ;; texture _page_, which may have stuff in it before the index 1 texture. + (let ((main-font-tx (texture-page-login + (new 'static 'texture-id :index #x1 :page #x4fe) + texture-page-default-allocate + global + ) + ) + ) + + ;; if we have the font texture after log-in, then set our heap marker to before it. + ;; resetting the heap to here would kick + (if (and main-font-tx (-> main-font-tx page)) + (set! heap-before-font-tex + (the-as int (-> main-font-tx page segment 0 dest)) + ) + ) + ;; clear the temp texture DMA list + (let ((dma-buff *txt-dma-list*)) + (let ((v1-6 dma-buff)) + (set! (-> v1-6 base) (-> v1-6 data)) + (set! (-> v1-6 end) (&-> v1-6 data-buffer (-> v1-6 allocated-length))) + ) + + ;; relocate the font + (let ((font-tx-1 *font-texture*) ;; texture 1 + (font-tx-1-dest #xe0000) ;; the depth buffer + (font-tx-1-fmt (gs-psm mt4hl)) ;; 4-bit, using 4 of the 8 free bits of z24 + ) + ;; do the relocation! + (texture-relocate + dma-buff + font-tx-1 + font-tx-1-dest + font-tx-1-fmt + font-clut + ) + ;; tell the font system that we put the texture here. + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* small-font-lo-tmpl)) + font-tx-1 + (the-as uint font-tx-1-dest) + (the-as uint font-tx-1-fmt) + (the-as uint clut-dest-addr) + ) + ) + (let ((font-tx-0 (lookup-texture-by-id (new 'static 'texture-id :page #x4fe))) + (font-tx-0-dest #xe0000) + (font-tx-0-fmt (gs-psm mt4hh)) + ) + (texture-relocate + dma-buff + font-tx-0 + font-tx-0-dest + font-tx-0-fmt + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* small-font-hi-tmpl)) + font-tx-0 + (the-as uint font-tx-0-dest) + (the-as uint font-tx-0-fmt) + (the-as uint clut-dest-addr) + ) + ) + (let ((font-tx-3 (lookup-texture-by-id (new 'static 'texture-id :index #x3 :page #x4fe))) + (font-tx-3-dest #xe6000) + (font-tx-3-fmt (gs-psm mt4hl)) + ) + (texture-relocate + dma-buff + font-tx-3 + font-tx-3-dest + font-tx-3-fmt + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* large-font-lo-tmpl)) + font-tx-3 + (the-as uint font-tx-3-dest) + (the-as uint font-tx-3-fmt) + (the-as uint clut-dest-addr) + ) + (set! font-tx-3 (lookup-texture-by-id (new 'static 'texture-id :index #x2 :page #x4fe))) + (set! font-tx-3-dest #xe6000) + (set! font-tx-3-fmt (gs-psm mt4hh)) + (texture-relocate + dma-buff + font-tx-3 + font-tx-3-dest + font-tx-3-fmt + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* large-font-hi-tmpl)) + font-tx-3 + (the-as uint font-tx-3-dest) + (the-as uint font-tx-3-fmt) + (the-as uint clut-dest-addr) + ) + ) + + ;; texflush + (let* ((v1-15 dma-buff) + (a0-18 (the-as object (-> v1-15 base))) + ) + (set! + (-> (the-as dma-packet a0-18) dma) + (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a0-18) vif0) (new 'static 'vif-tag)) + (set! + (-> (the-as dma-packet a0-18) vif1) + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-15 base) (&+ (the-as pointer a0-18) 16)) + ) + (let* ((v1-16 dma-buff) + (a0-20 (the-as object (-> v1-16 base))) + ) + (set! + (-> (the-as gs-gif-tag a0-20) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1) + ) + (set! + (-> (the-as gs-gif-tag a0-20) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-16 base) (&+ (the-as pointer a0-20) 16)) + ) + (let* ((v1-17 dma-buff) + (a0-22 (-> v1-17 base)) + ) + (set! (-> (the-as (pointer uint64) a0-22) 0) (the-as uint 1)) + (set! (-> (the-as (pointer gs-reg64) a0-22) 1) (gs-reg64 texflush)) + (set! (-> v1-17 base) (&+ a0-22 16)) + ) + + ;; end of DMA + (let* ((v1-18 dma-buff) + (a0-24 (the-as object (-> v1-18 base))) + ) + (set! + (-> (the-as dma-packet a0-24) dma) + (new 'static 'dma-tag :id (dma-tag-id end)) + ) + (set! (-> (the-as (pointer uint64) a0-24) 1) (the-as uint 0)) + (set! (-> v1-18 base) (&+ (the-as pointer a0-24) 16)) + ) + + ;; send and sync! VIF tags are probably ignored. + (#cond + (PC_PORT + (format 0 "Skipping dma-buffer-send-chain to relocate font texture~%") + ) + (else + (dma-buffer-send-chain (the-as dma-bank-source #x10009000) dma-buff) + ) + ) + ) + (dma-sync (the-as pointer #x10009000) 0 0) + + ;; try to kick out the font texture + (if (and main-font-tx ;; we found it + (-> main-font-tx page) ;; directory has it + (= (-> obj cur) (+ heap-before-font-tex (the-as int (-> main-font-tx page size)))) ;; not killing other stuff + ) + (set! (-> obj cur) heap-before-font-tex) ;; kick first copy out of VRAM! + ;; or, if we failed, complain. + (format 0 "ERROR: could not resize heap to remove gamefont.~%") + ) + ) + ) + 0 + (none) + ) + +;; The texture page directory is a list of all texture pages. +;; It is actually stored in the dir-tpages.o object file, which is pre-populated with lengths. + (defmethod asize-of texture-page-dir ((obj texture-page-dir)) - (the-as int - (+ (-> texture-page-dir size) (the-as uint (* 12 (+ (-> obj length) -1)))) - ) + "Get the size in memory of a texture-page-dir" + (the-as int (+ (-> texture-page-dir size) (the-as uint (* 12 (+ (-> obj length) -1))))) ) (defmethod length texture-page-dir ((obj texture-page-dir)) + "Get the number of tpages in the texture-page-dir" (-> obj length) ) (defmethod relocate texture-page-dir ((obj texture-page-dir) (arg0 kheap) (arg1 (pointer uint8))) + "Load a texture-page-dir" + ;; just set the global. + (tex-dbg "Loaded texture-page-dir ~A with ~D entries~%" obj (-> obj length)) (set! *texture-page-dir* obj) (none) ) +(defmethod relocate-dests! texture-page ((obj texture-page) (new-dest int) (seg-id int)) + "Update a texture-page so all the textures point to a new location" + (let ((v1-0 (shr new-dest 6)) + (dst-block (shr (-> obj segment seg-id dest) 6)) + ) + (when (!= v1-0 dst-block) ;; skip if already correct + (dotimes (tex-id (-> obj length)) ;; iterate through all textures + (when (-> obj data tex-id) ;; only if we have a texture + (let* ((tex (-> obj data tex-id)) + (num-mips (-> tex num-mips)) + ) + ;; (tex-dbg " relocate-dests! ~A~%" tex) + + ;; relocate clut + (if (zero? seg-id) + (set! (-> tex clutdest) (+ (- (-> tex clutdest) dst-block) (the-as uint v1-0))) + ) + + ;; move the texture data for each mip level + (dotimes (mip-id (the-as int num-mips)) + (let ((t4-0 mip-id) + (t5-0 num-mips) + ) + (if (= seg-id (if (>= (the-as uint 2) t5-0) + (+ (- -1 t4-0) (the-as int t5-0)) + (max 0 (- 2 t4-0)) + ) + ) + (set! (-> tex dest mip-id) + (+ (- (-> tex dest mip-id) dst-block) (the-as uint v1-0)) + ) + ) + ) + ) + ) + ) + ) + (set! (-> obj segment seg-id dest) (the-as uint new-dest)) + ) + ) + (none) + ) + +(defmethod relocate texture-page ((obj texture-page) (arg0 kheap) (arg1 (pointer uint8))) + "Add to VRAM and allocate links" + (tex-dbg "loaded tpage ~A ~A ~A ~A ~A~%" obj + (-> obj info file-name) + (-> obj info maya-file-name) + (-> obj info tool-debug) + (-> obj info mdb-file-name)) + (local-vars (s4-0 texture-page-dir-entry)) + (cond + ((or (not obj) + (not (file-info-correct-version? (-> obj info) (file-kind tpage) 0)) + ) + ;; bad file + (set! obj (the-as texture-page #f)) + ) + ((begin + (let ((v1-2 (-> *level* unknown-level-2))) ;; loading/linking level + (tex-dbg " tpage is with level ~A~%" v1-2) + (when v1-2 + ;; add us to the loading level's tpages + (set! (-> v1-2 loaded-texture-page (-> v1-2 loaded-texture-page-count)) + obj + ) + (+! (-> v1-2 loaded-texture-page-count) 1) + ) + ) + ;; set our dests for the 3 segments being in order + (set! (-> obj segment 1 dest) (-> obj segment 0 size)) + (set! (-> obj segment 2 dest) (+ (-> obj segment 0 size) (-> obj segment 1 size))) + + ;; grab our tpage dir entry + (let ((a3-0 (-> obj id))) + (set! s4-0 (-> *texture-page-dir* entries a3-0)) + (set! (-> *texture-relocate-later* memcpy) #f) + + ;; allocate! + ((-> *texture-pool* allocate-func) + *texture-pool* + obj + arg0 + (the-as int a3-0) + ) + ) + ;; the actual condition + (not (-> *texture-relocate-later* memcpy)) + ) + ;; if no relocate later memcpy, then we allocate links + (set! (-> s4-0 page) obj) + (if (not (-> s4-0 link)) + (set! (-> s4-0 link) + (the-as + texture-link + (malloc 'loading-level (* (max (-> s4-0 length) (-> obj length)) 4)) + ) + ) + ) + ) + (else + ;; yes memcpy, we can't allocate on the heap. + (let ((v1-19 *texture-relocate-later*)) + (set! (-> v1-19 entry) s4-0) + (set! (-> v1-19 page) obj) + ) + ) + ) + (none) + ) + + +(defun relocate-later () + "Level loader will call this. At this point, the data is kicked out" + (let ((gp-0 *texture-relocate-later*)) + (let ((s5-0 (-> gp-0 entry)) + (s4-0 (-> gp-0 page)) + ) + ;; do this first, before allocating + (ultimate-memcpy + (the-as pointer (-> gp-0 dest)) + (the-as pointer (-> gp-0 source)) + (-> gp-0 move) + ) + (set! (-> s5-0 page) s4-0) + ;; now safe to allocate links! + (if (not (-> s5-0 link)) + (set! (-> s5-0 link) + (the-as + texture-link + (malloc 'loading-level (* (max (-> s5-0 length) (-> s4-0 length)) 4)) + ) + ) + ) + ) + (set! (-> gp-0 memcpy) #f) + ) + #f + ) + +(defun texture-page-login ((id texture-id) (alloc-func (function texture-pool texture-page kheap int texture-page)) (heap kheap)) + "Return the tpage-dir entry for the given texture. + Load if from the debug network if its not loaded. Return #f if it doesn't work" + + ;; make sure its a valid entry + (when (and (nonzero? (-> id page)) + (< (the-as uint (-> id page)) (the-as uint (-> *texture-page-dir* length))) + ) + ;; look up current entry + (let ((dir-entry (-> *texture-page-dir* entries (the-as uint (-> id page))))) + (when (not (-> dir-entry page)) + ;; no, we don't have it. + ;; set a new allocation function + (let ((old-alloc-func (-> *texture-pool* allocate-func))) + (set! (-> *texture-pool* allocate-func) alloc-func) + ;; generate a file name + (let* ((file-name (make-file-name + (file-kind tpage) + (the-as string (* (-> id page) 8)) ;; int -> binteger, later prined with ~S + 0 + #f + ) + ) + ;; and load it! The loado links but doesn't execute + (s2-0 (the-as texture-page (loado file-name heap))) + ) + ;; if we loaded, relocate! + (if s2-0 + (relocate s2-0 heap (charp-basename (-> file-name data))) + ) + ) + (set! (-> *texture-pool* allocate-func) old-alloc-func) + ) + ) + dir-entry + ) + ) + ) + +(defun lookup-texture-by-id ((arg0 texture-id)) + "Look up a texture by ID, loading it from debug network if its not loaded. + Default allocates if it has to load, so it will permanently use VRAM" + (let ((v1-0 (texture-page-login arg0 texture-page-default-allocate loading-level))) + (if (and v1-0 (< (-> arg0 index) (the-as uint (-> v1-0 page length)))) + (-> v1-0 page data (-> arg0 index)) + ) + ) + ) + +(defmethod unload! texture-pool ((obj texture-pool) (arg0 texture-page)) + "Unload the texture from the directory" + (local-vars (a0-2 int)) + (let ((v1-0 *texture-page-dir*)) + ;; iterate through all textures + (dotimes (a0-1 (-> v1-0 length)) + ;; found it! + (if (= arg0 (-> v1-0 entries a0-1 page)) + (begin + (set! a0-2 a0-1) + (goto cfg-7) + ) + ) + ) + (set! a0-2 -1) + (label cfg-7) + ;; remove + (when (>= a0-2 0) + (set! (-> v1-0 entries a0-2 page) #f) + (set! (-> v1-0 entries a0-2 link) #f) + ) + ) + 0 + ) + +;; debug menu shader stuff +(define *shader-list* '()) +(define *edit-shader* 0) + +(defun link-texture-by-id ((arg0 texture-id) (arg1 adgif-shader)) + "Link the given adgif shader to the texture with the given ID" + (when (not (or (zero? (-> arg0 page)) + (>= (the-as uint (-> arg0 page)) + (the-as uint (-> *texture-page-dir* length)) + ) + ) + ) + ;; look up entry + (let ((s4-0 (-> *texture-page-dir* entries (the-as uint (-> arg0 page))))) + ;; allocate if needed. + (if (not (-> s4-0 link)) + (set! (-> s4-0 link) + (the-as texture-link (malloc 'loading-level (* (-> s4-0 length) 4))) + ) + ) + (when (< (-> arg0 index) (the-as uint (-> s4-0 length))) + ;; push to head of the list. + (set! (-> arg1 next shader) (-> s4-0 link next (-> arg0 index) shader)) + (set! (-> s4-0 link next (-> arg0 index) shader) + (shr (the-as uint arg1) 4) + ) + ) + s4-0 + ) + ) + ) + +(defmethod unlink-textures-in-heap! texture-page-dir ((obj texture-page-dir) (heap kheap)) + "Remove adgif shaders that are in the given heap" + (local-vars (dist-past-end uint)) + (let ((mem-start (-> heap base)) + (mem-end (-> heap top-base)) + ) + ;; iterate over all entries in the director + (dotimes (entry-idx (-> obj length)) + (let* ((entry (-> obj entries entry-idx)) + (tex-page (-> entry page)) + (link-arr (-> entry link next)) + (tex-count (min (-> tex-page length) (-> entry length))) + ) + 0 + (when link-arr + ;; when we have an allocate link array, loop over all textures + (dotimes (tex-idx tex-count) + (let ((link-slot (&-> link-arr 0)) + (shader (the-as adgif-shader (* (-> link-arr 0 shader) 16))) + ) + (while (nonzero? (the-as int shader)) + ;; got a shader, lets see if we should unlink it + ;; some clever branching here: + ;; branch to cfg-7 if we're below mem start + (b! (< (the-as int (- (the-as int shader) (the-as int mem-start))) 0) + cfg-7 + :delay (set! dist-past-end (the-as uint (- (the-as int shader) (the int mem-end)))) + ) + ;; in the delay slot of the above branch we determined our distance from end of memory + (b! (>= (the-as int dist-past-end) 0) cfg-7 :delay (nop!)) + ;; in here, we're in the heap. + ;; splice this adgif shader out. + (let ((t4-2 (-> shader next))) + (b! #t cfg-8 :delay (set! (-> link-slot 0) t4-2)) + ) + (label cfg-7) + ;; only advance link slot if we didn't splice + (set! link-slot (&-> shader next)) + (label cfg-8) + ;; move on to the next shader, this should work if we spliced or not. + (set! shader (the-as adgif-shader (* (-> shader next shader) 16))) + ) ;; end loop over linked list + ) + + (set! link-arr (&-> link-arr 1)) + ) ;; end loop over textures + ) + ) + ) ;; end loop over tpages + ) + 0 + ) + +;; TODO method 9 + +(defun adgif-shader<-texture! ((arg0 adgif-shader) (arg1 texture)) + "Set up an ADGIF shader from a texture." + ;; tex1 + (set! (-> arg0 tex1 mxl) (+ (-> arg1 num-mips) -1)) + (set! (-> arg0 tex1 l) (-> arg1 mip-shift)) + (set! (-> arg0 tex1 mmag) (logand (-> arg1 tex1-control) 1)) + (set! (-> arg0 tex1 mmin) (shr (-> arg1 tex1-control) 1)) + ;; tex0 + (set! (-> arg0 tex0) + (new 'static 'gs-tex0 + :tcc #x1 + :cld #x1 + :cpsm (-> arg1 clutpsm) + :cbp (-> arg1 clutdest) + :tfx (-> arg0 tex0 tfx) + :th (log2 (-> arg1 h)) + :tw (log2 (-> arg1 w)) + :tbw (-> arg1 width 0) + :tbp0 (-> arg1 dest 0) + :psm (the-as int (-> arg1 psm)) + ) + ) + ;; mitptbp1 + (set! (-> arg0 miptbp1) + (new 'static 'gs-miptbp + :tbp1 (-> arg1 dest 1) + :tbw1 (-> arg1 width 1) + :tbp2 (-> arg1 dest 2) + :tbw2 (-> arg1 width 2) + :tbp3 (-> arg1 dest 3) + :tbw3 (-> arg1 width 3) + ) + ) + + ;; hack - if we have a lot of mips, set alpha to miptbp. + ;; and modify the adgif thing to have a (miptbp2-1 54) + (when (< (the-as uint 4) (-> arg1 num-mips)) + (set! + (-> arg0 alpha) + (new 'static 'gs-miptbp + :tbp1 (-> arg1 dest 4) + :tbw1 (-> arg1 width 4) + :tbp2 (-> arg1 dest 5) + :tbw2 (-> arg1 width 5) + :tbp3 (-> arg1 dest 6) + :tbw3 (-> arg1 width 6) + ) + ) + ;; 54 = (gs-reg miptbp2-1) + (set! (-> (&-> arg0 quad 4 vector4w z) 0) 54) + ) + arg0 + ) + +(defun adgif-shader-update! ((arg0 adgif-shader) (arg1 texture)) + "Update tex1" + (let ((s5-0 (the int (/ 256.0 (-> arg1 uv-dist)))) + (v1-2 (-> arg0 tex1 l)) + ) + (if (= v1-2 1) + (set! (-> arg0 tex1 k) + (+ (+ (logand (ash s5-0 (- 5 (log2 s5-0))) 31) -350) (* (log2 s5-0) 32)) + ) + (set! (-> arg0 tex1 k) + (+ (+ (logand (ash s5-0 (- 4 (log2 s5-0))) 15) -175) (* (log2 s5-0) 16)) + ) + ) + ) + (none) + ) + +;; TODO adgif-shader<-texture-with-update! + +(defun adgif-shader-login ((shader adgif-shader)) + "If not logged in already, link us and update from texture." + + ;; only do it if we need to + (when (nonzero? (logand (-> shader link-test) (link-test-flags needs-log-in))) + (set! (-> shader link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> shader link-test)) + ) + ;; remap our texture + (set! (-> shader texture-id) (level-remap-texture (-> shader texture-id))) + ;; link this shader to the tpage dir + (link-texture-by-id (-> shader texture-id) shader) + ;; grab our texture object + (let ((tex (lookup-texture-by-id (-> shader texture-id)))) + (if tex + (adgif-shader<-texture-with-update! shader tex) ;; success, update! + ;; nope, couldn't find the texture, complain. + (format 0 "login could not find texture ~X in shader ~X~%" (-> shader texture-id) shader) + ) + tex + ) + ) + ) + +(defun adgif-shader-login-no-remap ((arg0 adgif-shader)) + "Same as adgif-shader-login, but don't remap our texture id" + (when (nonzero? (logand (-> arg0 link-test) (link-test-flags needs-log-in))) + (set! (-> arg0 link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> arg0 link-test)) + ) + (link-texture-by-id (-> arg0 texture-id) arg0) + (let ((s5-0 (lookup-texture-by-id (-> arg0 texture-id)))) + (if s5-0 + (adgif-shader<-texture-with-update! arg0 s5-0) + (format 0 "login could not find texture ~X in shader ~X~%" (-> arg0 texture-id) arg0) + ) + s5-0 + ) + ) + ) + +(defun adgif-shader-login-fast ((shader adgif-shader)) + "Like adgif-shader-login, but assumes you've already logged in the texture" + (when (nonzero? (logand (-> shader link-test) (link-test-flags needs-log-in))) + ;; usual remap + (set! (-> shader link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> shader link-test)) + ) + (set! (-> shader texture-id) (level-remap-texture (-> shader texture-id))) + (let ((tex-id (-> shader texture-id))) + (when (and (nonzero? (-> tex-id page)) + (< (the-as uint (-> tex-id page)) + (the-as uint (-> *texture-page-dir* length)) + ) + ) + ;; grab entry directly + (let ((dir-entry (-> *texture-page-dir* entries (the-as uint (-> tex-id page))))) + ;; and link this shader + (when (and (< (-> tex-id index) (the-as uint (-> dir-entry length))) + (-> dir-entry link) + ) + ;; push + (set! (-> shader next shader) + (-> dir-entry link next (-> tex-id index) shader) + ) + (set! (-> dir-entry link next (-> tex-id index) shader) + (shr (the-as uint shader) 4) + ) + ) + (when (and (-> dir-entry page) + (< (-> tex-id index) (the-as uint (-> dir-entry page length))) + ) + (let ((tex (-> dir-entry page data (-> tex-id index)))) + ;; setup adgif. + (if tex + (adgif-shader<-texture-with-update! shader tex) + ) + tex + ) + ) + ) + ) + ) + ) + ) + +(defun adgif-shader-login-no-remap-fast ((arg0 adgif-shader)) + "Like adgif-shader-login-fast, but no level remap" + (when (nonzero? (logand (-> arg0 link-test) (link-test-flags needs-log-in))) + (set! (-> arg0 link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> arg0 link-test)) + ) + (let ((v1-4 (-> arg0 texture-id))) + (when (and (nonzero? (-> v1-4 page)) + (< (the-as uint (-> v1-4 page)) + (the-as uint (-> *texture-page-dir* length)) + ) + ) + (let ((a1-7 (-> *texture-page-dir* entries (the-as uint (-> v1-4 page))))) + (when (and (< (-> v1-4 index) (the-as uint (-> a1-7 length))) (-> a1-7 link)) + (set! (-> arg0 next shader) (-> a1-7 link next (-> v1-4 index) shader)) + (set! (-> a1-7 link next (-> v1-4 index) shader) + (shr (the-as uint arg0) 4) + ) + ) + (when (and (-> a1-7 page) + (< (-> v1-4 index) (the-as uint (-> a1-7 page length))) + ) + (let ((gp-0 (-> a1-7 page data (-> v1-4 index)))) + (if gp-0 + (adgif-shader<-texture-with-update! arg0 gp-0) + ) + gp-0 + ) + ) + ) + ) + ) + ) + ) + +(when (not *debug-segment*) + ;; when not debugging, use the "fast" logins. There's no way we can load a texture over the network anyway. + (set! adgif-shader-login adgif-shader-login-fast) + (set! adgif-shader-login-no-remap adgif-shader-login-no-remap-fast) + ) + +(defun adgif-shader<-texture-simple! ((arg0 adgif-shader) (arg1 texture)) + (set! (-> arg0 tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1)) + (set! (-> arg0 tex0 tfx) 0) + #|(set! + (-> arg0 tex0) + (the-as + gs-tex0 + (logand (the-as uint (-> arg0 tex0)) (the-as uint #xffffffe7ffffffff)) + ) + )|# + (if arg1 + (adgif-shader<-texture! arg0 arg1) + ) + (set! (-> arg0 clamp) (new 'static 'gs-clamp :wms #x1 :wmt #x1)) + (set! (-> arg0 alpha) (new 'static 'gs-miptbp :tbp1 #x44)) + (set! (-> arg0 prims 1) (gs-reg64 tex0-1)) + (set! (-> arg0 prims 3) (gs-reg64 tex1-1)) + (set! (-> arg0 prims 5) (gs-reg64 miptbp1-1)) + (set! (-> arg0 clamp-reg) (gs-reg64 clamp-1)) + (set! (-> arg0 prims 9) (gs-reg64 alpha-1)) + arg0 + ) + + + + + + + (defun-debug texture-page-dir-inspect ((dir texture-page-dir) (mode symbol)) (format #t "[~8x] ~A~%" dir (-> dir type)) (let ((pool *texture-pool*)) @@ -1779,3 +3302,11 @@ ) (none) ) + +(defmethod inspect texture-page-dir ((obj texture-page-dir)) + (texture-page-dir-inspect obj #f) + obj + ) + + +(define *texture-pool* (new 'global 'texture-pool)) diff --git a/goal_src/engine/level/level-h.gc b/goal_src/engine/level/level-h.gc index a4324bb1eb..073986ef4f 100644 --- a/goal_src/engine/level/level-h.gc +++ b/goal_src/engine/level/level-h.gc @@ -130,7 +130,7 @@ (vis-self-index int32 :offset-assert 440) (vis-adj-index int32 :offset-assert 444) (vis-buffer uint8 2048 :offset-assert 448) - (mem-usage-block basic :offset-assert 2496) + (mem-usage-block memory-usage-block :offset-assert 2496) (mem-usage int32 :offset-assert 2500) (code-memory-start pointer :offset-assert 2504) (code-memory-end pointer :offset-assert 2508) @@ -144,10 +144,10 @@ (:methods (deactivate (_type_) _type_ 9) (dummy-10 (_type_ int) symbol 10) - (dummy-11 (_type_) none 11) + (add-irq-to-tex-buckets! (_type_) none 11) (unload! (_type_) _type_ 12) (bsp-name (_type_) symbol 13) - (dummy-14 (_type_) none 14) + (dummy-14 (_type_ object) none 14) (dummy-15 (_type_ vector) symbol 15) (dummy-16 (_type_) none 16) (load-continue (_type_) _type_ 17) diff --git a/goal_src/engine/level/level.gc b/goal_src/engine/level/level.gc index 18022fabe2..5dd427d486 100644 --- a/goal_src/engine/level/level.gc +++ b/goal_src/engine/level/level.gc @@ -392,7 +392,7 @@ ) ;; otherwise, copy stuff that needs copying (when (-> *texture-relocate-later* memcpy) - ;; (relocate-later) TODO + (relocate-later) (dgo-load-continue (align64 (-> obj heap current))) (return obj) ) @@ -475,6 +475,7 @@ (let ((s4-0 (kmalloc (-> obj heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2")) (s5-2 (kmalloc (-> obj heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2")) ) + (load-dbg " DGO buffers at #x~X #x~X~%" s4-0 s5-2) (set! (-> obj code-memory-start) (-> obj heap current)) (format 0 "-----------> begin load ~A [~S]~%" (-> obj load-name) *temp-string*) (dgo-load-begin *temp-string* s5-2 s4-0 (align64 (-> obj heap current))) @@ -629,16 +630,16 @@ (dotimes (s2-3 (-> s1-2 length)) (let ((s0-2 (-> s1-2 array-data s2-3 envmap-shader))) (when (nonzero? s0-2) - ;;(adgif-shader-login-no-remap s0-2) TODO texture.gc - (set! (-> s0-2 tex1) (the-as uint 96)) - (set! (-> s0-2 clamp) (the-as uint 5)) - (set! (-> s0-2 alpha) (the-as uint 88)) - (set! (-> s0-2 prims 1) (the-as uint 6)) - (set! (-> s0-2 prims 3) (the-as uint 20)) - (set! (-> s0-2 prims 5) (the-as uint 52)) - (set! (-> s0-2 clamp-reg) (the-as uint 8)) - (set! (-> s0-2 prims 9) (the-as uint 66)) - ) + (adgif-shader-login-no-remap s0-2) + (set! (-> s0-2 tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1)) + (set! (-> s0-2 clamp) (new 'static 'gs-clamp :wms #x1 :wmt #x1)) + (set! (-> s0-2 alpha) (new 'static 'gs-miptbp :tbp1 #x58)) + (set! (-> s0-2 prims 1) (gs-reg64 tex0-1)) + (set! (-> s0-2 prims 3) (gs-reg64 tex1-1)) + (set! (-> s0-2 prims 5) (gs-reg64 miptbp1-1)) + (set! (-> s0-2 clamp-reg) (gs-reg64 clamp-1)) + (set! (-> s0-2 prims 9) (gs-reg64 alpha-1)) + ) ) ) (set! (-> level-login-state pos) (the-as uint 0)) @@ -810,12 +811,12 @@ (set! (-> *texture-pool* common-page v1-27) (the-as texture-page 0)) ) ) - (dummy-20 *texture-pool* (-> obj loaded-texture-page s5-1)) + (unload! *texture-pool* (-> obj loaded-texture-page s5-1)) ) ) (set! (-> obj loaded-texture-page-count) 0) - (dummy-9 *texture-page-dir* (-> obj heap)) + (unlink-textures-in-heap! *texture-page-dir* (-> obj heap)) ;; (unlink-part-group-by-heap (-> obj heap)) TODO ; (dotimes (s5-2 2) ; (let ((v1-41 (-> *art-control* buffer s5-2 pending-load-file))) diff --git a/goal_src/engine/load/file-io.gc b/goal_src/engine/load/file-io.gc index 70022a0e2e..16e0b8ccb9 100644 --- a/goal_src/engine/load/file-io.gc +++ b/goal_src/engine/load/file-io.gc @@ -5,6 +5,12 @@ ;; name in dgo: file-io ;; dgos: GAME, ENGINE +;; GOAL File I/O +;; This is mostly not used in the retail game and was more for loading stuff during development. +;; The file-stream is an inefficient way to load data, but is flexible and can load +;; from the CD, or over the network in development. +;; The file-info type is used in actual game data for checking versions. + ;; represents a file that can be read/written, similar to FILE* in C. ;; NOTE: this is a special type in three ways: ;; 1). It is used in the C runtime. This must be kept in sync with kmachine.h's FileStream diff --git a/goal_src/engine/load/loader-h.gc b/goal_src/engine/load/loader-h.gc index 37d89c15d3..9e68d1a849 100644 --- a/goal_src/engine/load/loader-h.gc +++ b/goal_src/engine/load/loader-h.gc @@ -5,6 +5,9 @@ ;; name in dgo: loader-h ;; dgos: GAME, ENGINE +;; This is not well-understood yet, but it is definitely related to streaming animation loading, +;; and possibly art-group stuff. + ;; This type didn't have an inspect method, so these field names are made up. (declare-type art-group basic) (deftype load-dir (basic) diff --git a/goal_src/engine/math/vector-h.gc b/goal_src/engine/math/vector-h.gc index 01430d9e92..235a5668e9 100644 --- a/goal_src/engine/math/vector-h.gc +++ b/goal_src/engine/math/vector-h.gc @@ -5,6 +5,9 @@ ;; name in dgo: vector-h ;; dgos: GAME, ENGINE + +;; Type definitions/inline functions for bit array and vector types. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; bit array ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/goal_src/engine/ps2/pad.gc b/goal_src/engine/ps2/pad.gc index c6f4dee8fa..9a11a6ab67 100644 --- a/goal_src/engine/ps2/pad.gc +++ b/goal_src/engine/ps2/pad.gc @@ -5,6 +5,11 @@ ;; name in dgo: pad ;; dgos: GAME, ENGINE +;; Interface for game controllers. +;; the *cpad-list* contains both game controllers. +;; Use the service-cpads functions once per frame to update the data and vibration control +;; The cpad-set-buzz! function can be used for vibration. + (defenum pad-buttons :bitfield #t :type uint32 diff --git a/goal_src/engine/ps2/timer-h.gc b/goal_src/engine/ps2/timer-h.gc index 6bd12f5c86..ddddcabf08 100644 --- a/goal_src/engine/ps2/timer-h.gc +++ b/goal_src/engine/ps2/timer-h.gc @@ -6,12 +6,41 @@ ;; dgos: GAME, ENGINE -;; The Emotion Engine has 4 hardware timers. +;; There are two sources for timing: +;; - EE TIMER1, used for the frame profiler. There are 9765 counts of this per frame. It gets reset in drawable. +;; - The "stopwatch" system, used for reading the CPU clock cycle counter, at 300 MHz (32-bit) + +;; The Emotion Engine has 4 hardware timers, timer1 is used as the (defconstant TIMER0_BANK #x10000000) ;; has HOLD register! (defconstant TIMER1_BANK #x10000800) ;; has HOLD register! (defconstant TIMER2_BANK #x10001000) ;; does NOT have HOLD register! (defconstant TIMER3_BANK #x10001800) ;; does NOT have HOLD register! + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PC Port Timer +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defmacro get-cpu-clock () + "Read the 300 MHz clock." + ;; __read-ee-timer is a 300 MHz timer from the C Kernel. + ;; it's a real timer. + `(the uint (logand #xffffffff (__read-ee-timer))) + ) + +(defmacro get-bus-clock/256 () + "Read the 150 MHz / 256 clock." + ;; 300 MHz / (2^9) + `(the uint (logand #xffffffff (shr (__read-ee-timer) 9))) + ) + +(#when PC_PORT + ;; the bus clock can be reset, which just stores the current count here. + (define *timer-reset-value* (the uint 0)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Timer HW +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defenum timer-clock-selection :type uint8 (busclk 0) @@ -66,6 +95,8 @@ ) ;; stopwatches are used to measure CPU clock cycles +;; they don't use the timer above, but instead the Count COP0 register +;; which counts CPU clock cycles directly (deftype stopwatch (basic) ((prev-time-elapsed uint64 :offset-assert 8) (start-time uint64 :offset-assert 16) @@ -77,6 +108,7 @@ ) ;; Confusing! What IS this measuring exactly? Hmm... +;; this is set by default for NTSC, it will later be changed if PAL. (define *ticks-per-frame* (/ 2500000 256)) ;; 2 500 000 / 256 = 9765 (defun timer-init ((timer timer-bank) (mode timer-mode)) @@ -88,9 +120,18 @@ ;; needs PS2 TIMER porting (#unless PC_PORT (timer-init (the-as timer-bank TIMER1_BANK) (new 'static 'timer-mode :clks (timer-clock-selection busclk/16) :cue 1)) - ) + ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Profiler +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The profiler uses the EE Timer 1 to record how long is spent in each part of the frame. +;; There is a EE and VU1 profiler. The EE profiler relies on code manually reporting how long +;; it takes to run, and the VU1 profiler uses VIF interrupts to do this automatically on +;; microprogram completion. + +;; A single thing in the profiler (deftype profile-frame (structure) ((name symbol :offset-assert 0) (time-stamp uint32 :offset-assert 4) @@ -111,6 +152,7 @@ obj ) +;; A "bar" to display all the timed events (declare-type dma-buffer basic) (deftype profile-bar (basic) ((profile-frame-count int32 :offset-assert 4) diff --git a/goal_src/engine/ps2/timer.gc b/goal_src/engine/ps2/timer.gc index 78ac37c830..329533e8d9 100644 --- a/goal_src/engine/ps2/timer.gc +++ b/goal_src/engine/ps2/timer.gc @@ -6,8 +6,21 @@ ;; dgos: GAME, ENGINE +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Timer (EE timers) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun timer-reset ((timer timer-bank)) "Reset a timer's counter to zero" + + (#when PC_PORT + ;; just store the current offset. + (if (= timer TIMER1_BANK) + (set! *timer-reset-value* (get-bus-clock/256)) + (format 0 "Unknown timer #x~X in timer-reset~%") + ) + (return (the uint 0)) + ) (.sync.l) (set! (-> timer count) 0) (.sync.l) @@ -15,6 +28,14 @@ (defun timer-count ((timer timer-bank)) "Return a timer's counter value" + + (#when PC_PORT + (when (= timer TIMER1_BANK) + (return (- (get-bus-clock/256) *timer-reset-value*)) + ) + (format 0 "Unknown timer #x~X requested.~%" timer) + ) + (.sync.l) (let ((count (-> timer count))) (.sync.l) @@ -22,12 +43,16 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Interrupt Control +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; cop0 status register "interrupt enable" flag ;; if cop0 status is needed anywhere else, move this elsewhere (defconstant COP0_STATUS_IE (the-as uint #x1)) (defun disable-irq () - "Disable all interrupts" + "Disable all interrupts. Has no effect on PC Port" (rlet ((status :class gpr :type uint)) (let ((status-mask (lognot COP0_STATUS_IE))) (.mfc0 status Status) @@ -39,7 +64,7 @@ ) (defun enable-irq () - "Enable all interrupts" + "Enable all interrupts. Has no effect on PC Port." (rlet ((status :class gpr :type uint)) (.mfc0 status Status) (logior! status COP0_STATUS_IE) @@ -49,6 +74,10 @@ ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Stopwatch (CPU clock cycle counting) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun stopwatch-init ((obj stopwatch)) "Init a stopwatch" (set! (-> obj begin-level) 0) @@ -62,6 +91,9 @@ (when (> (-> obj begin-level) 0) (let ((count 0)) (.mfc0 count Count) + (#when PC_PORT + (set! count (the int (get-cpu-clock))) + ) (set! (-> obj start-time) count) ) ) @@ -73,6 +105,9 @@ (set! (-> obj begin-level) 1) (let ((count 0)) (.mfc0 count Count) + (#when PC_PORT + (set! count (the int (get-cpu-clock))) + ) (set! (-> obj start-time) count) ) ) @@ -85,6 +120,9 @@ (let ((count 0)) (let ((count 0)) (.mfc0 count Count) ;; wrong register? a typo in a rlet? who knows. + (#when PC_PORT + (set! count (the int (get-cpu-clock))) + ) (+! (-> obj prev-time-elapsed) (- count (-> obj start-time))) ) ) @@ -96,6 +134,9 @@ (when (zero? (-> obj begin-level)) (let ((count 0)) (.mfc0 count Count) + (#when PC_PORT + (set! count (the int (get-cpu-clock))) + ) (set! (-> obj start-time) count) ) ) @@ -111,6 +152,10 @@ (set! (-> obj begin-level) 0) (let ((count 0)) (.mfc0 count Count) + (#when PC_PORT + (set! count (the int (get-cpu-clock))) + ) + (+! (-> obj prev-time-elapsed) (- count (-> obj start-time))) ) ) @@ -122,6 +167,10 @@ (when (> (-> obj begin-level) 0) (let ((count (the uint 0))) (.mfc0 count Count) + (#when PC_PORT + (set! count (get-cpu-clock)) + ) + (+! elapsed (- count (-> obj start-time))) (set! count elapsed) ;; ?? ) diff --git a/goal_src/engine/sound/gsound-h.gc b/goal_src/engine/sound/gsound-h.gc index 8465497a0d..d80207afdf 100644 --- a/goal_src/engine/sound/gsound-h.gc +++ b/goal_src/engine/sound/gsound-h.gc @@ -6,7 +6,8 @@ ;; dgos: GAME, ENGINE ;; Type definitions for sound. -;; The actual sound code is all on the IOP, and the EE can send RPCs to control. +;; Sound is handled on the IOP, a separate processor. +;; The EE sends commands using the IOP RPC system to the OVERLORD IOP driver telling it to load and play sounds. ;; There is also some sort of per-frame status update, that is not included here. (deftype sound-id (uint32) @@ -23,6 +24,7 @@ ) ;; Sound names were sometimes packed into a uint128 +;; this is also used for dgo names sent to the IOP. ;; fields added by us (deftype sound-name (uint128) ((lo uint64 :offset 0) @@ -52,6 +54,7 @@ ) ) +;; command types that can be sent to the IOP. (defenum sound-command :type uint16 (load-bank) @@ -78,8 +81,9 @@ (list-sounds) (unload-music) ) + ;; like should match the sound type in OVERLORD -;; This is shared between all sound RPCs. +;; This is shared between all sound RPCs and acts like the header for the sound messages (deftype sound-rpc-cmd (structure) ((rsvd1 uint16 :offset-assert 0) (command sound-command :offset-assert 2) diff --git a/goal_src/engine/ui/text-h.gc b/goal_src/engine/ui/text-h.gc index 31a63a6661..cb588379e6 100644 --- a/goal_src/engine/ui/text-h.gc +++ b/goal_src/engine/ui/text-h.gc @@ -13,6 +13,7 @@ :type uint32 :bitfield #f (zero 0) + (pause #x109) (sfx-volume #x10a) (music-volume #x10b) (speech-volume #x10c) diff --git a/goal_src/engine/util/types-h.gc b/goal_src/engine/util/types-h.gc index 2472765ee8..e63366bfc0 100644 --- a/goal_src/engine/util/types-h.gc +++ b/goal_src/engine/util/types-h.gc @@ -103,6 +103,7 @@ ;; set to #t to get lots of prints during loading (defglobalconstant DEBUG_LOAD #t) +(defglobalconstant DEBUG_TEX #t) (defmacro load-dbg (fmt-str &rest args) (if DEBUG_LOAD @@ -110,3 +111,10 @@ '(empty) ) ) + +(defmacro tex-dbg (fmt-str &rest args) + (if DEBUG_TEX + `(format 0 ,(string-append "[TEX] " fmt-str) ,@args) + '(empty) + ) + ) diff --git a/goal_src/kernel-defs.gc b/goal_src/kernel-defs.gc index 31c40b915a..40a14b706b 100644 --- a/goal_src/kernel-defs.gc +++ b/goal_src/kernel-defs.gc @@ -176,6 +176,10 @@ ;; *kernel-boot-mode* ;; *kernel-boot-level* +;; PC Port functions +(define-extern __read-ee-timer (function uint)) +(define-extern __mem-move (function pointer pointer uint none)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ksound - InitSoundScheme ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/goal_src/kernel/gkernel-h.gc b/goal_src/kernel/gkernel-h.gc index 0641953f22..14eb48d8fd 100644 --- a/goal_src/kernel/gkernel-h.gc +++ b/goal_src/kernel/gkernel-h.gc @@ -5,7 +5,8 @@ ;; name in dgo: gkernel-h ;; dgos: KERNEL -;; Type definitions for the GOAL Kernel. +;; Type definitions and constants for the GOAL Kernel and process pools. +;; The kernel is dispatched from a simple loop in C and runs all GOAL processes. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CONSTANTS @@ -335,7 +336,7 @@ ;; This is the parent type for any stack frame. (deftype stack-frame (basic) ((name basic :offset 4) - (next stack-frame :offset 8) ;; which way does this point? + (next stack-frame :offset 8) ;; follow this to get to the root frame, away from top. ) :size-assert #xc diff --git a/goal_src/kernel/gkernel.gc b/goal_src/kernel/gkernel.gc index accbefcc4d..dd5d19f21e 100644 --- a/goal_src/kernel/gkernel.gc +++ b/goal_src/kernel/gkernel.gc @@ -5,6 +5,15 @@ ;; name in dgo: gkernel ;; dgos: KERNEL +;; The GOAL kernel provides: +;; - threads/stack management +;; - processes, and the process pools +;; - actor heap compacting GC +;; - process suspend +;; - executing the listener function and printing the result in the REPL +;; - catch/throw and stack frame utilities for the state system +;; - package loading (mostly unused loading system separate from levels) + ;; Fwd (define-extern change-parent (function process-tree process-tree process-tree)) @@ -12,7 +21,7 @@ ;; System Globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; HACK ADDED +;; Set to #f to not use the fancy printing of results (define *use-old-listener-print* #f) ;; Set version number symbols diff --git a/goal_src/kernel/gstring-h.gc b/goal_src/kernel/gstring-h.gc index 5061a84181..7947bd7c30 100644 --- a/goal_src/kernel/gstring-h.gc +++ b/goal_src/kernel/gstring-h.gc @@ -5,11 +5,11 @@ ;; name in dgo: gstring-h ;; dgos: KERNEL -;; generates no code. +;; generates no code, see gstring.gc for the string implementation. (define-extern *string-tmp-str* string) (define-extern *temp-string* string) (define-extern *stdcon0* string) (define-extern *stdcon1* string) (define-extern *stdcon* string) -(define-extern *debug-draw-pauseable* symbol) \ No newline at end of file +(define-extern *debug-draw-pauseable* symbol) diff --git a/goal_src/levels/common/texture-upload.gc b/goal_src/levels/common/texture-upload.gc index 02398732d5..2a2efb37ed 100644 --- a/goal_src/levels/common/texture-upload.gc +++ b/goal_src/levels/common/texture-upload.gc @@ -5,3 +5,32 @@ ;; name in dgo: texture-upload ;; dgos: GAME, ART +;; This will happen part way through the list of tpages + +;; we already got the font texture, so set that up. +;; NOTE: I added this check so you can load the engine without the font texture. +(cond + ((and *texture-page-dir* (lookup-texture-by-id (new 'static 'texture-id :index #x1 :page #x4fe))) + (setup-font-texture! *texture-pool*) + ;; Load some textures + (define *shadow-middot-texture* (lookup-texture-by-id (new 'static 'texture-id :index #x4 :page #x2))) + ;; not sure what's going on here, this isn't a valid texture ID. It ends up ignoring the 0x14 in the lower + ;; bits, and just gets you the 0th texture in the environment-generic texture page. + (define *generic-envmap-texture* (lookup-texture-by-id (the-as texture-id #x10000014))) + (define *ocean-texture* (lookup-texture-by-id (new 'static 'texture-id :page #x370))) + ) + (else + (format 0 "NOTE: skipped texture setup in texture-upload.gc, textures were not loaded.~%") + (set! *shadow-middot-texture* #f) + (set! *generic-envmap-texture* #f) + (set! *ocean-texture* #f) + ) + ) + + + +;; the next texture we're going to load is the HUD for the start menu, which shouldn't +;; be allocated with the default allocator. So for now we can set it to common-boot, which +;; will place this in common, then disable itself once it encounters another normal texture +(set! (-> *texture-pool* allocate-func) texture-page-common-boot-allocate) + diff --git a/test/decompiler/reference/engine/debug/memory-usage-h_REF.gc b/test/decompiler/reference/engine/debug/memory-usage-h_REF.gc index 5f4f4b6cc9..0d18e9d7d1 100644 --- a/test/decompiler/reference/engine/debug/memory-usage-h_REF.gc +++ b/test/decompiler/reference/engine/debug/memory-usage-h_REF.gc @@ -37,7 +37,7 @@ (:methods (reset! (_type_) _type_ 9) (calculate-total (_type_) int 10) - (dummy-11 () none 11) + (print-mem-usage (_type_ level object) none 11) ) ) @@ -56,7 +56,7 @@ ;; definition for symbol *dma-mem-usage*, type memory-usage-block (define *dma-mem-usage* (new 'debug 'memory-usage-block)) -;; definition for symbol *temp-mem-usage*, type symbol -(define *temp-mem-usage* #f) +;; definition for symbol *temp-mem-usage*, type memory-usage-block +(define *temp-mem-usage* (the-as memory-usage-block #f)) ) diff --git a/test/decompiler/reference/engine/debug/stats-h_REF.gc b/test/decompiler/reference/engine/debug/stats-h_REF.gc index 37df742eaa..acc3b408e0 100644 --- a/test/decompiler/reference/engine/debug/stats-h_REF.gc +++ b/test/decompiler/reference/engine/debug/stats-h_REF.gc @@ -94,7 +94,8 @@ ;; definition of type perf-stat-array (deftype perf-stat-array (inline-array-class) - () + ((data perf-stat :inline :dynamic :offset-assert 16) + ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 @@ -105,7 +106,7 @@ (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tlength: ~D~%" (-> obj length)) (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) - (format #t "~Tdata[0] @ #x~X~%" (-> obj _data)) + (format #t "~Tdata[0] @ #x~X~%" (-> obj data)) obj ) diff --git a/test/decompiler/reference/engine/entity/actor-link-h_REF.gc b/test/decompiler/reference/engine/entity/actor-link-h_REF.gc index 6356d109c1..70c11e851e 100644 --- a/test/decompiler/reference/engine/entity/actor-link-h_REF.gc +++ b/test/decompiler/reference/engine/entity/actor-link-h_REF.gc @@ -241,20 +241,21 @@ ;; definition for method 23 of type actor-link-info ;; INFO: Return type mismatch int vs none. (defmethod send-to-next actor-link-info ((obj actor-link-info) (arg0 object)) - (with-pp (let ((a0-1 (-> obj next))) - (when a0-1 - (let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process))) - (when a0-2 - (let ((v1-4 (new 'stack-no-clear 'event-message-block))) - (set! (-> v1-4 from) pp) - (set! (-> v1-4 num-params) 0) - (set! (-> v1-4 message) (the-as basic arg0)) - (send-event-function a0-2 v1-4) - ) - ) - ) - ) - ) + (with-pp + (let ((a0-1 (-> obj next))) + (when a0-1 + (let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process))) + (when a0-2 + (let ((v1-4 (new 'stack-no-clear 'event-message-block))) + (set! (-> v1-4 from) pp) + (set! (-> v1-4 num-params) 0) + (set! (-> v1-4 message) (the-as basic arg0)) + (send-event-function a0-2 v1-4) + ) + ) + ) + ) + ) 0 (none) ) @@ -263,20 +264,21 @@ ;; definition for method 24 of type actor-link-info ;; INFO: Return type mismatch int vs none. (defmethod send-to-prev actor-link-info ((obj actor-link-info) (arg0 object)) - (with-pp (let ((a0-1 (-> obj prev))) - (when a0-1 - (let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process))) - (when a0-2 - (let ((v1-4 (new 'stack-no-clear 'event-message-block))) - (set! (-> v1-4 from) pp) - (set! (-> v1-4 num-params) 0) - (set! (-> v1-4 message) (the-as basic arg0)) - (send-event-function a0-2 v1-4) - ) - ) - ) - ) - ) + (with-pp + (let ((a0-1 (-> obj prev))) + (when a0-1 + (let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process))) + (when a0-2 + (let ((v1-4 (new 'stack-no-clear 'event-message-block))) + (set! (-> v1-4 from) pp) + (set! (-> v1-4 num-params) 0) + (set! (-> v1-4 message) (the-as basic arg0)) + (send-event-function a0-2 v1-4) + ) + ) + ) + ) + ) 0 (none) ) diff --git a/test/decompiler/reference/engine/game/task/task-control_REF.gc b/test/decompiler/reference/engine/game/task/task-control_REF.gc index 0a5d692d90..99414d8600 100644 --- a/test/decompiler/reference/engine/game/task/task-control_REF.gc +++ b/test/decompiler/reference/engine/game/task/task-control_REF.gc @@ -365,8 +365,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (or (closed? arg0 (game-task jungle-eggtop) (task-status need-reminder)) @@ -398,8 +397,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (or (closed? arg0 (game-task jungle-eggtop) (task-status need-reminder)) @@ -452,8 +450,7 @@ :status (task-status unknown) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (task-closed? (game-task village4-button) (task-status need-reward-speech) @@ -522,16 +519,16 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) - (with-pp (let ((a1-0 (new 'stack-no-clear 'event-message-block))) - (set! (-> a1-0 from) pp) - (set! (-> a1-0 num-params) 2) - (set! (-> a1-0 message) 'query) - (set! (-> a1-0 param 0) (the-as uint 'pickup)) - (set! (-> a1-0 param 1) (the-as uint 6)) - (>= (the int (send-event-function *target* a1-0)) 45) - ) + (lambda ((arg0 task-control)) + (with-pp + (let ((a1-0 (new 'stack-no-clear 'event-message-block))) + (set! (-> a1-0 from) pp) + (set! (-> a1-0 num-params) 2) + (set! (-> a1-0 message) 'query) + (set! (-> a1-0 param 0) (the-as uint 'pickup)) + (set! (-> a1-0 param 1) (the-as uint 6)) + (>= (the int (send-event-function *target* a1-0)) 45) + ) ) ) ) @@ -555,8 +552,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (and (task-closed? (game-task beach-flutflut) (task-status need-reminder)) @@ -587,8 +583,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (and (task-closed? (game-task beach-flutflut) (task-status need-reminder)) @@ -619,8 +614,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (if (task-closed? (game-task beach-flutflut) (task-status need-reminder)) (or @@ -671,8 +665,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (if (task-closed? (game-task beach-flutflut) (task-status need-reminder)) (or @@ -732,8 +725,7 @@ :game-task (game-task swamp-flutflut) :status (task-status unknown) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (task-closed? (game-task beach-flutflut) (task-status need-reminder)) ) ) @@ -742,8 +734,7 @@ :status (task-status need-reminder) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (task-closed? (game-task beach-flutflut) (task-status need-reminder)) ) ) @@ -833,8 +824,7 @@ :status (task-status need-resolution) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-race) (task-status need-reward-speech)) ) ) @@ -843,8 +833,7 @@ :status (task-status need-resolution) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task village2-gambler-money) @@ -857,8 +846,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-race) (task-status need-reminder)) ) ) @@ -867,8 +855,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -899,8 +886,7 @@ :status (task-status need-reminder) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-race) (task-status need-introduction)) ) ) @@ -908,8 +894,7 @@ :game-task (game-task village2-gambler-money) :status (task-status need-reminder) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-race) (task-status need-introduction)) ) ) @@ -960,8 +945,7 @@ :status (task-status need-resolution) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-moles) (task-status need-reward-speech)) ) ) @@ -970,8 +954,7 @@ :status (task-status need-resolution) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task village2-geologist-money) @@ -984,8 +967,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-moles) (task-status need-reminder)) ) ) @@ -994,8 +976,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1026,8 +1007,7 @@ :status (task-status need-reminder) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-moles) (task-status need-introduction)) ) ) @@ -1035,8 +1015,7 @@ :game-task (game-task village2-geologist-money) :status (task-status need-reminder) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task rolling-moles) (task-status need-introduction)) ) ) @@ -1087,8 +1066,7 @@ :status (task-status need-resolution) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task jungle-lurkerm) (task-status need-reward-speech)) ) ) @@ -1097,8 +1075,7 @@ :status (task-status need-resolution) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task village1-mayor-money) @@ -1111,8 +1088,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task jungle-lurkerm) (task-status need-reminder)) ) ) @@ -1121,8 +1097,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1153,8 +1128,7 @@ :status (task-status need-reminder-a) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task jungle-lurkerm) (task-status need-introduction)) ) ) @@ -1163,8 +1137,7 @@ :status (task-status need-reminder) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task jungle-lurkerm) (task-status need-introduction)) ) ) @@ -1172,8 +1145,7 @@ :game-task (game-task village1-mayor-money) :status (task-status need-reminder) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (closed? arg0 (game-task jungle-lurkerm) (task-status need-introduction)) ) ) @@ -1229,8 +1201,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? arg0 (game-task beach-ecorocks) (task-status need-reminder)) @@ -1262,8 +1233,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? arg0 (game-task beach-ecorocks) (task-status need-reminder)) @@ -1310,8 +1280,7 @@ :status (task-status unknown) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (task-closed? (game-task village4-button) (task-status need-reward-speech) @@ -1369,8 +1338,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? arg0 (game-task rolling-plants) (task-status need-reminder)) @@ -1402,8 +1370,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? arg0 (game-task rolling-plants) (task-status need-reminder)) @@ -1509,8 +1476,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1552,8 +1518,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1637,8 +1602,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1680,8 +1644,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1765,8 +1728,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1808,8 +1770,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1921,8 +1882,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1953,8 +1913,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -1985,8 +1944,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -2017,8 +1975,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -2050,8 +2007,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? @@ -2087,8 +2043,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? @@ -2124,8 +2079,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? arg0 (game-task cave-gnawers) (task-status need-reminder)) @@ -2153,8 +2107,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? arg0 (game-task cave-gnawers) (task-status need-reminder)) @@ -2335,8 +2288,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? @@ -2372,8 +2324,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control) (arg1 task-control)) + (lambda ((arg0 task-control) (arg1 task-control)) (with-pp (or (closed? @@ -2861,8 +2812,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -3388,8 +3338,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (and (not (task-closed? (game-task ogre-boss) (task-status need-reminder))) (not @@ -3407,8 +3356,7 @@ :flags (task-flags has-entity closed-by-default) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (and (not (task-closed? (game-task ogre-boss) (task-status need-reminder))) (not @@ -3425,8 +3373,7 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (with-pp (the-as symbol @@ -5122,16 +5069,16 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) - (with-pp (let ((a1-0 (new 'stack-no-clear 'event-message-block))) - (set! (-> a1-0 from) pp) - (set! (-> a1-0 num-params) 2) - (set! (-> a1-0 message) 'query) - (set! (-> a1-0 param 0) (the-as uint 'pickup)) - (set! (-> a1-0 param 1) (the-as uint 6)) - (>= (the int (send-event-function *target* a1-0)) 20) - ) + (lambda ((arg0 task-control)) + (with-pp + (let ((a1-0 (new 'stack-no-clear 'event-message-block))) + (set! (-> a1-0 from) pp) + (set! (-> a1-0 num-params) 2) + (set! (-> a1-0 message) 'query) + (set! (-> a1-0 param 0) (the-as uint 'pickup)) + (set! (-> a1-0 param 1) (the-as uint 6)) + (>= (the int (send-event-function *target* a1-0)) 20) + ) ) ) ) @@ -5227,16 +5174,16 @@ :status (task-status need-reward-speech) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) - (with-pp (let ((a1-0 (new 'stack-no-clear 'event-message-block))) - (set! (-> a1-0 from) pp) - (set! (-> a1-0 num-params) 2) - (set! (-> a1-0 message) 'query) - (set! (-> a1-0 param 0) (the-as uint 'pickup)) - (set! (-> a1-0 param 1) (the-as uint 6)) - (>= (the int (send-event-function *target* a1-0)) 72) - ) + (lambda ((arg0 task-control)) + (with-pp + (let ((a1-0 (new 'stack-no-clear 'event-message-block))) + (set! (-> a1-0 from) pp) + (set! (-> a1-0 num-params) 2) + (set! (-> a1-0 message) 'query) + (set! (-> a1-0 param 0) (the-as uint 'pickup)) + (set! (-> a1-0 param 1) (the-as uint 6)) + (>= (the int (send-event-function *target* a1-0)) 72) + ) ) ) ) @@ -5406,8 +5353,7 @@ :status (task-status unknown) :flags (task-flags has-entity) :condition - (lambda - ((arg0 task-control)) + (lambda ((arg0 task-control)) (task-closed? (game-task village4-button) (task-status need-reward-speech) diff --git a/test/decompiler/reference/engine/gfx/hw/display-h_REF.gc b/test/decompiler/reference/engine/gfx/hw/display-h_REF.gc index 87a777de20..d819fa94a2 100644 --- a/test/decompiler/reference/engine/gfx/hw/display-h_REF.gc +++ b/test/decompiler/reference/engine/gfx/hw/display-h_REF.gc @@ -341,8 +341,8 @@ ;; definition for symbol *pre-draw-hook*, type (function none) (define *pre-draw-hook* nothing) -;; definition for symbol *post-draw-hook*, type (function none) -(define *post-draw-hook* nothing) +;; definition for symbol *post-draw-hook*, type (function dma-buffer none) +(define *post-draw-hook* (the-as (function dma-buffer none) nothing)) ;; failed to figure out what this is: 0 diff --git a/test/decompiler/reference/engine/gfx/texture-h_REF.gc b/test/decompiler/reference/engine/gfx/texture-h_REF.gc index 54ec916406..a4a6cff202 100644 --- a/test/decompiler/reference/engine/gfx/texture-h_REF.gc +++ b/test/decompiler/reference/engine/gfx/texture-h_REF.gc @@ -64,7 +64,7 @@ (new (symbol type) _type_ 0) (initialize! (_type_) _type_ 9) (print-usage (_type_) _type_ 10) - (dummy-11 (_type_) none 11) + (setup-font-texture! (_type_) none 11) (allocate-defaults! (_type_) none 12) (login-level-textures (_type_ level int (pointer texture-id)) none 13) (add-tex-to-dma! (_type_ level int) none 14) @@ -73,7 +73,7 @@ (dummy-17 () none 17) (dummy-18 () none 18) (dummy-19 () none 19) - (dummy-20 (_type_ texture-page) int 20) + (unload! (_type_ texture-page) int 20) (upload-one-common! (_type_) symbol 21) (lookup-boot-common-id (_type_ int) int 22) ) @@ -106,7 +106,9 @@ ;; definition of type texture (deftype texture (basic) ((w int16 :offset-assert 4) + (wu uint16 :offset 4) (h int16 :offset-assert 6) + (hu uint16 :offset 6) (num-mips uint8 :offset-assert 8) (tex1-control uint8 :offset-assert 9) (psm gs-psm :offset-assert 10) @@ -176,7 +178,7 @@ ;; definition of type texture-page (deftype texture-page (basic) - ((info basic :offset-assert 4) + ((info file-info :offset-assert 4) (name basic :offset-assert 8) (id uint32 :offset-assert 12) (length int32 :offset-assert 16) @@ -195,7 +197,7 @@ (get-leftover-block-count (_type_ int int) int 10) (dummy-11 () none 11) (relocate-dests! (_type_ int int) none 12) - (add-to-dma-buffer (_type_ dma-buffer int) none 13) + (add-to-dma-buffer (_type_ dma-buffer int) int 13) (upload-now! (_type_ int) none 14) ) ) @@ -273,7 +275,7 @@ :flag-assert #xa00000014 (:methods (relocate (_type_ kheap (pointer uint8)) none :replace 7) - (dummy-9 (_type_ kheap) int 9) + (unlink-textures-in-heap! (_type_ kheap) int 9) ) ) @@ -314,17 +316,17 @@ ;; definition of type adgif-shader (deftype adgif-shader (structure) - ((quad qword 5 :inline :offset 0) - (prims uint64 10 :offset 0) - (tex0 uint64 :offset 0) - (tex1 uint64 :offset 16) - (miptbp1 uint64 :offset 32) - (clamp uint64 :offset 48) - (clamp-reg uint64 :offset 56) - (alpha uint64 :offset 64) - (link-test uint32 :offset 8) - (texture-id uint32 :offset 24) - (next shader-ptr :offset 40) + ((quad qword 5 :inline :offset 0) + (prims gs-reg64 10 :offset 0) + (tex0 gs-tex0 :offset 0) + (tex1 gs-tex1 :offset 16) + (miptbp1 gs-miptbp :offset 32) + (clamp gs-clamp :offset 48) + (clamp-reg gs-reg64 :offset 56) + (alpha gs-miptbp :offset 64) + (link-test link-test-flags :offset 8) + (texture-id texture-id :offset 24) + (next shader-ptr :offset 40) ) :method-count-assert 9 :size-assert #x50 @@ -334,8 +336,8 @@ ;; definition for method 3 of type adgif-shader (defmethod inspect adgif-shader ((obj adgif-shader)) (format #t "[~8x] ~A~%" obj 'adgif-shader) - (format #t "~Tquad[5] @ #x~X~%" (-> obj quad)) - (format #t "~Tprims[10] @ #x~X~%" (-> obj quad)) + (format #t "~Tquad[5] @ #x~X~%" (&-> obj tex0)) + (format #t "~Tprims[10] @ #x~X~%" (&-> obj tex0)) (format #t "~Ttex0: #x~X~%" (-> obj tex0)) (format #t "~Ttex1: #x~X~%" (-> obj tex1)) (format #t "~Tmiptbp1: #x~X~%" (-> obj miptbp1)) diff --git a/test/decompiler/reference/engine/gfx/texture_REF.gc b/test/decompiler/reference/engine/gfx/texture_REF.gc new file mode 100644 index 0000000000..131469eb94 --- /dev/null +++ b/test/decompiler/reference/engine/gfx/texture_REF.gc @@ -0,0 +1,3712 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for method 2 of type texture-page +(defmethod print texture-page ((obj texture-page)) + (format + #t + "#" + (-> obj name) + (-> obj length) + (shr (-> obj segment 0 dest) 6) + (shr (-> obj size) 8) + obj + ) + obj + ) + +;; definition for method 4 of type texture-page +(defmethod length texture-page ((obj texture-page)) + (-> obj length) + ) + +;; definition for method 5 of type texture-page +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of texture-page ((obj texture-page)) + (the-as int (+ (-> obj type size) (the-as uint (* (-> obj length) 4)))) + ) + +;; definition for method 8 of type texture-page +(defmethod + mem-usage + texture-page + ((obj texture-page) (arg0 memory-usage-block) (arg1 int)) + (set! (-> arg0 length) (max 80 (-> arg0 length))) + (set! (-> arg0 data 79 name) "texture") + (set! (-> arg0 data 79 count) (+ (-> arg0 data 79 count) (-> obj length))) + (let ((v1-7 (- (asize-of obj) (the-as int (* (-> obj size) 4))))) + (dotimes (a0-6 (-> obj length)) + (if (-> obj data a0-6) + (+! v1-7 64) + ) + ) + (set! (-> arg0 data 79 used) (+ (-> arg0 data 79 used) v1-7)) + (set! + (-> arg0 data 79 total) + (+ (-> arg0 data 79 total) (logand -16 (+ v1-7 15))) + ) + ) + obj + ) + +;; definition for function texture-bpp +(defun texture-bpp ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (cond + ((= v1-0 (gs-psm mt8)) + 8 + ) + ((= v1-0 (gs-psm mt4)) + 4 + ) + (else + (if + (or + (= v1-0 (gs-psm ct16)) + (= v1-0 (gs-psm ct16s)) + (= v1-0 (gs-psm mz16)) + (= v1-0 (gs-psm mz16s)) + ) + 16 + 32 + ) + ) + ) + ) + ) + +;; definition for function texture-qwc +(defun texture-qwc ((w int) (h int) (tex-format gs-psm)) + (let ((v1-0 (texture-bpp tex-format))) + (/ (+ (* (* w h) v1-0) 127) 128) + ) + ) + +;; definition for function physical-address +(defun physical-address ((arg0 pointer)) + (logand #xfffffff arg0) + ) + +;; definition for function dma-buffer-add-ref-texture +;; INFO: Return type mismatch symbol vs none. +(defun + dma-buffer-add-ref-texture + ((buf dma-buffer) (data pointer) (tex-w int) (tex-h int) (tex-format gs-psm)) + (let ((data-ptr (physical-address data)) + (qwc (texture-qwc tex-w tex-h tex-format)) + ) + (while (> qwc 0) + (let ((qwc-this-time (min #x7fff qwc))) + (let ((eop (if (= qwc qwc-this-time) + 1 + 0 + ) + ) + ) + (let* ((a2-2 buf) + (setup-dma (the-as dma-packet (-> a2-2 base))) + ) + (set! + (-> setup-dma dma) + (new 'static 'dma-tag :qwc #x1 :id (dma-tag-id cnt)) + ) + (set! (-> setup-dma vif0) (new 'static 'vif-tag)) + (set! + (-> setup-dma vif1) + (new 'static 'vif-tag :imm #x1 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> a2-2 base) (&+ (the-as pointer setup-dma) 16)) + ) + (let* ((a2-3 buf) + (setup-dif (the-as gs-gif-tag (-> a2-3 base))) + ) + (set! + (-> setup-dif tag) + (new 'static 'gif-tag64 :flg #x2 :eop eop :nloop qwc-this-time) + ) + (set! (-> setup-dif regs) (new 'static 'gif-tag-regs)) + (set! (-> a2-3 base) (&+ (the-as pointer setup-dif) 16)) + ) + ) + (let* ((a1-9 buf) + (data-dma (the-as dma-packet (-> a1-9 base))) + ) + (set! + (-> data-dma dma) + (new 'static 'dma-tag + :id (dma-tag-id ref) + :addr (the-as int data-ptr) + :qwc qwc-this-time + ) + ) + (set! (-> data-dma vif0) (new 'static 'vif-tag)) + (set! + (-> data-dma vif1) + (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1 :imm qwc-this-time) + ) + (set! (-> a1-9 base) (&+ (the-as pointer data-dma) 16)) + ) + (&+! data-ptr (* qwc-this-time 16)) + (set! qwc (- qwc qwc-this-time)) + ) + ) + ) + (none) + ) + +;; definition for method 2 of type texture +(defmethod print texture ((obj texture)) + (format + #t + "# obj name) + (psm->string (-> obj psm)) + (-> obj w) + (-> obj h) + (-> obj num-mips) + (shr (-> obj size) 8) + ) + (dotimes (s5-1 (the-as int (-> obj num-mips))) + (format #t " #x~X/~X" (-> obj dest s5-1) (-> obj width s5-1)) + ) + (if (< (texture-bpp (-> obj psm)) 16) + (format #t " :clut #x~X/1" (-> obj clutdest)) + ) + (format #t " @ #x~X>" obj) + obj + ) + +;; definition for symbol ct32-24-block-table, type (array int32) +(define + ct32-24-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 0 + 1 + 4 + 5 + 16 + 17 + 20 + 21 + 2 + 3 + 6 + 7 + 18 + 19 + 22 + 23 + 8 + 9 + 12 + 13 + 24 + 25 + 28 + 29 + 10 + 11 + 14 + 15 + 26 + 27 + 30 + 31 + ) + ) + ) + +;; definition for symbol mz32-24-block-table, type (array int32) +(define + mz32-24-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 16 + 17 + 20 + 21 + 0 + 1 + 4 + 5 + 18 + 19 + 22 + 23 + 2 + 3 + 6 + 7 + 24 + 25 + 28 + 29 + 8 + 9 + 12 + 13 + 26 + 27 + 30 + 31 + 10 + 11 + 14 + 15 + ) + ) + ) + +;; definition for symbol ct16-block-table, type (array int32) +(define + ct16-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 0 + 2 + 8 + 10 + 1 + 3 + 9 + 11 + 4 + 6 + 12 + 14 + 5 + 7 + 13 + 15 + 16 + 18 + 24 + 26 + 17 + 19 + 25 + 27 + 20 + 22 + 28 + 30 + 21 + 23 + 29 + 31 + ) + ) + ) + +;; definition for symbol ct16s-block-table, type (array int32) +(define + ct16s-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 0 + 2 + 16 + 18 + 1 + 3 + 17 + 19 + 8 + 10 + 24 + 26 + 9 + 11 + 25 + 27 + 4 + 6 + 20 + 22 + 5 + 7 + 21 + 23 + 12 + 14 + 28 + 30 + 13 + 15 + 29 + 31 + ) + ) + ) + +;; definition for symbol mz16-block-table, type (array int32) +(define + mz16-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 16 + 18 + 24 + 26 + 17 + 19 + 25 + 27 + 20 + 22 + 28 + 30 + 21 + 23 + 29 + 31 + 0 + 2 + 8 + 10 + 1 + 3 + 9 + 11 + 4 + 6 + 12 + 14 + 5 + 7 + 13 + 15 + ) + ) + ) + +;; definition for symbol mz16s-block-table, type (array int32) +(define + mz16s-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 16 + 18 + 0 + 2 + 17 + 19 + 1 + 3 + 24 + 26 + 8 + 10 + 25 + 27 + 9 + 11 + 20 + 22 + 4 + 6 + 21 + 23 + 5 + 7 + 28 + 30 + 12 + 14 + 29 + 31 + 13 + 15 + ) + ) + ) + +;; definition for symbol mt8-block-table, type (array int32) +(define + mt8-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 0 + 1 + 4 + 5 + 16 + 17 + 20 + 21 + 2 + 3 + 6 + 7 + 18 + 19 + 22 + 23 + 8 + 9 + 12 + 13 + 24 + 25 + 28 + 29 + 10 + 11 + 14 + 15 + 26 + 27 + 30 + 31 + ) + ) + ) + +;; definition for symbol mt4-block-table, type (array int32) +(define + mt4-block-table + (the-as (array int32) + (new + 'static + 'boxed-array + :type int32 :length 32 :allocated-length 32 + 0 + 2 + 8 + 10 + 1 + 3 + 9 + 11 + 4 + 6 + 12 + 14 + 5 + 7 + 13 + 15 + 16 + 18 + 24 + 26 + 17 + 19 + 25 + 27 + 20 + 22 + 28 + 30 + 21 + 23 + 29 + 31 + ) + ) + ) + +;; definition for function gs-find-block +(defun gs-find-block ((bx int) (by int) (tex-format gs-psm)) + (cond + ((= tex-format (gs-psm ct32)) + (-> ct32-24-block-table (+ bx (* by 8))) + ) + ((= tex-format (gs-psm ct24)) + (-> ct32-24-block-table (+ bx (* by 8))) + ) + ((= tex-format (gs-psm ct16)) + (-> ct16-block-table (+ bx (* by 4))) + ) + ((= tex-format (gs-psm ct16s)) + (-> ct16s-block-table (+ bx (* by 4))) + ) + ((= tex-format (gs-psm mz32)) + (-> mz32-24-block-table (+ bx (* by 8))) + ) + ((= tex-format (gs-psm mz24)) + (-> mz32-24-block-table (+ bx (* by 8))) + ) + ((= tex-format (gs-psm mz16)) + (-> mz16-block-table (+ bx (* by 4))) + ) + ((= tex-format (gs-psm mz16s)) + (-> mz16s-block-table (+ bx (* by 4))) + ) + ((= tex-format (gs-psm mt8)) + (-> mt8-block-table (+ bx (* by 8))) + ) + ((= tex-format (gs-psm mt4)) + (-> mt4-block-table (+ bx (* by 4))) + ) + (else + 0 + ) + ) + ) + +;; definition for function gs-page-width +(defun gs-page-width ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (cond + ((or + (= v1-0 (gs-psm ct32)) + (= v1-0 (gs-psm ct24)) + (= v1-0 (gs-psm ct16)) + (= v1-0 (gs-psm ct16s)) + ) + 64 + ) + (else + (cond + ((or (= v1-0 (gs-psm mt8)) (= v1-0 (gs-psm mt4))) + 128 + ) + (else + (format #t "Warning: Unknown block width for psm ~D~%" arg0) + 1 + ) + ) + ) + ) + ) + ) + +;; definition for function gs-page-height +(defun gs-page-height ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (cond + ((or (= v1-0 (gs-psm ct32)) (= v1-0 (gs-psm ct24))) + 32 + ) + (else + (cond + ((or (= v1-0 (gs-psm ct16)) (= v1-0 (gs-psm ct16s))) + 64 + ) + ((= v1-0 (gs-psm mt8)) + 64 + ) + ((= v1-0 (gs-psm mt4)) + 128 + ) + (else + (format #t "Warning: Unknown block width for psm ~D~%" arg0) + 1 + ) + ) + ) + ) + ) + ) + +;; definition for function gs-block-width +(defun gs-block-width ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (cond + ((or (= v1-0 (gs-psm ct32)) (= v1-0 (gs-psm ct24))) + 8 + ) + (else + (cond + ((or (= v1-0 (gs-psm ct16)) (= v1-0 (gs-psm ct16s)) (= v1-0 (gs-psm mt8))) + 16 + ) + ((= v1-0 (gs-psm mt4)) + 32 + ) + (else + (format #t "Warning: Unknown block width for psm ~D~%" arg0) + 1 + ) + ) + ) + ) + ) + ) + +;; definition for function gs-block-height +(defun gs-block-height ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (cond + ((or + (= v1-0 (gs-psm ct32)) + (= v1-0 (gs-psm ct24)) + (= v1-0 (gs-psm ct16)) + (= v1-0 (gs-psm ct16s)) + ) + 8 + ) + (else + (cond + ((or (= v1-0 (gs-psm mt8)) (= v1-0 (gs-psm mt4))) + 16 + ) + (else + (format #t "Warning: Unknown block width for psm ~D~%" arg0) + 1 + ) + ) + ) + ) + ) + ) + +;; definition for function gs-largest-block +(defun gs-largest-block ((tex-width int) (tex-height int) (tex-format gs-psm)) + (let* ((block-width (gs-block-width tex-format)) + (block-height (gs-block-height tex-format)) + (real-width + (* (/ (+ (+ block-width -1) tex-width) block-width) block-width) + ) + (real-height + (* (/ (+ (+ block-height -1) tex-height) block-height) block-height) + ) + (width-blocks (/ real-width block-width)) + (height-blocks (/ real-height block-height)) + (max-block 0) + ) + (dotimes (x width-blocks) + (dotimes (y height-blocks) + (set! max-block (max max-block (gs-find-block x y tex-format))) + ) + ) + max-block + ) + ) + +;; definition for function gs-blocks-used +(defun gs-blocks-used ((tex-width int) (tex-height int) (tex-format gs-psm)) + (let* ((page-width (gs-page-width tex-format)) + (page-height (gs-page-height tex-format)) + (real-width + (* (/ (+ (+ page-width -1) tex-width) page-width) page-width) + ) + (real-height + (* (/ (+ (+ page-height -1) tex-height) page-height) page-height) + ) + (width-blocks (/ real-width page-width)) + (height-blocks (/ real-height page-height)) + (a0-9 (- tex-width (* (+ width-blocks -1) page-width))) + (a1-7 (- tex-height (* (+ height-blocks -1) page-height))) + ) + (if (or (< a0-9 page-width) (< a1-7 page-height)) + (+ + (+ (gs-largest-block a0-9 a1-7 tex-format) 1) + (* (+ (* width-blocks height-blocks) -1) 32) + ) + (* (* height-blocks width-blocks) 32) + ) + ) + ) + +;; definition for method 0 of type texture-pool +(defmethod new texture-pool ((allocation symbol) (type-to-make type)) + (initialize! + (object-new allocation type-to-make (the-as int (-> type-to-make size))) + ) + ) + +;; definition for method 15 of type texture-pool +(defmethod + allocate-vram-words! + texture-pool + ((obj texture-pool) (word-count int)) + (let ((v0-0 (-> obj cur))) + (set! (-> obj cur) (+ (-> obj cur) word-count)) + v0-0 + ) + ) + +;; definition for method 22 of type texture-pool +(defmethod lookup-boot-common-id texture-pool ((obj texture-pool) (tpage-id int)) + (let ((v1-0 tpage-id)) + (cond + ((= v1-0 1032) + 0 + ) + ((= v1-0 1119) + 1 + ) + ((= v1-0 1478) + 2 + ) + ((= v1-0 1485) + 3 + ) + ((= v1-0 1486) + 4 + ) + ((= v1-0 1487) + 5 + ) + (else + (cond + ((or (= v1-0 635) (= v1-0 1609)) + 6 + ) + ((= v1-0 636) + 7 + ) + ((= v1-0 637) + 8 + ) + ((= v1-0 752) + 9 + ) + ((= v1-0 1598) + 10 + ) + ((= v1-0 1599) + 11 + ) + ((= v1-0 1600) + 12 + ) + ((= v1-0 1601) + 13 + ) + ((= v1-0 1602) + 14 + ) + ((= v1-0 1603) + 15 + ) + ((= v1-0 1604) + 16 + ) + ((= v1-0 1605) + 17 + ) + ((= v1-0 1606) + 18 + ) + ((= v1-0 1607) + 19 + ) + (else + -1 + ) + ) + ) + ) + ) + ) + +;; definition for method 9 of type texture-pool +(defmethod initialize! texture-pool ((obj texture-pool)) + (set! (-> obj cur) 0) + (set! (-> obj top) (-> obj cur)) + (set! (-> obj allocate-func) texture-page-default-allocate) + (allocate-defaults! obj) + (set! (-> obj font-palette) (allocate-vram-words! obj 64)) + (dotimes (v1-6 32) + (set! (-> obj common-page v1-6) (the-as texture-page 0)) + ) + (set! (-> obj common-page-mask) 0) + (dotimes (v1-9 160) + (set! (-> obj ids v1-9) (the-as uint 0)) + ) + obj + ) + +;; definition for method 10 of type texture-page +(defmethod + get-leftover-block-count + texture-page + ((obj texture-page) (segment-count int) (additional-size int)) + (let ((v1-0 additional-size)) + (dotimes (a2-1 segment-count) + (+! v1-0 (the-as int (-> obj segment a2-1 size))) + ) + (logand (/ v1-0 64) 63) + ) + ) + +;; definition for method 10 of type texture-pool +(defmethod print-usage texture-pool ((obj texture-pool)) + (format #t "--------------------~%") + (format + #t + "texture pool ~DK - ~DK (~DK used, ~DK free)~%" + (/ (-> obj top) 256) + (/ (-> obj cur) 256) + (/ (- (-> obj cur) (-> obj top)) 256) + (/ (- #xfa000 (-> obj cur)) 256) + ) + (format #t "--------------------~%") + obj + ) + +;; definition for method 16 of type texture-pool +(defmethod + allocate-segment! + texture-pool + ((obj texture-pool) (segment texture-pool-segment) (size int)) + (set! (-> segment size) (the-as uint size)) + (set! (-> segment dest) (the-as uint (allocate-vram-words! obj size))) + segment + ) + +;; definition for method 12 of type texture-pool +;; INFO: Return type mismatch int vs none. +(defmethod allocate-defaults! texture-pool ((obj texture-pool)) + (allocate-segment! obj (-> obj segment-common) #x1c000) + (allocate-segment! obj (-> obj segment-near) #x62000) + (set! *sky-base-vram-word* (allocate-vram-words! obj #x7000)) + (set! *sky-base-block* (/ *sky-base-vram-word* 64)) + (set! *sky-base-page* (sar *sky-base-vram-word* 11)) + (set! *eyes-base-vram-word* (+ *sky-base-vram-word* 6144)) + (set! *eyes-base-block* (/ *eyes-base-vram-word* 64)) + (set! *eyes-base-page* (sar *eyes-base-vram-word* 11)) + (set! *ocean-base-vram-word* (+ *sky-base-vram-word* 6144)) + (set! *ocean-base-block* (/ *ocean-base-vram-word* 64)) + (set! *ocean-base-page* (sar *ocean-base-vram-word* 11)) + (set! *depth-cue-base-vram-word* (+ *sky-base-vram-word* 6144)) + (set! *depth-cue-base-block* (/ *depth-cue-base-vram-word* 64)) + (set! *depth-cue-base-page* (sar *depth-cue-base-vram-word* 11)) + 0 + (none) + ) + +;; definition for method 9 of type texture-page +(defmethod remove-from-heap texture-page ((obj texture-page) (seg kheap)) + (set! (-> seg current) (-> obj segment 0 block-data)) + obj + ) + +;; definition for function texture-page-default-allocate +(defun + texture-page-default-allocate + ((pool texture-pool) (page texture-page) (seg kheap) (tpage-id int)) + (dotimes (seg-id 3) + (let + ((a1-2 + (allocate-vram-words! pool (the-as int (-> page segment seg-id size))) + ) + ) + (relocate-dests! page a1-2 seg-id) + ) + ) + (upload-now! page -1) + (remove-from-heap page seg) + page + ) + +;; definition for function texture-page-common-allocate +(defun + texture-page-common-allocate + ((pool texture-pool) (page texture-page) (seg kheap) (tpage-id int)) + (let ((s5-0 (-> pool segment-common dest))) + (dotimes (seg-id 3) + (relocate-dests! page (the-as int s5-0) seg-id) + (+! s5-0 (-> page segment seg-id size)) + ) + ) + page + ) + +;; definition for function texture-page-common-boot-allocate +(defun + texture-page-common-boot-allocate + ((pool texture-pool) (page texture-page) (heap kheap) (tpage-id int)) + (let ((tex-id (lookup-boot-common-id pool tpage-id))) + (cond + ((>= tex-id 0) + (texture-page-common-allocate pool page heap tpage-id) + (set! (-> pool common-page tex-id) page) + ) + (else + (set! (-> *texture-pool* allocate-func) texture-page-default-allocate) + (texture-page-default-allocate pool page heap tpage-id) + ) + ) + ) + page + ) + +;; definition for function upload-vram-data +;; INFO: Return type mismatch symbol vs none. +(defun + upload-vram-data + ((buf dma-buffer) (dest int) (tex-data pointer) (tex-h int)) + (while (> tex-h 0) + (let ((height-this-time (min 2048 tex-h))) + (let* ((v1-1 buf) + (dma (the-as dma-packet (-> v1-1 base))) + ) + (set! (-> dma dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt))) + (set! (-> dma vif0) (new 'static 'vif-tag)) + (set! + (-> dma vif1) + (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-1 base) (&+ (the-as pointer dma) 16)) + ) + (let* ((v1-2 buf) + (gif (the-as gs-gif-tag (-> v1-2 base))) + ) + (set! (-> gif tag) (new 'static 'gif-tag64 :nloop #x4 :nreg #x1)) + (set! (-> gif regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d))) + (set! (-> v1-2 base) (&+ (the-as pointer gif) 16)) + ) + (let* ((v1-3 buf) + (gs-data (-> v1-3 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) gs-data) 0) + (new 'static 'gs-bitbltbuf :dbw #x2 :dbp dest) + ) + (set! (-> (the-as (pointer gs-reg64) gs-data) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) gs-data) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) gs-data) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) gs-data) 4) + (new 'static 'gs-trxreg :rrw #x80 :rrh height-this-time) + ) + (set! (-> (the-as (pointer gs-reg64) gs-data) 5) (gs-reg64 trxreg)) + (set! (-> (the-as (pointer gs-trxdir) gs-data) 6) (new 'static 'gs-trxdir)) + (set! (-> (the-as (pointer gs-reg64) gs-data) 7) (gs-reg64 trxdir)) + (set! (-> v1-3 base) (&+ gs-data 64)) + ) + (dma-buffer-add-ref-texture buf tex-data 128 height-this-time (gs-psm ct32)) + ) + (+! dest 4096) + (&+! tex-data #x100000) + (+! tex-h -2048) + ) + (none) + ) + +;; definition for function upload-vram-pages +(defun + upload-vram-pages + ((pool texture-pool) + (segment texture-pool-segment) + (page texture-page) + (mode int) + (bucket-idx int) + ) + (local-vars + (tex-data pointer) + (tex-dest-base-chunk uint) + (chunk-count int) + (chunks-to-upload-count int) + (first-chunk-idx-to-upload int) + (tex-id uint) + ) + (let ((total-upload-size 0)) + (let* + ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) + (dma-start (-> dma-buf base)) + ) + (set! tex-data (-> page segment 0 block-data)) + (set! tex-dest-base-chunk (shr (-> page segment 0 dest) 12)) + (set! chunk-count (the-as int (-> page segment 0 size))) + (set! chunks-to-upload-count 0) + (set! first-chunk-idx-to-upload 0) + (set! tex-id (-> page id)) + (let ((v1-8 mode)) + (cond + ((= v1-8 -3) + (return 0) + ) + ((zero? v1-8) + ) + ((= v1-8 -2) + (set! chunk-count (the-as int (+ chunk-count (-> page segment 1 size)))) + ) + ((= v1-8 -1) + (set! chunk-count (the-as int (-> page size))) + ) + ((= v1-8 2) + (set! tex-data (-> page segment 2 block-data)) + (set! tex-dest-base-chunk (shr (-> page segment 2 dest) 12)) + (set! chunk-count (the-as int (-> page segment 2 size))) + ) + ) + ) + (set! + chunk-count + (shr + (min (the-as int (-> segment size)) (the-as int (+ chunk-count 4095))) + 12 + ) + ) + (dotimes (upload-chunk-idx chunk-count) + (let + ((current-dest-chunk + (+ tex-dest-base-chunk (the-as uint upload-chunk-idx)) + ) + ) + (cond + ((zero? chunks-to-upload-count) + (when (!= (-> pool ids current-dest-chunk) tex-id) + (set! first-chunk-idx-to-upload upload-chunk-idx) + (set! (-> pool ids current-dest-chunk) tex-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + ) + (else + (cond + ((= (-> pool ids current-dest-chunk) tex-id) + (upload-vram-data + dma-buf + (the-as + int + (* + (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) + 64 + ) + ) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (* chunks-to-upload-count 32) + ) + (+! total-upload-size chunks-to-upload-count) + (set! chunks-to-upload-count 0) + 0 + ) + (else + (set! (-> pool ids current-dest-chunk) tex-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + ) + ) + ) + ) + ) + (when (nonzero? chunks-to-upload-count) + (upload-vram-data + dma-buf + (the-as + int + (* (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) 64) + ) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (* chunks-to-upload-count 32) + ) + (+! total-upload-size chunks-to-upload-count) + ) + (let* ((v1-47 dma-buf) + (dma (the-as dma-packet (-> v1-47 base))) + ) + (set! (-> dma dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt))) + (set! (-> dma vif0) (new 'static 'vif-tag)) + (set! + (-> dma vif1) + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-47 base) (&+ (the-as pointer dma) 16)) + ) + (let* ((v1-48 dma-buf) + (gif (the-as gs-gif-tag (-> v1-48 base))) + ) + (set! (-> gif tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1)) + (set! + (-> gif regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-48 base) (&+ (the-as pointer gif) 16)) + ) + (let* ((v1-49 dma-buf) + (gif-data (-> v1-49 base)) + ) + (set! (-> (the-as (pointer uint64) gif-data) 0) (the-as uint 1)) + (set! (-> (the-as (pointer gs-reg64) gif-data) 1) (gs-reg64 texflush)) + (set! (-> v1-49 base) (&+ gif-data 16)) + ) + (let ((a3-3 (-> dma-buf base))) + (let ((dma-end (the-as dma-packet (-> dma-buf base)))) + (set! (-> dma-end dma) (new 'static 'dma-tag :id (dma-tag-id next))) + (set! (-> dma-end vif0) (new 'static 'vif-tag)) + (set! (-> dma-end vif1) (new 'static 'vif-tag)) + (set! (-> dma-buf base) (&+ (the-as pointer dma-end) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + bucket-idx + dma-start + (the-as (pointer dma-tag) a3-3) + ) + ) + ) + (shl total-upload-size 14) + ) + ) + +;; definition for function update-vram-pages +(defun + update-vram-pages + ((pool texture-pool) + (pool-segment texture-pool-segment) + (page texture-page) + (mode int) + ) + (-> page segment 0 block-data) + (let ((dest-block (shr (-> page segment 0 dest) 12)) + (sz (-> page segment 0 size)) + (modified-chunk-count 0) + ) + 0 + (let ((page-id (-> page id))) + (cond + ((= mode -3) + (return 0) + ) + ((zero? mode) + ) + ((= mode -2) + (+! sz (-> page segment 1 size)) + ) + ((= mode -1) + (set! sz (-> page size)) + ) + ((= mode 2) + (-> page segment 2 block-data) + (set! dest-block (shr (-> page segment 2 dest) 12)) + (set! sz (-> page segment 2 size)) + ) + ) + (let + ((upload-chunks + (shr + (min (the-as int (-> pool-segment size)) (the-as int (+ sz 4095))) + 12 + ) + ) + ) + (dotimes (chunk-idx upload-chunks) + (let ((vram-chunk (+ dest-block (the-as uint chunk-idx)))) + (cond + ((zero? modified-chunk-count) + (when (!= (-> pool ids vram-chunk) page-id) + (set! (-> pool ids vram-chunk) page-id) + (+! modified-chunk-count 1) + ) + ) + (else + (cond + ((= (-> pool ids vram-chunk) page-id) + (set! modified-chunk-count 0) + ) + (else + (set! (-> pool ids vram-chunk) page-id) + (+! modified-chunk-count 1) + ) + ) + ) + ) + ) + ) + ) + ) + ) + 0 + ) + +;; definition for function upload-vram-pages-pris +(defun + upload-vram-pages-pris + ((pool texture-pool) + (segment texture-pool-segment) + (page texture-page) + (bucket-idx int) + (allow-cache-mask int) + ) + (local-vars + (tex-data pointer) + (tex-dest-base-chunk uint) + (chunk-count int) + (chunks-to-upload-count int) + (first-chunk-idx-to-upload int) + (page-id uint) + (current-dest-chunk uint) + (allow-cached symbol) + ) + (let ((total-upload-size 0)) + (let* + ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) + (s4-0 (-> dma-buf base)) + ) + (set! tex-data (-> page segment 0 block-data)) + (set! tex-dest-base-chunk (shr (-> page segment 0 dest) 12)) + (set! chunk-count (the-as int (-> page size))) + (set! chunks-to-upload-count 0) + (set! first-chunk-idx-to-upload 0) + (set! page-id (-> page id)) + (set! + chunk-count + (shr + (min (the-as int (-> segment size)) (the-as int (+ chunk-count 4095))) + 12 + ) + ) + (dotimes (upload-chunk-idx chunk-count) + (set! + current-dest-chunk + (+ tex-dest-base-chunk (the-as uint upload-chunk-idx)) + ) + (set! + allow-cached + (nonzero? (logand allow-cache-mask (ash 1 upload-chunk-idx))) + ) + (cond + ((zero? chunks-to-upload-count) + (when (and (!= (-> pool ids current-dest-chunk) page-id) allow-cached) + (set! first-chunk-idx-to-upload upload-chunk-idx) + (set! (-> pool ids current-dest-chunk) page-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + ) + (else + (cond + ((or (= (-> pool ids current-dest-chunk) page-id) (not allow-cached)) + (upload-vram-data + dma-buf + (the-as + int + (* + (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) + 64 + ) + ) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (* chunks-to-upload-count 32) + ) + (+! total-upload-size chunks-to-upload-count) + (set! chunks-to-upload-count 0) + 0 + ) + (else + (set! (-> pool ids current-dest-chunk) page-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + ) + ) + ) + ) + (when (nonzero? chunks-to-upload-count) + (upload-vram-data + dma-buf + (the-as + int + (* (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) 64) + ) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (* chunks-to-upload-count 32) + ) + (+! total-upload-size chunks-to-upload-count) + ) + (let* ((v1-52 dma-buf) + (dma (the-as dma-packet (-> v1-52 base))) + ) + (set! (-> dma dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt))) + (set! (-> dma vif0) (new 'static 'vif-tag)) + (set! + (-> dma vif1) + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-52 base) (&+ (the-as pointer dma) 16)) + ) + (let* ((v1-53 dma-buf) + (gif (the-as gs-gif-tag (-> v1-53 base))) + ) + (set! (-> gif tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1)) + (set! + (-> gif regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-53 base) (&+ (the-as pointer gif) 16)) + ) + (let* ((v1-54 dma-buf) + (a0-25 (-> v1-54 base)) + ) + (set! (-> (the-as (pointer uint64) a0-25) 0) (the-as uint 1)) + (set! (-> (the-as (pointer gs-reg64) a0-25) 1) (gs-reg64 texflush)) + (set! (-> v1-54 base) (&+ a0-25 16)) + ) + (let ((a3-3 (-> dma-buf base))) + (let ((dma-end (the-as dma-packet (-> dma-buf base)))) + (set! (-> dma-end dma) (new 'static 'dma-tag :id (dma-tag-id next))) + (set! (-> dma-end vif0) (new 'static 'vif-tag)) + (set! (-> dma-end vif1) (new 'static 'vif-tag)) + (set! (-> dma-buf base) (&+ (the-as pointer dma-end) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + bucket-idx + s4-0 + (the-as (pointer dma-tag) a3-3) + ) + ) + ) + (shl total-upload-size 14) + ) + ) + +;; definition for function texture-page-near-allocate-0 +(defun + texture-page-near-allocate-0 + ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) + (relocate-dests! page (the-as int (-> pool segment-near dest)) 2) + (let ((common-dest (-> pool segment-common dest))) + (dotimes (page-seg-idx 2) + (relocate-dests! page (the-as int common-dest) page-seg-idx) + (+! common-dest (-> page segment page-seg-idx size)) + ) + ) + (upload-now! page 2) + (update-vram-pages pool (-> pool segment-near) page 2) + (let + ((page-seg-2-size + (logand -4096 (the-as int (+ (-> page segment 2 size) 4095))) + ) + ) + (cond + ((< (the-as uint #x24000) page-seg-2-size) + (let ((after-seg-2-data (&+ (-> page segment 2 block-data) #x90000))) + (let ((seg-2-data (-> page segment 2 block-data))) + (set! (-> page segment 2 size) (+ -147456 (the-as int page-seg-2-size))) + (set! + (-> page segment 2 dest) + (+ #x24000 (the-as int (-> pool segment-near dest))) + ) + (set! + (-> heap current) + (&+ (-> page segment 2 block-data) (* (-> page segment 2 size) 4)) + ) + (set! (-> *texture-relocate-later* memcpy) #t) + (set! (-> *texture-relocate-later* dest) (the-as uint seg-2-data)) + ) + (set! (-> *texture-relocate-later* source) (the-as uint after-seg-2-data)) + ) + (set! (-> *texture-relocate-later* move) (* (-> page segment 2 size) 4)) + ) + (else + (set! (-> page segment 2 size) (the-as uint 0)) + (set! (-> heap current) (-> page segment 2 block-data)) + ) + ) + ) + (set! (-> *texture-pool* allocate-func) texture-page-common-allocate) + (set! (-> *level* unknown-level-2 code-memory-end) (the-as pointer page)) + page + ) + +;; definition for function texture-page-near-allocate-1 +(defun + texture-page-near-allocate-1 + ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) + (let + ((seg2-size (logand -4096 (the-as int (+ (-> page segment 2 size) 4095))))) + (let + ((seg2-dest + (+ (- #x62000 (the-as int seg2-size)) (-> pool segment-near dest)) + ) + ) + (relocate-dests! page (the-as int seg2-dest) 2) + ) + (let ((common-dest (-> pool segment-common dest))) + (dotimes (page-seg-idx 2) + (relocate-dests! page (the-as int common-dest) page-seg-idx) + (+! common-dest (-> page segment page-seg-idx size)) + ) + ) + (upload-now! page 2) + (update-vram-pages pool (-> pool segment-near) page 2) + (cond + ((< (the-as uint #x24000) seg2-size) + (set! (-> page segment 2 size) (+ -147456 (the-as int seg2-size))) + (set! + (-> heap current) + (&+ (-> page segment 2 block-data) (* (-> page segment 2 size) 4)) + ) + ) + (else + (set! (-> page segment 2 size) (the-as uint 0)) + (set! (-> heap current) (-> page segment 2 block-data)) + ) + ) + ) + (set! (-> *texture-pool* allocate-func) texture-page-common-allocate) + (set! (-> *level* unknown-level-2 code-memory-end) (the-as pointer page)) + page + ) + +;; definition for function texture-page-level-allocate +(defun + texture-page-level-allocate + ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) + (let ((common-id (lookup-boot-common-id pool mode))) + (cond + ((>= common-id 0) + (texture-page-common-allocate pool page heap mode) + (set! (-> pool common-page common-id) page) + ) + (else + (let ((level-idx (-> *level* unknown-level-2 index))) + (cond + ((zero? level-idx) + (texture-page-near-allocate-0 pool page heap mode) + ) + ((= level-idx 1) + (texture-page-near-allocate-1 pool page heap mode) + ) + ) + ) + ) + ) + ) + page + ) + +;; definition for function texture-page-size-check +(defun + texture-page-size-check + ((pool texture-pool) (level level) (hide-prints symbol)) + (let ((oversize 0)) + (let* ((tfrag-page (-> level texture-page 0)) + (tfrag-mip0-size (-> tfrag-page mip0-size)) + ) + (when tfrag-page + (if (< (the-as uint #x3e000) tfrag-mip0-size) + (set! oversize (logior oversize 1)) + ) + (if + (< + (the-as uint #x1c000) + (+ (-> tfrag-page segment 0 size) (-> tfrag-page segment 1 size)) + ) + (set! oversize (logior oversize 1)) + ) + (when (not hide-prints) + (format + #t + "~Tlevel ~10S TFRAG tpage ~A uses ~DK of near ~DK~%" + (-> level name) + (-> tfrag-page name) + (shr tfrag-mip0-size 8) + 992 + ) + (format + #t + "~Tlevel ~10S TFRAG tpage ~A uses ~DK of common ~DK~%" + (-> level name) + (-> tfrag-page name) + (shr (+ (-> tfrag-page segment 0 size) (-> tfrag-page segment 1 size)) 8) + 448 + ) + ) + ) + ) + (let ((pris-page (-> level texture-page 1))) + (when pris-page + (if (< (the-as uint #x1c000) (-> pris-page size)) + (set! oversize (logior oversize 2)) + ) + (if (not hide-prints) + (format + #t + "~Tlevel ~10S PRIS tpage ~A uses ~DK of common ~DK~%" + (-> level name) + (-> pris-page name) + (shr (-> pris-page size) 8) + 448 + ) + ) + ) + ) + (let ((shrub-page (-> level texture-page 2))) + (when shrub-page + (if (< (the-as uint #x1c000) (-> shrub-page size)) + (set! oversize (logior oversize 4)) + ) + (if (not hide-prints) + (format + #t + "~Tlevel ~10S SHRUB tpage ~A uses ~DK of common ~DK~%" + (-> level name) + (-> shrub-page name) + (shr (-> shrub-page size) 8) + 448 + ) + ) + ) + ) + (let ((alpha-page (-> level texture-page 3))) + (when alpha-page + (if (< (the-as uint #x1c000) (-> alpha-page size)) + (set! oversize (logior oversize 8)) + ) + (if (not hide-prints) + (format + #t + "~Tlevel ~10S ALPHA tpage ~A uses ~DK of common ~DK~%" + (-> level name) + (-> alpha-page name) + (shr (-> alpha-page size) 8) + 448 + ) + ) + ) + ) + (let ((water-page (-> level texture-page 4))) + (when water-page + (if (< (the-as uint #x1c000) (-> water-page size)) + (set! oversize (logior oversize 16)) + ) + (if (not hide-prints) + (format + #t + "~Tlevel ~10S WATER tpage ~A uses ~DK of common ~DK~%" + (-> level name) + (-> water-page name) + (shr (-> water-page size) 8) + 448 + ) + ) + ) + ) + oversize + ) + ) + +;; definition for method 13 of type texture-pool +;; INFO: Return type mismatch int vs none. +(defmethod + login-level-textures + texture-pool + ((obj texture-pool) + (level level) + (max-page-kind int) + (id-array (pointer texture-id)) + ) + (dotimes (page-idx 9) + (set! (-> level texture-page page-idx) #f) + ) + (when (>= max-page-kind 0) + (let + ((tfrag-dir-entry + (texture-page-login (-> id-array 0) (if (= (-> level index) 1) + texture-page-near-allocate-1 + texture-page-near-allocate-0 + ) + loading-level + ) + ) + ) + (if tfrag-dir-entry + (set! (-> level texture-page 0) (-> tfrag-dir-entry page)) + ) + ) + ) + (when (>= max-page-kind 1) + (let + ((pris-dir-entry + (texture-page-login + (-> id-array 1) + texture-page-common-allocate + loading-level + ) + ) + ) + (if pris-dir-entry + (set! (-> level texture-page 1) (-> pris-dir-entry page)) + ) + ) + ) + (when (>= max-page-kind 2) + (let + ((shrub-dir-entry + (texture-page-login + (-> id-array 2) + texture-page-common-allocate + loading-level + ) + ) + ) + (if shrub-dir-entry + (set! (-> level texture-page 2) (-> shrub-dir-entry page)) + ) + ) + ) + (when (>= max-page-kind 3) + (let + ((alpha-dir-entry + (texture-page-login + (-> id-array 3) + texture-page-common-allocate + loading-level + ) + ) + ) + (if alpha-dir-entry + (set! (-> level texture-page 3) (-> alpha-dir-entry page)) + ) + ) + ) + (when (>= max-page-kind 4) + (let + ((water-dir-entry + (texture-page-login + (-> id-array 4) + texture-page-common-allocate + loading-level + ) + ) + ) + (if water-dir-entry + (set! (-> level texture-page 4) (-> water-dir-entry page)) + ) + ) + ) + (let ((overflow-bits (texture-page-size-check obj level #t))) + (when (nonzero? overflow-bits) + (format + #t + "-------------------- tpage overflow error #x~X~%" + overflow-bits + ) + (texture-page-size-check obj level #f) + (format #t "--------------------~%") + ) + ) + 0 + (none) + ) + +;; definition for method 14 of type texture-pool +;; INFO: Return type mismatch int vs none. +(defmethod + add-tex-to-dma! + texture-pool + ((obj texture-pool) (level level) (tex-page-kind int)) + (when (zero? tex-page-kind) + (let ((tfrag-page (-> level texture-page 0)) + (tfrag-bucket (if (zero? (-> level index)) + 5 + 12 + ) + ) + (distance + (fmin + (fmin + (-> level closest-object 0) + (if + (and + (< 0.0 (-> level level-distance)) + (< + (+ 409600.0 (-> level level-distance)) + (-> level closest-object 5) + ) + ) + 4095996000.0 + (-> level closest-object 5) + ) + ) + (-> level closest-object 6) + ) + ) + ) + (when tfrag-page + (set! (-> level upload-size 0) 0) + (if (< distance 81920.0) + (set! + (-> level upload-size 0) + (+ + (-> level upload-size 0) + (upload-vram-pages obj (-> obj segment-near) tfrag-page 2 tfrag-bucket) + ) + ) + ) + (cond + ((= distance 4095996000.0) + ) + ((< 102400.0 distance) + (set! + (-> level upload-size 0) + (+ + (-> level upload-size 0) + (upload-vram-pages + obj + (-> obj segment-common) + tfrag-page + 0 + tfrag-bucket + ) + ) + ) + ) + (else + (set! + (-> level upload-size 0) + (+ + (-> level upload-size 0) + (upload-vram-pages + obj + (-> obj segment-common) + tfrag-page + -2 + tfrag-bucket + ) + ) + ) + ) + ) + ) + ) + 0 + ) + (when (= tex-page-kind 1) + (let ((pris-page (-> level texture-page 1))) + (when (and pris-page (nonzero? pris-page)) + (let ((pris-bucket (if (zero? (-> level index)) + 48 + 51 + ) + ) + ) + (set! + (-> level upload-size 1) + (upload-vram-pages-pris + obj + (-> obj segment-common) + pris-page + pris-bucket + (the-as int (-> level texture-mask 7)) + ) + ) + ) + ) + ) + ) + (when (= tex-page-kind 2) + (let ((shrub-page (-> level texture-page 2)) + (shrub-closest (-> level closest-object 2)) + ) + (when (and shrub-page (nonzero? shrub-page)) + (let ((shrub-bucket (if (zero? (-> level index)) + 19 + 25 + ) + ) + (shrub-mode (cond + ((= shrub-closest 4095996000.0) + -3 + ) + ((< 102400.0 shrub-closest) + 0 + ) + ((< 81920.0 shrub-closest) + -2 + ) + (else + -1 + ) + ) + ) + ) + (set! + (-> level upload-size 2) + (upload-vram-pages + obj + (-> obj segment-common) + shrub-page + shrub-mode + shrub-bucket + ) + ) + ) + ) + ) + ) + (when (= tex-page-kind 3) + (let ((alpha-page (-> level texture-page 3)) + (alpha-closest (-> level closest-object 3)) + ) + (when (and alpha-page (nonzero? alpha-page)) + (let ((alpha-bucket (if (zero? (-> level index)) + 31 + 38 + ) + ) + (alpha-mode (cond + ((< 348160.0 alpha-closest) + 0 + ) + ((< 163840.0 alpha-closest) + -2 + ) + (else + -1 + ) + ) + ) + ) + (let ((alpha-dest-chunk (shr (-> alpha-page segment 0 dest) 12))) + (when (movie?) + (set! (-> obj ids alpha-dest-chunk) (the-as uint 0)) + (set! (-> obj ids (+ alpha-dest-chunk 1)) (the-as uint 0)) + 0 + ) + ) + (set! + (-> level upload-size 3) + (upload-vram-pages + obj + (-> obj segment-common) + alpha-page + alpha-mode + alpha-bucket + ) + ) + ) + ) + ) + ) + (when (= tex-page-kind 4) + (let ((water-page (-> level texture-page 4))) + (when (and water-page (nonzero? water-page)) + (let ((water-bucket (if (zero? (-> level index)) + 57 + 60 + ) + ) + ) + (set! + (-> level upload-size 4) + (upload-vram-pages-pris + obj + (-> obj segment-common) + water-page + water-bucket + (the-as int (-> level texture-mask 8)) + ) + ) + ) + ) + ) + ) + 0 + (none) + ) + +;; definition for method 21 of type texture-pool +(defmethod upload-one-common! texture-pool ((obj texture-pool)) + (dotimes (v1-0 32) + (let ((a2-0 (-> obj common-page v1-0))) + (when + (and + (nonzero? a2-0) + (nonzero? (logand (-> obj common-page-mask) (ash 1 v1-0))) + ) + (upload-vram-pages obj (-> obj segment-common) a2-0 -2 65) + (return #f) + ) + ) + ) + #f + ) + +;; definition for method 11 of type level +;; INFO: Return type mismatch int vs none. +(defmethod add-irq-to-tex-buckets! level ((obj level)) + (cond + ((zero? (-> obj index)) + (let* + ((v1-4 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-0 (-> v1-4 base)) + ) + (let* ((a0-4 v1-4) + (a1-0 (the-as object (-> a0-4 base))) + ) + (set! + (-> (the-as dma-packet a1-0) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-0) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-0) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-4 base) (&+ (the-as pointer a1-0) 16)) + ) + (let ((a3-3 (-> v1-4 base))) + (let ((a0-5 (the-as object (-> v1-4 base)))) + (set! + (-> (the-as dma-packet a0-5) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-5) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-5) vif1) (new 'static 'vif-tag)) + (set! (-> v1-4 base) (&+ (the-as pointer a0-5) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 5 + a2-0 + (the-as (pointer dma-tag) a3-3) + ) + ) + ) + (let* + ((v1-12 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-1 (-> v1-12 base)) + ) + (let* ((a0-14 v1-12) + (a1-4 (the-as object (-> a0-14 base))) + ) + (set! + (-> (the-as dma-packet a1-4) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-4) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-4) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-14 base) (&+ (the-as pointer a1-4) 16)) + ) + (let ((a3-7 (-> v1-12 base))) + (let ((a0-15 (the-as object (-> v1-12 base)))) + (set! + (-> (the-as dma-packet a0-15) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-15) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-15) vif1) (new 'static 'vif-tag)) + (set! (-> v1-12 base) (&+ (the-as pointer a0-15) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 48 + a2-1 + (the-as (pointer dma-tag) a3-7) + ) + ) + ) + (let* + ((v1-20 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-2 (-> v1-20 base)) + ) + (let* ((a0-24 v1-20) + (a1-8 (the-as object (-> a0-24 base))) + ) + (set! + (-> (the-as dma-packet a1-8) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-8) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-8) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-24 base) (&+ (the-as pointer a1-8) 16)) + ) + (let ((a3-11 (-> v1-20 base))) + (let ((a0-25 (the-as object (-> v1-20 base)))) + (set! + (-> (the-as dma-packet a0-25) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-25) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-25) vif1) (new 'static 'vif-tag)) + (set! (-> v1-20 base) (&+ (the-as pointer a0-25) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 19 + a2-2 + (the-as (pointer dma-tag) a3-11) + ) + ) + ) + (let* + ((v1-28 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-3 (-> v1-28 base)) + ) + (let* ((a0-34 v1-28) + (a1-12 (the-as object (-> a0-34 base))) + ) + (set! + (-> (the-as dma-packet a1-12) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-12) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-12) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-34 base) (&+ (the-as pointer a1-12) 16)) + ) + (let ((a3-15 (-> v1-28 base))) + (let ((a0-35 (the-as object (-> v1-28 base)))) + (set! + (-> (the-as dma-packet a0-35) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-35) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-35) vif1) (new 'static 'vif-tag)) + (set! (-> v1-28 base) (&+ (the-as pointer a0-35) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 31 + a2-3 + (the-as (pointer dma-tag) a3-15) + ) + ) + ) + ) + (else + (let* + ((v1-36 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-4 (-> v1-36 base)) + ) + (let* ((a0-44 v1-36) + (a1-16 (the-as object (-> a0-44 base))) + ) + (set! + (-> (the-as dma-packet a1-16) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-16) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-16) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-44 base) (&+ (the-as pointer a1-16) 16)) + ) + (let ((a3-19 (-> v1-36 base))) + (let ((a0-45 (the-as object (-> v1-36 base)))) + (set! + (-> (the-as dma-packet a0-45) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-45) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-45) vif1) (new 'static 'vif-tag)) + (set! (-> v1-36 base) (&+ (the-as pointer a0-45) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 12 + a2-4 + (the-as (pointer dma-tag) a3-19) + ) + ) + ) + (let* + ((v1-44 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-5 (-> v1-44 base)) + ) + (let* ((a0-54 v1-44) + (a1-20 (the-as object (-> a0-54 base))) + ) + (set! + (-> (the-as dma-packet a1-20) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-20) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-20) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-54 base) (&+ (the-as pointer a1-20) 16)) + ) + (let ((a3-23 (-> v1-44 base))) + (let ((a0-55 (the-as object (-> v1-44 base)))) + (set! + (-> (the-as dma-packet a0-55) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-55) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-55) vif1) (new 'static 'vif-tag)) + (set! (-> v1-44 base) (&+ (the-as pointer a0-55) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 51 + a2-5 + (the-as (pointer dma-tag) a3-23) + ) + ) + ) + (let* + ((v1-52 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-6 (-> v1-52 base)) + ) + (let* ((a0-64 v1-52) + (a1-24 (the-as object (-> a0-64 base))) + ) + (set! + (-> (the-as dma-packet a1-24) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-24) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-24) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-64 base) (&+ (the-as pointer a1-24) 16)) + ) + (let ((a3-27 (-> v1-52 base))) + (let ((a0-65 (the-as object (-> v1-52 base)))) + (set! + (-> (the-as dma-packet a0-65) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-65) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-65) vif1) (new 'static 'vif-tag)) + (set! (-> v1-52 base) (&+ (the-as pointer a0-65) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 25 + a2-6 + (the-as (pointer dma-tag) a3-27) + ) + ) + ) + (let* + ((v1-60 (-> *display* frames (-> *display* on-screen) frame global-buf)) + (a2-7 (-> v1-60 base)) + ) + (let* ((a0-74 v1-60) + (a1-28 (the-as object (-> a0-74 base))) + ) + (set! + (-> (the-as dma-packet a1-28) dma) + (new 'static 'dma-tag :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a1-28) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a1-28) vif1) (new 'static 'vif-tag :irq #x1)) + (set! (-> a0-74 base) (&+ (the-as pointer a1-28) 16)) + ) + (let ((a3-31 (-> v1-60 base))) + (let ((a0-75 (the-as object (-> v1-60 base)))) + (set! + (-> (the-as dma-packet a0-75) dma) + (new 'static 'dma-tag :id (dma-tag-id next)) + ) + (set! (-> (the-as dma-packet a0-75) vif0) (new 'static 'vif-tag)) + (set! (-> (the-as dma-packet a0-75) vif1) (new 'static 'vif-tag)) + (set! (-> v1-60 base) (&+ (the-as pointer a0-75) 16)) + ) + (dma-bucket-insert-tag + (-> *display* frames (-> *display* on-screen) frame bucket-group) + 38 + a2-7 + (the-as (pointer dma-tag) a3-31) + ) + ) + ) + ) + ) + 0 + (none) + ) + +;; definition for symbol *txt-dma-list*, type dma-buffer +(define *txt-dma-list* (new 'global 'dma-buffer 4096)) + +;; definition for method 14 of type texture-page +;; INFO: Return type mismatch int vs none. +(defmethod upload-now! texture-page ((obj texture-page) (arg0 int)) + (let ((gp-0 *txt-dma-list*)) + (let ((v1-0 gp-0)) + (set! (-> v1-0 base) (-> v1-0 data)) + (set! (-> v1-0 end) (&-> v1-0 data-buffer (-> v1-0 allocated-length))) + ) + (add-to-dma-buffer obj gp-0 arg0) + (let* ((v1-3 gp-0) + (a0-1 (the-as object (-> v1-3 base))) + ) + (set! + (-> (the-as dma-packet a0-1) dma) + (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a0-1) vif0) (new 'static 'vif-tag)) + (set! + (-> (the-as dma-packet a0-1) vif1) + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-3 base) (&+ (the-as pointer a0-1) 16)) + ) + (let* ((v1-4 gp-0) + (a0-3 (the-as object (-> v1-4 base))) + ) + (set! + (-> (the-as gs-gif-tag a0-3) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1) + ) + (set! + (-> (the-as gs-gif-tag a0-3) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-4 base) (&+ (the-as pointer a0-3) 16)) + ) + (let* ((v1-5 gp-0) + (a0-5 (-> v1-5 base)) + ) + (set! (-> (the-as (pointer uint64) a0-5) 0) (the-as uint 1)) + (set! (-> (the-as (pointer gs-reg64) a0-5) 1) (gs-reg64 texflush)) + (set! (-> v1-5 base) (&+ a0-5 16)) + ) + (let* ((v1-6 gp-0) + (a0-7 (the-as object (-> v1-6 base))) + ) + (set! + (-> (the-as dma-packet a0-7) dma) + (new 'static 'dma-tag :id (dma-tag-id end)) + ) + (set! (-> (the-as (pointer uint64) a0-7) 1) (the-as uint 0)) + (set! (-> v1-6 base) (&+ (the-as pointer a0-7) 16)) + ) + (dma-buffer-send-chain (the-as dma-bank-source #x1000a000) gp-0) + ) + (dma-sync (the-as pointer #x1000a000) 0 0) + (none) + ) + +;; definition for method 13 of type texture-page +(defmethod + add-to-dma-buffer + texture-page + ((obj texture-page) (dma-buff dma-buffer) (mode int)) + (local-vars (total-size int)) + (let ((v1-0 mode)) + (set! total-size (the-as int (cond + ((= v1-0 -3) + 0 + ) + ((= v1-0 -2) + (the-as + int + (+ + (-> obj segment 0 size) + (-> obj segment 1 size) + ) + ) + ) + ((= v1-0 -1) + (the-as int (-> obj size)) + ) + (else + (the-as int (-> obj segment mode size)) + ) + ) + ) + ) + ) + (let* ((start-segment (max 0 mode)) + (chunk-count (* (/ (+ (/ total-size 64) 63) 64) 32)) + (current-dest (shr (-> obj segment start-segment dest) 6)) + (current-data (-> obj segment start-segment block-data)) + ) + (while (> chunk-count 0) + (let ((chunks-now (min 2048 chunk-count))) + (let* ((v1-11 dma-buff) + (pkt (the-as dma-packet (-> v1-11 base))) + ) + (set! (-> pkt dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt))) + (set! (-> pkt vif0) (new 'static 'vif-tag)) + (set! + (-> pkt vif1) + (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-11 base) (&+ (the-as pointer pkt) 16)) + ) + (let* ((v1-12 dma-buff) + (gs-tag (the-as gs-gif-tag (-> v1-12 base))) + ) + (set! (-> gs-tag tag) (new 'static 'gif-tag64 :nloop #x4 :nreg #x1)) + (set! + (-> gs-tag regs) + (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)) + ) + (set! (-> v1-12 base) (&+ (the-as pointer gs-tag) 16)) + ) + (let* ((v1-13 dma-buff) + (gs-reg-data (-> v1-13 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) gs-reg-data) 0) + (new 'static 'gs-bitbltbuf :dbw #x2 :dbp current-dest) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 1) (gs-reg64 bitbltbuf)) + (set! + (-> (the-as (pointer gs-trxpos) gs-reg-data) 2) + (new 'static 'gs-trxpos) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) gs-reg-data) 4) + (new 'static 'gs-trxreg :rrw #x80 :rrh chunks-now) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 5) (gs-reg64 trxreg)) + (set! + (-> (the-as (pointer gs-trxdir) gs-reg-data) 6) + (new 'static 'gs-trxdir) + ) + (set! (-> (the-as (pointer gs-reg64) gs-reg-data) 7) (gs-reg64 trxdir)) + (set! (-> v1-13 base) (&+ gs-reg-data 64)) + ) + (dma-buffer-add-ref-texture + dma-buff + current-data + 128 + chunks-now + (gs-psm ct32) + ) + ) + (+! current-dest 4096) + (&+! current-data #x100000) + (+! chunk-count -2048) + ) + ) + total-size + ) + +;; definition for function texture-relocate +(defun + texture-relocate + ((dma-buff dma-buffer) + (tex texture) + (dest-loc int) + (dest-fmt gs-psm) + (clut-dst int) + ) + (dotimes (mip-level (the-as int (-> tex num-mips))) + (let ((mip-w (ash (-> tex w) (- mip-level))) + (mip-h (ash (-> tex h) (- mip-level))) + ) + (let* ((t3-2 dma-buff) + (dma-pkt (the-as dma-packet (-> t3-2 base))) + ) + (set! + (-> dma-pkt dma) + (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt)) + ) + (set! (-> dma-pkt vif0) (new 'static 'vif-tag)) + (set! + (-> dma-pkt vif1) + (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> t3-2 base) (&+ (the-as pointer dma-pkt) 16)) + ) + (let* ((t3-3 dma-buff) + (gs-pkt (the-as gs-gif-tag (-> t3-3 base))) + ) + (set! + (-> gs-pkt tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4) + ) + (set! + (-> gs-pkt regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> t3-3 base) (&+ (the-as pointer gs-pkt) 16)) + ) + (let* ((t3-4 dma-buff) + (t4-4 (-> t3-4 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) t4-4) 0) + (new 'static 'gs-bitbltbuf + :sbp (-> tex dest mip-level) + :sbw (-> tex width mip-level) + :spsm (the-as int (-> tex psm)) + :dbp (/ dest-loc 64) + :dbw (-> tex width mip-level) + :dpsm (the-as int dest-fmt) + ) + ) + (set! (-> (the-as (pointer gs-reg64) t4-4) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) t4-4) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) t4-4) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) t4-4) 4) + (new 'static 'gs-trxreg :rrw mip-w :rrh mip-h) + ) + (set! (-> (the-as (pointer gs-reg64) t4-4) 5) (gs-reg64 trxreg)) + (set! + (-> (the-as (pointer gs-trxdir) t4-4) 6) + (new 'static 'gs-trxdir :xdir #x2) + ) + (set! (-> (the-as (pointer gs-reg64) t4-4) 7) (gs-reg64 trxdir)) + (set! (-> t3-4 base) (&+ t4-4 64)) + ) + ) + (set! (-> tex dest mip-level) (the-as uint (/ dest-loc 64))) + ) + (cond + ((< clut-dst 0) + ) + ((= (-> tex psm) (gs-psm mt4)) + (let* ((v1-7 dma-buff) + (a2-2 (the-as object (-> v1-7 base))) + ) + (set! + (-> (the-as dma-packet a2-2) dma) + (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a2-2) vif0) (new 'static 'vif-tag)) + (set! + (-> (the-as dma-packet a2-2) vif1) + (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-7 base) (&+ (the-as pointer a2-2) 16)) + ) + (let* ((v1-8 dma-buff) + (a2-4 (the-as object (-> v1-8 base))) + ) + (set! + (-> (the-as gs-gif-tag a2-4) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4) + ) + (set! + (-> (the-as gs-gif-tag a2-4) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-8 base) (&+ (the-as pointer a2-4) 16)) + ) + (let* ((v1-9 dma-buff) + (a2-6 (-> v1-9 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) a2-6) 0) + (new 'static 'gs-bitbltbuf + :sbw #x1 + :dbw #x1 + :dpsm (-> tex clutpsm) + :dbp (/ clut-dst 64) + :spsm (-> tex clutpsm) + :sbp (-> tex clutdest) + ) + ) + (set! (-> (the-as (pointer gs-reg64) a2-6) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) a2-6) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) a2-6) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) a2-6) 4) + (new 'static 'gs-trxreg :rrw #x8 :rrh #x2) + ) + (set! (-> (the-as (pointer gs-reg64) a2-6) 5) (gs-reg64 trxreg)) + (set! + (-> (the-as (pointer gs-trxdir) a2-6) 6) + (new 'static 'gs-trxdir :xdir #x2) + ) + (set! (-> (the-as (pointer gs-reg64) a2-6) 7) (gs-reg64 trxdir)) + (set! (-> v1-9 base) (&+ a2-6 64)) + ) + (set! (-> tex clutdest) (the-as uint (/ clut-dst 64))) + ) + ((= (-> tex psm) (gs-psm mt8)) + (let* ((v1-13 dma-buff) + (a2-9 (the-as object (-> v1-13 base))) + ) + (set! + (-> (the-as dma-packet a2-9) dma) + (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a2-9) vif0) (new 'static 'vif-tag)) + (set! + (-> (the-as dma-packet a2-9) vif1) + (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-13 base) (&+ (the-as pointer a2-9) 16)) + ) + (let* ((v1-14 dma-buff) + (a2-11 (the-as object (-> v1-14 base))) + ) + (set! + (-> (the-as gs-gif-tag a2-11) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4) + ) + (set! + (-> (the-as gs-gif-tag a2-11) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-14 base) (&+ (the-as pointer a2-11) 16)) + ) + (let* ((v1-15 dma-buff) + (a2-13 (-> v1-15 base)) + ) + (set! + (-> (the-as (pointer gs-bitbltbuf) a2-13) 0) + (new 'static 'gs-bitbltbuf + :sbw #x2 + :dbw #x2 + :dpsm (-> tex clutpsm) + :dbp (/ clut-dst 64) + :spsm (-> tex clutpsm) + :sbp (-> tex clutdest) + ) + ) + (set! (-> (the-as (pointer gs-reg64) a2-13) 1) (gs-reg64 bitbltbuf)) + (set! (-> (the-as (pointer gs-trxpos) a2-13) 2) (new 'static 'gs-trxpos)) + (set! (-> (the-as (pointer gs-reg64) a2-13) 3) (gs-reg64 trxpos)) + (set! + (-> (the-as (pointer gs-trxreg) a2-13) 4) + (new 'static 'gs-trxreg :rrw #x10 :rrh #x10) + ) + (set! (-> (the-as (pointer gs-reg64) a2-13) 5) (gs-reg64 trxreg)) + (set! + (-> (the-as (pointer gs-trxdir) a2-13) 6) + (new 'static 'gs-trxdir :xdir #x2) + ) + (set! (-> (the-as (pointer gs-reg64) a2-13) 7) (gs-reg64 trxdir)) + (set! (-> v1-15 base) (&+ a2-13 64)) + ) + (set! (-> tex clutdest) (the-as uint (/ clut-dst 64))) + ) + ) + (set! (-> tex psm) dest-fmt) + dma-buff + ) + +;; definition (perm) for symbol *font-texture*, type texture +(define-perm *font-texture* texture #f) + +;; definition for method 11 of type texture-pool +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 16 signed mismatch +;; WARN: Stack slot offset 16 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 16 signed mismatch +;; WARN: Stack slot offset 16 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 20 signed mismatch +;; WARN: Stack slot offset 16 signed mismatch +;; WARN: Stack slot offset 16 signed mismatch +;; INFO: Return type mismatch int vs none. +(defmethod setup-font-texture! texture-pool ((obj texture-pool)) + (local-vars (heap-before-font-tex int) (clut-dest-addr int)) + (let ((font-clut (-> obj font-palette))) + (set! heap-before-font-tex (-> obj cur)) + (set! clut-dest-addr (/ font-clut 64)) + (set! + *font-texture* + (lookup-texture-by-id (new 'static 'texture-id :index #x1 :page #x4fe)) + ) + (let + ((main-font-tx + (texture-page-login + (new 'static 'texture-id :index #x1 :page #x4fe) + texture-page-default-allocate + global + ) + ) + ) + (if (and main-font-tx (-> main-font-tx page)) + (set! + heap-before-font-tex + (the-as int (-> main-font-tx page segment 0 dest)) + ) + ) + (let ((dma-buff *txt-dma-list*)) + (let ((v1-6 dma-buff)) + (set! (-> v1-6 base) (-> v1-6 data)) + (set! (-> v1-6 end) (&-> v1-6 data-buffer (-> v1-6 allocated-length))) + ) + (let ((font-tx-1 *font-texture*) + (font-tx-1-dest #xe0000) + (font-tx-1-fmt 36) + ) + (texture-relocate + dma-buff + font-tx-1 + font-tx-1-dest + (the-as gs-psm font-tx-1-fmt) + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* small-font-lo-tmpl)) + font-tx-1 + (the-as uint font-tx-1-dest) + (the-as uint font-tx-1-fmt) + (the-as uint clut-dest-addr) + ) + ) + (let + ((font-tx-0 (lookup-texture-by-id (new 'static 'texture-id :page #x4fe))) + (font-tx-0-dest #xe0000) + (font-tx-0-fmt 44) + ) + (texture-relocate + dma-buff + font-tx-0 + font-tx-0-dest + (the-as gs-psm font-tx-0-fmt) + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* small-font-hi-tmpl)) + font-tx-0 + (the-as uint font-tx-0-dest) + (the-as uint font-tx-0-fmt) + (the-as uint clut-dest-addr) + ) + ) + (let + ((font-tx-3 + (lookup-texture-by-id (new 'static 'texture-id :index #x3 :page #x4fe)) + ) + (font-tx-3-dest #xe6000) + (font-tx-3-fmt 36) + ) + (texture-relocate + dma-buff + font-tx-3 + font-tx-3-dest + (the-as gs-psm font-tx-3-fmt) + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* large-font-lo-tmpl)) + font-tx-3 + (the-as uint font-tx-3-dest) + (the-as uint font-tx-3-fmt) + (the-as uint clut-dest-addr) + ) + ) + (let + ((font-tx-2 + (lookup-texture-by-id (new 'static 'texture-id :index #x2 :page #x4fe)) + ) + (font-tx-2-dest #xe6000) + (font-tx-2-fmt 44) + ) + (texture-relocate + dma-buff + font-tx-2 + font-tx-2-dest + (the-as gs-psm font-tx-2-fmt) + font-clut + ) + (font-set-tex0 + (the-as (pointer gs-tex0) (-> *font-work* large-font-hi-tmpl)) + font-tx-2 + (the-as uint font-tx-2-dest) + (the-as uint font-tx-2-fmt) + (the-as uint clut-dest-addr) + ) + ) + (let* ((v1-15 dma-buff) + (a0-18 (the-as object (-> v1-15 base))) + ) + (set! + (-> (the-as dma-packet a0-18) dma) + (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)) + ) + (set! (-> (the-as dma-packet a0-18) vif0) (new 'static 'vif-tag)) + (set! + (-> (the-as dma-packet a0-18) vif1) + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + (set! (-> v1-15 base) (&+ (the-as pointer a0-18) 16)) + ) + (let* ((v1-16 dma-buff) + (a0-20 (the-as object (-> v1-16 base))) + ) + (set! + (-> (the-as gs-gif-tag a0-20) tag) + (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1) + ) + (set! + (-> (the-as gs-gif-tag a0-20) regs) + (new 'static 'gif-tag-regs + :regs0 (gif-reg-id a+d) + :regs1 (gif-reg-id a+d) + :regs2 (gif-reg-id a+d) + :regs3 (gif-reg-id a+d) + :regs4 (gif-reg-id a+d) + :regs5 (gif-reg-id a+d) + :regs6 (gif-reg-id a+d) + :regs7 (gif-reg-id a+d) + :regs8 (gif-reg-id a+d) + :regs9 (gif-reg-id a+d) + :regs10 (gif-reg-id a+d) + :regs11 (gif-reg-id a+d) + :regs12 (gif-reg-id a+d) + :regs13 (gif-reg-id a+d) + :regs14 (gif-reg-id a+d) + :regs15 (gif-reg-id a+d) + ) + ) + (set! (-> v1-16 base) (&+ (the-as pointer a0-20) 16)) + ) + (let* ((v1-17 dma-buff) + (a0-22 (-> v1-17 base)) + ) + (set! (-> (the-as (pointer uint64) a0-22) 0) (the-as uint 1)) + (set! (-> (the-as (pointer gs-reg64) a0-22) 1) (gs-reg64 texflush)) + (set! (-> v1-17 base) (&+ a0-22 16)) + ) + (let* ((v1-18 dma-buff) + (a0-24 (the-as object (-> v1-18 base))) + ) + (set! + (-> (the-as dma-packet a0-24) dma) + (new 'static 'dma-tag :id (dma-tag-id end)) + ) + (set! (-> (the-as (pointer uint64) a0-24) 1) (the-as uint 0)) + (set! (-> v1-18 base) (&+ (the-as pointer a0-24) 16)) + ) + (dma-buffer-send-chain (the-as dma-bank-source #x10009000) dma-buff) + ) + (dma-sync (the-as pointer #x10009000) 0 0) + (if + (and + main-font-tx + (-> main-font-tx page) + (= + (-> obj cur) + (+ heap-before-font-tex (the-as int (-> main-font-tx page size))) + ) + ) + (set! (-> obj cur) heap-before-font-tex) + (format 0 "ERROR: could not resize heap to remove gamefont.~%") + ) + ) + ) + 0 + (none) + ) + +;; definition for method 5 of type texture-page-dir +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of texture-page-dir ((obj texture-page-dir)) + (the-as + int + (+ (-> texture-page-dir size) (the-as uint (* 12 (+ (-> obj length) -1)))) + ) + ) + +;; definition for method 4 of type texture-page-dir +(defmethod length texture-page-dir ((obj texture-page-dir)) + (-> obj length) + ) + +;; definition for method 7 of type texture-page-dir +;; INFO: Return type mismatch texture-page-dir vs none. +(defmethod + relocate + texture-page-dir + ((obj texture-page-dir) (arg0 kheap) (arg1 (pointer uint8))) + (set! *texture-page-dir* obj) + (none) + ) + +;; definition for method 12 of type texture-page +;; INFO: Return type mismatch texture-page vs none. +(defmethod + relocate-dests! + texture-page + ((obj texture-page) (new-dest int) (seg-id int)) + (let ((v1-0 (shr new-dest 6)) + (dst-block (shr (-> obj segment seg-id dest) 6)) + ) + (when (!= v1-0 dst-block) + (dotimes (tex-id (-> obj length)) + (when (-> obj data tex-id) + (let* ((tex (-> obj data tex-id)) + (num-mips (-> tex num-mips)) + ) + (if (zero? seg-id) + (set! + (-> tex clutdest) + (+ (- (-> tex clutdest) dst-block) (the-as uint v1-0)) + ) + ) + (dotimes (mip-id (the-as int num-mips)) + (let ((t4-0 mip-id) + (t5-0 num-mips) + ) + (if (= seg-id (if (>= (the-as uint 2) t5-0) + (+ (- -1 t4-0) (the-as int t5-0)) + (max 0 (- 2 t4-0)) + ) + ) + (set! + (-> tex dest mip-id) + (+ (- (-> tex dest mip-id) dst-block) (the-as uint v1-0)) + ) + ) + ) + ) + ) + ) + ) + (set! (-> obj segment seg-id dest) (the-as uint new-dest)) + ) + ) + (none) + ) + +;; definition for method 7 of type texture-page +;; INFO: Return type mismatch texture-page vs none. +(defmethod + relocate + texture-page + ((obj texture-page) (arg0 kheap) (arg1 (pointer uint8))) + (local-vars (s4-0 texture-page-dir-entry)) + (cond + ((or + (not obj) + (not (file-info-correct-version? (-> obj info) (file-kind tpage) 0)) + ) + (set! obj (the-as texture-page #f)) + ) + ((begin + (let ((v1-2 (-> *level* unknown-level-2))) + (when v1-2 + (set! + (-> v1-2 loaded-texture-page (-> v1-2 loaded-texture-page-count)) + obj + ) + (set! + (-> v1-2 loaded-texture-page-count) + (+ (-> v1-2 loaded-texture-page-count) 1) + ) + ) + ) + (set! (-> obj segment 1 dest) (-> obj segment 0 size)) + (set! + (-> obj segment 2 dest) + (+ (-> obj segment 0 size) (-> obj segment 1 size)) + ) + (let ((a3-0 (-> obj id))) + (set! s4-0 (-> *texture-page-dir* entries a3-0)) + (set! (-> *texture-relocate-later* memcpy) #f) + ((-> *texture-pool* allocate-func) + *texture-pool* + obj + arg0 + (the-as int a3-0) + ) + ) + (not (-> *texture-relocate-later* memcpy)) + ) + (set! (-> s4-0 page) obj) + (if (not (-> s4-0 link)) + (set! + (-> s4-0 link) + (the-as + texture-link + (malloc 'loading-level (* (max (-> s4-0 length) (-> obj length)) 4)) + ) + ) + ) + ) + (else + (let ((v1-19 *texture-relocate-later*)) + (set! (-> v1-19 entry) s4-0) + (set! (-> v1-19 page) obj) + ) + ) + ) + (none) + ) + +;; definition for function relocate-later +(defun relocate-later () + (let ((gp-0 *texture-relocate-later*)) + (let ((s5-0 (-> gp-0 entry)) + (s4-0 (-> gp-0 page)) + ) + (ultimate-memcpy + (the-as pointer (-> gp-0 dest)) + (the-as pointer (-> gp-0 source)) + (-> gp-0 move) + ) + (set! (-> s5-0 page) s4-0) + (if (not (-> s5-0 link)) + (set! + (-> s5-0 link) + (the-as + texture-link + (malloc 'loading-level (* (max (-> s5-0 length) (-> s4-0 length)) 4)) + ) + ) + ) + ) + (set! (-> gp-0 memcpy) #f) + ) + #f + ) + +;; definition for function texture-page-login +(defun + texture-page-login + ((id texture-id) + (alloc-func (function texture-pool texture-page kheap int texture-page)) + (heap kheap) + ) + (when + (and + (nonzero? (-> id page)) + (< (the-as uint (-> id page)) (the-as uint (-> *texture-page-dir* length))) + ) + (let ((dir-entry (-> *texture-page-dir* entries (the-as uint (-> id page))))) + (when (not (-> dir-entry page)) + (let ((old-alloc-func (-> *texture-pool* allocate-func))) + (set! (-> *texture-pool* allocate-func) alloc-func) + (let* + ((file-name + (make-file-name + (file-kind tpage) + (the-as string (* (-> id page) 8)) + 0 + #f + ) + ) + (s2-0 (the-as texture-page (loado file-name heap))) + ) + (if s2-0 + (relocate s2-0 heap (charp-basename (-> file-name data))) + ) + ) + (set! (-> *texture-pool* allocate-func) old-alloc-func) + ) + ) + dir-entry + ) + ) + ) + +;; definition for function lookup-texture-by-id +(defun lookup-texture-by-id ((arg0 texture-id)) + (let + ((v1-0 (texture-page-login arg0 texture-page-default-allocate loading-level)) + ) + (if (and v1-0 (< (-> arg0 index) (the-as uint (-> v1-0 page length)))) + (-> v1-0 page data (-> arg0 index)) + ) + ) + ) + +;; definition for method 20 of type texture-pool +(defmethod unload! texture-pool ((obj texture-pool) (arg0 texture-page)) + (local-vars (a0-2 int)) + (let ((v1-0 *texture-page-dir*)) + (dotimes (a0-1 (-> v1-0 length)) + (if (= arg0 (-> v1-0 entries a0-1 page)) + (begin + (set! a0-2 a0-1) + (goto cfg-7) + ) + ) + ) + (set! a0-2 -1) + (label cfg-7) + (when (>= a0-2 0) + (set! (-> v1-0 entries a0-2 page) #f) + (set! (-> v1-0 entries a0-2 link) #f) + ) + ) + 0 + ) + +;; definition for symbol *shader-list*, type pair +(define *shader-list* '()) + +;; definition for symbol *edit-shader*, type int +(define *edit-shader* 0) + +;; definition for function link-texture-by-id +(defun link-texture-by-id ((arg0 texture-id) (arg1 adgif-shader)) + (when + (not + (or + (zero? (-> arg0 page)) + (>= + (the-as uint (-> arg0 page)) + (the-as uint (-> *texture-page-dir* length)) + ) + ) + ) + (let + ((dir-entry (-> *texture-page-dir* entries (the-as uint (-> arg0 page))))) + (if (not (-> dir-entry link)) + (set! + (-> dir-entry link) + (the-as texture-link (malloc 'loading-level (* (-> dir-entry length) 4))) + ) + ) + (when (< (-> arg0 index) (the-as uint (-> dir-entry length))) + (set! + (-> arg1 next shader) + (-> dir-entry link next (-> arg0 index) shader) + ) + (set! + (-> dir-entry link next (-> arg0 index) shader) + (shr (the-as uint arg1) 4) + ) + ) + dir-entry + ) + ) + ) + +;; definition for method 9 of type texture-page-dir +(defmethod + unlink-textures-in-heap! + texture-page-dir + ((obj texture-page-dir) (heap kheap)) + (local-vars (dist-past-end uint)) + (let ((mem-start (-> heap base)) + (mem-end (-> heap top-base)) + ) + (dotimes (entry-idx (-> obj length)) + (let* ((entry (-> obj entries entry-idx)) + (tex-page (-> entry page)) + (link-arr (-> entry link next)) + (tex-count (min (-> tex-page length) (-> entry length))) + ) + 0 + (when link-arr + (dotimes (tex-idx tex-count) + (let ((link-slot (&-> link-arr 0)) + (shader (the-as adgif-shader (* (-> link-arr 0 shader) 16))) + ) + (while (nonzero? (the-as int shader)) + (b! + (< (the-as int (- (the-as int shader) (the-as int mem-start))) 0) + cfg-7 + :delay + (set! dist-past-end (the-as uint (- (the-as int shader) mem-end))) + ) + (b! (>= (the-as int dist-past-end) 0) cfg-7 :delay (nop!)) + (let ((t4-2 (-> shader next))) + (b! #t cfg-8 :delay (set! (-> link-slot 0) t4-2)) + ) + (label cfg-7) + (set! link-slot (&-> shader next)) + (label cfg-8) + (set! shader (the-as adgif-shader (* (-> shader next shader) 16))) + ) + ) + (set! link-arr (&-> link-arr 1)) + ) + ) + ) + ) + ) + 0 + ) + +;; definition for function adgif-shader<-texture! +(defun adgif-shader<-texture! ((arg0 adgif-shader) (arg1 texture)) + (set! (-> arg0 tex1 mxl) (+ (-> arg1 num-mips) -1)) + (set! (-> arg0 tex1 l) (-> arg1 mip-shift)) + (set! (-> arg0 tex1 mmag) (logand (-> arg1 tex1-control) 1)) + (set! (-> arg0 tex1 mmin) (shr (-> arg1 tex1-control) 1)) + (set! + (-> arg0 tex0) + (new 'static 'gs-tex0 + :tcc #x1 + :cld #x1 + :cpsm (-> arg1 clutpsm) + :cbp (-> arg1 clutdest) + :tfx (-> arg0 tex0 tfx) + :th (log2 (-> arg1 h)) + :tw (log2 (-> arg1 w)) + :tbw (-> arg1 width 0) + :tbp0 (-> arg1 dest 0) + :psm (the-as int (-> arg1 psm)) + ) + ) + (set! + (-> arg0 miptbp1) + (new 'static 'gs-miptbp + :tbp1 (-> arg1 dest 1) + :tbw1 (-> arg1 width 1) + :tbp2 (-> arg1 dest 2) + :tbw2 (-> arg1 width 2) + :tbp3 (-> arg1 dest 3) + :tbw3 (-> arg1 width 3) + ) + ) + (when (< (the-as uint 4) (-> arg1 num-mips)) + (set! + (-> arg0 alpha) + (new 'static 'gs-miptbp + :tbp1 (-> arg1 dest 4) + :tbw1 (-> arg1 width 4) + :tbp2 (-> arg1 dest 5) + :tbw2 (-> arg1 width 5) + :tbp3 (-> arg1 dest 6) + :tbw3 (-> arg1 width 6) + ) + ) + (set! (-> (&-> arg0 quad 4 vector4w z) 0) 54) + ) + arg0 + ) + +;; definition for function adgif-shader-update! +;; INFO: Return type mismatch gs-tex1 vs none. +(defun adgif-shader-update! ((arg0 adgif-shader) (arg1 texture)) + (let ((s5-0 (the int (/ 256.0 (-> arg1 uv-dist)))) + (v1-2 (-> arg0 tex1 l)) + ) + (if (= v1-2 1) + (set! + (-> arg0 tex1 k) + (+ (+ (logand (ash s5-0 (- 5 (log2 s5-0))) 31) -350) (* (log2 s5-0) 32)) + ) + (set! + (-> arg0 tex1 k) + (+ (+ (logand (ash s5-0 (- 4 (log2 s5-0))) 15) -175) (* (log2 s5-0) 16)) + ) + ) + ) + (none) + ) + +;; definition for function adgif-shader<-texture-with-update! +;; WARN: Unsupported inline assembly instruction kind - [plzcw v1, v1] +;; WARN: Unsupported inline assembly instruction kind - [subu v1, t0, v1] +;; WARN: Unsupported inline assembly instruction kind - [plzcw a3, a3] +;; WARN: Unsupported inline assembly instruction kind - [subu a3, t0, a3] +;; WARN: Unsupported inline assembly instruction kind - [plzcw a3, v1] +;; WARN: Unsupported inline assembly instruction kind - [subu a3, t0, a3] +(defun adgif-shader<-texture-with-update! ((arg0 adgif-shader) (arg1 texture)) + (local-vars + (v1-11 int) + (v1-12 int) + (a3-4 int) + (a3-5 int) + (a3-9 int) + (a3-10 int) + (a3-13 int) + (a3-22 uint) + ) + (let* ((a2-0 (-> arg0 tex1)) + (v1-0 256) + (a2-1 (incomplete-bitfield-access a2-0)) + (f0-1 (the float v1-0)) + (v1-1 (-> arg1 num-mips)) + (f1-0 (-> arg1 uv-dist)) + (v1-2 (+ v1-1 -1)) + (f0-2 (/ f0-1 f1-0)) + (a2-2 (logior a2-1 (the-as uint (* v1-2 4)))) + (v1-5 (shl (-> arg1 mip-shift) 19)) + (a3-0 (-> arg1 tex1-control)) + (a2-4 + (logior (logior a2-2 (the-as uint v1-5)) (the-as uint (* a3-0 32))) + ) + ) + (let* ((t1-1 (incomplete-bitfield-access (-> arg0 tex0))) + (v1-6 (-> arg1 psm)) + (t1-2 (sar t1-1 62)) + (v1-7 (shl (the-as int v1-6) 20)) + (t1-3 (shl t1-2 35)) + (a3-2 (-> arg1 dest 0)) + (t1-4 (logior t1-3 v1-7)) + (v1-8 (-> arg1 width 0)) + (t1-6 (logior (logior t1-4 a3-2) (shl v1-8 14))) + ) + (let ((v1-10 (-> arg1 wu))) + (.plzcw v1-11 v1-10) + ) + (let ((t0-0 30)) + (.subu v1-12 t0-0 v1-11) + (let ((a3-3 (-> arg1 hu)) + (v1-13 (shl v1-12 26)) + ) + (.plzcw a3-4 a3-3) + (let ((t1-7 (logior t1-6 (the-as uint v1-13)))) + (.subu a3-5 t0-0 a3-4) + (let* ((a3-6 (shl a3-5 30)) + (v1-14 1) + (t1-9 + (logior + (logior t1-7 (the-as uint a3-6)) + (the-as uint (shl v1-14 34)) + ) + ) + (v1-17 (shl (-> arg1 clutdest) 37)) + (a3-8 (shl (-> arg1 clutpsm) 51)) + (t1-11 (logior (logior t1-9 v1-17) a3-8)) + (v1-19 (shl 1 61)) + (f0-3 (the int f0-2)) + (t1-12 (logior t1-11 (the-as uint v1-19))) + (v1-20 f0-3) + ) + (set! (-> arg0 tex0) (the-as gs-tex0 t1-12)) + (.plzcw a3-9 v1-20) + (.subu a3-10 t0-0 a3-9) + (let ((t0-2 (+ (-> arg1 mip-shift) -1))) + (nop!) + (b! (zero? t0-2) cfg-2) + ) + (let* ((t0-3 (+ a3-10 -4)) + (a3-11 (* a3-10 16)) + (t0-4 (sar v1-20 t0-3)) + (a3-12 (+ a3-11 -175)) + (t0-5 (logand t0-4 15)) + ) + (nop!) + (b! #t cfg-3 :delay (set! a3-13 (the-as int (+ a3-12 t0-5)))) + ) + (label cfg-2) + (let* ((t0-6 (+ a3-10 -5)) + (a3-14 (* a3-10 32)) + (t0-7 (sar v1-20 t0-6)) + (a3-15 (+ a3-14 -350)) + (t0-8 (logand t0-7 31)) + ) + (nop!) + (set! a3-13 (+ a3-15 t0-8)) + ) + ) + ) + ) + ) + ) + (nop!) + (label cfg-3) + (let* ((a3-16 (logand a3-13 4095)) + (t1-13 (-> arg1 dest 1)) + (a3-17 (shl a3-16 32)) + (v1-21 (-> arg1 width 1)) + (a2-5 (logior a2-4 (the-as uint a3-17))) + (v1-22 (shl v1-21 14)) + ) + (set! (-> arg0 tex1) a2-5) + (let ((a2-6 (logior t1-13 v1-22)) + (v1-23 (-> arg1 dest 2)) + ) + (nop!) + (let* ((a3-18 (-> arg1 width 2)) + (a2-8 (logior (logior a2-6 (shl v1-23 20)) (shl a3-18 34))) + (v1-25 (-> arg1 dest 3)) + (a3-20 (-> arg1 width 3)) + (a2-10 (logior (logior a2-8 (shl v1-25 40)) (shl a3-20 54))) + (t0-10 (+ (-> arg1 num-mips) -5)) + ) + (set! (-> arg0 miptbp1) (the-as gs-miptbp a2-10)) + (b! + (< (the-as int t0-10) 0) + cfg-5 + :delay + (set! a3-22 (the-as uint (-> arg1 width 4))) + ) + ) + ) + ) + ) + (let* ((a2-12 (logior (-> arg1 dest 4) (shl a3-22 14))) + (v1-28 (shl (-> arg1 dest 5) 20)) + (a3-24 (-> arg1 width 5)) + (a2-14 (logior (logior a2-12 v1-28) (shl a3-24 34))) + (v1-30 (shl (-> arg1 dest 6) 40)) + (a3-26 (-> arg1 width 6)) + (a2-16 (logior (logior a2-14 v1-30) (shl a3-26 54))) + (v1-31 54) + ) + (set! (-> arg0 alpha) (the-as gs-miptbp a2-16)) + (nop!) + (set! (-> arg0 quad 4 vector4w z) v1-31) + ) + (nop!) + (label cfg-5) + arg0 + ) + +;; definition for function adgif-shader-login +(defun adgif-shader-login ((shader adgif-shader)) + (when (nonzero? (logand (-> shader link-test) (link-test-flags needs-log-in))) + (set! + (-> shader link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> shader link-test)) + ) + (set! (-> shader texture-id) (level-remap-texture (-> shader texture-id))) + (link-texture-by-id (-> shader texture-id) shader) + (let ((tex (lookup-texture-by-id (-> shader texture-id)))) + (if tex + (adgif-shader<-texture-with-update! shader tex) + (format + 0 + "login could not find texture ~X in shader ~X~%" + (-> shader texture-id) + shader + ) + ) + tex + ) + ) + ) + +;; definition for function adgif-shader-login-no-remap +(defun adgif-shader-login-no-remap ((arg0 adgif-shader)) + (when (nonzero? (logand (-> arg0 link-test) (link-test-flags needs-log-in))) + (set! + (-> arg0 link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> arg0 link-test)) + ) + (link-texture-by-id (-> arg0 texture-id) arg0) + (let ((s5-0 (lookup-texture-by-id (-> arg0 texture-id)))) + (if s5-0 + (adgif-shader<-texture-with-update! arg0 s5-0) + (format + 0 + "login could not find texture ~X in shader ~X~%" + (-> arg0 texture-id) + arg0 + ) + ) + s5-0 + ) + ) + ) + +;; definition for function adgif-shader-login-fast +(defun adgif-shader-login-fast ((shader adgif-shader)) + (when (nonzero? (logand (-> shader link-test) (link-test-flags needs-log-in))) + (set! + (-> shader link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> shader link-test)) + ) + (set! (-> shader texture-id) (level-remap-texture (-> shader texture-id))) + (let ((tex-id (-> shader texture-id))) + (when + (and + (nonzero? (-> tex-id page)) + (< + (the-as uint (-> tex-id page)) + (the-as uint (-> *texture-page-dir* length)) + ) + ) + (let + ((dir-entry + (-> *texture-page-dir* entries (the-as uint (-> tex-id page))) + ) + ) + (when + (and + (< (-> tex-id index) (the-as uint (-> dir-entry length))) + (-> dir-entry link) + ) + (set! + (-> shader next shader) + (-> dir-entry link next (-> tex-id index) shader) + ) + (set! + (-> dir-entry link next (-> tex-id index) shader) + (shr (the-as uint shader) 4) + ) + ) + (when + (and + (-> dir-entry page) + (< (-> tex-id index) (the-as uint (-> dir-entry page length))) + ) + (let ((tex (-> dir-entry page data (-> tex-id index)))) + (if tex + (adgif-shader<-texture-with-update! shader tex) + ) + tex + ) + ) + ) + ) + ) + ) + ) + +;; definition for function adgif-shader-login-no-remap-fast +(defun adgif-shader-login-no-remap-fast ((arg0 adgif-shader)) + (when (nonzero? (logand (-> arg0 link-test) (link-test-flags needs-log-in))) + (set! + (-> arg0 link-test) + (logand (lognot (link-test-flags needs-log-in bit-9)) (-> arg0 link-test)) + ) + (let ((v1-4 (-> arg0 texture-id))) + (when + (and + (nonzero? (-> v1-4 page)) + (< + (the-as uint (-> v1-4 page)) + (the-as uint (-> *texture-page-dir* length)) + ) + ) + (let ((a1-7 (-> *texture-page-dir* entries (the-as uint (-> v1-4 page))))) + (when + (and (< (-> v1-4 index) (the-as uint (-> a1-7 length))) (-> a1-7 link)) + (set! (-> arg0 next shader) (-> a1-7 link next (-> v1-4 index) shader)) + (set! + (-> a1-7 link next (-> v1-4 index) shader) + (shr (the-as uint arg0) 4) + ) + ) + (when + (and + (-> a1-7 page) + (< (-> v1-4 index) (the-as uint (-> a1-7 page length))) + ) + (let ((gp-0 (-> a1-7 page data (-> v1-4 index)))) + (if gp-0 + (adgif-shader<-texture-with-update! arg0 gp-0) + ) + gp-0 + ) + ) + ) + ) + ) + ) + ) + +;; failed to figure out what this is: +(when (not *debug-segment*) + (set! adgif-shader-login adgif-shader-login-fast) + (set! adgif-shader-login-no-remap adgif-shader-login-no-remap-fast) + ) + +;; definition for function adgif-shader<-texture-simple! +(defun adgif-shader<-texture-simple! ((arg0 adgif-shader) (arg1 texture)) + (set! (-> arg0 tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1)) + (set! + (-> arg0 tex0) + (the-as + gs-tex0 + (logand (the-as uint (-> arg0 tex0)) (the-as uint #xffffffe7ffffffff)) + ) + ) + (if arg1 + (adgif-shader<-texture! arg0 arg1) + ) + (set! (-> arg0 clamp) (new 'static 'gs-clamp :wms #x1 :wmt #x1)) + (set! (-> arg0 alpha) (new 'static 'gs-miptbp :tbp1 #x44)) + (set! (-> arg0 prims 1) (gs-reg64 tex0-1)) + (set! (-> arg0 prims 3) (gs-reg64 tex1-1)) + (set! (-> arg0 prims 5) (gs-reg64 miptbp1-1)) + (set! (-> arg0 clamp-reg) (gs-reg64 clamp-1)) + (set! (-> arg0 prims 9) (gs-reg64 alpha-1)) + arg0 + ) + +;; definition (debug) for function texture-page-dir-inspect +;; INFO: Return type mismatch texture-page-dir vs none. +(defun-debug texture-page-dir-inspect ((dir texture-page-dir) (mode symbol)) + (format #t "[~8x] ~A~%" dir (-> dir type)) + (let ((pool *texture-pool*)) + (format + #t + "~Ttexture pool (~DK used, ~DK free)~%" + (/ (- (-> pool cur) (-> pool top)) 256) + (/ (- #xa0000 (-> pool cur)) 256) + ) + ) + (dotimes (level-idx (-> *level* length)) + (let ((lev (-> *level* level level-idx))) + (if (= (-> lev status) 'active) + (texture-page-size-check *texture-pool* lev #f) + ) + ) + ) + (format #t "~Tlength: ~D~%" (-> dir length)) + (format #t "~Tdata[~D]: @ #x~X~%" (-> dir length) (-> dir entries)) + (dotimes (entry-idx (-> dir length)) + (let ((entry-page (-> dir entries entry-idx page)) + (entry-link (-> dir entries entry-idx link)) + ) + (cond + (entry-page + (format #t "~T [~3D] loaded ~S ~A~%" entry-idx (if entry-link + " linked" + "unlinked" + ) + entry-page + ) + ) + (else + (if (= mode 'full) + (format + #t + "~T [~3D] unloaded ~S #~%" + entry-idx + (if entry-link + " linked" + "unlinked" + ) + (-> dir entries entry-idx length) + ) + ) + ) + ) + (when (and (or entry-page entry-link) mode) + (dotimes (entry-list-length (-> dir entries entry-idx length)) + (cond + ((not entry-link) + (format #t "~T [~3D] unlinked" entry-list-length) + ) + ((zero? (-> entry-link next entry-list-length shader)) + (format #t "~T [~3D] UNUSED " entry-list-length) + ) + (else + (let ((t9-9 format) + (a0-12 #t) + (a1-10 "~T [~3D] ~3D links ") + (a2-11 entry-list-length) + (a3-7 0) + ) + (let + ((v1-40 + (the-as object (* (-> entry-link next entry-list-length shader) 16)) + ) + ) + (while (nonzero? (the-as int v1-40)) + (nop!) + (+! a3-7 1) + (set! v1-40 (* (-> (the-as adgif-shader v1-40) next shader) 16)) + ) + ) + (t9-9 a0-12 a1-10 a2-11 a3-7) + ) + ) + ) + (cond + ((not entry-page) + (format #t " unloaded~%") + ) + ((not (-> entry-page data entry-list-length)) + (format #t " empty~%") + ) + (else + (format #t " ~A~%" (-> entry-page data entry-list-length)) + ) + ) + ) + ) + ) + ) + (none) + ) + +;; definition for method 3 of type texture-page-dir +(defmethod inspect texture-page-dir ((obj texture-page-dir)) + (texture-page-dir-inspect obj #f) + obj + ) + +;; definition for symbol *texture-pool*, type texture-pool +(define *texture-pool* (new 'global 'texture-pool)) + + + + diff --git a/test/decompiler/reference/engine/gfx/tie/prototype_REF.gc b/test/decompiler/reference/engine/gfx/tie/prototype_REF.gc index 76009b8778..ce162db556 100644 --- a/test/decompiler/reference/engine/gfx/tie/prototype_REF.gc +++ b/test/decompiler/reference/engine/gfx/tie/prototype_REF.gc @@ -16,14 +16,14 @@ (let ((s4-1 (-> s4-0 envmap-shader))) (when (nonzero? s4-1) (adgif-shader-login-no-remap s4-1) - (set! (-> s4-1 tex1) (the-as uint 96)) - (set! (-> s4-1 clamp) (the-as uint 5)) - (set! (-> s4-1 alpha) (the-as uint 88)) - (set! (-> s4-1 prims 1) (the-as uint 6)) - (set! (-> s4-1 prims 3) (the-as uint 20)) - (set! (-> s4-1 prims 5) (the-as uint 52)) - (set! (-> s4-1 clamp-reg) (the-as uint 8)) - (set! (-> s4-1 prims 9) (the-as uint 66)) + (set! (-> s4-1 tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1)) + (set! (-> s4-1 clamp) (new 'static 'gs-clamp :wms #x1 :wmt #x1)) + (set! (-> s4-1 alpha) (new 'static 'gs-miptbp :tbp1 #x58)) + (set! (-> s4-1 prims 1) (gs-reg64 tex0-1)) + (set! (-> s4-1 prims 3) (gs-reg64 tex1-1)) + (set! (-> s4-1 prims 5) (gs-reg64 miptbp1-1)) + (set! (-> s4-1 clamp-reg) (gs-reg64 clamp-1)) + (set! (-> s4-1 prims 9) (gs-reg64 alpha-1)) ) ) ) diff --git a/test/decompiler/reference/engine/level/level-h_REF.gc b/test/decompiler/reference/engine/level/level-h_REF.gc index 3d94458b22..7b33006f5a 100644 --- a/test/decompiler/reference/engine/level/level-h_REF.gc +++ b/test/decompiler/reference/engine/level/level-h_REF.gc @@ -173,7 +173,7 @@ (vis-self-index int32 :offset-assert 440) (vis-adj-index int32 :offset-assert 444) (vis-buffer uint8 2048 :offset-assert 448) - (mem-usage-block basic :offset-assert 2496) + (mem-usage-block memory-usage-block :offset-assert 2496) (mem-usage int32 :offset-assert 2500) (code-memory-start pointer :offset-assert 2504) (code-memory-end pointer :offset-assert 2508) @@ -187,10 +187,10 @@ (:methods (deactivate (_type_) _type_ 9) (dummy-10 (_type_ int) symbol 10) - (dummy-11 (_type_) none 11) + (add-irq-to-tex-buckets! (_type_) none 11) (unload! (_type_) _type_ 12) (bsp-name (_type_) symbol 13) - (dummy-14 (_type_) none 14) + (dummy-14 (_type_ object) none 14) (dummy-15 (_type_ vector) symbol 15) (dummy-16 (_type_) none 16) (load-continue (_type_) _type_ 17) diff --git a/test/decompiler/reference/engine/math/quaternion_REF.gc b/test/decompiler/reference/engine/math/quaternion_REF.gc index 6965e17f9d..217a8fe76a 100644 --- a/test/decompiler/reference/engine/math/quaternion_REF.gc +++ b/test/decompiler/reference/engine/math/quaternion_REF.gc @@ -1069,19 +1069,16 @@ ;; definition (debug) for function quaternion-validate ;; INFO: Return type mismatch int vs none. (defun-debug quaternion-validate ((arg0 quaternion)) - (with-pp (let ((f0-0 (quaternion-norm arg0))) - (when (or (< 1.01 f0-0) (< f0-0 0.99)) - (format - #t - "WARNING: bad quaternion (magnitude ~F) process is " - f0-0 - ) - (if (and pp (type-type? (-> pp type) process-tree)) - (format #t "~A~%" (-> pp name)) - (format #t "#f~%") - ) - ) - ) + (with-pp + (let ((f0-0 (quaternion-norm arg0))) + (when (or (< 1.01 f0-0) (< f0-0 0.99)) + (format #t "WARNING: bad quaternion (magnitude ~F) process is " f0-0) + (if (and pp (type-type? (-> pp type) process-tree)) + (format #t "~A~%" (-> pp name)) + (format #t "#f~%") + ) + ) + ) 0 (none) ) diff --git a/test/decompiler/reference/engine/nav/navigate-h_REF.gc b/test/decompiler/reference/engine/nav/navigate-h_REF.gc index d2afb92d61..7b30793a36 100644 --- a/test/decompiler/reference/engine/nav/navigate-h_REF.gc +++ b/test/decompiler/reference/engine/nav/navigate-h_REF.gc @@ -449,103 +449,91 @@ ;; Used lq/sq (defun nav-mesh-connect ((proc process) (trans trsqv) (nav-cont nav-control)) (local-vars (sv-16 type) (sv-32 symbol)) - (with-pp (let ((ent (-> proc entity))) - (when (zero? (-> (the-as entity-actor ent) nav-mesh)) - (let - ((lookup-entity - (entity-actor-lookup - (the-as entity-actor ent) - 'nav-mesh-actor - 0 - ) - ) - ) - (if lookup-entity - (set! ent lookup-entity) - ) + (with-pp + (let ((ent (-> proc entity))) + (when (zero? (-> (the-as entity-actor ent) nav-mesh)) + (let + ((lookup-entity + (entity-actor-lookup (the-as entity-actor ent) 'nav-mesh-actor 0) + ) + ) + (if lookup-entity + (set! ent lookup-entity) + ) + ) + ) + (let ((entity-nav-mesh (-> (the-as entity-actor ent) nav-mesh))) + (cond + ((nonzero? entity-nav-mesh) + (when (zero? (-> entity-nav-mesh user-list)) + (set! + process-level-heap + (-> + (the-as entity-links (-> (the-as entity (-> pp entity)) extra)) + level + heap + ) + ) + (let ((s1-0 (method-of-type engine new)) + (s0-0 'process-level-heap) ) - ) - (let ((entity-nav-mesh (-> (the-as entity-actor ent) nav-mesh))) - (cond - ((nonzero? entity-nav-mesh) - (when (zero? (-> entity-nav-mesh user-list)) - (set! - process-level-heap - (-> - (the-as - entity-links - (-> (the-as entity (-> pp entity)) extra) - ) - level - heap - ) - ) - (let ((s1-0 (method-of-type engine new)) - (s0-0 'process-level-heap) - ) - (set! sv-16 engine) - (set! sv-32 'nav-engine) - (let - ((a3-1 - ((method-of-type res-lump get-property-value) - ent - 'nav-max-users - 'interp - -1000000000.0 - (the-as uint128 32) - (the-as (pointer res-tag) #f) - *res-static-buf* - ) - ) - ) - (set! - (-> entity-nav-mesh user-list) - (s1-0 s0-0 sv-16 sv-32 (the-as int a3-1)) - ) - ) - ) - (dummy-13 entity-nav-mesh) - (dummy-17 entity-nav-mesh) - ) - (add-connection - (-> entity-nav-mesh user-list) - proc - (the-as (function object object object object object) nothing) - proc - nav-cont - trans - ) - ) - (else - (if (and nav-cont (-> proc entity)) - (set! - (-> - (the-as - entity-links - (-> (the-as entity (-> proc entity)) extra) - ) - perm - status - ) - (logior - (-> - (the-as - entity-links - (-> (the-as entity (-> proc entity)) extra) - ) - perm - status - ) - (entity-perm-status bit-1) - ) - ) - ) - (set! entity-nav-mesh *default-nav-mesh*) - ) - ) - entity-nav-mesh + (set! sv-16 engine) + (set! sv-32 'nav-engine) + (let + ((a3-1 + ((method-of-type res-lump get-property-value) + ent + 'nav-max-users + 'interp + -1000000000.0 + (the-as uint128 32) + (the-as (pointer res-tag) #f) + *res-static-buf* ) ) + ) + (set! + (-> entity-nav-mesh user-list) + (s1-0 s0-0 sv-16 sv-32 (the-as int a3-1)) + ) + ) + ) + (dummy-13 entity-nav-mesh) + (dummy-17 entity-nav-mesh) + ) + (add-connection + (-> entity-nav-mesh user-list) + proc + (the-as (function object object object object object) nothing) + proc + nav-cont + trans + ) + ) + (else + (if (and nav-cont (-> proc entity)) + (set! + (-> + (the-as entity-links (-> (the-as entity (-> proc entity)) extra)) + perm + status + ) + (logior + (-> + (the-as entity-links (-> (the-as entity (-> proc entity)) extra)) + perm + status + ) + (entity-perm-status bit-1) + ) + ) + ) + (set! entity-nav-mesh *default-nav-mesh*) + ) + ) + entity-nav-mesh + ) + ) ) ) diff --git a/test/decompiler/reference/kernel/gkernel_REF.gc b/test/decompiler/reference/kernel/gkernel_REF.gc index 8abe605873..badd604ae2 100644 --- a/test/decompiler/reference/kernel/gkernel_REF.gc +++ b/test/decompiler/reference/kernel/gkernel_REF.gc @@ -1131,12 +1131,13 @@ ;; INFO: Return type mismatch process-tree vs process. (defun process-by-name ((arg0 object) (arg1 process-tree)) (set! *global-search-name* (the-as basic arg0)) - (the-as - process - (search-process-tree - arg1 - (lambda ((arg0 process)) (name= (-> arg0 name) *global-search-name*)) - ) + (the-as process (search-process-tree arg1 (lambda ((arg0 process)) + (name= + (-> arg0 name) + *global-search-name* + ) + ) + ) ) ) @@ -1144,25 +1145,28 @@ ;; INFO: Return type mismatch process-tree vs process. (defun process-not-name ((arg0 object) (arg1 process-tree)) (set! *global-search-name* (the-as basic arg0)) - (the-as - process - (search-process-tree - arg1 - (lambda ((arg0 process)) (not (name= (-> arg0 name) *global-search-name*))) - ) + (the-as process (search-process-tree arg1 (lambda ((arg0 process)) + (not + (name= + (-> arg0 name) + *global-search-name* + ) + ) + ) + ) ) ) ;; definition for function process-count (defun process-count ((arg0 process-tree)) (set! *global-search-count* 0) - (iterate-process-tree - arg0 - (lambda - ((arg0 process)) - (set! *global-search-count* (+ *global-search-count* 1)) - #t - ) + (iterate-process-tree arg0 (lambda ((arg0 process)) + (set! + *global-search-count* + (+ *global-search-count* 1) + ) + #t + ) *null-kernel-context* ) *global-search-count* @@ -1185,12 +1189,13 @@ (local-vars (a0-1 process-tree)) (set! *global-search-name* (the-as basic arg0)) (while (begin - (set! - a0-1 - (search-process-tree - arg1 - (lambda ((arg0 process)) (= (-> arg0 type) *global-search-name*)) - ) + (set! a0-1 (search-process-tree arg1 (lambda ((arg0 process)) + (= + (-> arg0 type) + *global-search-name* + ) + ) + ) ) a0-1 ) @@ -1216,12 +1221,13 @@ (local-vars (a0-1 process-tree)) (set! *global-search-name* (the-as basic arg0)) (while (begin - (set! - a0-1 - (search-process-tree - arg1 - (lambda ((arg0 process)) (!= (-> arg0 type) *global-search-name*)) - ) + (set! a0-1 (search-process-tree arg1 (lambda ((arg0 process)) + (!= + (-> arg0 type) + *global-search-name* + ) + ) + ) ) a0-1 ) @@ -1340,98 +1346,112 @@ (set! *enable-method-set* (+ *enable-method-set* -1)) 0 ) - (execute-process-tree - *active-pool* - (lambda ((arg0 process)) (let ((s5-0 *kernel-context*) - (v1-0 (-> arg0 status)) - ) - (cond - ((or (= v1-0 'waiting-to-run) (= v1-0 'suspended)) - (set! (-> s5-0 current-process) arg0) - (cond - ((nonzero? - (logand (-> arg0 mask) (process-mask pause)) - ) - (set! *stdcon* *stdcon1*) - (set! *debug-draw-pauseable* #t) - ) - (else - (set! *stdcon* *stdcon0*) - (set! *debug-draw-pauseable* #f) - ) - ) - (when (-> arg0 trans-hook) - (let - ((s4-0 - (new - 'process - 'cpu-thread - arg0 - 'trans - 256 - (-> arg0 main-thread stack-top) - ) - ) - ) - (reset-and-call s4-0 (-> arg0 trans-hook)) - (delete s4-0) - ) - (when (= (-> arg0 status) 'dead) - (set! (-> s5-0 current-process) #f) - (return 'dead) - ) - ) - (if - (nonzero? - (logand - (-> arg0 mask) - (process-mask sleep-code) - ) - ) - (set! (-> arg0 status) 'suspended) - ((-> arg0 main-thread resume-hook) - (-> arg0 main-thread) - ) - ) - (cond - ((= (-> arg0 status) 'dead) - (set! (-> s5-0 current-process) #f) - 'dead - ) - (else - (when (-> arg0 post-hook) - (let - ((s4-1 - (new - 'process - 'cpu-thread - arg0 - 'post - 256 - (&-> *dram-stack* 14336) - ) - ) - ) - (reset-and-call s4-1 (-> arg0 post-hook)) - (delete s4-1) - ) - (when (= (-> arg0 status) 'dead) - (set! (-> s5-0 current-process) #f) - (return 'dead) - ) - (set! (-> arg0 status) 'suspended) - ) - (set! (-> s5-0 current-process) #f) - #f - ) - ) - ) - ((= v1-0 'dead) - 'dead - ) - ) - ) - ) + (execute-process-tree *active-pool* (lambda ((arg0 process)) + (let ((s5-0 *kernel-context*) + (v1-0 (-> arg0 status)) + ) + (cond + ((or + (= v1-0 'waiting-to-run) + (= v1-0 'suspended) + ) + (set! (-> s5-0 current-process) arg0) + (cond + ((nonzero? + (logand + (-> arg0 mask) + (process-mask pause) + ) + ) + (set! *stdcon* *stdcon1*) + (set! *debug-draw-pauseable* #t) + ) + (else + (set! *stdcon* *stdcon0*) + (set! *debug-draw-pauseable* #f) + ) + ) + (when (-> arg0 trans-hook) + (let + ((s4-0 + (new + 'process + 'cpu-thread + arg0 + 'trans + 256 + (-> arg0 main-thread stack-top) + ) + ) + ) + (reset-and-call + s4-0 + (-> arg0 trans-hook) + ) + (delete s4-0) + ) + (when (= (-> arg0 status) 'dead) + (set! (-> s5-0 current-process) #f) + (return 'dead) + ) + ) + (if + (nonzero? + (logand + (-> arg0 mask) + (process-mask sleep-code) + ) + ) + (set! (-> arg0 status) 'suspended) + ((-> arg0 main-thread resume-hook) + (-> arg0 main-thread) + ) + ) + (cond + ((= (-> arg0 status) 'dead) + (set! (-> s5-0 current-process) #f) + 'dead + ) + (else + (when (-> arg0 post-hook) + (let + ((s4-1 + (new + 'process + 'cpu-thread + arg0 + 'post + 256 + (&-> *dram-stack* 14336) + ) + ) + ) + (reset-and-call + s4-1 + (-> arg0 post-hook) + ) + (delete s4-1) + ) + (when (= (-> arg0 status) 'dead) + (set! + (-> s5-0 current-process) + #f + ) + (return 'dead) + ) + (set! (-> arg0 status) 'suspended) + ) + (set! (-> s5-0 current-process) #f) + #f + ) + ) + ) + ((= v1-0 'dead) + 'dead + ) + ) + ) + ) *kernel-context* ) ) @@ -1497,14 +1517,15 @@ new protect-frame ((allocation symbol) (type-to-make type) (arg0 (function object))) - (with-pp (let ((v0-0 (the-as object (+ (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 v0-0) - ) + (with-pp + (let ((v0-0 (the-as object (+ (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 v0-0) + ) ) ) @@ -1797,55 +1818,56 @@ ;; WARN: Unsupported inline assembly instruction kind - [jr ra] (defmethod deactivate process ((obj process)) (local-vars (s7-0 none) (ra-0 int)) - (with-pp (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! s4-0 (-> (the-as protect-frame s4-0) next)) - ) - ) - (let ((s6-2 s5-0)) - ) - ) - (process-disconnect obj) - (let ((v1-11 (-> obj child))) - (while v1-11 - (let ((s5-1 (-> v1-11 0 brother))) - (deactivate (-> v1-11 0)) - (set! v1-11 s5-1) - ) - ) - ) - (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!) - 0 - ) - ((= (-> obj status) 'initialize) - (set! (-> obj status) 'dead) - (throw 'initialize #f) - ) - ) - (set! (-> obj status) 'dead) - 0 - ) + (with-pp + (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! s4-0 (-> (the-as protect-frame s4-0) next)) + ) + ) + (let ((s6-2 s5-0)) + ) + ) + (process-disconnect obj) + (let ((v1-11 (-> obj child))) + (while v1-11 + (let ((s5-1 (-> v1-11 0 brother))) + (deactivate (-> v1-11 0)) + (set! v1-11 s5-1) + ) + ) + ) + (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!) + 0 + ) + ((= (-> obj status) 'initialize) + (set! (-> obj status) 'dead) + (throw 'initialize #f) + ) + ) + (set! (-> obj status) 'dead) + 0 + ) (none) ) ) diff --git a/test/offline/offline_test_main.cpp b/test/offline/offline_test_main.cpp index 56d624aed6..dfea7700f0 100644 --- a/test/offline/offline_test_main.cpp +++ b/test/offline/offline_test_main.cpp @@ -146,6 +146,10 @@ const std::unordered_set g_functions_to_skip_compiling = { "curve-evaluate!", // asm requiring manual rewrite "point-in-triangle-cross", // logior on floats manual fixup + // texture + "(method 9 texture-page-dir)", // multiplication on pointers + "adgif-shader<-texture-with-update!", // misrecognized bitfield stuff. + // asm "invalidate-cache-line",