From 0a6602e320809e494cb7c38b1356e4faeba5909a Mon Sep 17 00:00:00 2001 From: water111 <48171810+water111@users.noreply.github.com> Date: Wed, 5 May 2021 17:38:16 -0400 Subject: [PATCH] [Decompile] connect, text-h, settings-h, capture, memory-usage-h (#410) * decompile stuff * temp * temp2 * fix * temp * preparing for merge * working * fix stupid format * fix codacy --- common/type_system/TypeSystem.cpp | 3 +- decompiler/IR2/AtomicOp.cpp | 12 +- decompiler/IR2/AtomicOp.h | 4 +- decompiler/IR2/AtomicOpForm.cpp | 17 +- decompiler/IR2/AtomicOpTypeAnalysis.cpp | 4 +- decompiler/IR2/Form.cpp | 8 +- decompiler/IR2/Form.h | 4 +- decompiler/IR2/FormExpressionAnalysis.cpp | 16 +- decompiler/ObjectFile/ObjectFileDB_IR2.cpp | 7 +- decompiler/analysis/atomic_op_builder.cpp | 2 +- decompiler/analysis/stack_spill.cpp | 5 +- decompiler/config/all-types.gc | 295 +-- .../jak1_ntsc_black_label/label_types.jsonc | 20 + .../jak1_ntsc_black_label/type_casts.jsonc | 60 + .../jak1_ntsc_black_label/var_names.jsonc | 303 ++- goal_src/engine/debug/memory-usage-h.gc | 18 +- goal_src/engine/engine/connect.gc | 205 +- goal_src/engine/game/main-h.gc | 1 + goal_src/engine/game/main.gc | 4 + goal_src/engine/gfx/capture.gc | 117 ++ goal_src/engine/gfx/hw/display-h.gc | 2 +- goal_src/engine/gfx/texture-h.gc | 93 +- goal_src/engine/gfx/texture.gc | 1653 +++++++++++++++++ goal_src/engine/level/level-h.gc | 53 +- goal_src/engine/ui/text-h.gc | 2 +- goal_src/kernel-defs.gc | 8 +- goal_src/kernel/gcommon.gc | 13 + goalc/compiler/compilation/Type.cpp | 2 +- scripts/decomp_progress.py | 2 +- .../reference/all_forward_declarations.gc | 21 +- test/decompiler/reference/capture_REF.gc | 187 ++ test/decompiler/reference/connect_REF.gc | 548 ++++++ test/decompiler/reference/display-h_REF.gc | 4 +- test/decompiler/reference/font-h_REF.gc | 797 ++++++++ test/decompiler/reference/gstate_REF.gc | 9 +- test/decompiler/reference/level-h_REF.gc | 16 +- .../reference/memory-usage-h_REF.gc | 69 + test/decompiler/reference/settings-h_REF.gc | 226 +++ test/decompiler/reference/text-h_REF.gc | 63 + test/decompiler/reference/texture-h_REF.gc | 107 +- test/offline/offline_test_main.cpp | 15 +- 41 files changed, 4626 insertions(+), 369 deletions(-) create mode 100644 test/decompiler/reference/capture_REF.gc create mode 100644 test/decompiler/reference/connect_REF.gc create mode 100644 test/decompiler/reference/font-h_REF.gc create mode 100644 test/decompiler/reference/memory-usage-h_REF.gc create mode 100644 test/decompiler/reference/settings-h_REF.gc create mode 100644 test/decompiler/reference/text-h_REF.gc diff --git a/common/type_system/TypeSystem.cpp b/common/type_system/TypeSystem.cpp index a891376c16..f609083446 100644 --- a/common/type_system/TypeSystem.cpp +++ b/common/type_system/TypeSystem.cpp @@ -756,6 +756,7 @@ void TypeSystem::add_builtin_types() { uint_type->disallow_in_runtime(); // Methods and Fields + forward_declare_type_as_structure("memory-usage-block"); // OBJECT add_method(obj_type, "new", make_function_typespec({"symbol", "type", "int"}, "_type_")); @@ -768,7 +769,7 @@ void TypeSystem::add_builtin_types() { add_method(obj_type, "copy", make_function_typespec({"_type_", "symbol"}, "_type_")); add_method(obj_type, "relocate", make_function_typespec({"_type_", "int"}, "_type_")); add_method(obj_type, "mem-usage", - make_function_typespec({"_type_"}, "int32")); // todo - this is a guess. + make_function_typespec({"_type_", "memory-usage-block"}, "_type_")); // STRUCTURE // structure new doesn't support dynamic sizing, which is kinda weird - it grabs the size from diff --git a/decompiler/IR2/AtomicOp.cpp b/decompiler/IR2/AtomicOp.cpp index 09e6bdf063..ba7c56bd23 100644 --- a/decompiler/IR2/AtomicOp.cpp +++ b/decompiler/IR2/AtomicOp.cpp @@ -1647,9 +1647,11 @@ void FunctionEndOp::collect_vars(RegAccessSet& vars) const { // StackSpillStoreOp ///////////////////////////// -StackSpillStoreOp::StackSpillStoreOp(RegisterAccess value, int size, int offset, int my_idx) +StackSpillStoreOp::StackSpillStoreOp(const SimpleAtom& value, int size, int offset, int my_idx) : AtomicOp(my_idx), m_value(value), m_size(size), m_offset(offset) { - assert(m_value.mode() == AccessMode::READ); + if (m_value.is_var()) { + assert(m_value.var().mode() == AccessMode::READ); + } } goos::Object StackSpillStoreOp::to_form(const std::vector&, const Env& env) const { @@ -1673,11 +1675,13 @@ bool StackSpillStoreOp::is_sequence_point() const { } void StackSpillStoreOp::update_register_info() { - m_read_regs.push_back(m_value.reg()); + if (m_value.is_var()) { + m_read_regs.push_back(m_value.var().reg()); + } } void StackSpillStoreOp::collect_vars(RegAccessSet& vars) const { - vars.insert(m_value); + m_value.collect_vars(vars); } RegisterAccess StackSpillStoreOp::get_set_destination() const { diff --git a/decompiler/IR2/AtomicOp.h b/decompiler/IR2/AtomicOp.h index 01f37a3afd..f0a60a358e 100644 --- a/decompiler/IR2/AtomicOp.h +++ b/decompiler/IR2/AtomicOp.h @@ -724,7 +724,7 @@ class FunctionEndOp : public AtomicOp { */ class StackSpillStoreOp : public AtomicOp { public: - StackSpillStoreOp(RegisterAccess value, int size, int offset, int my_idx); + StackSpillStoreOp(const SimpleAtom& value, int size, int offset, int my_idx); goos::Object to_form(const std::vector& labels, const Env& env) const override; bool operator==(const AtomicOp& other) const override; bool is_sequence_point() const override; @@ -737,7 +737,7 @@ class StackSpillStoreOp : public AtomicOp { void collect_vars(RegAccessSet& vars) const override; private: - RegisterAccess m_value; + SimpleAtom m_value; int m_size; int m_offset; }; diff --git a/decompiler/IR2/AtomicOpForm.cpp b/decompiler/IR2/AtomicOpForm.cpp index 42e5d108d4..6ba74506f9 100644 --- a/decompiler/IR2/AtomicOpForm.cpp +++ b/decompiler/IR2/AtomicOpForm.cpp @@ -742,13 +742,20 @@ FormElement* StackSpillLoadOp::get_as_form(FormPool& pool, const Env& env) const } FormElement* StackSpillStoreOp::get_as_form(FormPool& pool, const Env& env) const { - auto& slot_type = env.stack_slot_entries.at(m_offset).typespec; - auto src_type = env.get_types_before_op(m_my_idx).get(m_value.reg()).typespec(); std::optional cast_type; - if (!env.dts->ts.tc(slot_type, src_type)) { - // we fail the typecheck for a normal set!, so add a cast. - cast_type = slot_type; + // if we aren't a var, we're 0. + TypeSpec src_type = TypeSpec("int"); + if (m_value.is_var() && env.has_type_analysis()) { + src_type = env.get_types_before_op(m_my_idx).get(m_value.var().reg()).typespec(); + } + + auto kv = env.stack_slot_entries.find(m_offset); + if (kv != env.stack_slot_entries.end()) { + if (!env.dts->ts.tc(kv->second.typespec, src_type)) { + // we fail the typecheck for a normal set!, so add a cast. + cast_type = kv->second.typespec; + } } return pool.alloc_element(m_value, m_size, m_offset, cast_type); diff --git a/decompiler/IR2/AtomicOpTypeAnalysis.cpp b/decompiler/IR2/AtomicOpTypeAnalysis.cpp index 06a893b162..0c3d1a3f85 100644 --- a/decompiler/IR2/AtomicOpTypeAnalysis.cpp +++ b/decompiler/IR2/AtomicOpTypeAnalysis.cpp @@ -1074,14 +1074,14 @@ TypeState StackSpillLoadOp::propagate_types_internal(const TypeState& input, TypeState StackSpillStoreOp::propagate_types_internal(const TypeState& input, const Env& env, - DecompilerTypeSystem&) { + DecompilerTypeSystem& dts) { auto info = env.stack_spills().lookup(m_offset); if (info.size != m_size) { throw std::runtime_error(fmt::format( "Stack slot load mismatch: defined as size {}, got size {}\n", info.size, m_size)); } - auto& stored_type = input.get(m_value.reg()); + auto stored_type = m_value.get_type(input, env, dts); auto result = input; result.spill_slots[m_offset] = stored_type; return result; diff --git a/decompiler/IR2/Form.cpp b/decompiler/IR2/Form.cpp index b2427f9a60..b44ab20dc4 100644 --- a/decompiler/IR2/Form.cpp +++ b/decompiler/IR2/Form.cpp @@ -1504,7 +1504,7 @@ std::string fixed_operator_to_string(FixedOperatorKind kind) { case FixedOperatorKind::NONE: return "none"; case FixedOperatorKind::PCPYLD: - return ".pcpyld"; + return "make-u128"; default: assert(false); return ""; @@ -2302,7 +2302,7 @@ void VectorFloatLoadStoreElement::collect_vf_regs(RegSet& regs) const { // StackSpillStoreElement //////////////////////////////// -StackSpillStoreElement::StackSpillStoreElement(RegisterAccess value, +StackSpillStoreElement::StackSpillStoreElement(SimpleAtom value, int size, int stack_offset, const std::optional& cast_type) @@ -2320,7 +2320,9 @@ void StackSpillStoreElement::apply(const std::function& f) { void StackSpillStoreElement::apply_form(const std::function&) {} void StackSpillStoreElement::collect_vars(RegAccessSet& vars, bool) const { - vars.insert(m_value); + if (m_value.is_var()) { + vars.insert(m_value.var()); + } } void StackSpillStoreElement::get_modified_regs(RegSet&) const {} diff --git a/decompiler/IR2/Form.h b/decompiler/IR2/Form.h index a5f952340f..41be814b35 100644 --- a/decompiler/IR2/Form.h +++ b/decompiler/IR2/Form.h @@ -1325,7 +1325,7 @@ class VectorFloatLoadStoreElement : public FormElement { class StackSpillStoreElement : public FormElement { public: - StackSpillStoreElement(RegisterAccess value, + StackSpillStoreElement(SimpleAtom value, int size, int stack_offset, const std::optional& cast_type); @@ -1338,7 +1338,7 @@ class StackSpillStoreElement : public FormElement { const std::optional& cast_type() const { return m_cast_type; } private: - RegisterAccess m_value; + SimpleAtom m_value; int m_size = -1; int m_stack_offset = -1; std::optional m_cast_type; diff --git a/decompiler/IR2/FormExpressionAnalysis.cpp b/decompiler/IR2/FormExpressionAnalysis.cpp index aaa243a251..71e0dc02c5 100644 --- a/decompiler/IR2/FormExpressionAnalysis.cpp +++ b/decompiler/IR2/FormExpressionAnalysis.cpp @@ -1855,6 +1855,10 @@ void FunctionCallElement::update_from_stack(const Env& env, fmt::format("Inconsistent types in method call: {} and {}", type_1, type_2)); } + if (type_2 == "array") { + type_2 = "boxed-array"; + } + auto quoted_type = pool.alloc_single_element_form( nullptr, SimpleAtom::make_sym_ptr(type_2)); @@ -2052,13 +2056,15 @@ void CondNoElseElement::push_to_stack(const Env& env, FormPool& pool, FormStack& x->push_to_stack(env, pool, stack); } + bool first = true; for (auto& entry : entries) { for (auto form : {entry.condition, entry.body}) { if (form == first_condition) { form->clear(); form->push_back(stack.pop_back(pool)); } else { - FormStack temp_stack(false); + FormStack temp_stack(first && stack.is_root()); + first = false; for (auto& elt : form->elts()) { elt->push_to_stack(env, pool, temp_stack); } @@ -3161,7 +3167,13 @@ void ConditionalMoveFalseElement::push_to_stack(const Env& env, FormPool& pool, /////////////////////////// void StackSpillStoreElement::push_to_stack(const Env& env, FormPool& pool, FormStack& stack) { mark_popped(); - auto src = pop_to_forms({m_value}, env, pool, stack, true).at(0); + Form* src; + if (m_value.is_var()) { + src = pop_to_forms({m_value.var()}, env, pool, stack, true).at(0); + } else { + src = pool.alloc_single_element_form(nullptr, m_value); + } + auto dst = pool.alloc_single_element_form( nullptr, env.get_spill_slot_var_name(m_stack_offset)); if (m_cast_type) { diff --git a/decompiler/ObjectFile/ObjectFileDB_IR2.cpp b/decompiler/ObjectFile/ObjectFileDB_IR2.cpp index 794d8c594b..c11a48c198 100644 --- a/decompiler/ObjectFile/ObjectFileDB_IR2.cpp +++ b/decompiler/ObjectFile/ObjectFileDB_IR2.cpp @@ -255,7 +255,7 @@ void ObjectFileDB::ir2_stack_spill_slot_pass() { } func.ir2.env.set_stack_spills(spill_map); }); - lg::info("Analyzed stack spills: found {} functions will spills (total {} vars), took {:.2f} ms", + lg::info("Analyzed stack spills: found {} functions with spills (total {} vars), took {:.2f} ms", functions_with_spills, total_slots, timer.getMs()); } @@ -614,7 +614,7 @@ std::string ObjectFileDB::ir2_to_file(ObjectFileData& data) { } } - if (func.ir2.print_debug_forms) { + if (false && func.ir2.print_debug_forms) { result += '\n'; result += ";; DEBUG OUTPUT BELOW THIS LINE:\n"; result += func.ir2.debug_form_string; @@ -815,9 +815,8 @@ std::string ObjectFileDB::ir2_function_to_string(ObjectFileData& data, Function& } if (func.cfg) { - result += func.cfg->to_form_string(); - if (!func.cfg->is_fully_resolved()) { + result += func.cfg->to_form_string(); result += "\n"; result += func.cfg->to_dot(); result += "\n"; diff --git a/decompiler/analysis/atomic_op_builder.cpp b/decompiler/analysis/atomic_op_builder.cpp index 9b333b84e4..775f90adde 100644 --- a/decompiler/analysis/atomic_op_builder.cpp +++ b/decompiler/analysis/atomic_op_builder.cpp @@ -187,7 +187,7 @@ std::unique_ptr make_standard_store(const Instruction& i0, return std::make_unique(i0, idx); } // it's a stack spill. - return std::make_unique(make_src_var(i0.get_src(0).get_reg(), idx), + return std::make_unique(make_src_atom(i0.get_src(0).get_reg(), idx), store_size, i0.get_src(1).get_imm(), idx); } SimpleAtom val; diff --git a/decompiler/analysis/stack_spill.cpp b/decompiler/analysis/stack_spill.cpp index 41f9c93dbf..98a4b74c20 100644 --- a/decompiler/analysis/stack_spill.cpp +++ b/decompiler/analysis/stack_spill.cpp @@ -66,7 +66,10 @@ struct StackInstrInfo { }; constexpr StackInstrInfo stack_instrs[] = {{InstructionKind::SQ, false, 16, false}, - {InstructionKind::LQ, true, 16, false}}; + {InstructionKind::LQ, true, 16, false}, + {InstructionKind::SW, false, 4, false}, + //{InstructionKind::LWU, true, 4, false} + {InstructionKind::SD, false, 8, false}}; } // namespace StackSpillMap build_spill_map(const std::vector& instructions, Range range) { diff --git a/decompiler/config/all-types.gc b/decompiler/config/all-types.gc index 6e7762cbfe..856657a68c 100644 --- a/decompiler/config/all-types.gc +++ b/decompiler/config/all-types.gc @@ -44,6 +44,7 @@ (define-extern int128 type) (define-extern float type) (define-extern nothing (function none)) +(define-extern kheap type) ;; functions defined in C. TODO - this will end up being a duplicate of kernel-defs.gc? @@ -2800,9 +2801,7 @@ ;; ND did something REALLY strange with these and now we have to suffer from it (deftype dma-gif-packet (structure) ((dma-vif dma-packet :inline :offset-assert 0) - ;(gif gif-tag64 :offset-assert 16) - ;(gif-regs gif-tag-regs :offset-assert 24) - (gif uint64 2 :offset-assert 16) + (gif uint64 2 :offset-assert 16) ;; guess (quad uint128 2 :offset 0) ) :method-count-assert 9 @@ -3625,8 +3624,10 @@ (vu1-buf dma-buffer :offset 8) (debug-buf dma-buffer :offset 36) (global-buf dma-buffer :offset 40) - (buffer uint32 11 :offset 4) ;; for debugging? (bucket-group dma-bucket :offset 44) + (buffer uint32 11 :offset 4) ;; for debugging? + + (profile-bar profile-bar 2 :offset 48) (run-time uint64 :offset 56) ) @@ -3699,9 +3700,11 @@ (define-extern *display* display) -;;;;;;;;;;;;;;; -;; display -;;;;;;;;;;;;;;; +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; DISPLAY ;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~; (define-extern get-current-time (function uint)) (define-extern get-integral-current-time (function uint)) @@ -3979,6 +3982,8 @@ (define-extern *texture-enable-user-menu* int) (define-extern *texture-enable-user* int) +(declare-type level basic) + (deftype texture-id (uint32) ((index uint16 :offset 8 :size 12) (page uint16 :offset 20 :size 12) @@ -3998,52 +4003,62 @@ :flag-assert #x900000008 ) +(declare-type texture-page basic) +(declare-type texture-page-segment structure) +(declare-type texture-relocate-later basic) + ;; texture-h (deftype texture-pool (basic) ((top int32 :offset-assert 4) (cur int32 :offset-assert 8) - (allocate-func basic :offset-assert 12) - (font-palette int32 :offset-assert 16) - (segment texture-pool-segment 4 :inline :offset-assert 20) - (segment-near texture-pool-segment :inline :offset 20) - (segment-common texture-pool-segment :inline :offset 28) - (common-page int32 32 :offset-assert 52) + (allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12) + (font-palette int32 :offset-assert 16) ;; vram word idx + + ;; these were reordered + (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) + + (common-page texture-page 32 :offset-assert 52) (common-page-mask int32 :offset-assert 180) - (ids int32 126 :offset-assert 184) + (ids uint32 126 :offset-assert 184) ) :method-count-assert 23 :size-assert #x2b0 :flag-assert #x17000002b0 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) - (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) - (dummy-15 () none 15) - (dummy-16 () none 16) + (new (symbol type) _type_ 0) + (initialize! (_type_) _type_ 9) + (print-usage (_type_) _type_ 10) + (dummy-11 (_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. + (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 () none 20) - (dummy-21 () none 21) - (dummy-22 () none 22) + (upload-one-common! (_type_) symbol 21) + (lookup-boot-common-id (_type_ int) int 22) ) ) +(define-extern *texture-pool* texture-pool) + ;; texture-h (deftype texture (basic) ((w int16 :offset-assert 4) (h int16 :offset-assert 6) (num-mips uint8 :offset-assert 8) - (tex1-control uint8 :offset-assert 9) - (psm uint8 :offset-assert 10) + (tex1-control uint8 :offset-assert 9) ;; each level has a dest and a width + (psm gs-psm :offset-assert 10) (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) + (dest uint16 7 :offset-assert 14) ;; dest vram word addr, per leve + (clutdest uint16 :offset-assert 28) ;; destination vram word addr of clut. + (width uint8 7 :offset-assert 30) ;; mip widths (name basic :offset-assert 40) (size uint32 :offset-assert 44) (uv-dist float :offset-assert 48) @@ -4073,28 +4088,30 @@ ((info basic :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 texture (mip0-size uint32 :offset-assert 20) - (size uint32 :offset-assert 24) + (size uint32 :offset-assert 24) ;; in vram words. (segment texture-page-segment 3 :inline :offset-assert 28) (pad uint32 16 :offset-assert 64) - (data uint8 :dynamic :offset-assert 128) + (data texture :dynamic :offset-assert 128) ) :method-count-assert 15 :size-assert #x80 :flag-assert #xf00000080 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) + (remove-from-heap (_type_ kheap) _type_ 9) + (get-leftover-block-count (_type_ int int) int 10) (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) + (relocate-dests! (_type_ int int) none 12) + (add-to-dma-buffer (_type_ dma-buffer int) none 13) + (upload-now! (_type_ int) none 14) ) ) +(declare-type adgif-shader structure) + (deftype shader-ptr (uint32) - () + ((shader uint32 :offset 8 :size 24)) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 @@ -4102,7 +4119,7 @@ ;; texture-h (deftype texture-link (structure) - ((next uint32 :offset-assert 0) + ((next shader-ptr 1 :offset-assert 0) ) :method-count-assert 9 :size-assert #x4 @@ -4113,9 +4130,10 @@ (deftype texture-page-dir-entry (structure) ((length int16 :offset-assert 0) (status uint16 :offset-assert 2) - (page basic :offset-assert 4) - (link uint32 :offset-assert 8) + (page texture-page :offset-assert 4) + (link texture-link :offset-assert 8) ) + :pack-me :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c @@ -4123,7 +4141,8 @@ ;; texture-h (deftype texture-page-dir (basic) - ((pad uint8 #x10)) + ((length int32) + (entries texture-page-dir-entry 1 :inline)) (:methods (dummy-9 () none 9) ) @@ -4137,7 +4156,7 @@ (source uint32 :offset-assert 12) (move uint32 :offset-assert 16) (entry texture-page-dir-entry :offset-assert 20) - (page basic :offset-assert 24) + (page texture-page :offset-assert 24) ) :method-count-assert 9 :size-assert #x1c @@ -4158,7 +4177,7 @@ (alpha uint64 :offset 64) (link-test uint32 :offset 8) (texture-id uint32 :offset 24) - (next uint32 :offset 40) + (next shader-ptr :offset 40) ) :method-count-assert 9 :size-assert #x50 @@ -4272,7 +4291,7 @@ (bsp basic :offset-assert 48) (art-group basic :offset-assert 52) (info basic :offset-assert 56) - (texture-page basic 9 :offset-assert 60) + (texture-page texture-page 9 :offset-assert 60) (loaded-texture-page basic 16 :offset-assert 96) (loaded-texture-page-count int32 :offset-assert 160) ; (foreground-sink-group-0 dma-foreground-sink-group :inline :offset-assert 176) @@ -4283,8 +4302,8 @@ (foreground-draw-engine basic 3 :offset-assert 272) (entity basic :offset-assert 284) (ambient basic :offset-assert 288) - (closest-object basic 9 :offset-assert 292) - (upload-size uint32 9 :offset-assert 328) + (closest-object float 9 :offset-assert 292) + (upload-size int32 9 :offset-assert 328) (level-distance float :offset-assert 364) ; meters (inside-sphere? basic :offset-assert 368) (inside-boxes? basic :offset-assert 372) @@ -4314,7 +4333,7 @@ (:methods (dummy-9 () none 9) (dummy-10 () none 10) - (dummy-11 () none 11) + (dummy-11 (_type_) none 11) (dummy-12 () none 12) (dummy-13 () none 13) (dummy-14 () none 14) @@ -4342,8 +4361,8 @@ ;; level-h (deftype level-group (basic) ((length int32 :offset-assert 4) - (unknown-field-1 basic :offset-assert 8) - (unknown-field-2 basic :offset-assert 12) + (unknown-level-1 level :offset-assert 8) + (unknown-level-2 level :offset-assert 12) (entity-link entity-links :offset 16) ;; not sure what's going on here (border? basic :offset-assert 20) (vis? basic :offset-assert 24) @@ -4722,6 +4741,9 @@ ) ) +(define-extern *text-group-names* (array string)) +(define-extern *common-text-heap* kheap) +(define-extern *common-text* symbol) ;;;;;;;;;;;;;;;; ;; settings-h ;;;;;;;;;;;;;;;; @@ -4822,23 +4844,27 @@ ((vifcode vif-tag 4 :offset-assert 0) (giftag gif-tag :offset-assert 16) (bitbltbuf gs-bitbltbuf :offset-assert 32) - (bitbltbuf-addr int64 :offset-assert 40) + (bitbltbuf-addr gs-reg64 :offset-assert 40) (trxpos gs-trxpos :offset-assert 48) - (trxpos-addr int64 :offset-assert 56) + (trxpos-addr gs-reg64 :offset-assert 56) (trxreg gs-trxreg :offset-assert 64) - (trxreg-addr int64 :offset-assert 72) + (trxreg-addr gs-reg64 :offset-assert 72) (finish int64 :offset-assert 80) ;; gs-finish - (finish-addr int64 :offset-assert 88) + (finish-addr gs-reg64 :offset-assert 88) (trxdir gs-trxdir :offset-assert 96) - (trxdir-addr int64 :offset-assert 104) + (trxdir-addr gs-reg64 :offset-assert 104) ) :method-count-assert 9 :size-assert #x70 :flag-assert #x900000070 ) -(define-extern store-image (function int int int int)) +(define-extern gs-store-image (function object object object)) +(define-extern store-image (function int int)) +(define-extern sync-path (function int int none)) (define-extern gs-set-default-store-image (function gs-store-image-packet int int int int int int int int)) +(define-extern file-stream-close (function file-stream file-stream)) +(define-extern file-stream-write (function file-stream pointer uint uint)) ;;;;;;;;;;;;;;;;;; ;; memory-usage-h @@ -4864,19 +4890,108 @@ :size-assert #x6e0 :flag-assert #xc000006e0 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) + (reset! (_type_) _type_ 9) + (calculate-total (_type_) int 10) (dummy-11 () none 11) ) ) +(define-extern *mem-usage* memory-usage-block) +(define-extern *dma-mem-usage* memory-usage-block) +(define-extern *temp-mem-usage* symbol) + ;;;;;;;;;;;;;; ;; texture ;;;;;;;;;;;;;; -; ;; texture +(define-extern loado (function string kheap object)) + +(define-extern ct32-24-block-table (array int32)) +(define-extern mz32-24-block-table (array int32)) +(define-extern ct16-block-table (array int32)) +(define-extern ct16s-block-table (array int32)) +(define-extern mz16-block-table (array int32)) +(define-extern mz16s-block-table (array int32)) +(define-extern mt8-block-table (array int32)) +(define-extern mt4-block-table (array int32)) + +(define-extern texture-page-dir-inspect (function texture-page-dir symbol none)) + +(define-extern texture-bpp (function gs-psm int)) +(define-extern texture-qwc (function int int gs-psm int)) +(define-extern physical-address (function pointer pointer)) +(define-extern dma-buffer-add-ref-texture (function dma-buffer pointer int int gs-psm none)) +(define-extern gs-find-block (function int int gs-psm int)) +(define-extern gs-page-width (function gs-psm int)) +(define-extern gs-page-height (function gs-psm int)) +(define-extern gs-block-width (function gs-psm int)) +(define-extern gs-block-height (function gs-psm int)) +(define-extern gs-largest-block (function int int gs-psm int)) +(define-extern gs-blocks-used (function int int gs-psm int)) + +;; 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 texture-page-common-allocate (function texture-pool texture-page kheap int texture-page)) +(define-extern texture-page-common-boot-allocate (function texture-pool texture-page kheap int texture-page)) +(define-extern upload-vram-data (function dma-buffer int pointer int none)) +(define-extern upload-vram-pages (function texture-pool texture-pool-segment texture-page int int int)) +(define-extern update-vram-pages (function texture-pool texture-pool-segment texture-page int int)) ;; todo +(define-extern upload-vram-pages-pris (function texture-pool texture-pool-segment texture-page int int int)) + +(define-extern texture-page-near-allocate-0 (function texture-pool texture-page kheap int texture-page)) +(define-extern texture-page-near-allocate-1 (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 texture-page-size-check (function texture-pool level symbol int)) +(define-extern texture-relocate (function dma-buffer texture int int int int)) + +(define-extern *shader-list* pair) ;; unknown type +(define-extern adgif-shader-login-no-remap-fast function) + + + +(define-extern relocate-later (function none)) + + + +(define-extern *txt-dma-list* dma-buffer) ;; unknown type +(define-extern adgif-shader-login-fast function) + + +(define-extern lookup-texture-by-id (function texture-id texture)) +;;(define-extern *texture-pool* object) ;; unknown type + +(define-extern link-texture-by-id (function adgif-shader texture-id int)) + +(define-extern *edit-shader* int) ;; unknown type +(define-extern adgif-shader-update! function) + + +(define-extern loading-level kheap) + +(define-extern texture-page-login (function texture-id function kheap texture-page-dir-entry)) + + +(define-extern adgif-shader-login function) +(define-extern adgif-shader-login-no-remap function) + + +;;;; unknown type + +(define-extern adgif-shader<-texture-simple! function) + +(define-extern adgif-shader<-texture! function) + + + + +(define-extern *font-texture* texture) + + +;; texture ; (deftype texture-page-dir (basic) -; () +; ((length int32) +; (pad uint8 12)) ; :method-count-assert 10 ; :size-assert #x14 ; :flag-assert #xa00000014 @@ -7895,8 +8010,9 @@ :flag-assert #x90000012c ) -(define-extern show-mc-info (function none)) +(define-extern show-mc-info (function dma-buffer none)) (define-extern mc-sync (function int)) +(define-extern mc-get-slot-info (function int mc-slot-info)) ;; game-info-h (deftype game-bank (basic) @@ -33485,54 +33601,7 @@ ;;(define-extern memory-usage-block object) ;; unknown type ;;(define-extern *dma-mem-usage* object) ;; unknown type ;;(define-extern memory-usage-info object) ;; unknown type -(define-extern upload-vram-pages function) -;;(define-extern *shader-list* object) ;; unknown type -(define-extern adgif-shader-login-no-remap-fast function) -;;(define-extern mt8-block-table object) ;; unknown type -(define-extern texture-bpp function) -(define-extern gs-blocks-used function) -(define-extern relocate-later function) -(define-extern gs-page-width function) -(define-extern upload-vram-pages-pris function) -;;(define-extern ct16s-block-table object) ;; unknown type -;;(define-extern *txt-dma-list* object) ;; unknown type -(define-extern adgif-shader-login-fast function) -(define-extern gs-page-height function) -;;(define-extern mz16s-block-table object) ;; unknown type -(define-extern lookup-texture-by-id function) -;;(define-extern *texture-pool* object) ;; unknown type -(define-extern dma-buffer-add-ref-texture function) -(define-extern link-texture-by-id function) -;;(define-extern mt4-block-table object) ;; unknown type -;;(define-extern *edit-shader* object) ;; unknown type -(define-extern adgif-shader-update! function) -;;(define-extern ct16-block-table object) ;; unknown type -(define-extern texture-page-common-boot-allocate function) -(define-extern gs-find-block function) -(define-extern texture-page-level-allocate function) -(define-extern texture-page-common-allocate function) -(define-extern texture-page-login function) -(define-extern texture-page-dir-inspect function) -(define-extern texture-qwc function) -(define-extern adgif-shader-login function) -(define-extern adgif-shader-login-no-remap function) -;;(define-extern mz16-block-table object) ;; unknown type -(define-extern gs-largest-block function) -;;(define-extern ct32-24-block-table object) ;; unknown type -(define-extern gs-block-width function) -(define-extern adgif-shader<-texture-simple! function) -(define-extern texture-relocate function) -(define-extern adgif-shader<-texture! function) -(define-extern update-vram-pages function) -(define-extern texture-page-near-allocate-0 function) -;;(define-extern mz32-24-block-table object) ;; unknown type -(define-extern texture-page-default-allocate function) -(define-extern texture-page-size-check function) -(define-extern gs-block-height function) -(define-extern physical-address function) -(define-extern upload-vram-data function) -(define-extern texture-page-near-allocate-1 function) -;;(define-extern *font-texture* object) ;; unknown type + (define-extern adgif-shader<-texture-with-update! function) ;;(define-extern full object) ;; unknown type ;;(define-extern active object) ;; unknown type @@ -33848,7 +33917,7 @@ ;;(define-extern task object) ;; unknown type ;;(define-extern base object) ;; unknown type ;;(define-extern rot object) ;; unknown type -(define-extern vu-lights-default! function) +(define-extern vu-lights-default! (function light-group none)) (define-extern light-group-slerp function) (define-extern light-slerp function) (define-extern light-group-process! function) @@ -34472,7 +34541,7 @@ ;;(define-extern *sprite-array-2d* object) ;; unknown type (define-extern sprite-allocate-user-hvdf function) (define-extern sprite-draw-distorters function) -;;(define-extern *shadow-middot-texture* object) ;; unknown type +(define-extern *shadow-middot-texture* texture) ;; unknown type (define-extern sprite-init-distorter function) ;;(define-extern sprite-distorter-sine-tables object) ;; unknown type ;;(define-extern *sprite-distorter-sine-tables* object) ;; unknown type @@ -34641,7 +34710,7 @@ (define-extern generic-prepare-dma-double function) (define-extern generic-upload-vu0 function) (define-extern generic-work-init function) -;;(define-extern *generic-envmap-texture* object) ;; unknown type +(define-extern *generic-envmap-texture* texture) ;; unknown type (define-extern mercneric-shader-asm function) ;;(define-extern *inv-init-table* object) ;; unknown type (define-extern mercneric-bittable-asm function) @@ -37196,7 +37265,7 @@ ;;(define-extern at-pick-object object) ;; unknown type ;;(define-extern far object) ;; unknown type ;;(define-extern anim-speed object) ;; unknown type -;;(define-extern *ocean-texture* object) ;; unknown type +(define-extern *ocean-texture* texture) ;; unknown type ;;(define-extern texture-level object) ;; unknown type ;;(define-extern breath-in object) ;; unknown type ;;(define-extern breath-in-loud object) ;; unknown type diff --git a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc index 8cbbc53de8..c8010a7802 100644 --- a/decompiler/config/jak1_ntsc_black_label/label_types.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/label_types.jsonc @@ -408,5 +408,25 @@ ["L113", "float", true], ["L112", "float", true], ["L111", "float", true] + ], + + "texture": [ + ["L356", "_auto_", true], + ["L355", "_auto_", true], + ["L354", "_auto_", true], + ["L353", "_auto_", true], + ["L352", "_auto_", true], + ["L351", "_auto_", true], + ["L350", "_auto_", true], + ["L349", "_auto_", true], + ["L369", "uint64", true], + ["L373", "uint64", true], + ["L371", "uint64", true], + ["L364", "float", true], + ["L360", "float", true], + ["L362", "float", true], + ["L359", "float", true], + ["L358", "float", true], + ["L361", "float", true] ] } diff --git a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc index 05fc19f2dc..503ddc8997 100644 --- a/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/type_casts.jsonc @@ -320,5 +320,65 @@ [66, "a3", "(pointer gs-reg64)"], [67, "a3", "(pointer uint64)"], [69, "a3", "(pointer gs-reg64)"] + ], + + "(method 9 connection)": [[8, "a0", "pointer"]], + + "(method 10 connection)": [[8, "a0", "pointer"]], + + "(method 0 engine)": [[39, "v0", "pointer"]], + + "(method 12 engine)": [[[5, 16], "s4", "connection"]], + + "(method 13 engine)": [[[5, 24], "s4", "connection"]], + + "(method 15 engine)": [[[0, 36], "v1", "connection"]], + + "(method 19 engine)": [[8, "a0", "connection"]], + + "(method 20 engine)": [[8, "a0", "connection"]], + + "gs-set-default-store-image": [ + [9, "t4", "gif-tag64"], + [9, "v1", "gif-tag-regs"] + ], + + "dma-buffer-add-ref-texture": [ + [[25, 29], "a3", "dma-packet"], + [[32, 44], "a3", "gs-gif-tag"], + [[47, 62], "a2", "dma-packet"] + ], + + "upload-vram-data":[ + [[9, 15], "a0", "dma-packet"], + [[18, 24], "a0", "gs-gif-tag"], + [33, "a0", "(pointer gs-bitbltbuf)"], + [35, "a0", "(pointer gs-reg64)"], + [36, "a0", "(pointer gs-trxpos)"], + [38, "a0", "(pointer gs-reg64)"], + [42, "a0", "(pointer gs-trxreg)"], + [44, "a0", "(pointer gs-reg64)"], + [45, "a0", "(pointer gs-trxdir)"], + [47, "a0", "(pointer gs-reg64)"] + ], + + "texture-page-dir-inspect":[ + [[133, 136], "v1", "adgif-shader"] + ], + + "upload-vram-pages": [ + [[135, 140], "a0", "dma-packet"], + [[144, 149], "a0", "gs-gif-tag"], + [[155, 157], "a0", "(pointer gs-reg64)"], + [154, "a0", "(pointer uint64)"], + [[162, 165], "v1", "dma-packet"] + ], + + "upload-vram-pages-pris": [ + [[128, 134], "a0", "dma-packet"], + [[137, 143], "a0", "gs-gif-tag"], + [148, "a0", "(pointer uint64)"], + [150, "a0", "(pointer gs-reg64)"], + [[154, 159], "v1", "dma-packet"] ] } diff --git a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc index f671901c21..f8b090f0a8 100644 --- a/decompiler/config/jak1_ntsc_black_label/var_names.jsonc +++ b/decompiler/config/jak1_ntsc_black_label/var_names.jsonc @@ -778,7 +778,7 @@ "args": ["packet", "reg-idx", "reg-val"], "vars": { "v1-0": "tag" } }, - + "(method 9 font-context)": { "args": ["obj", "mat"] }, @@ -813,7 +813,16 @@ "args": ["obj", "scale"] }, "(method 0 font-context)": { - "args": ["allocation", "type-to-make", "mat", "x", "y", "z", "color", "flags"], + "args": [ + "allocation", + "type-to-make", + "mat", + "x", + "y", + "z", + "color", + "flags" + ], "vars": { "v0-0": "obj" } }, "font-set-tex0": { @@ -991,7 +1000,32 @@ }, "gs-set-default-store-image": { - "args": ["packet"] + "args": [ + "packet", + "src-fbp", + "src-w", + "src-psm", + "ssax", + "ssay", + "rrw", + "rrh" + ] + }, + + "store-image": { + "args": ["oddeven"], + "vars": { + "s4-0": "buff0", + "s1-0": "buff1", + "s0-0": "packet", + "gp-0": "file", + "s3-0": "width", + "s2-0": "height", + "s0-1": "ptr-0", + "sv-16": "ptr-1", + "sv-32": "y-idx", + "sv-48": "y-idx-2" + } }, "(method 0 draw-context)": { @@ -1011,6 +1045,241 @@ "args": ["ctxt", "x", "y"] }, + "texture-qwc": { + "args": ["w", "h", "tex-format"] + }, + + "gs-find-block": { + "args": ["bx", "by", "tex-format"] + }, + + "gs-largest-block": { + "args": ["tex-width", "tex-height", "tex-format"], + "vars": { + "s5-0": "block-width", + "v1-0": "block-height", + "a0-6": "real-width", + "a1-4": "real-height", + "s5-1": "width-blocks", + "s3-1": "height-blocks", + "s2-0": "x", + "s1-0": "y", + "s4-1": "max-block" + } + }, + + "gs-blocks-used": { + "args": ["tex-width", "tex-height", "tex-format"], + "vars": { + "s4-0": "page-width", + "v1-0": "page-height", + "a0-6": "real-width", + "a1-4": "real-height", + "s3-0": "width-blocks", + "s1-0": "height-blocks" + } + }, + + "dma-buffer-add-ref-texture": { + "args": ["buf", "data", "tex-w", "tex-h", "tex-format"], + "vars": { + "s5-0": "data-ptr", + "v1-0": "qwc", + "a0-4": "qwc-this-time", + "a1-3": "eop", + "a3-1": ["setup-dma", "dma-packet"], + "a3-3": ["setup-dif", "gs-gif-tag"], + "a2-4": ["data-dma", "dma-packet"] + } + }, + + "(method 15 texture-pool)": { + "args": ["obj", "word-count"] + }, + + "(method 22 texture-pool)": { + "args": ["obj", "tpage-id"] + }, + + "(method 10 texture-page)": { + "args": ["obj", "segment-count", "additional-size"] + }, + + "(method 16 texture-pool)": { + "args": ["obj", "segment", "size"] + }, + + "(method 9 texture-page)": { + "args": ["obj", "seg"] + }, + + "texture-page-default-allocate": { + "args": ["pool", "page", "seg", "tpage-id"], + "vars": { "s3-0": "seg-id" } + }, + + "texture-page-common-allocate": { + "args": ["pool", "page", "seg", "tpage-id"], + "vars": { "s4-0": "seg-id" } + }, + + "(method 12 texture-page)": { + "args": ["obj", "new-dest", "seg-id"], + "vars": { + "a3-4": "dst-block", + "t0-1": "tex-id", + "t1-6": "tex", + "t2-0": "num-mips", + "t3-4": "mip-id" + } + }, + + "texture-page-common-boot-allocate": { + "args": ["pool", "page", "heap", "tpage-id"], + "vars": { "s2-0": "tex-id" } + }, + + "upload-vram-data": { + "args": ["buf", "dest", "tex-data", "tex-h"], + "vars": { + "a3-2": "height-this-time", + "a0-1": ["dma", "dma-packet"], + "a0-3": ["gif", "gs-gif-tag"], + "a0-5": "gs-data" + } + }, + + "upload-vram-pages": { + "args": ["pool", "segment", "page", "mode", "bucket-idx"], + "vars": { + "s3-0": "dma-buf", + "sv-16": "tex-data", + "sv-20": "tex-dest-base-chunk", + "sv-24": "chunk-count", + "sv-48": "tex-id", + "s1-0": "upload-chunk-idx", + "v1-24": "current-dest-chunk", + "sv-32": "chunks-to-upload-count", + "sv-40": "first-chunk-idx-to-upload", + "gp-0": "total-upload-size", + "s4-0": "dma-start", + "a0-26": ["dma", "dma-packet"], + "a0-28": ["gif", "gs-gif-tag"], + "a0-30": "gif-data", + "v1-50": ["dma-end", "dma-packet"] + } + }, + + "update-vram-pages": { + "args": ["pool", "pool-segment", "page", "mode"], + "vars": { + "t1-0": "dest-block", + "t2-0": "sz", + "t0-1": "page-id", + "a1-4": "upload-chunks", + "a2-3": "chunk-idx", + "v1-2": "modified-chunk-count", + "a3-8": "vram-chunk" + } + }, + + "upload-vram-pages-pris": { + "args": ["pool", "segment", "page", "bucket-idx", "allow-cache-mask"], + "vars": { + "s3-0": "dma-buf", + "sv-16": "tex-data", + "sv-20": "tex-dest-base-chunk", + "sv-24": "chunk-count", + "sv-32": "chunks-to-upload-count", + "sv-40": "first-chunk-idx-to-upload", + "sv-48": "page-id", + "s0-0": "upload-chunk-idx", + "sv-52": "current-dest-chunk", + "sv-56": "allow-cached", + "gp-0":"total-upload-size", + "a0-21":["dma", "dma-packet"], + "a0-23":["gif", "gs-gif-tag"], + "v1-55":["dma-end", "dma-packet"] + } + }, + + "texture-page-near-allocate-0": { + "args": ["pool", "page", "heap", "mode"], + "vars": { + "s3-0":"common-dest", + "s2-0":"page-seg-idx", + "a1-5":"page-seg-2-size", + "v1-15":"after-seg-2-data", + "a0-8":"seg-2-data" + } + }, + + "texture-page-near-allocate-1": { + "args": ["pool", "page", "heap", "mode"], + "vars": { + "s4-0":"seg2-size", + "a1-1":"seg2-dest", + "s2-0":"common-dest", + "s1-0":"page-seg-idx" + } + }, + + "texture-page-level-allocate": { + "args": ["pool", "page", "heap", "mode"], + "vars": { + "s2-0":"common-id", + "v1-6":"level-idx" + } + }, + + "texture-page-size-check": { + "args": ["pool", "level", "hide-prints"], + "vars": { + "gp-0":"oversize", + "s3-0":"tfrag-page", + "v1-0":"tfrag-mip0-size", + "v1-3":"pris-page", + "v1-5":"shrub-page", + "v1-7":"alpha-page", + "v1-9":"water-page" + } + }, + + "(method 13 texture-pool)": { + "args":["obj", "level", "max-page-kind", "id-array"], + "vars": { + "v1-0":"page-idx", + "v1-5":"tfrag-dir-entry", + "v1-7":"pris-dir-entry", + "v1-9":"shrub-dir-entry", + "v1-11":"alpha-dir-entry", + "v1-13":"water-dir-entry", + "a2-7":"overflow-bits" + } + }, + + "(method 14 texture-pool)": { + "args":["obj", "level", "tex-page-kind"], + "vars": { + "s3-0":"tfrag-page", + "s2-0":"tfrag-bucket", + "f30-0":"distance", + "a2-4":"pris-page", + "a3-3":"pris-bucket", + "a2-5":"shrub-page", + "f0-5":"shrub-closest", + "t0-4":"shrub-bucket", + "a3-4":"shrub-mode", + "s3-1":"alpha-page", + "f0-6":"alpha-closest", + "s2-1":"alpha-bucket", + "s1-3":"alpha-mode", + "s0-0":"alpha-dest-chunk", + "a2-7":"water-page", + "a3-6":"water-bucket" + } + }, + "(method 9 __assert-info-private-struct)": { "args": ["obj", "filename", "line-num", "column-num"] }, @@ -1196,6 +1465,34 @@ "vars": { "v0-0": "obj", "v1-11": "idx-to-link", "a0-1": "end-idx" } }, + "(method 10 engine)": { + "args": ["obj", "f"], + "vars": { "a0-1": "current", "s4-0": "next" } + }, + + "(method 11 engine)": { + "args": ["obj", "f"], + "vars": { "s4-0": "iter" } + }, + + "(method 12 engine)": { + "vars": { "s4-0": ["ct", "connection"] } + }, + + "(method 13 engine)": { + "vars": { "s4-0": ["ct", "connection"], "v1-2": "result" } + }, + + "(method 19 engine)": { + "args": ["obj", "p1-value"], + "vars": { "a0-1": "current", "s4-0": "next" } + }, + + "(method 20 engine)": { + "args": ["obj", "p2-value"], + "vars": { "a0-1": "current", "s4-0": "next" } + }, + "connection-process-apply": { "args": ["proc", "func"], "vars": { "s5-0": "iter" } diff --git a/goal_src/engine/debug/memory-usage-h.gc b/goal_src/engine/debug/memory-usage-h.gc index 194153f17b..27daa54d33 100644 --- a/goal_src/engine/debug/memory-usage-h.gc +++ b/goal_src/engine/debug/memory-usage-h.gc @@ -25,8 +25,8 @@ :size-assert #x6e0 :flag-assert #xc000006e0 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) + (reset! (_type_) _type_ 9) + (calculate-total (_type_) int 10) (dummy-11 () none 11) ) ) @@ -34,3 +34,17 @@ (define *mem-usage* (new 'debug 'memory-usage-block)) (define *dma-mem-usage* (new 'debug 'memory-usage-block)) (define *temp-mem-usage* #f) + + +;; Memory usage stats are organized by the type of object. +;; This enum allows you to go from type to the index in the memory-usage-block's data array. +(defenum mem-usage-id + :bitfield #f + :type uint32 + (texture 79) + ) + +;; get a memory usage id as an integer. +(defmacro mem-usage-id-int (kind) + `(the int (mem-usage-id ,kind)) + ) diff --git a/goal_src/engine/engine/connect.gc b/goal_src/engine/engine/connect.gc index 11b5bc8f39..92be350d79 100644 --- a/goal_src/engine/engine/connect.gc +++ b/goal_src/engine/engine/connect.gc @@ -137,18 +137,21 @@ (defmethod get-engine connection ((obj connection)) "Get the engine for this connection. This must be used on a live connection." + + ;; back up, until we get to the node that's inline on the engine. (while (-> obj prev0) (nop!) (nop!) (set! obj (the connection (-> obj prev0))) ) - ;; the alive-list node has prev0 = #f, so we can just do an offset trick. + ;; obj is now alive-list field in an engine, so we can do an offset trick: (the-as engine (&+ obj -28)) ) (defmethod get-process connection ((obj connection)) "Get the process for this connection" - ;; use prev1 to iterate through the process list. + + ;; same trick as get-engine, but backs up using prev1 until we hit the process. (while (-> obj prev1) (nop!) (nop!) @@ -250,32 +253,35 @@ ) (defmethod inspect engine ((obj engine)) - (local-vars (s5-0 binteger) (s5-1 binteger) (s5-2 binteger) (s5-3 binteger)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tengine-time: ~D~%" (-> obj engine-time)) (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) (format #t "~Tlength: ~D~%" (-> obj length)) (format #t "~Talive-list:~%") - (set! s5-0 *print-column*) - (set! *print-column* (+ *print-column* 8)) - ((method-of-type connectable inspect) (-> obj alive-list)) - (set! *print-column* s5-0) + (let ((s5-0 *print-column*)) + (set! *print-column* (+ *print-column* 8)) + ((method-of-type connectable inspect) (-> obj alive-list)) + (set! *print-column* s5-0) + ) (format #t "~Talive-list-end:~%") - (set! s5-1 *print-column*) - (set! *print-column* (+ *print-column* 8)) - ((method-of-type connectable inspect) (-> obj alive-list-end)) - (set! *print-column* s5-1) + (let ((s5-1 *print-column*)) + (set! *print-column* (+ *print-column* 8)) + ((method-of-type connectable inspect) (-> obj alive-list-end)) + (set! *print-column* s5-1) + ) (format #t "~Tdead-list:~%") - (set! s5-2 *print-column*) - (set! *print-column* (+ *print-column* 8)) - ((method-of-type connectable inspect) (-> obj dead-list)) - (set! *print-column* s5-2) + (let ((s5-2 *print-column*)) + (set! *print-column* (+ *print-column* 8)) + ((method-of-type connectable inspect) (-> obj dead-list)) + (set! *print-column* s5-2) + ) (format #t "~Tdead-list-end:~%") - (set! s5-3 *print-column*) - (set! *print-column* (+ *print-column* 8)) - ((method-of-type connectable inspect) (-> obj dead-list-end)) - (set! *print-column* s5-3) + (let ((s5-3 *print-column*)) + (set! *print-column* (+ *print-column* 8)) + ((method-of-type connectable inspect) (-> obj dead-list-end)) + (set! *print-column* s5-3) + ) (format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data)) obj ) @@ -292,78 +298,68 @@ ) ) -(defmethod apply-to-connections engine ((obj engine) (arg0 (function connectable none))) - "Apply the given function to all the live connectables in an engine" - (local-vars - (iter connectable) - (next connectable) - ) - (set! iter (-> obj alive-list next0)) - (set! next (-> iter next0)) - (while (!= iter (-> obj alive-list-end)) - (arg0 iter) - (set! iter next) - (set! next (-> next next0)) +(defmethod apply-to-connections engine ((obj engine) (f (function connectable none))) + "Apply f to all connections for the engine. It's okay to have f remove the connection." + (let* ((current (-> obj alive-list next0)) + ;; need to get this _before_ running f, in case we remove. + (next (-> current next0)) + ) + (while (!= current (-> obj alive-list-end)) + (f current) + (set! current next) + (set! next (-> next next0)) + ) ) 0 ) -(defmethod apply-to-connections-reverse engine ((obj engine) (arg0 (function connectable none))) - "Apply the given function to all the live conntables in the engine, iterating backward." - (let ((s4-0 (-> obj alive-list-end prev0))) - (while (!= s4-0 (-> obj alive-list)) - (arg0 s4-0) - (set! s4-0 (-> s4-0 prev0)) +(defmethod apply-to-connections-reverse engine ((obj engine) (f (function connectable none))) + "Apply f to all connections, reverse order. + Do not use f to remove yourself from the list." + (let ((iter (-> obj alive-list-end prev0))) + (while (!= iter (-> obj alive-list)) + (f iter) + (set! iter (-> iter prev0)) + ) ) - ) 0 ) (defmethod execute-connections engine ((obj engine) (arg0 object)) - "Iterate through all live connectables and execute them." - (local-vars (s4-0 connectable)) + "Run the engine!" - ;; update the engine-time + ;; remember when (set! (-> obj engine-time) (-> *display* real-frame-counter)) - ;; iterate! - (set! s4-0 (-> obj alive-list-end prev0)) - (while (!= s4-0 (-> obj alive-list)) - ;; Execute! - ((-> (the-as connection s4-0) param0) - (-> (the-as connection s4-0) param1) - (-> (the-as connection s4-0) param2) - (-> (the-as connection s4-0) param3) - arg0 - ) - (set! s4-0 (-> s4-0 prev0)) + ;; go through the connection list, in reverse. + (let ((ct (the-as connection (-> obj alive-list-end prev0)))) + (while (!= ct (-> obj alive-list)) + ;; execute! + ((-> ct param0) (-> ct param1) (-> ct param2) (-> ct param3) arg0) + ;; advance to previous. + (set! ct (the-as connection (-> ct prev0))) + ) ) - 0) + 0 + ) (defmethod execute-connections-and-move-to-dead engine ((obj engine) (arg0 object)) - "Execute connections, but remove dead connections from the list." - (local-vars (v0-2 int) (v1-2 object) (s4-0 connectable)) - - ;; update the engine time + "Run the engine! If any objects return 'dead, then remove them" (set! (-> obj engine-time) (-> *display* real-frame-counter)) - (set! s4-0 (-> obj alive-list-end prev0)) - - ;; iterate through alive list in reverse - (while (!= s4-0 (-> obj alive-list)) - (set! v1-2 - ((-> (the-as connection s4-0) param0) - (-> (the-as connection s4-0) param1) - (-> (the-as connection s4-0) param2) - (-> (the-as connection s4-0) param3) - arg0 - ) + (let ((ct (the-as connection (-> obj alive-list-end prev0)))) + (while (!= ct (-> obj alive-list)) + ;; execute function + (let ((result ((-> ct param0) (-> ct param1) (-> ct param2) (-> ct param3) arg0))) + ;; set the next one, _before_ removing + (set! ct (the-as connection (-> ct prev0))) + ;; remove if desired. + (if (= result 'dead) + ((method-of-type connection move-to-dead) (the-as connection (-> ct next0))) + ) + ) + ) ) - (set! s4-0 (-> s4-0 prev0)) - ;; if we died, move us to the dead list. - (if (= v1-2 'dead) - (move-to-dead (the-as connection (-> s4-0 next0))) - ) - ) - 0) + 0 + ) (defmethod execute-connections-if-needed engine ((obj engine) (arg0 object)) "Execute connections, but only if it hasn't been done on this frame." @@ -529,37 +525,36 @@ ) 0) - -(defmethod remove-by-param1 engine ((obj engine) (arg0 object)) - "Remove all connections with param1 matching arg0." - (local-vars - (a0-1 connectable) - (s4-0 connectable) - ) - (set! a0-1 (-> obj alive-list next0)) - (set! s4-0 (-> a0-1 next0)) - (while (!= a0-1 (-> obj alive-list-end)) - (if (= (-> (the-as connection a0-1) param1) arg0) - ((method-of-type connection move-to-dead) (the connection a0-1)) +(defmethod remove-by-param1 engine ((obj engine) (p1-value object)) + "Remove all connections with param1 matching arg0" + (let* ((current (-> obj alive-list next0)) + (next (-> current next0)) + ) + (while (!= current (-> obj alive-list-end)) + (if (= (-> (the-as connection current) param1) p1-value) + ((method-of-type connection move-to-dead) (the-as connection current)) + ) + (set! current next) + (set! next (-> next next0)) ) - (set! a0-1 s4-0) - (set! s4-0 (-> s4-0 next0)) ) - 0) + 0 + ) -(defmethod remove-by-param2 engine ((obj engine) (arg0 int)) - "Remove all connections with param2 matching arg0" - (local-vars - (a0-1 connectable) - (s4-0 connectable) - ) - (set! a0-1 (-> obj alive-list next0)) - (set! s4-0 (-> a0-1 next0)) - (while (!= a0-1 (-> obj alive-list-end)) - (if (= (-> (the-as connection a0-1) param2) arg0) - ((method-of-type connection move-to-dead) (the connection a0-1)) + + +(defmethod remove-by-param2 engine ((obj engine) (p2-value int)) + "Remove all connections with param2 matching p2-value" + (let* ((current (-> obj alive-list next0)) + (next (-> current next0)) + ) + (while (!= current (-> obj alive-list-end)) + (if (= (-> (the-as connection current) param2) p2-value) + ((method-of-type connection move-to-dead) (the-as connection current)) + ) + (set! current next) + (set! next (-> next next0)) + ) ) - (set! a0-1 s4-0) - (set! s4-0 (-> s4-0 next0)) - ) - 0) + 0 + ) diff --git a/goal_src/engine/game/main-h.gc b/goal_src/engine/game/main-h.gc index 560684461f..4981ecbf59 100644 --- a/goal_src/engine/game/main-h.gc +++ b/goal_src/engine/game/main-h.gc @@ -135,3 +135,4 @@ ) ) +(defun-extern movie? symbol) diff --git a/goal_src/engine/game/main.gc b/goal_src/engine/game/main.gc index d9805742ab..a84f5de33b 100644 --- a/goal_src/engine/game/main.gc +++ b/goal_src/engine/game/main.gc @@ -5,3 +5,7 @@ ;; name in dgo: main ;; dgos: GAME, ENGINE +(defun movie? () + "Are we in a movie?" + (nonzero? (logand (-> *kernel-context* prevent-from-run) (process-mask movie))) + ) diff --git a/goal_src/engine/gfx/capture.gc b/goal_src/engine/gfx/capture.gc index 961a01da99..03ee86b1bb 100644 --- a/goal_src/engine/gfx/capture.gc +++ b/goal_src/engine/gfx/capture.gc @@ -5,3 +5,120 @@ ;; name in dgo: capture ;; dgos: GAME, ENGINE +;; vif/gif tags to do a transfer of data from VRAM to EE memory. +(deftype gs-store-image-packet (structure) + ((vifcode vif-tag 4 :offset-assert 0) + (giftag gif-tag :offset-assert 16) + (bitbltbuf gs-bitbltbuf :offset-assert 32) + (bitbltbuf-addr gs-reg64 :offset-assert 40) + (trxpos gs-trxpos :offset-assert 48) + (trxpos-addr gs-reg64 :offset-assert 56) + (trxreg gs-trxreg :offset-assert 64) + (trxreg-addr gs-reg64 :offset-assert 72) + (finish int64 :offset-assert 80) + (finish-addr gs-reg64 :offset-assert 88) + (trxdir gs-trxdir :offset-assert 96) + (trxdir-addr gs-reg64 :offset-assert 104) + ) + :method-count-assert 9 + :size-assert #x70 + :flag-assert #x900000070 + ) + +(defun gs-set-default-store-image ((packet gs-store-image-packet) (src-fbp int) (src-w int) (src-psm int) (ssax int) (ssay int) (rrw int) (rrh int)) + "Set up a gs-store-image-packet for storing" + ;; nop + (set! (-> packet vifcode 0) (new 'static 'vif-tag :cmd (vif-cmd nop))) + ;; set mskpath3 + (set! (-> packet vifcode 1) + (new 'static 'vif-tag :imm #x8000 :cmd (vif-cmd mskpath3)) + ) + ;; flush! + (set! (-> packet vifcode 2) + (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1) + ) + ;; direct gif transfer. + (set! (-> packet vifcode 3) + (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1) + ) + ;;gif a+d + (set! (-> packet giftag) (the-as gif-tag + (make-u128 + (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)) + (new 'static 'gif-tag64 :nloop #x5 :eop #x1 :nreg #x1) + ) + ) + ) + + ;; all the a+d + (set! (-> packet bitbltbuf) (new 'static 'gs-bitbltbuf :sbp src-fbp :sbw src-w :spsm src-psm)) + (set! (-> packet bitbltbuf-addr) (gs-reg64 bitbltbuf)) + (set! (-> packet trxpos) (new 'static 'gs-trxpos :ssax ssax :ssay ssay)) + (set! (-> packet trxpos-addr) (gs-reg64 trxpos)) + (set! (-> packet trxreg) (new 'static 'gs-trxreg :rrw rrw :rrh rrh)) + (set! (-> packet trxreg-addr) (gs-reg64 trxreg)) + (set! (-> packet finish) 0) + (set! (-> packet finish-addr) (gs-reg64 finish)) + (set! (-> packet trxdir) (new 'static 'gs-trxdir :xdir #x1)) + (set! (-> packet trxdir-addr) (gs-reg64 trxdir)) + (.sync.l) + 7 + ) + + +(defun store-image ((oddeven int)) + "Store an image to image.raw" + (local-vars (ptr-1 (pointer uint8)) (y-idx int) (y-idx-2 int)) + (let ((width 512) + (height (-> *video-parms* screen-sy)) + (file (new 'debug 'file-stream "image.raw" 'write)) + ) + ;; create (and leak memory) for 2 arrays. + (let ((buff0 (new 'debug 'boxed-array uint128 (sar (* width height) 2)))) + (let ((buff1 (new 'debug 'boxed-array uint128 (sar (* width height) 2)))) + ;; set up a packet. + (let ((packet (new 'static 'gs-store-image-packet))) + ;; capture one field + (gs-set-default-store-image packet #x2800 (sar width 6) 0 0 0 width height) + (flush-cache 0) + (gs-store-image packet (-> buff0 data)) + (sync-path 0 0) + ;; capture other field + (gs-set-default-store-image packet #x3000 (sar width 6) 0 0 0 width height) + (flush-cache 0) + (gs-store-image packet (-> buff1 data)) + ) + ;; wait for capture to complete. + (sync-path 0 0) + (let ((ptr-0 (-> buff0 data))) + (set! ptr-1 (-> buff1 data)) + (cond + ((zero? oddeven) + (set! y-idx 0) + (while (< y-idx height) + (file-stream-write file (&+ ptr-0 (* y-idx (shl width 2))) (the-as uint (shl width 2))) + (file-stream-write file (&+ ptr-1 (* y-idx (shl width 2))) (the-as uint (shl width 2))) + (set! y-idx (+ y-idx 1)) + ) + ) + (else + (set! y-idx-2 0) + (while (< y-idx-2 height) + (file-stream-write file (&+ ptr-1 (* y-idx-2 (shl width 2))) (the-as uint (shl width 2))) + (file-stream-write file (&+ ptr-0 (* y-idx-2 (shl width 2))) (the-as uint (shl width 2))) + (set! y-idx-2 (+ y-idx-2 1)) + ) + ) + ) + ) + (format #t "oddeven = ~d~%" oddeven) + ;; this does nothing. + (delete buff1) + ) + ;; also does nothing. + (delete buff0) + ) + (file-stream-close file) + ) + 0 + ) diff --git a/goal_src/engine/gfx/hw/display-h.gc b/goal_src/engine/gfx/hw/display-h.gc index 4b1d6a595a..d6c0973929 100644 --- a/goal_src/engine/gfx/hw/display-h.gc +++ b/goal_src/engine/gfx/hw/display-h.gc @@ -131,8 +131,8 @@ (vu1-buf dma-buffer :offset 8) (debug-buf dma-buffer :offset 36) (global-buf dma-buffer :offset 40) - (buffer uint32 11 :offset 4) ;; for debugging? (bucket-group dma-bucket :offset 44) + (buffer uint32 11 :offset 4) ;; for debugging? (profile-bar profile-bar 2 :offset 48) (run-time uint64 :offset 56) ) diff --git a/goal_src/engine/gfx/texture-h.gc b/goal_src/engine/gfx/texture-h.gc index 5e1e70e4a9..9238cb63d5 100644 --- a/goal_src/engine/gfx/texture-h.gc +++ b/goal_src/engine/gfx/texture-h.gc @@ -5,6 +5,17 @@ ;; name in dgo: texture-h ;; dgos: GAME, ENGINE + +(defenum tpage-kind + :type uint32 + :bitfield #f + (tfrag 0) + (pris 1) + (shrub 2) + (alpha 3) + (water 4) + ) + ;; mask for different texture things. ;; these are the ones that will be displayed in the menu (define *texture-enable-user-menu* #x1f) @@ -31,36 +42,43 @@ :flag-assert #x900000008 ) +(declare-type texture-page basic) +(declare-type level basic) + (deftype texture-pool (basic) - ((top int32 :offset-assert 4) - (cur int32 :offset-assert 8) - (allocate-func basic :offset-assert 12) - (font-palette int32 :offset-assert 16) - (segment texture-pool-segment 4 :inline :offset-assert 20) - (segment-near texture-pool-segment :inline :offset 20) - (segment-common texture-pool-segment :inline :offset 28) - (common-page int32 32 :offset-assert 52) - (common-page-mask int32 :offset-assert 180) - (ids int32 126 :offset-assert 184) + ((top int32 :offset-assert 4) + (cur int32 :offset-assert 8) + (allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12) + (font-palette int32 :offset-assert 16) ;; vram word idx + + ;; these were reordered + (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) + + (common-page texture-page 32 :offset-assert 52) + (common-page-mask int32 :offset-assert 180) + (ids uint32 126 :offset-assert 184) ) :method-count-assert 23 :size-assert #x2b0 :flag-assert #x17000002b0 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) - (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) - (dummy-15 () none 15) - (dummy-16 () none 16) + (new (symbol type) _type_ 0) + (initialize! (_type_) _type_ 9) + (print-usage (_type_) _type_ 10) + (dummy-11 (_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. + (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 () none 20) - (dummy-21 () none 21) - (dummy-22 () none 22) + (upload-one-common! (_type_) symbol 21) + (lookup-boot-common-id (_type_ int) int 22) ) ) @@ -69,7 +87,7 @@ (h int16 :offset-assert 6) (num-mips uint8 :offset-assert 8) (tex1-control uint8 :offset-assert 9) - (psm uint8 :offset-assert 10) + (psm gs-psm :offset-assert 10) (mip-shift uint8 :offset-assert 11) (clutpsm uint16 :offset-assert 12) (dest uint16 7 :offset-assert 14) @@ -109,30 +127,30 @@ (size uint32 :offset-assert 24) (segment texture-page-segment 3 :inline :offset-assert 28) (pad uint32 16 :offset-assert 64) - (data uint8 :dynamic :offset-assert 128) + (data texture :dynamic :offset-assert 128) ) :method-count-assert 15 :size-assert #x80 :flag-assert #xf00000080 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) + (remove-from-heap (_type_ kheap) _type_ 9) + (get-leftover-block-count (_type_ int int) int 10) (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) + (relocate-dests! (_type_ int int) none 12) + (add-to-dma-buffer (_type_ dma-buffer int) none 13) + (upload-now! (_type_ int) none 14) ) ) (deftype shader-ptr (uint32) - () + ((shader uint32 :offset 8 :size 24)) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) (deftype texture-link (structure) - ((next uint32 :offset-assert 0) + ((next shader-ptr 1 :offset-assert 0) ) :method-count-assert 9 :size-assert #x4 @@ -142,16 +160,18 @@ (deftype texture-page-dir-entry (structure) ((length int16 :offset-assert 0) (status uint16 :offset-assert 2) - (page basic :offset-assert 4) - (link uint32 :offset-assert 8) + (page texture-page :offset-assert 4) + (link texture-link :offset-assert 8) ) + :pack-me :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c ) (deftype texture-page-dir (basic) - ((pad uint8 #x10)) + ((length int32) + (entries texture-page-dir-entry 1 :inline)) (:methods (dummy-9 () none 9) ) @@ -164,7 +184,7 @@ (source uint32 :offset-assert 12) (move uint32 :offset-assert 16) (entry texture-page-dir-entry :offset-assert 20) - (page basic :offset-assert 24) + (page texture-page :offset-assert 24) ) :method-count-assert 9 :size-assert #x1c @@ -186,7 +206,7 @@ (alpha uint64 :offset 64) (link-test uint32 :offset 8) (texture-id uint32 :offset 24) - (next uint32 :offset 40) + (next shader-ptr :offset 40) ) :method-count-assert 9 :size-assert #x50 @@ -213,3 +233,8 @@ (define *ocean-base-vram-word* 0) (define *ocean-base-block* 0) (define *ocean-base-page* 0) + + +(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-pool* texture-pool) diff --git a/goal_src/engine/gfx/texture.gc b/goal_src/engine/gfx/texture.gc index f01779da4d..62077fe1c9 100644 --- a/goal_src/engine/gfx/texture.gc +++ b/goal_src/engine/gfx/texture.gc @@ -5,3 +5,1656 @@ ;; name in dgo: texture ;; dgos: GAME, ENGINE +;; 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 +;; (used for effects) +;; - "fixed textures" that live in VRAM always and aren't kept in RAM. +;; (common textures for Jak, crates, etc) +;; - "global common" textures that are uploaded as needed, but aren't level specific +;; (the start menu hud) +;; - "level common" textures that are uploaded as needed +;; - "level near" textures. Part of these textures remain in VRAM always (don't live in RAM) and +;; part is reuploaded as needed. This is for TFRAG stuff near the camera + +;; common/near textures use a lazy loading scheme to avoid loading texture data that happens to already +;; be in the right spot. + +;; During a level load, the first texture-page loaded is TFRAG, which contains both "near" and "common" data. +;; TFRAG is the only known thing to use "near" + +;; Note: there is something weird going on with the zoomer hud texture. + +;; On the DVD, textures are stored in "tpage files". Each file contains: +;; - a texture-page object, describing the file +;; - a texture object per texture, describing each texture (possibly multiple textures, mipmapped textures are considered 1 "texture") +;; the texture system will update these texture records to point the correct location in VRAM. +;; - the "block-data" - the actual texture data. + +;; To make texture uploads as fast as possible, all data is designed to be uploaded as ct32, width 128. +;; The GS will end up scrambling up the data during the upload, but the tpage files are pre-scrambled in +;; the correct way to make everything work out. +;; This avoids having to load in other formats, which are slower. + +;; Additionally, each texture-page is divided into three segments. +;; For TFRAG textures, segment 2 is "near" and segment 1 and 0 is "common" + +;; To manage VRAM, there is a single texture-pool. It also has segments. +;; - near segment (level near textures) +;; - common segment (level and global common textures) + +;; textures that are _always_ in VRAM (starting at boot) do not go in either of these segments + +;; the common segment is shared between texture pages. There is lazy loading for this. + +;; the near segment is shared between 2 texture pages - one per each level. +;; the first 0x24000 words are for level 0, and the last 0x24000 words are for level 1. +;; the stuff in the middle is shared and lazily loaded as needed. + +;; there are 5 texture uploads per frame: +;; - TFRAG +;; - PRIS +;; - SHRUB +;; - ALPHA +;; - WATER +;; it is unknown how this works when drawing two levels. + +;; Generally, "dest" refers to a location in vram, specified in 32-bit words. +;; block-data is a pointer to EE memory containing texture data. + +;; There is a single "texture-pool" which is responsible for managing the vram. +;; it does not consider the frame/depth buffer. + +;; There are three main units to describe VRAM: +;; words: 32-bit words, interally this is how the GS addresses things. "dest"/"size" is in words usually +;; blocks: 256 bytes, or 64 words. Some things in the GS must be block aligned, like transfers of textures. +;; KB: kilobytes, used only for diagnostic printing. 2^10 bytes (1024) +;; "ND page". Twice the size of a GS page. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; texture-page type +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; 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 also contain records of textures. The texture system will update these records +;; to reflect where the textures are actually placed in VRAM. +;; However, it is possible that multiple texture are assigned to the same destination. +;; You can check for this by looking at the texture-pool ids. +;; Or, use the upload-vram-pages function which will add uploads to a DMA chain only if needed. + +(defmethod print texture-page ((obj texture-page)) + "Print a short description of a texture page." + (format #t "#" + (-> obj name) + (-> obj length) ;; number of textures. + (shr (-> obj segment 0 dest) 6) ;; destination (vram words (4 byte) -> blocks (256 byte)) + (shr (-> obj size) 8) ;; size (vram words -> kilobytes) + obj + ) + obj + ) + +(defmethod length texture-page ((obj texture-page)) + "Get the number of textures in a texture page" + (-> obj length) + ) + +(defmethod asize-of texture-page ((obj texture-page)) + "Get the size in memory of a texture page object, not including the actual texture objects or texture data" + (the-as int (+ (-> obj type size) (the-as uint (shl (-> obj length) 2)))) + ) + +(defmethod mem-usage texture-page ((obj texture-page) (arg0 memory-usage-block)) + "Update the mem-usage for a texture." + + ;; some setup for texture memory usage. + (set! (-> arg0 length) (max (+ 1 (mem-usage-id-int texture)) (-> arg0 length))) + (set! (-> arg0 data (mem-usage-id texture) name) "texture") + + ;; count will hold the number of textures. + (set! (-> arg0 data (mem-usage-id texture) count) + (+ (-> arg0 data (mem-usage-id texture) count) (-> obj length))) + + ;; We subtract off the size of the textures. This makes the memory usage negative! + ;; I don't understand why this happens, but + ;; - it matches the game (texture size shows up as negative in the debug menu) + ;; - the game sizes seem correct. + (let ((v1-7 (- (asize-of obj) (the-as int (shl (-> obj size) 2))))) + ;; add 64-bytes for each entry, the size of texture. + (dotimes (a0-6 (-> obj length)) + (if (-> obj data a0-6) + (+! v1-7 64) + ) + ) + ;; update used and total. + (set! (-> arg0 data (mem-usage-id texture) used) (+ (-> arg0 data (mem-usage-id texture) used) v1-7)) + ;; total assumes 16-byte alignment. + (set! (-> arg0 data (mem-usage-id texture) total) + (+ (-> arg0 data (mem-usage-id texture) total) (logand -16 (+ v1-7 15))) + ) + ) + obj + ) + + +;;;;;;;;;;;;;;;;;;;;;; +;; Texture Data Load +;;;;;;;;;;;;;;;;;;;;;; + +(defun texture-bpp ((arg0 gs-psm)) + "Get the number of bits per pixel for the given texture format" + (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 + ) + ) + ) + ) + ) + +(defun texture-qwc ((w int) (h int) (tex-format gs-psm)) + "Get the number of quadwords in a texture. Round up." + (let ((v1-0 (texture-bpp tex-format))) + (sar (+ (* (* w h) v1-0) 127) 7) + ) + ) + +(defun physical-address ((arg0 pointer)) + "Convert a pointer to a physical address than can be used for DMA" + (the-as pointer (logand #xfffffff (the-as int arg0))) + ) + +(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." + + ;; get pointer and size (quadwords) + (let ((data-ptr (physical-address data)) + (qwc (texture-qwc tex-w tex-h tex-format)) + ) + ;; do transfers until its all gone. + (while (> qwc 0) + ;; only #x7fff quadwords/transfer is allowed. + (let ((qwc-this-time (min #x7fff qwc))) + ;; is this the last transfer? + (let ((eop (if (= qwc qwc-this-time) 1 0))) + ;; set up dma/vif for a single giftag + (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)) + ) + + ;; set up IMAGE mode! + (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)) + ) + ) + + ;; and send the data. + (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)) + ) + + ;; seek to next data. + (&+! data-ptr (shl qwc-this-time 4)) + (set! qwc (- qwc qwc-this-time)) + ) + ) + ) + (none) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;; +;; texture +;;;;;;;;;;;;;;;;;;;;;;;; + +;; A texture stores some metadata about a single (possibly mipmapped) texture. +;; after load, these point to location of the texture in VRAM _if the texture were uploaded to address 0_. +;; these records will be updated to point to the correct spot in VRAM by the texture allocators. + +(defmethod print texture ((obj texture)) + "Print out texture object, describing the texture format." + (format #t "# obj name) + (psm->string (-> obj psm)) + (-> obj w) + (-> obj h) + (-> obj num-mips) + (shr (-> obj size) 8) ;; (vram words -> kb) + ) + ;; print each level + (dotimes (s5-1 (the-as int (-> obj num-mips))) + (format #t " #x~X/~X" (-> obj dest s5-1) (-> obj width s5-1)) + ) + ;; for < 16 bpp textures, there is a color look-up table. + (if (< (texture-bpp (-> obj psm)) 16) + (format #t " :clut #x~X/1" (-> obj clutdest)) + ) + (format #t " @ #x~X>" obj) + obj + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Unused and partially broken texture format utils +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define ct32-24-block-table + (new 'static 'boxed-array int32 + 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)) + +(define mz32-24-block-table + (new 'static 'boxed-array int32 + 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)) + +(define ct16-block-table + (new 'static 'boxed-array int32 + 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)) + +(define ct16s-block-table + (new 'static 'boxed-array int32 + 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)) + +(define mz16-block-table + (new 'static 'boxed-array int32 + 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)) + +(define mz16s-block-table + (new 'static 'boxed-array int32 + 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)) + +(define mt8-block-table + (new 'static 'boxed-array int32 + 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)) + +(define mt4-block-table + (new 'static 'boxed-array int32 + 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)) + +(defun gs-find-block ((bx int) (by int) (tex-format gs-psm)) + "Block index lookup." + (cond + ((zero? tex-format) + (-> ct32-24-block-table (+ bx (shl by 3))) + ) + ((= tex-format (gs-psm ct24)) + (-> ct32-24-block-table (+ bx (shl by 3))) + ) + ((= tex-format (gs-psm ct16)) + (-> ct16-block-table (+ bx (shl by 2))) + ) + ((= tex-format (gs-psm ct16s)) + (-> ct16s-block-table (+ bx (shl by 2))) + ) + ((= tex-format (gs-psm mz32)) + (-> mz32-24-block-table (+ bx (shl by 3))) + ) + ((= tex-format (gs-psm mz24)) + (-> mz32-24-block-table (+ bx (shl by 3))) + ) + ((= tex-format (gs-psm mz16)) + (-> mz16-block-table (+ bx (shl by 2))) + ) + ((= tex-format (gs-psm mz16s)) + (-> mz16s-block-table (+ bx (shl by 2))) + ) + ((= tex-format (gs-psm mt8)) + (-> mt8-block-table (+ bx (shl by 3))) + ) + ((= tex-format (gs-psm mt4)) + (-> mt4-block-table (+ bx (shl by 2))) + ) + (else + 0 + ) + ) + ) + +(defun gs-page-width ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (if (or (zero? v1-0) + (= v1-0 (gs-psm ct24)) + (= v1-0 (gs-psm ct16)) + (= v1-0 (gs-psm ct16s)) + ) + 64 + (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 + ) + ) + ) + ) + ) + +(defun gs-page-height ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (if (or (zero? v1-0) (= v1-0 (gs-psm ct24))) + 32 + (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 + ) + ) + ) + ) + ) + +(defun gs-block-width ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (if (or (zero? v1-0) (= v1-0 (gs-psm ct24))) + 8 + (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 + ) + ) + ) + ) + ) + +(defun gs-block-height ((arg0 gs-psm)) + (let ((v1-0 arg0)) + (if (or (zero? v1-0) + (= v1-0 (gs-psm ct24)) + (= v1-0 (gs-psm ct16)) + (= v1-0 (gs-psm ct16s)) + ) + 8 + (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 + ) + ) + ) + ) + ) + +(defun gs-largest-block ((tex-width int) (tex-height int) (tex-format gs-psm)) + "Determine the largest block occupied by the given texture" + (let* ((block-width (gs-block-width tex-format)) + (block-height (gs-block-height tex-format)) + ;; round up to neaest block. + (real-width + (* (/ (+ (+ block-width -1) tex-width) block-width) block-width) + ) + (real-height + (* (/ (+ (+ block-height -1) tex-height) block-height) block-height) + ) + ;; and now convert to actual blocks + (width-blocks (/ real-width block-width)) + (height-blocks (/ real-height block-height)) + (max-block 0) + ) + ;; loop over each block... + (dotimes (x width-blocks) + (dotimes (y height-blocks) + ;; and see where it is. + (set! max-block (max max-block (gs-find-block x y tex-format))) + ) + ) + max-block + ) + ) + +(defun gs-blocks-used ((tex-width int) (tex-height int) (tex-format gs-psm)) + "This function doesn't make much sense... It's unused so maybe it's just wrong?" + (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)) + ;; past here, it doesn't make much sense to me. + (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) + (shl (+ (* width-blocks height-blocks) -1) 5) + ) + (shl (* height-blocks width-blocks) 5) + ) + ) + ) +;;;;;;;;;;;;;; end of weird gs functions that are unused. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Texture Pool +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; there is a single texture pool (*texture-pool*) that is responsible for +;; managing the textures in VRAM. +;; It can allocate plain memory, and also tracks "segments", which are just +;; chunks of VRAM that have a location+size. + +(defmethod new texture-pool ((allocation symbol) (type-to-make type)) + "Allocate and initialize a texture-pool" + (initialize! + (object-new allocation type-to-make (the-as int (-> type-to-make size))) + ) + ) + +(defmethod allocate-vram-words! texture-pool ((obj texture-pool) (word-count int)) + "Allocate words in vram. Returns the index of the first word." + (let ((v0-0 (-> obj cur))) + (set! (-> obj cur) (+ (-> obj cur) word-count)) + v0-0 + ) + ) + +;; boot common textures are "common" textures that are loaded at boot, but will live in RAM +;; and be uploaded to VRAM as needed. + +(defmethod lookup-boot-common-id texture-pool ((obj texture-pool) (arg0 int)) + "Map these special textures to a number betwen 0 and 19. For other textures, return -1. + NOTE: hud means start menu + zoomer, not the usual health HUD." + (let ((v1-0 arg0)) + (cond + ((= v1-0 1032) 0) ;; hud (seg0 only) + ((= v1-0 1119) 1) ;; zoomer-hud (not actually loaded at boot) + ((= v1-0 1478) 2) ;; doesn't exist? (likely demo1) + ((= v1-0 1485) 3) ;; demo2 (seg0 only) + ((= v1-0 1486) 4) ;; demo3 (seg0 only) + ((= v1-0 1487) 5) ;; demo4 (seg0 only) + (else + (cond + ((or (= v1-0 635) (= v1-0 1609)) 6) ;; X or demo5j (seg0 only) + ((= v1-0 636) 7) ;; nope + ((= v1-0 637) 8) ;; nope + ((= v1-0 752) 9) ;; nope + ((= v1-0 1598) 10) ;; nope + ((= v1-0 1599) 11) ;; demo2f + ((= v1-0 1600) 12) ;; demo2g + ((= v1-0 1601) 13) ;; demo2i + ((= v1-0 1602) 14) ;; demo2s + ((= v1-0 1603) 15) ;; demo4e + ((= v1-0 1604) 16) ;; demo4f + ((= v1-0 1605) 17) ;; demo4g + ((= v1-0 1606) 18) ;; demo4i + ((= v1-0 1607) 19) ;; demo4s + (else -1) + ) + ) + ) + ) + ) + +(defmethod initialize! texture-pool ((obj texture-pool)) + "Initialize (or maybe reinitialize) a texture pool." + ;; reset allocator + (set! (-> obj cur) 0) + ;; I think top is basically unused. + (set! (-> obj top) (-> obj cur)) + ;; by default, use the default allocator. + (set! (-> obj allocate-func) texture-page-default-allocate) + ;; allocate the weird stuff we always want (font, sky, etc) + (allocate-defaults! obj) + (set! (-> obj font-palette) (allocate-vram-words! obj 64)) + + ;; clear out common pages. + (dotimes (v1-6 32) + (set! (-> obj common-page v1-6) (the-as texture-page 0)) + ) + (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. + ;; 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)) + ) + obj + ) + +(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." + (let ((v1-0 additional-size)) + (dotimes (a2-1 segment-count) + (+! v1-0 (the-as int (-> obj segment a2-1 size))) + ) + (logand (sar v1-0 6) 63) + ) + ) + +(defmethod print-usage texture-pool ((obj texture-pool)) + "Print out VRAM usage." + (format #t "--------------------~%") + (format #t "texture pool ~DK - ~DK (~DK used, ~DK free)~%" + (sar (-> obj top) 8) ;; vram words to kb + (sar (-> obj cur) 8) ;; vram words to kb + (sar (- (-> obj cur) (-> obj top)) 8) + (sar (- #xfa000 (-> obj cur)) 8) ;; 4 MB, doesn't seem to account for framebuffers? + ) + (format #t "--------------------~%") + obj + ) + +(defmethod allocate-segment! texture-pool ((obj texture-pool) (segment texture-pool-segment) (size int)) + "Allocate a segment of the given size. The segment is an output here, containing size/dest." + (set! (-> segment size) (the-as uint size)) + (set! (-> segment dest) (the-as uint (allocate-vram-words! obj size))) + segment + ) + +(defconstant NEAR_SEGMENT_WORDS #x62000) ;; ~1.6 MB +(defconstant COMMON_SEGMENT_WORDS #x1c000) ;; ~0.5 MB +(defconstant SPECIAL_VRAM_WORDS #x7000) ;; for sky, eyes, ocean, and depth-cue effect rendering. + +(defmethod allocate-defaults! texture-pool ((obj texture-pool)) + "Allocate default segments" + ;; 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. + (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)) + (set! *eyes-base-vram-word* (+ *sky-base-vram-word* 6144)) + (set! *eyes-base-block* (sar *eyes-base-vram-word* 6)) + (set! *eyes-base-page* (sar *eyes-base-vram-word* 11)) + (set! *ocean-base-vram-word* (+ *sky-base-vram-word* 6144)) + (set! *ocean-base-block* (sar *ocean-base-vram-word* 6)) + (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* (sar *depth-cue-base-vram-word* 6)) + (set! *depth-cue-base-page* (sar *depth-cue-base-vram-word* 11)) + (none) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; texture-page management +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(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." + (set! (-> seg current) (-> obj segment 0 block-data)) + obj + ) + +(defun texture-page-default-allocate ((pool texture-pool) (page texture-page) (heap kheap) (tpage-id int)) + "Default allocator for textures. This _permanently_ uploads the texture to VRAM and uses up VRAM that + 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." + + ;; loop over the semgments in the texture page. + (dotimes (seg-id 3) + ;; get vram for the segment + (let ((vram (allocate-vram-words! pool (the-as int (-> page segment seg-id size))))) + ;; adjust the texture so it points to the vram address the allocator gave us. + (relocate-dests! page vram seg-id) + ) + ) + ;; upload the texture page (all segments). This function will return after the upload has finished. + (upload-now! page -1) + ;; and kick the data out from the heap, now that it is permanently in vram. + (remove-from-heap page heap) + page + ) + + +(defun texture-page-common-allocate ((pool texture-pool) (page texture-page) (seg kheap) (tpage-id int)) + "Set up an entire texture page for eventual upload to the common segment of the pool. + All three segments will be together." + + ;; 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))) + (dotimes (seg-id 3) + ;; fixup texture data so it points to the right spot in the common segment. + (relocate-dests! page (the-as int s5-0) seg-id) + (+! s5-0 (-> page segment seg-id size)) + ) + ) + page + ) + +(defun texture-page-common-boot-allocate ((pool texture-pool) (page texture-page) (heap kheap) (tpage-id int)) + "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." + + ;; 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) + ;; 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 common memory (not level-specific) + ;; have a record in this common-page array. + ;; this helps other code find the appropriate tpage to upload. + ;; level-specific texture pages are stored in the level structure itself, but this doesn't apply here. + (set! (-> pool common-page tex-id) page) + ) + (else + ;; 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) + (texture-page-default-allocate pool page heap tpage-id) + ) + ) + ) + page + ) + + +;;;;;;;;;;;;;;;;;; +;; texture upload +;;;;;;;;;;;;;;;;;; + +;; 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. + +(defun upload-vram-data ((buf dma-buffer) (dest int) (tex-data pointer) (tex-h int)) + "Add DMA packet to prepare to upload a texture." + (while (> tex-h 0) + ;; only 2048 height/transfer. + (let ((height-this-time (min 2048 tex-h))) + ;; add dma/vif tag. + (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)) + ) + + ;; add gif (a+d) + (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)) + ) + + ;; add transfer setting registers + (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) ;; all uploads are ct32. + ) + ) + (+! dest 4096) + (set! tex-data (&+ tex-data #x100000)) + (+! tex-h -2048) + ) + (none) + ) + +(defun upload-vram-pages ((pool texture-pool) (segment texture-pool-segment) (page texture-page) (mode int) (bucket-idx int)) + "Add a dma chain to upload textures to the bucket. This will only upload chunks that aren't already there. + This will automatically update the cache info in the pool for the upload. + mode: -3 = don't want anything (this function does nothing) + 0 = page segment 0 + -2 = page segment 0 and 1 + -1 = the whole page. + 2 = just segment 2 of the page." + (local-vars + (tex-data pointer) + (tex-dest-base-chunk uint) + (chunk-count uint) + (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)) ;; the global DMA buffer + (dma-start (-> dma-buf base)) ;; the start of the DMA to add to the bucket. + ) + + ;; default to segment 0 only (mode 0) + (set! tex-data (-> page segment 0 block-data)) ;; data to send, in EE memory + (set! tex-dest-base-chunk (shr (-> page segment 0 dest) 12)) ;; destination chunk idx. + (set! chunk-count (-> page segment 0 size)) ;; number of chunks in segment + (set! chunks-to-upload-count 0) ;; number of chunks to actually upload + (set! first-chunk-idx-to-upload 0) ;; index in data of first chunk to send + (set! tex-id (-> page id)) ;; the id of the texture. + (let ((v1-8 mode)) + (cond + ((= v1-8 -3) + (return 0) ;; mode -3, do nothing. + ) + ((zero? v1-8) ;; mode 0, default is okay + ) + ((= v1-8 -2) ;; mode -2, add on segment 1 + (set! chunk-count (+ chunk-count (-> page segment 1 size))) + ) + ((= v1-8 -1) ;; mode -1, do the whole thing. + (set! chunk-count (-> page size)) + ) + ((= v1-8 2) ;; mode 2, overwrite and do segment 2 only. + (set! tex-data (-> page segment 2 block-data)) + (set! tex-dest-base-chunk (shr (-> page segment 2 dest) 12)) + (set! chunk-count (-> page segment 2 size)) + ) + ) + ) + + ;; make sure we don't overflow the segment we're loading to. + (set! chunk-count + (the uint (shr (min (the-as int (-> segment size)) (the-as int (+ chunk-count 4095))) 12)) + ) + + ;; next, loop over each chunk to upload. + ;; we want to: + ;; - skip uploading chunks we already uploaded + ;; - group together consecutive chunks we need to upload. + (dotimes (upload-chunk-idx (the-as int chunk-count)) + ;; the destination of the chunk. + (let ((current-dest-chunk + (+ tex-dest-base-chunk (the-as uint upload-chunk-idx)) + ) + ) + ;; now we see if we can get away with not uploading the chunk. + (if (zero? chunks-to-upload-count) + (when (!= (-> pool ids current-dest-chunk) tex-id) + ;; we hit the beginning of a run of chunks that need uploading + (set! first-chunk-idx-to-upload upload-chunk-idx) + ;; remember that we will upload this. + (set! (-> pool ids current-dest-chunk) tex-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + (cond + ;; in here, we are in the middle of a run of "needs uploading" chunks + ((= (-> pool ids current-dest-chunk) tex-id) + ;; and the run ends, we found a chunk that's already loaded. + ;; so we upload the run: + (upload-vram-data dma-buf + (the int (shl (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) 6)) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (shl chunks-to-upload-count 5) + ) + (+! total-upload-size chunks-to-upload-count) + ;; reset + (set! chunks-to-upload-count 0) + ) + (else + ;; the run continues! + (set! (-> pool ids current-dest-chunk) tex-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + ) + ) + ) + ) + + ;; if we finished with a run of "needs upload", set up the upload. + (when (nonzero? chunks-to-upload-count) + (upload-vram-data + dma-buf + (the int (shl (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) 6)) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (shl chunks-to-upload-count 5) + ) + (+! total-upload-size chunks-to-upload-count) + ) + + ;; do a texflush + + ;; first, set up dma/vif + (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)) + ) + + ;; and gif (a+d) + (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)) + ) + + ;; texflush + (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)) + ) + + ;; we end the chain with a next. The bucket system will patch the next chain to this, + ;; and then patch all the buckets togehter before sending the DMA. + (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 first thing in this chain, bucket will patch previous to this + (the-as (pointer dma-tag) a3-3) ;; end of this chain (ptr to next tag) + ) + ) + ) + (shl total-upload-size 14) + ) + ) + +(defun update-vram-pages ((pool texture-pool) (pool-segment texture-pool-segment) (page texture-page) (mode int)) + "Update texture pool info if given texture page was uploaded in the given mode, but not using upload-vram-pages + or upload-vram-pages-pris + You should call this after doing an upload-now!, for example" + + ;; this is clearly copy-pasta from upload-vram-pages, and there are some weird leftovers. + (let ((v1-0 (-> page segment 0 block-data))) + ) + + (let ((dest-block (shr (-> page segment 0 dest) 12)) ;; where we're loading to + (sz (-> page segment 0 size)) + (modified-chunk-count 0) + ) + (let ((t0-0 0)) + ) + (let ((page-id (-> page id))) + (cond + ((= mode -3) + (return 0) ;; do nothing + ) + ((zero? mode) ;; use segment 0 + ) + ((= mode -2) + (+! sz (-> page segment 1 size)) ;; segment 0 + 1 + ) + ((= mode -1) + (set! sz (-> page size)) ;; the whole page + ) + ((= mode 2) ;; segment 2 only + (let ((a3-5 (-> page segment 2 block-data))) + ) + (set! dest-block (shr (-> page segment 2 dest) 12)) + (set! sz (-> page segment 2 size)) + ) + ) + + ;; don't overflow. + (let ((upload-chunks (shr (min (the-as int (-> pool-segment size)) (the-as int (+ sz 4095))) 12))) + + ;; for each chunk we might want to upload... + (dotimes (chunk-idx (the-as int upload-chunks)) + ;; this has the weird run logic, but it isn't really used. + ;; no matter what (-> pool ids vram-chunk) will be set to page-id. + (let ((vram-chunk (+ dest-block (the-as uint chunk-idx)))) + (if (zero? modified-chunk-count) + (when (!= (-> pool ids vram-chunk) page-id) + (set! (-> pool ids vram-chunk) page-id) + (+! modified-chunk-count 1) + ) + (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 + ) + +(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. + 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) + (tex-dest-base-chunk uint) + (chunk-count uint) + (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)) + (dma-start (-> dma-buf base)) + ) + (set! tex-data (-> page segment 0 block-data)) ;; data in RAM + (set! tex-dest-base-chunk (shr (-> page segment 0 dest) 12)) ;; where to load + (set! chunk-count (-> page size)) ;; how much to load + (set! chunks-to-upload-count 0) ;; for runs of uploads + (set! first-chunk-idx-to-upload 0) ;; for runs of uploads + (set! page-id (-> page id)) + + ;; don't overflow. + (set! chunk-count (the uint (shr (min (the-as int (-> segment size)) (the-as int (+ chunk-count 4095))) 12))) + + ;; iterate through chunks to possibly upload + (dotimes (upload-chunk-idx (the-as int chunk-count)) + ;; where to load to + (set! current-dest-chunk + (+ 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))) + ) + ;; 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) + ;; 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)) + ;; 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)) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (shl chunks-to-upload-count 5) + ) + (+! total-upload-size chunks-to-upload-count) + (set! chunks-to-upload-count 0) + ) + (else + ;; run continuing. + (set! (-> pool ids current-dest-chunk) page-id) + (set! chunks-to-upload-count (+ chunks-to-upload-count 1)) + ) + ) + ) + ) + + ;; if we ended in a run, upload it. + (when (nonzero? chunks-to-upload-count) + (upload-vram-data + dma-buf + (the int (shl (+ tex-dest-base-chunk (the-as uint first-chunk-idx-to-upload)) 6)) + (&+ tex-data (shl first-chunk-idx-to-upload 14)) + (shl chunks-to-upload-count 5) + ) + (+! total-upload-size chunks-to-upload-count) + ) + + ;; do a texflush. + (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)) + ) + + ;; terminate the chain for the bucket. + (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)) + ) + + ;; add chain to bucket. + (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) + ) + ) + + +;; NEAR segment layout: + +;; ---------------------------------------------- +;; | level 0 private | shared | level 1 private | +;; ---------------------------------------------- + +;; the textures for level 0 and level 1 may 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. + +;; the near allocators will only keep the shared part of the near data in RAM +;; NOTE: only segment 2 of the TFRAG texture page is NEAR. + +(defun texture-page-near-allocate-0 ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) + "Allocator for tpages which use the near segment. + This is expected to be used on the first texture of a level load, the TFRAG. + Note: the zoomerhud texture may occur before this, but it's strange. + This is used for level 0, which gets the first part of the NEAR segment + as private texture memory." + + ;; set up segment 2 to be in the near segment + (relocate-dests! page (the-as int (-> pool segment-near dest)) 2) + + ;; segment 0, 1 go in common. + (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 near data, and update the upload cache stuff. + (upload-now! page 2) + (update-vram-pages pool (-> pool segment-near) page 2) + + ;; our strategy is to remove the private memory from RAM. + ;; to avoid leaving an unused hole, we copy the shared data backward. + ;; unfortunately, it would be too slow to do it now. + ;; this function runs during level loading, during the login of the linked tpage file. + ;; the linker aims to use ~3% of a frame and limits itself to copies of up to ~600 kB + ;; per frame. Copying back the near data may be slightly over 1 MB in the worst case, + ;; and we've already used some time in the upload-now!, so we will delay the actual + ;; copy until the next frame. + ;; The level loader know about this, and all we have to do is set up *texture-reloate-later* + + (let ((page-seg-2-size (logand -4096 (the-as int (+ (-> page segment 2 size) 4095))))) + (cond + ((< (the-as uint #x24000) page-seg-2-size) + ;; we use the shared memory of near. + + ;; this data should be kept in the heap + (let ((after-seg-2-data (+ #x90000 (the-as int (-> page segment 2 block-data))))) + (let ((seg-2-data (-> page segment 2 block-data))) + + ;; reduce size for the stuff that's in VRAM. + (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 the size of the heap as needed to hold only the unlocked texture data. + (set! (-> heap current) + (&+ (-> page segment 2 block-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 + (set! (-> *texture-relocate-later* dest) (the-as uint seg-2-data)) + ) + ;; from the start of the unlocked data. + (set! (-> *texture-relocate-later* source) (the-as uint after-seg-2-data)) + ) + ;; the number of bytes to copy. + (set! (-> *texture-relocate-later* move) (shl (-> page segment 2 size) 2)) + ) + (else + ;; 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)) + (set! (-> heap current) (-> page segment 2 block-data)) + ) + ) + ) + + ;; set the allocator to the common allocator for all other textures. + ;; only TFRAG, the first page, uses near. + (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. + (set! (-> *level* unknown-level-2 code-memory-end) (the-as uint page)) + page + ) + + +(defun texture-page-near-allocate-1 ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) + "Allocate for level 1's near textures" + + ;; 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)))) + ;; relocate to point to this point. + (relocate-dests! page (the-as int seg2-dest) 2) + ) + + ;; set up other segments for the common segment. + (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 the near data now. + (upload-now! page 2) + ;; and remember it in the cache. + (update-vram-pages pool (-> pool segment-near) page 2) + + (cond + ((< (the-as uint #x24000) 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))) + (set! (-> heap current) + (&+ (-> page segment 2 block-data) (shl (-> page segment 2 size) 2)) + ) + ) + (else + ;; we fit entirely in private. Kick out the whole thing! + (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 uint page)) + page + ) + + +(defun texture-page-level-allocate ((pool texture-pool) (page texture-page) (heap kheap) (mode int)) + "Allocator for level textures." + (let ((common-id (lookup-boot-common-id pool mode))) + (cond + ((>= common-id 0) + ;; this will handle the zoomer HUD, which comes in before TFRAG. + (texture-page-common-allocate pool page heap mode) + (set! (-> pool common-page common-id) page) + ) + (else + (let ((level-idx (-> *level* unknown-level-2 index))) + ;; these will handle TFRAG. These allocators will then switch the allocator + ;; to common for everything else. + (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 + ) + + +(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)) + (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 + ) + ) + + +(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." + + ;; mark any existing as not loaded. + (dotimes (page-idx 9) + (set! (-> level texture-page page-idx) #f) + ) + + (if (>= max-page-kind 0) ;; tfrag. + ;; login with near allocator. + (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)) + ) + ) + ) + + (if (>= max-page-kind 1) ;; pris. + ;; login with common. + (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)) + ) + ) + ) + (if (>= max-page-kind 2) ;; shrub. + (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)) + ) + ) + ) + (if (>= 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)) + ) + ) + ) + (if (>= 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)) + ) + ) + ) + ;; check with no prints first + (let ((overflow-bits (texture-page-size-check obj level #t))) + (when (nonzero? overflow-bits) + ;; and if it failed, print info + (format #t "-------------------- tpage overflow error #x~X~%" overflow-bits) + (texture-page-size-check obj level #f) + (format #t "--------------------~%") + ) + ) + (none) + ) + +;; for movie hack. +(defun-extern movie? symbol) + +(defmethod add-tex-to-dma! texture-pool ((obj texture-pool) (level level) (tex-page-kind int)) + "For the given tpage-kind, upload as needed for the level" + (when (= tex-page-kind (tpage-kind tfrag)) ;; TFRAG (0) + ;; get the texture page, bucket to add to, and an effective distance from the closest thing. + (let ((tfrag-page (-> level texture-page 0)) + (tfrag-bucket (if (zero? (-> level index)) 5 12)) + ;; not really sure how this is calculated, but it's a distance. + (distance (fmin (fmin (-> level closest-object 0) + (if (and (< 0.0 (-> level level-distance)) + (< (+ 409600.0 (-> level level-distance)) + (-> level closest-object 5) + ) + ) + 4095995904.0 + (-> level closest-object 5) + ) + ) + (-> level closest-object 6) + ) + ) + ) + (when tfrag-page + ;; reset upload size counter. + (set! (-> level upload-size 0) 0) + + ;; near upload. + (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 4095995904.0)) ;; not near at all, don't upload anything. + ((< 102400.0 distance) + ;; pretty far. Just do segment 0. + (set! (-> level upload-size 0) + (+ (-> level upload-size 0) + (upload-vram-pages obj (-> obj segment-common) tfrag-page 0 tfrag-bucket) + ) + ) + ) + (else + ;; pretty close. Do segment 0 and 1. + (set! (-> level upload-size 0) + (+ (-> level upload-size 0) + (upload-vram-pages obj (-> obj segment-common) tfrag-page -2 tfrag-bucket) + ) + ) + ) + ) + ) + ) + ) + + (if (= tex-page-kind (tpage-kind pris)) ;; PRIS (1) + (let ((pris-page (-> level texture-page 1))) + (if (and pris-page (nonzero? pris-page)) + (let ((pris-bucket (if (zero? (-> level index)) 48 51))) + ;; just upload the whole thing always. + ;; use the cache mask as requested by the level. + (set! (-> level upload-size 1) + (upload-vram-pages-pris obj (-> obj segment-common) pris-page pris-bucket (the-as int (-> level texture-mask 7))) + ) + ) + ) + ) + ) + + (if (= tex-page-kind (tpage-kind shrub)) ;; SHRUB (2) + (let ((shrub-page (-> level texture-page 2)) + (shrub-closest (-> level closest-object 2)) ;; I guess this is the shrub closest. + ) + (if (and shrub-page (nonzero? shrub-page)) + (let ((shrub-bucket (if (zero? (-> level index)) 19 25)) + (shrub-mode (cond + ((= shrub-closest 4095995904.0) + -3 ;; nothing + ) + ((< 102400.0 shrub-closest) + 0 ;; seg 0 + ) + ((< 81920.0 shrub-closest) + -2 ;; seg 0 and 1 + ) + (else + -1 ;; the whole thing. + ) + ) + ) + ) + (set! (-> level upload-size 2) + (upload-vram-pages obj (-> obj segment-common) shrub-page shrub-mode shrub-bucket) + ) + ) + ) + ) + ) + + (if (= tex-page-kind (tpage-kind alpha)) ;; ALPHA (3) + (let ((alpha-page (-> level texture-page 3)) + (alpha-closest (-> level closest-object 3)) + ) + (if (and alpha-page (nonzero? alpha-page)) + (let ((alpha-bucket (if (zero? (-> level index)) 31 38)) + (alpha-mode (cond + ((< 348160.0 alpha-closest) + 0 ;; segment 0 + ) + ((< 163840.0 alpha-closest) + -2 ;; 0 and 1 + ) + (else + -1 ;; the whole thing. + ) + ) + ) + ) + (let ((alpha-dest-chunk (shr (-> alpha-page segment 0 dest) 12))) + ;; there's some serious hack here. We invalidate some + ;; alpha texture when in movie mode. + (when (movie?) + (set! (-> obj ids alpha-dest-chunk) (the-as uint 0)) + (set! (-> obj ids (+ alpha-dest-chunk 1)) (the-as uint 0)) + ) + ) + (set! (-> level upload-size 3) + (upload-vram-pages obj (-> obj segment-common) alpha-page alpha-mode alpha-bucket) + ) + ) + ) + ) + ) + + (if (= tex-page-kind (tpage-kind water)) ;; WATER (4) + (let ((water-page (-> level texture-page 4))) + (if (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))) + ) + ) + ) + ) + ) + + (none) + ) diff --git a/goal_src/engine/level/level-h.gc b/goal_src/engine/level/level-h.gc index dd43072d3c..dbe91b958e 100644 --- a/goal_src/engine/level/level-h.gc +++ b/goal_src/engine/level/level-h.gc @@ -5,6 +5,43 @@ ;; name in dgo: level-h ;; dgos: GAME, ENGINE +(defenum bucket-id + :type uint32 + :bitfield #f + + (tfrag-tex0 5) + ;; merc0 10 + ;; generic0 11 + + (tfrag-tex1 12) + ;; merc1 17 + ;; generic1 18 + + (shrub-tex0 19) + + (shrub-tex1 25) + + (alpha-tex0 31) + + (alpha-tex1 38) + + (pris-tex0 48) + ;; merc0 49 + ;; generic0 50 + + (pris-tex1 51) + ;; merc1 52 + ;; generic1 53 + + (water-tex0 57) + ;; merc0 58 (+ default) + ;; generic0 59 (+ default) + + (water-tex1 60) + ;; merc1 61 + ;; generic1 62 + ) + ;; Information related to visibility data for a level. ;; Unclear why there are 8 of these per level. ;; Perhaps there are up to 8 "chunks" of the visibility loaded at a single time? @@ -94,15 +131,15 @@ (bsp basic :offset-assert 48) (art-group basic :offset-assert 52) (info basic :offset-assert 56) - (texture-page basic 9 :offset-assert 60) + (texture-page texture-page 9 :offset-assert 60) (loaded-texture-page basic 16 :offset-assert 96) (loaded-texture-page-count int32 :offset-assert 160) (foreground-sink-group dma-foreground-sink-group 3 :inline :offset-assert 176) ;; inline basic, todo check stride. (foreground-draw-engine basic 3 :offset-assert 272) (entity basic :offset-assert 284) (ambient basic :offset-assert 288) - (closest-object basic 9 :offset-assert 292) - (upload-size uint32 9 :offset-assert 328) + (closest-object float 9 :offset-assert 292) + (upload-size int32 9 :offset-assert 328) (level-distance float :offset-assert 364) ; meters (inside-sphere? basic :offset-assert 368) (inside-boxes? basic :offset-assert 372) @@ -132,7 +169,7 @@ (:methods (dummy-9 () none 9) (dummy-10 () none 10) - (dummy-11 () none 11) + (dummy-11 (_type_) none 11) (dummy-12 () none 12) (dummy-13 () none 13) (dummy-14 () none 14) @@ -161,8 +198,8 @@ ;; don't belong to any level, for example to render Jak. (deftype level-group (basic) ((length int32 :offset-assert 4) - (unknown-field-1 basic :offset-assert 8) - (unknown-field-2 basic :offset-assert 12) + (unknown-level-1 level :offset-assert 8) + (unknown-level-2 level :offset-assert 12) (entity-link entity-links :offset 16) ;; not sure what's going on here (border? basic :offset-assert 20) (vis? basic :offset-assert 24) @@ -211,8 +248,8 @@ (set! *level* (new 'static 'level-group :length 2 - :unknown-field-1 #f - :unknown-field-2 #f + :unknown-level-1 #f + :unknown-level-2 #f :entity-link #f :border? #f :want-level #f diff --git a/goal_src/engine/ui/text-h.gc b/goal_src/engine/ui/text-h.gc index 54d109021d..701e401809 100644 --- a/goal_src/engine/ui/text-h.gc +++ b/goal_src/engine/ui/text-h.gc @@ -40,4 +40,4 @@ (define *common-text-heap* (new 'global 'kheap)) ;; probably some other type. -(define *common-text* #f) \ No newline at end of file +(define *common-text* #f) diff --git a/goal_src/kernel-defs.gc b/goal_src/kernel-defs.gc index 6bbb2aabd3..723673dcbc 100644 --- a/goal_src/kernel-defs.gc +++ b/goal_src/kernel-defs.gc @@ -122,14 +122,14 @@ ;; put-display-env ;; syncv -;; sync-path +(define-extern sync-path (function int int none)) (define-extern reset-path (function none)) (define-extern reset-graph (function int int int int none)) ;; dma-sync (define-extern dma-sync (function pointer int int int)) ;; gs-put-imr ;; gs-get-imr -;; gs-store-image +(define-extern gs-store-image (function object object object)) (define-extern flush-cache (function int none)) ;; cpad-open (declare-type cpad-info structure) @@ -139,11 +139,11 @@ ;; install-debug-handler ;; file-stream-open (define-extern file-stream-open (function file-stream basic basic file-stream)) -;; file-stream-close +(define-extern file-stream-close (function file-stream file-stream)) (define-extern file-stream-length (function file-stream int)) ;; file-stream-seek (define-extern file-stream-read (function file-stream pointer int int)) -;; file-stream-write +(define-extern file-stream-write (function file-stream pointer uint uint)) ;; scf-get-language ;; scf-get-time ;; scf-get-aspect diff --git a/goal_src/kernel/gcommon.gc b/goal_src/kernel/gcommon.gc index 59e15998d6..14d3dbdcff 100644 --- a/goal_src/kernel/gcommon.gc +++ b/goal_src/kernel/gcommon.gc @@ -1397,3 +1397,16 @@ ;; Copies the contents of a gpr to a cop0 (system control) register (fake-asm .mtc0 dest src) ) + + +(defmacro make-u128 (upper lower) + "Make a i128 from two 64-bit values." + `(rlet ((result :class i128) + (upper-xmm :class i128) + (lower-xmm :class i128)) + (.mov upper-xmm ,upper) + (.mov lower-xmm ,lower) + (.pcpyld result upper-xmm lower-xmm) + result + ) + ) diff --git a/goalc/compiler/compilation/Type.cpp b/goalc/compiler/compilation/Type.cpp index d818480d5c..cffa60f00f 100644 --- a/goalc/compiler/compilation/Type.cpp +++ b/goalc/compiler/compilation/Type.cpp @@ -146,7 +146,7 @@ void Compiler::generate_field_description(const goos::Object& form, format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(env)); } else if (m_ts.tc(m_ts.make_typespec("integer"), f.type())) { // Integer - if (f.type().print() == "uint128") { + if (m_ts.lookup_type(f.type())->get_load_size() > 8) { str_template += fmt::format("~T{}: ~%", f.name()); } else { str_template += fmt::format("~T{}: ~D~%", f.name()); diff --git a/scripts/decomp_progress.py b/scripts/decomp_progress.py index a21326a942..ad1221f84e 100644 --- a/scripts/decomp_progress.py +++ b/scripts/decomp_progress.py @@ -41,7 +41,7 @@ def main(): file_stats = [] total_gc_files = 0 - excluded_files = {"all_files.gc", "goal-lib.gc", "ocean-trans-tables.gc", "ocean-frames.gc"} + excluded_files = {"all_files.gc", "goal-lib.gc", "ocean-trans-tables.gc", "ocean-frames.gc", "ocean-tables.gc"} for fn in all_files: diff --git a/test/decompiler/reference/all_forward_declarations.gc b/test/decompiler/reference/all_forward_declarations.gc index 6d183b3a1c..fb94bfe8b9 100644 --- a/test/decompiler/reference/all_forward_declarations.gc +++ b/test/decompiler/reference/all_forward_declarations.gc @@ -406,4 +406,23 @@ (defenum gs-reg64 :type uint64 :copy-entries gs-reg - ) \ No newline at end of file + ) + +;; connect +(declare-type engine basic) + +(defmacro make-u128 (upper lower) + `(rlet ((result :class i128) + (upper-xmm :class i128) + (lower-xmm :class i128)) + (.mov upper-xmm ,upper) + (.mov lower-xmm ,lower) + (.pcpyld result upper-xmm lower-xmm) + result + ) + ) + +;; texture + +(declare-type texture-page basic) +(declare-type level basic) \ No newline at end of file diff --git a/test/decompiler/reference/capture_REF.gc b/test/decompiler/reference/capture_REF.gc new file mode 100644 index 0000000000..59434ef193 --- /dev/null +++ b/test/decompiler/reference/capture_REF.gc @@ -0,0 +1,187 @@ +;;-*-Lisp-*- +(in-package goal) + +;; this file is debug only +(when *debug-segment* +;; definition of type gs-store-image-packet +(deftype gs-store-image-packet (structure) + ((vifcode vif-tag 4 :offset-assert 0) + (giftag gif-tag :offset-assert 16) + (bitbltbuf gs-bitbltbuf :offset-assert 32) + (bitbltbuf-addr gs-reg64 :offset-assert 40) + (trxpos gs-trxpos :offset-assert 48) + (trxpos-addr gs-reg64 :offset-assert 56) + (trxreg gs-trxreg :offset-assert 64) + (trxreg-addr gs-reg64 :offset-assert 72) + (finish int64 :offset-assert 80) + (finish-addr gs-reg64 :offset-assert 88) + (trxdir gs-trxdir :offset-assert 96) + (trxdir-addr gs-reg64 :offset-assert 104) + ) + :method-count-assert 9 + :size-assert #x70 + :flag-assert #x900000070 + ) + +;; definition for method 3 of type gs-store-image-packet +;; Used lq/sq +(defmethod inspect gs-store-image-packet ((obj gs-store-image-packet)) + (format #t "[~8x] ~A~%" obj 'gs-store-image-packet) + (format #t "~Tvifcode[4] @ #x~X~%" (-> obj vifcode)) + (format #t "~Tgiftag: ~D~%" (-> obj giftag)) + (format #t "~Tbitbltbuf: ~D~%" (-> obj bitbltbuf)) + (format #t "~Tbitbltbuf-addr: ~D~%" (-> obj bitbltbuf-addr)) + (format #t "~Ttrxpos: ~D~%" (-> obj trxpos)) + (format #t "~Ttrxpos-addr: ~D~%" (-> obj trxpos-addr)) + (format #t "~Ttrxreg: ~D~%" (-> obj trxreg)) + (format #t "~Ttrxreg-addr: ~D~%" (-> obj trxreg-addr)) + (format #t "~Tfinish: ~D~%" (-> obj finish)) + (format #t "~Tfinish-addr: ~D~%" (-> obj finish-addr)) + (format #t "~Ttrxdir: ~D~%" (-> obj trxdir)) + (format #t "~Ttrxdir-addr: ~D~%" (-> obj trxdir-addr)) + obj + ) + +;; definition for function gs-set-default-store-image +;; WARN: Unsupported inline assembly instruction kind - [sync.l] +;; Used lq/sq +(defun + gs-set-default-store-image + ((packet gs-store-image-packet) + (src-fbp int) + (src-w int) + (src-psm int) + (ssax int) + (ssay int) + (rrw int) + (rrh int) + ) + (set! (-> packet vifcode 0) (new 'static 'vif-tag)) + (set! + (-> packet vifcode 1) + (new 'static 'vif-tag :imm #x8000 :cmd (vif-cmd mskpath3)) + ) + (set! + (-> packet vifcode 2) + (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1) + ) + (set! + (-> packet vifcode 3) + (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1) + ) + (set! + (-> packet giftag) + (the-as + gif-tag + (make-u128 + (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)) + (new 'static 'gif-tag64 :nloop #x5 :eop #x1 :nreg #x1) + ) + ) + ) + (set! + (-> packet bitbltbuf) + (new 'static 'gs-bitbltbuf :sbp src-fbp :sbw src-w :spsm src-psm) + ) + (set! (-> packet bitbltbuf-addr) (gs-reg64 bitbltbuf)) + (set! (-> packet trxpos) (new 'static 'gs-trxpos :ssax ssax :ssay ssay)) + (set! (-> packet trxpos-addr) (gs-reg64 trxpos)) + (set! (-> packet trxreg) (new 'static 'gs-trxreg :rrw rrw :rrh rrh)) + (set! (-> packet trxreg-addr) (gs-reg64 trxreg)) + (set! (-> packet finish) 0) + (set! (-> packet finish-addr) (gs-reg64 finish)) + (set! (-> packet trxdir) (new 'static 'gs-trxdir :xdir #x1)) + (set! (-> packet trxdir-addr) (gs-reg64 trxdir)) + (.sync.l) + 7 + ) + +;; definition for function store-image +;; Used lq/sq +(defun store-image ((oddeven int)) + (local-vars (ptr-1 (pointer uint8)) (y-idx int) (y-idx-2 int)) + (let ((width 512) + (height (-> *video-parms* screen-sy)) + (file (new 'debug 'file-stream "image.raw" 'write)) + ) + (let ((buff0 (new 'debug 'boxed-array uint128 (sar (* width height) 2)))) + (let ((buff1 (new 'debug 'boxed-array uint128 (sar (* width height) 2)))) + (let ((packet (new 'static 'gs-store-image-packet))) + (gs-set-default-store-image + packet + #x2800 + (sar width 6) + 0 + 0 + 0 + width + height + ) + (flush-cache 0) + (gs-store-image packet (-> buff0 data)) + (sync-path 0 0) + (gs-set-default-store-image + packet + #x3000 + (sar width 6) + 0 + 0 + 0 + width + height + ) + (flush-cache 0) + (gs-store-image packet (-> buff1 data)) + ) + (sync-path 0 0) + (let ((ptr-0 (-> buff0 data))) + (set! ptr-1 (-> buff1 data)) + (cond + ((zero? oddeven) + (set! y-idx 0) + (while (< y-idx height) + (file-stream-write + file + (&+ ptr-0 (* y-idx (shl width 2))) + (the-as uint (shl width 2)) + ) + (file-stream-write + file + (&+ ptr-1 (* y-idx (shl width 2))) + (the-as uint (shl width 2)) + ) + (set! y-idx (+ y-idx 1)) + ) + ) + (else + (set! y-idx-2 0) + (while (< y-idx-2 height) + (file-stream-write + file + (&+ ptr-1 (* y-idx-2 (shl width 2))) + (the-as uint (shl width 2)) + ) + (file-stream-write + file + (&+ ptr-0 (* y-idx-2 (shl width 2))) + (the-as uint (shl width 2)) + ) + (set! y-idx-2 (+ y-idx-2 1)) + ) + ) + ) + ) + (format #t "oddeven = ~d~%" oddeven) + (delete buff1) + ) + (delete buff0) + ) + (file-stream-close file) + ) + 0 + ) + +) + + + diff --git a/test/decompiler/reference/connect_REF.gc b/test/decompiler/reference/connect_REF.gc new file mode 100644 index 0000000000..d99e6066d3 --- /dev/null +++ b/test/decompiler/reference/connect_REF.gc @@ -0,0 +1,548 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition of type connectable +(deftype connectable (structure) + ((next0 connectable :offset-assert 0) + (prev0 connectable :offset-assert 4) + (next1 connectable :offset-assert 8) + (prev1 connectable :offset-assert 12) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + +;; definition for method 3 of type connectable +(defmethod inspect connectable ((obj connectable)) + (format #t "[~8x] ~A~%" obj 'connectable) + (format #t "~Tnext0: ~`connectable`P~%" (-> obj next0)) + (format #t "~Tprev0: ~`connectable`P~%" (-> obj prev0)) + (format #t "~Tnext1: ~`connectable`P~%" (-> obj next1)) + (format #t "~Tprev1: ~`connectable`P~%" (-> obj prev1)) + obj + ) + +;; definition of type connection +(deftype connection (connectable) + ((param0 (function object object object object object) :offset-assert 16) + (param1 basic :offset-assert 20) + (param2 basic :offset-assert 24) + (param3 basic :offset-assert 28) + (quad uint128 2 :offset 0) + ) + :method-count-assert 14 + :size-assert #x20 + :flag-assert #xe00000020 + (:methods + (get-engine (connection) engine 9) + (get-process (connection) process 10) + (belongs-to-engine? (connection engine) symbol 11) + (belongs-to-process? (connection process) symbol 12) + (move-to-dead (connection) connection 13) + ) + ) + +;; definition for method 3 of type connection +(defmethod inspect connection ((obj connection)) + (format #t "[~8x] ~A~%" obj 'connection) + (format #t "~Tnext0: ~`connectable`P~%" (-> obj next0)) + (format #t "~Tprev0: ~`connectable`P~%" (-> obj prev0)) + (format #t "~Tnext1: ~`connectable`P~%" (-> obj next1)) + (format #t "~Tprev1: ~`connectable`P~%" (-> obj prev1)) + (format #t "~Tparam0: ~A~%" (-> obj param0)) + (format #t "~Tparam1: ~A~%" (-> obj param1)) + (format #t "~Tparam2: ~A~%" (-> obj param2)) + (format #t "~Tparam3: ~A~%" (-> obj param3)) + (format #t "~Tquad[2] @ #x~X~%" (&-> obj next0)) + obj + ) + +;; definition of type engine +(deftype engine (basic) + ((name basic :offset-assert 4) + (length int16 :offset-assert 8) + (allocated-length int16 :offset-assert 10) + (engine-time uint64 :offset-assert 16) + (alive-list connectable :inline :offset-assert 32) + (alive-list-end connectable :inline :offset-assert 48) + (dead-list connectable :inline :offset-assert 64) + (dead-list-end connectable :inline :offset-assert 80) + (data connection 1 :inline :offset-assert 96) + ) + :method-count-assert 24 + :size-assert #x80 + :flag-assert #x1800000080 + (:methods + (new (symbol type basic int) _type_ 0) + (inspect-all-connections (engine) engine 9) + (apply-to-connections (engine (function connectable none)) int 10) + (apply-to-connections-reverse (engine (function connectable none)) int 11) + (execute-connections (engine object) int 12) + (execute-connections-and-move-to-dead (engine object) int 13) + (execute-connections-if-needed (engine object) int 14) + (add-connection (engine process (function object object object object object) object object object) connection 15) + (remove-from-process (engine process) int 16) + (remove-matching (engine (function connection engine symbol)) int 17) + (remove-all (engine) int 18) + (remove-by-param1 (engine object) int 19) + (remove-by-param2 (engine int) int 20) + (get-first-connectable (engine) connectable 21) + (get-last-connectable (engine) connectable 22) + (unknown-1 (engine (pointer uint32)) uint 23) + ) + ) + +;; definition for method 12 of type connection +(defmethod belongs-to-process? connection ((obj connection) (arg0 process)) + (= arg0 ((method-of-type connection get-process) obj)) + ) + +;; definition for method 2 of type connection +(defmethod print connection ((obj connection)) + (format + #t + "#" + (-> obj param0) + (-> obj param1) + (-> obj param2) + (-> obj param3) + obj + ) + obj + ) + +;; definition for method 9 of type connection +;; INFO: Return type mismatch pointer vs engine. +(defmethod get-engine connection ((obj connection)) + (while (-> (the-as connectable obj) prev0) + (nop!) + (nop!) + (set! obj (the-as connection (-> (the-as connectable obj) prev0))) + ) + (the-as engine (&+ (the-as pointer obj) -28)) + ) + +;; definition for method 10 of type connection +;; INFO: Return type mismatch pointer vs process. +(defmethod get-process connection ((obj connection)) + (while (-> (the-as connectable obj) prev1) + (nop!) + (nop!) + (set! obj (the-as connection (-> (the-as connectable obj) prev1))) + ) + (the-as process (&+ (the-as pointer obj) -92)) + ) + +;; definition for method 11 of type connection +(defmethod belongs-to-engine? connection ((obj connection) (arg0 engine)) + (and + (< (the-as int arg0) (the-as int obj)) + (< (the-as int obj) (the-as int (-> arg0 data (-> arg0 allocated-length)))) + ) + ) + +;; definition for method 21 of type engine +(defmethod get-first-connectable engine ((obj engine)) + (-> obj alive-list next0) + ) + +;; definition for method 22 of type engine +(defmethod get-last-connectable engine ((obj engine)) + (-> obj alive-list-end) + ) + +;; definition for method 23 of type engine +(defmethod unknown-1 engine ((obj engine) (arg0 (pointer uint32))) + (-> arg0 0) + ) + +;; definition for method 0 of type engine +(defmethod + new + engine + ((allocation symbol) (type-to-make type) (name basic) (length int)) + (let + ((obj + (object-new + allocation + type-to-make + (the-as + int + (+ (-> type-to-make size) (the-as uint (shl (+ length -1) 5))) + ) + ) + ) + ) + (set! (-> (the-as engine obj) allocated-length) length) + (set! (-> (the-as engine obj) length) 0) + (set! (-> (the-as engine obj) name) name) + (set! + (-> (the-as engine obj) alive-list next0) + (-> (the-as engine obj) alive-list-end) + ) + (set! (-> (the-as engine obj) alive-list prev0) #f) + (set! (-> (the-as engine obj) alive-list next1) #f) + (set! (-> (the-as engine obj) alive-list prev1) #f) + (set! (-> (the-as engine obj) alive-list-end next0) #f) + (set! + (-> (the-as engine obj) alive-list-end prev0) + (-> (the-as engine obj) alive-list) + ) + (set! (-> (the-as engine obj) alive-list-end next1) #f) + (set! (-> (the-as engine obj) alive-list-end prev1) #f) + (set! + (-> (the-as engine obj) dead-list next0) + (the-as connectable (-> (the-as engine obj) data)) + ) + (set! (-> (the-as engine obj) dead-list prev0) #f) + (set! (-> (the-as engine obj) dead-list next1) #f) + (set! (-> (the-as engine obj) dead-list prev1) #f) + (set! (-> (the-as engine obj) dead-list-end next0) #f) + (set! + (-> (the-as engine obj) dead-list-end prev0) + (-> (the-as engine obj) data (+ length -1)) + ) + (set! (-> (the-as engine obj) dead-list-end next1) #f) + (set! (-> (the-as engine obj) dead-list-end prev1) #f) + (set! + (-> (the-as engine obj) data 0 prev0) + (-> (the-as engine obj) dead-list) + ) + (set! + (-> (the-as engine obj) data 0 next0) + (the-as connectable (&+ (the-as pointer obj) 124)) + ) + (let ((idx-to-link 1) + (end-idx (+ length -2)) + ) + (while (>= end-idx idx-to-link) + (set! + (-> (the-as engine obj) data idx-to-link prev0) + (-> (the-as engine obj) data (+ idx-to-link -1)) + ) + (set! + (-> (the-as engine obj) data idx-to-link next0) + (-> (the-as engine obj) data (+ idx-to-link 1)) + ) + (+! idx-to-link 1) + ) + ) + (set! + (-> (the-as engine obj) data (+ length -1) prev0) + (-> (the-as engine obj) data (+ length -2)) + ) + (set! + (-> (the-as engine obj) data (+ length -1) next0) + (-> (the-as engine obj) dead-list-end) + ) + (the-as engine obj) + ) + ) + +;; definition for method 2 of type engine +(defmethod print engine ((obj engine)) + (format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj) + obj + ) + +;; definition for method 3 of type engine +(defmethod inspect engine ((obj engine)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~A~%" (-> obj name)) + (format #t "~Tengine-time: ~D~%" (-> obj engine-time)) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Tlength: ~D~%" (-> obj length)) + (format #t "~Talive-list:~%") + (let ((s5-0 *print-column*)) + (set! *print-column* (+ *print-column* (the-as uint 64))) + ((method-of-type connectable inspect) (-> obj alive-list)) + (set! *print-column* s5-0) + ) + (format #t "~Talive-list-end:~%") + (let ((s5-1 *print-column*)) + (set! *print-column* (+ *print-column* (the-as uint 64))) + ((method-of-type connectable inspect) (-> obj alive-list-end)) + (set! *print-column* s5-1) + ) + (format #t "~Tdead-list:~%") + (let ((s5-2 *print-column*)) + (set! *print-column* (+ *print-column* (the-as uint 64))) + ((method-of-type connectable inspect) (-> obj dead-list)) + (set! *print-column* s5-2) + ) + (format #t "~Tdead-list-end:~%") + (let ((s5-3 *print-column*)) + (set! *print-column* (+ *print-column* (the-as uint 64))) + ((method-of-type connectable inspect) (-> obj dead-list-end)) + (set! *print-column* s5-3) + ) + (format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data)) + obj + ) + +;; definition for method 4 of type engine +(defmethod length engine ((obj engine)) + (-> obj length) + ) + +;; definition for method 5 of type engine +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of engine ((obj engine)) + (the-as + int + (+ (-> engine size) (the-as uint (shl (+ (-> obj allocated-length) -1) 5))) + ) + ) + +;; definition for method 10 of type engine +(defmethod + apply-to-connections + engine + ((obj engine) (f (function connectable none))) + (let* ((current (-> obj alive-list next0)) + (next (-> current next0)) + ) + (while (!= current (-> obj alive-list-end)) + (f current) + (set! current next) + (set! next (-> next next0)) + ) + ) + 0 + ) + +;; definition for method 11 of type engine +(defmethod + apply-to-connections-reverse + engine + ((obj engine) (f (function connectable none))) + (let ((iter (-> obj alive-list-end prev0))) + (while (!= iter (-> obj alive-list)) + (f iter) + (set! iter (-> iter prev0)) + ) + ) + 0 + ) + +;; definition for method 12 of type engine +(defmethod execute-connections engine ((obj engine) (arg0 object)) + (set! (-> obj engine-time) (-> *display* real-frame-counter)) + (let ((ct (the-as connection (-> obj alive-list-end prev0)))) + (while (!= ct (-> obj alive-list)) + ((-> ct param0) (-> ct param1) (-> ct param2) (-> ct param3) arg0) + (set! ct (the-as connection (-> ct prev0))) + ) + ) + 0 + ) + +;; definition for method 13 of type engine +(defmethod + execute-connections-and-move-to-dead + engine + ((obj engine) (arg0 object)) + (set! (-> obj engine-time) (-> *display* real-frame-counter)) + (let ((ct (the-as connection (-> obj alive-list-end prev0)))) + (while (!= ct (-> obj alive-list)) + (let + ((result + ((-> ct param0) (-> ct param1) (-> ct param2) (-> ct param3) arg0) + ) + ) + (set! ct (the-as connection (-> ct prev0))) + (if (= result 'dead) + ((method-of-type connection move-to-dead) + (the-as connection (-> ct next0)) + ) + ) + ) + ) + ) + 0 + ) + +;; definition for method 14 of type engine +(defmethod execute-connections-if-needed engine ((obj engine) (arg0 object)) + (if (!= (-> *display* real-frame-counter) (-> obj engine-time)) + (execute-connections obj arg0) + ) + 0 + ) + +;; definition for function connection-process-apply +(defun connection-process-apply ((proc process) (func (function object none))) + (when proc + (let ((iter (-> proc connection-list next1))) + (while iter + (func iter) + (set! iter (-> iter next1)) + ) + ) + #f + ) + ) + +;; definition for method 9 of type engine +(defmethod inspect-all-connections engine ((obj engine)) + (apply-to-connections + obj + (the-as (function connectable none) (-> connection methods-by-name inspect)) + ) + obj + ) + +;; definition for method 15 of type engine +(defmethod + add-connection + engine + ((obj engine) + (proc process) + (func (function object object object object object)) + (p1 object) + (p2 object) + (p3 object) + ) + (let ((con (the-as connection (-> obj dead-list next0)))) + (when (not (or (not proc) (= con (-> obj dead-list-end)))) + (set! (-> con param0) func) + (set! (-> con param1) (the-as basic p1)) + (set! (-> con param2) (the-as basic p2)) + (set! (-> con param3) (the-as basic p3)) + (set! (-> obj dead-list next0) (-> con next0)) + (set! (-> con next0 prev0) (-> obj dead-list)) + (set! (-> con next0) (-> obj alive-list next0)) + (set! (-> con next0 prev0) con) + (set! (-> con prev0) (-> obj alive-list)) + (set! (-> obj alive-list next0) con) + (set! (-> con next1) (-> proc connection-list next1)) + (if (-> con next1) + (set! (-> con next1 prev1) con) + ) + (set! (-> con prev1) (-> proc connection-list)) + (set! (-> proc connection-list next1) con) + (set! (-> obj length) (+ (-> obj length) 1)) + con + ) + ) + ) + +;; definition for method 13 of type connection +(defmethod move-to-dead connection ((obj connection)) + (let ((v1-1 ((method-of-type connection get-engine) obj))) + (set! (-> obj prev0 next0) (-> obj next0)) + (set! (-> obj next0 prev0) (-> obj prev0)) + (set! (-> obj prev1 next1) (-> obj next1)) + (if (-> obj next1) + (set! (-> obj next1 prev1) (-> obj prev1)) + ) + (set! (-> obj next0) (-> v1-1 dead-list next0)) + (set! (-> obj next0 prev0) obj) + (set! (-> obj prev0) (-> v1-1 dead-list)) + (set! (-> v1-1 dead-list next0) obj) + (set! (-> v1-1 length) (+ (-> v1-1 length) -1)) + ) + obj + ) + +;; definition for function process-disconnect +(defun process-disconnect ((arg0 process)) + (when arg0 + (let ((gp-0 (-> arg0 connection-list next1))) + (while gp-0 + ((method-of-type connection move-to-dead) (the-as connection gp-0)) + (set! gp-0 (-> gp-0 next1)) + ) + ) + ) + 0 + ) + +;; definition for method 16 of type engine +(defmethod remove-from-process engine ((obj engine) (arg0 process)) + (when arg0 + (let ((s5-0 (-> arg0 connection-list next1))) + (while s5-0 + (if + ((method-of-type connection belongs-to-engine?) + (the-as connection s5-0) + obj + ) + ((method-of-type connection move-to-dead) (the-as connection s5-0)) + ) + (set! s5-0 (-> s5-0 next1)) + ) + ) + ) + 0 + ) + +;; definition for method 17 of type engine +(defmethod + remove-matching + engine + ((obj engine) (arg0 (function connection engine symbol))) + (let* ((s4-0 (-> obj alive-list next0)) + (s3-0 (-> s4-0 next0)) + ) + (while (!= s4-0 (-> obj alive-list-end)) + (if (arg0 (the-as connection s4-0) obj) + ((method-of-type connection move-to-dead) (the-as connection s4-0)) + ) + (set! s4-0 s3-0) + (set! s3-0 (-> s3-0 next0)) + ) + ) + 0 + ) + +;; definition for method 18 of type engine +(defmethod remove-all engine ((obj engine)) + (let* ((a0-1 (-> obj alive-list next0)) + (s5-0 (-> a0-1 next0)) + ) + (while (!= a0-1 (-> obj alive-list-end)) + ((method-of-type connection move-to-dead) (the-as connection a0-1)) + (set! a0-1 s5-0) + (set! s5-0 (-> s5-0 next0)) + ) + ) + 0 + ) + +;; definition for method 19 of type engine +(defmethod remove-by-param1 engine ((obj engine) (p1-value object)) + (let* ((current (-> obj alive-list next0)) + (next (-> current next0)) + ) + (while (!= current (-> obj alive-list-end)) + (if (= (-> (the-as connection current) param1) p1-value) + ((method-of-type connection move-to-dead) (the-as connection current)) + ) + (set! current next) + (set! next (-> next next0)) + ) + ) + 0 + ) + +;; definition for method 20 of type engine +(defmethod remove-by-param2 engine ((obj engine) (p2-value int)) + (let* ((current (-> obj alive-list next0)) + (next (-> current next0)) + ) + (while (!= current (-> obj alive-list-end)) + (if (= (-> (the-as connection current) param2) p2-value) + ((method-of-type connection move-to-dead) (the-as connection current)) + ) + (set! current next) + (set! next (-> next next0)) + ) + ) + 0 + ) + + + + diff --git a/test/decompiler/reference/display-h_REF.gc b/test/decompiler/reference/display-h_REF.gc index 1008657922..a94d6c1276 100644 --- a/test/decompiler/reference/display-h_REF.gc +++ b/test/decompiler/reference/display-h_REF.gc @@ -89,8 +89,8 @@ (vu1-buf dma-buffer :offset 8) (debug-buf dma-buffer :offset 36) (global-buf dma-buffer :offset 40) - (buffer uint32 11 :offset 4) (bucket-group dma-bucket :offset 44) + (buffer uint32 11 :offset 4) (profile-bar profile-bar 2 :offset 48) (run-time uint64 :offset 56) ) @@ -110,7 +110,7 @@ (format #t "~Tvu1-buf: ~A~%" (-> obj calc-buf)) (format #t "~Tdebug-buf: ~A~%" (-> obj debug-buf)) (format #t "~Tglobal-buf: ~A~%" (-> obj global-buf)) - (format #t "~Tbucket-group: #~%" (-> obj buffer 10)) + (format #t "~Tbucket-group: #~%" (-> obj bucket-group)) (format #t "~Tprofile-bar[2] @ #x~X~%" (-> obj profile-bar)) (format #t "~Trun-time: ~D~%" (-> obj run-time)) obj diff --git a/test/decompiler/reference/font-h_REF.gc b/test/decompiler/reference/font-h_REF.gc new file mode 100644 index 0000000000..7a5828af21 --- /dev/null +++ b/test/decompiler/reference/font-h_REF.gc @@ -0,0 +1,797 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition of type char-verts +(deftype char-verts (structure) + ((pos vector 4 :inline :offset-assert 0) + (color vector 4 :inline :offset-assert 64) + (tex-st vector 4 :inline :offset-assert 128) + ) + :method-count-assert 9 + :size-assert #xc0 + :flag-assert #x9000000c0 + ) + +;; definition for method 3 of type char-verts +(defmethod inspect char-verts ((obj char-verts)) + (format #t "[~8x] ~A~%" obj 'char-verts) + (format #t "~Tpos[4] @ #x~X~%" (-> obj pos)) + (format #t "~Tcolor[4] @ #x~X~%" (-> obj color)) + (format #t "~Ttex-st[4] @ #x~X~%" (-> obj tex-st)) + obj + ) + +;; definition of type char-color +(deftype char-color (structure) + ((color rgba 4 :offset-assert 0) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + +;; definition for method 3 of type char-color +(defmethod inspect char-color ((obj char-color)) + (format #t "[~8x] ~A~%" obj 'char-color) + (format #t "~Tcolor[4] @ #x~X~%" (-> obj color)) + obj + ) + +;; definition for symbol *font-default-matrix*, type matrix +(define + *font-default-matrix* + (new 'static 'matrix + :data + (new 'static 'array float 16 + 1.0 + 0.0 + 0.0 + 0.0 + 0.0 + 1.0 + 0.0 + 0.0 + 0.0 + 0.0 + 1.0 + 0.0 + -256.0 + 0.0 + 0.0 + 1.0 + ) + ) + ) + +;; definition of type font-context +(deftype font-context (basic) + ((origin vector :inline :offset-assert 16) + (strip-gif vector :inline :offset-assert 32) + (width float :offset-assert 48) + (height float :offset-assert 52) + (projection float :offset-assert 56) + (color int64 :offset-assert 64) + (flags uint32 :offset-assert 72) + (mat matrix :offset-assert 76) + (start-line uint32 :offset-assert 80) + (scale float :offset-assert 84) + ) + :method-count-assert 20 + :size-assert #x58 + :flag-assert #x1400000058 + (:methods + (new (symbol type matrix int int float int uint) _type_ 0) + (set-mat! (font-context matrix) font-context 9) + (set-origin! (font-context int int) font-context 10) + (set-depth! (font-context int) font-context 11) + (set-w! (font-context float) font-context 12) + (set-width! (font-context int) font-context 13) + (set-height! (font-context int) font-context 14) + (set-projection! (font-context float) font-context 15) + (set-color! (font-context int) font-context 16) + (set-flags! (font-context uint) font-context 17) + (set-start-line! (font-context uint) font-context 18) + (set-scale! (font-context float) font-context 19) + ) + ) + +;; definition for method 3 of type font-context +(defmethod inspect font-context ((obj font-context)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Torigin: #~%" (-> obj origin)) + (format #t "~Tstrip-gif: #~%" (-> obj strip-gif)) + (format #t "~Twidth: ~f~%" (-> obj width)) + (format #t "~Theight: ~f~%" (-> obj height)) + (format #t "~Tprojection: ~f~%" (-> obj projection)) + (format #t "~Tcolor: ~D~%" (-> obj color)) + (format #t "~Tflags: ~D~%" (-> obj flags)) + (format #t "~Tmat: #~%" (-> obj mat)) + (format #t "~Tstart-line: ~D~%" (-> obj start-line)) + (format #t "~Tscale: ~f~%" (-> obj scale)) + obj + ) + +;; definition for method 9 of type font-context +(defmethod set-mat! font-context ((obj font-context) (mat matrix)) + (set! (-> obj mat) mat) + obj + ) + +;; definition for method 10 of type font-context +(defmethod set-origin! font-context ((obj font-context) (x int) (y int)) + (let ((x (gpr->fpr x))) + (set! (-> obj origin x) (the float x)) + ) + (set! (-> obj origin y) (the float y)) + obj + ) + +;; definition for method 11 of type font-context +(defmethod set-depth! font-context ((obj font-context) (z int)) + (let ((z (gpr->fpr z))) + (set! (-> obj origin z) (the float z)) + ) + obj + ) + +;; definition for method 12 of type font-context +(defmethod set-w! font-context ((obj font-context) (w float)) + (set! (-> obj origin w) w) + obj + ) + +;; definition for method 13 of type font-context +(defmethod set-width! font-context ((obj font-context) (width int)) + (let ((width (gpr->fpr width))) + (set! (-> obj width) (the float width)) + ) + obj + ) + +;; definition for method 14 of type font-context +(defmethod set-height! font-context ((obj font-context) (height int)) + (let ((height (gpr->fpr height))) + (set! (-> obj height) (the float height)) + ) + obj + ) + +;; definition for method 15 of type font-context +(defmethod set-projection! font-context ((obj font-context) (proj float)) + (set! (-> obj projection) proj) + obj + ) + +;; definition for method 16 of type font-context +(defmethod set-color! font-context ((obj font-context) (color int)) + (set! (-> obj color) color) + obj + ) + +;; definition for method 17 of type font-context +(defmethod set-flags! font-context ((obj font-context) (flags uint)) + (set! (-> obj flags) flags) + obj + ) + +;; definition for method 18 of type font-context +(defmethod set-start-line! font-context ((obj font-context) (start-line uint)) + (set! (-> obj start-line) start-line) + obj + ) + +;; definition for method 19 of type font-context +(defmethod set-scale! font-context ((obj font-context) (scale float)) + (set! (-> obj scale) scale) + obj + ) + +;; definition for method 0 of type font-context +(defmethod + new + font-context + ((allocation symbol) + (type-to-make type) + (mat matrix) + (x int) + (y int) + (z float) + (color int) + (flags uint) + ) + (let + ((obj + (object-new allocation type-to-make (the-as int (-> type-to-make size))) + ) + ) + (set! (-> obj mat) mat) + (let ((v1-3 obj)) + (set! (-> v1-3 origin x) (the float x)) + (set! (-> v1-3 origin y) (the float y)) + ) + (if (= z 0.0) + (let ((v1-4 obj)) + (set! (-> v1-4 origin z) (-> *math-camera* isometric data 14)) + ) + (let ((v1-5 obj)) + (set! (-> v1-5 origin z) z) + ) + ) + (let ((v1-6 obj)) + (set! (-> v1-6 origin w) 1.0) + ) + (let ((v1-7 obj)) + (set! (-> v1-7 width) (the float 512)) + ) + (let ((v1-8 obj)) + (set! (-> v1-8 height) (the float 256)) + ) + (let ((v1-9 obj)) + (set! (-> v1-9 projection) 1.0) + ) + (set! (-> obj color) color) + (set! (-> obj flags) flags) + (let ((a0-4 obj)) + (set! (-> a0-4 start-line) (the-as uint 0)) + ) + (let ((v1-13 obj)) + (set! (-> v1-13 scale) 1.0) + ) + obj + ) + ) + +;; definition of type font-work +(deftype font-work (structure) + ((font-tmpl dma-gif-packet :inline :offset-assert 0) + (char-tmpl dma-gif-packet :inline :offset-assert 32) + (tex1-tmpl uint64 2 :offset-assert 64) + (small-font-lo-tmpl uint64 2 :offset-assert 80) + (small-font-hi-tmpl uint64 2 :offset-assert 96) + (large-font-lo-tmpl uint64 2 :offset-assert 112) + (large-font-hi-tmpl uint64 2 :offset-assert 128) + (size1-small vector :inline :offset-assert 144) + (size2-small vector :inline :offset-assert 160) + (size3-small vector :inline :offset-assert 176) + (size1-large vector :inline :offset-assert 192) + (size2-large vector :inline :offset-assert 208) + (size3-large vector :inline :offset-assert 224) + (size-st1 vector :inline :offset-assert 240) + (size-st2 vector :inline :offset-assert 256) + (size-st3 vector :inline :offset-assert 272) + (save vector :inline :offset-assert 288) + (save-color vector 4 :inline :offset-assert 304) + (current-verts char-verts :inline :offset-assert 368) + (src-verts char-verts :inline :offset-assert 560) + (dest-verts char-verts :inline :offset-assert 752) + (justify vector 64 :inline :offset-assert 944) + (color-shadow vector4w :inline :offset-assert 1968) + (color-table char-color 64 :inline :offset-assert 1984) + (last-color uint64 :offset-assert 3008) + (save-last-color uint64 :offset-assert 3016) + (buf basic :offset-assert 3024) + (str-ptr uint32 :offset-assert 3028) + (flags uint32 :offset-assert 3032) + (reg-save uint32 5 :offset-assert 3036) + ) + :method-count-assert 9 + :size-assert #xbf0 + :flag-assert #x900000bf0 + ) + +;; definition for method 3 of type font-work +(defmethod inspect font-work ((obj font-work)) + (format #t "[~8x] ~A~%" obj 'font-work) + (format #t "~Tfont-tmpl: #~%" (-> obj font-tmpl)) + (format #t "~Tchar-tmpl: #~%" (-> obj char-tmpl)) + (format #t "~Ttex1-tmpl[2] @ #x~X~%" (-> obj tex1-tmpl)) + (format #t "~Tsmall-font-lo-tmpl[2] @ #x~X~%" (-> obj small-font-lo-tmpl)) + (format #t "~Tsmall-font-hi-tmpl[2] @ #x~X~%" (-> obj small-font-hi-tmpl)) + (format #t "~Tlarge-font-lo-tmpl[2] @ #x~X~%" (-> obj large-font-lo-tmpl)) + (format #t "~Tlarge-font-hi-tmpl[2] @ #x~X~%" (-> obj large-font-hi-tmpl)) + (format #t "~Tsize1-small: #~%" (-> obj size1-small)) + (format #t "~Tsize2-small: #~%" (-> obj size2-small)) + (format #t "~Tsize3-small: #~%" (-> obj size3-small)) + (format #t "~Tsize1-large: #~%" (-> obj size1-large)) + (format #t "~Tsize2-large: #~%" (-> obj size2-large)) + (format #t "~Tsize3-large: #~%" (-> obj size3-large)) + (format #t "~Tsize-st1: #~%" (-> obj size-st1)) + (format #t "~Tsize-st2: #~%" (-> obj size-st2)) + (format #t "~Tsize-st3: #~%" (-> obj size-st3)) + (format #t "~Tsave: #~%" (-> obj save)) + (format #t "~Tsave-color[4] @ #x~X~%" (-> obj save-color)) + (format #t "~Tcurrent-verts: #~%" (-> obj current-verts)) + (format #t "~Tsrc-verts: #~%" (-> obj src-verts)) + (format #t "~Tdest-verts: #~%" (-> obj dest-verts)) + (format #t "~Tjustify[64] @ #x~X~%" (-> obj justify)) + (format #t "~Tcolor-shadow: #~%" (-> obj color-shadow)) + (format #t "~Tcolor-table[64] @ #x~X~%" (-> obj color-table)) + (format #t "~Tlast-color: ~D~%" (-> obj last-color)) + (format #t "~Tsave-last-color: ~D~%" (-> obj save-last-color)) + (format #t "~Tbuf: ~A~%" (-> obj buf)) + (format #t "~Tstr-ptr: ~D~%" (-> obj str-ptr)) + (format #t "~Tflags: ~D~%" (-> obj flags)) + (format #t "~Treg-save[5] @ #x~X~%" (-> obj reg-save)) + obj + ) + +;; definition for symbol *font-work*, type font-work +(define + *font-work* + (new 'static 'font-work + :font-tmpl + (new 'static 'dma-gif-packet + :dma-vif + (new 'static 'dma-packet + :dma + (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)) + :vif1 + (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1) + ) + :gif + (new 'static 'array uint64 2 #x102e400000008001 #xe) + ) + :char-tmpl + (new 'static 'dma-gif-packet + :dma-vif + (new 'static 'dma-packet + :dma + (new 'static 'dma-tag :qwc #xe :id (dma-tag-id cnt)) + :vif1 + (new 'static 'vif-tag :imm #xe :cmd (vif-cmd direct) :msk #x1) + ) + :gif + (new 'static 'array uint64 2 #xd02e400000008001 #x412412412412e) + ) + :tex1-tmpl (new 'static 'array uint64 2 #x60 #x14) + :small-font-lo-tmpl (new 'static 'array uint64 2 #x0 #x6) + :small-font-hi-tmpl (new 'static 'array uint64 2 #x0 #x6) + :large-font-lo-tmpl (new 'static 'array uint64 2 #x0 #x6) + :large-font-hi-tmpl (new 'static 'array uint64 2 #x0 #x6) + :size1-small (new 'static 'vector :x 12.0 :w 0.5) + :size2-small (new 'static 'vector :y 8.0 :w 8.0) + :size3-small + (new 'static 'vector :x 12.0 :y 8.0 :w 8.0) + :size1-large (new 'static 'vector :x 24.0 :w 1.0) + :size2-large (new 'static 'vector :y 16.0 :w 16.0) + :size3-large + (new 'static 'vector :x 24.0 :y 16.0 :w 16.0) + :size-st1 (new 'static 'vector :x 0.08985 :w 0.5) + :size-st2 + (new 'static 'vector :y 0.06153846 :w 0.5) + :size-st3 + (new 'static 'vector :x 0.08985 :y 0.06153846 :w 0.5) + :current-verts + (new 'static 'char-verts + :pos + (new 'static 'inline-array vector 4 + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + ) + :tex-st + (new 'static 'inline-array vector 4 + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + ) + ) + :src-verts + (new 'static 'char-verts + :pos + (new 'static 'inline-array vector 4 + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + ) + :tex-st + (new 'static 'inline-array vector 4 + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + ) + ) + :dest-verts + (new 'static 'char-verts + :pos + (new 'static 'inline-array vector 4 + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + (new 'static 'vector :w 1.0) + ) + :tex-st + (new 'static 'inline-array vector 4 + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + (new 'static 'vector :z 1.0) + ) + ) + :color-shadow (new 'static 'vector4w :w #x80) + :color-table + (new 'static 'inline-array char-color 64 + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x70 :g #x78 :b #x70 :a #x80) + (new 'static 'rgba :r #x70 :g #x78 :b #x70 :a #x80) + (new 'static 'rgba :r #x30 :g #x38 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :g #x38 :b #x30 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :r #x60 :g #x60 :b #x60 :a #x80) + (new 'static 'rgba :r #x60 :g #x60 :b #x60 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x40) + (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x40) + (new 'static 'rgba :r #x60 :g #x60 :b #x60 :a #x40) + (new 'static 'rgba :r #x60 :g #x60 :b #x60 :a #x40) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80) + (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x64 :a #x80) + (new 'static 'rgba :r #x80 :g #x64 :a #x80) + (new 'static 'rgba :r #x80 :a #x80) + (new 'static 'rgba :r #x80 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x80 :a #x80) + (new 'static 'rgba :r #x80 :g #x80 :a #x80) + (new 'static 'rgba :r #x28 :g #x28 :a #x80) + (new 'static 'rgba :r #x28 :g #x28 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x20 :g #x80 :b #x20 :a #x80) + (new 'static 'rgba :r #x20 :g #x80 :b #x20 :a #x80) + (new 'static 'rgba :g #x30 :a #x80) + (new 'static 'rgba :g #x30 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x40 :g #x40 :b #x80 :a #x80) + (new 'static 'rgba :r #x40 :g #x40 :b #x80 :a #x80) + (new 'static 'rgba :b #x60 :a #x80) + (new 'static 'rgba :b #x60 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :g #x20 :b #x50 :a #x80) + (new 'static 'rgba :g #x20 :b #x50 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x40 :b #x80 :a #x80) + (new 'static 'rgba :r #x80 :g #x40 :b #x80 :a #x80) + (new 'static 'rgba :r #x30 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :b #x30 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x60 :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :r #x60 :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :g #x40 :b #x60 :a #x80) + (new 'static 'rgba :g #x40 :b #x60 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x40 :g #x60 :b #x60 :a #x80) + (new 'static 'rgba :r #x40 :g #x60 :b #x60 :a #x80) + (new 'static 'rgba :g #x20 :b #x40 :a #x80) + (new 'static 'rgba :g #x20 :b #x40 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80) + (new 'static 'rgba :r #x50 :g #x50 :b #x50 :a #x80) + (new 'static 'rgba :r #x50 :g #x50 :b #x50 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x50 :g #x50 :b #x50 :a #x80) + (new 'static 'rgba :r #x50 :g #x50 :b #x50 :a #x80) + (new 'static 'rgba :r #x28 :g #x28 :b #x28 :a #x80) + (new 'static 'rgba :r #x28 :g #x28 :b #x28 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x54 :a #x80) + (new 'static 'rgba :r #x80 :g #x54 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x70 :g #x80 :b #x30 :a #x80) + (new 'static 'rgba :r #x70 :g #x80 :b #x30 :a #x80) + (new 'static 'rgba :g #x60 :a #x80) + (new 'static 'rgba :g #x60 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x48 :g #x58 :b #x8 :a #x80) + (new 'static 'rgba :r #x48 :g #x58 :b #x10 :a #x80) + (new 'static 'rgba :g #x38 :a #x80) + (new 'static 'rgba :g #x38 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x58 :g #x60 :b #x58 :a #x80) + (new 'static 'rgba :r #x58 :g #x60 :b #x58 :a #x80) + (new 'static 'rgba :r #x30 :g #x40 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :g #x40 :b #x30 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x40 :g #x48 :b #x40 :a #x80) + (new 'static 'rgba :r #x40 :g #x48 :b #x40 :a #x80) + (new 'static 'rgba :r #x18 :g #x28 :b #x18 :a #x80) + (new 'static 'rgba :r #x18 :g #x28 :b #x18 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x30 :g #x20 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :g #x20 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :g #x20 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :g #x20 :b #x30 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x79 :b #x48 :a #x80) + (new 'static 'rgba :r #x80 :g #x79 :b #x48 :a #x80) + (new 'static 'rgba :r #x80 :g #x79 :b #x48 :a #x80) + (new 'static 'rgba :r #x80 :g #x79 :b #x48 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x20 :g #x5e :b #x78 :a #x80) + (new 'static 'rgba :r #x20 :g #x5e :b #x78 :a #x80) + (new 'static 'rgba :r #x80 :g #x7d :b #x4f :a #x80) + (new 'static 'rgba :r #x80 :g #x7d :b #x4f :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x1d :g #x1d :b #x1d :a #x80) + (new 'static 'rgba :r #x1d :g #x1d :b #x1d :a #x80) + (new 'static 'rgba :r #x1d :g #x1d :b #x1d :a #x80) + (new 'static 'rgba :r #x1d :g #x1d :b #x1d :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x40 :g #x40 :b #x40 :a #x80) + (new 'static 'rgba :r #x40 :g #x40 :b #x40 :a #x80) + (new 'static 'rgba :r #x40 :g #x40 :b #x40 :a #x80) + (new 'static 'rgba :r #x40 :g #x40 :b #x40 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x7a :g #x4d :b #x65 :a #x80) + (new 'static 'rgba :r #x7a :g #x4d :b #x65 :a #x80) + (new 'static 'rgba :r #x7a :g #x4d :b #x65 :a #x80) + (new 'static 'rgba :r #x7a :g #x4d :b #x65 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x7a :g #x34 :b #x34 :a #x80) + (new 'static 'rgba :r #x7a :g #x34 :b #x34 :a #x80) + (new 'static 'rgba :r #x7a :g #x34 :b #x34 :a #x80) + (new 'static 'rgba :r #x7a :g #x34 :b #x34 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x10 :g #x65 :b #x4c :a #x80) + (new 'static 'rgba :r #x10 :g #x65 :b #x4c :a #x80) + (new 'static 'rgba :r #x10 :g #x65 :b #x4c :a #x80) + (new 'static 'rgba :r #x10 :g #x65 :b #x4c :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x46 :g #x4a :b #x78 :a #x80) + (new 'static 'rgba :r #x46 :g #x4a :b #x78 :a #x80) + (new 'static 'rgba :r #x46 :g #x4a :b #x78 :a #x80) + (new 'static 'rgba :r #x46 :g #x4a :b #x78 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x57 :g #x7e :b #x80 :a #x80) + (new 'static 'rgba :r #x57 :g #x7e :b #x80 :a #x80) + (new 'static 'rgba :r #x29 :g #x63 :b #x79 :a #x80) + (new 'static 'rgba :r #x29 :g #x63 :b #x70 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x7f :g #x7b :b #x33 :a #x80) + (new 'static 'rgba :r #x7f :g #x7b :b #x33 :a #x80) + (new 'static 'rgba :r #x76 :g #x40 :b #x14 :a #x80) + (new 'static 'rgba :r #x76 :g #x40 :b #x14 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x79 :g #x79 :b #x2 :a #x80) + (new 'static 'rgba :r #x79 :g #x79 :b #x2 :a #x80) + (new 'static 'rgba :r #x1b :g #x51 :b #x20 :a #x80) + (new 'static 'rgba :r #x1b :g #x51 :b #x20 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x47 :g #x68 :b #x7a :a #x80) + (new 'static 'rgba :r #x47 :g #x68 :b #x7a :a #x80) + (new 'static 'rgba :g #x3c :b #x4f :a #x80) + (new 'static 'rgba :g #x3c :b #x4f :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x70 :g #x78 :b #x70 :a #x80) + (new 'static 'rgba :r #x70 :g #x78 :b #x70 :a #x80) + (new 'static 'rgba :r #x30 :g #x38 :b #x30 :a #x80) + (new 'static 'rgba :r #x30 :g #x38 :b #x30 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x60 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80) + (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80) + ) + ) + (new 'static 'char-color + :color + (new 'static 'array rgba 4 + (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80) + (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + (new 'static 'rgba :r #x60 :a #x80) + ) + ) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + (new 'static 'char-color) + ) + ) + ) + +;; definition for function font-set-tex0 +;; INFO: Return type mismatch int vs none. +(defun + font-set-tex0 + ((ptr-tex0 (pointer gs-tex0)) + (tex texture) + (tex-addr uint) + (psm uint) + (clut-addr uint) + ) + (set! + (-> ptr-tex0 0) + (new 'static 'gs-tex0 + :tcc #x1 + :cld #x1 + :cbp clut-addr + :th (log2 (-> tex h)) + :tw (log2 (-> tex w)) + :tbw (-> tex width 0) + :tbp0 (sar tex-addr 6) + :psm psm + ) + ) + (none) + ) + +;; failed to figure out what this is: +(let ((v0-4 0)) + ) + + + diff --git a/test/decompiler/reference/gstate_REF.gc b/test/decompiler/reference/gstate_REF.gc index 8ce8d84079..c8b549775a 100644 --- a/test/decompiler/reference/gstate_REF.gc +++ b/test/decompiler/reference/gstate_REF.gc @@ -62,7 +62,14 @@ (arg4 object) (arg5 object) ) - (local-vars (pp process) (s7-0 none) (sp-0 none) (sp-1 int) (ra-0 int)) + (local-vars + (pp process) + (s7-0 none) + (sp-0 none) + (sp-1 int) + (ra-0 int) + (sv-0 none) + ) (set! (-> pp mask) (logand (lognot (process-mask sleep sleep-code)) (-> pp mask)) diff --git a/test/decompiler/reference/level-h_REF.gc b/test/decompiler/reference/level-h_REF.gc index b1ace9d875..1d38250596 100644 --- a/test/decompiler/reference/level-h_REF.gc +++ b/test/decompiler/reference/level-h_REF.gc @@ -149,15 +149,15 @@ (bsp basic :offset-assert 48) (art-group basic :offset-assert 52) (info basic :offset-assert 56) - (texture-page basic 9 :offset-assert 60) + (texture-page texture-page 9 :offset-assert 60) (loaded-texture-page basic 16 :offset-assert 96) (loaded-texture-page-count int32 :offset-assert 160) (foreground-sink-group dma-foreground-sink-group 3 :inline :offset-assert 176) (foreground-draw-engine basic 3 :offset-assert 272) (entity basic :offset-assert 284) (ambient basic :offset-assert 288) - (closest-object basic 9 :offset-assert 292) - (upload-size uint32 9 :offset-assert 328) + (closest-object float 9 :offset-assert 292) + (upload-size int32 9 :offset-assert 328) (level-distance float :offset-assert 364) (inside-sphere? basic :offset-assert 368) (inside-boxes? basic :offset-assert 372) @@ -187,7 +187,7 @@ (:methods (dummy-9 () none 9) (dummy-10 () none 10) - (dummy-11 () none 11) + (dummy-11 (_type_) none 11) (dummy-12 () none 12) (dummy-13 () none 13) (dummy-14 () none 14) @@ -269,8 +269,8 @@ ;; definition of type level-group (deftype level-group (basic) ((length int32 :offset-assert 4) - (unknown-field-1 basic :offset-assert 8) - (unknown-field-2 basic :offset-assert 12) + (unknown-level-1 level :offset-assert 8) + (unknown-level-2 level :offset-assert 12) (entity-link entity-links :offset 16) (border? basic :offset-assert 20) (vis? basic :offset-assert 24) @@ -335,8 +335,8 @@ *level* (new 'static 'level-group :length 2 - :unknown-field-1 #f - :unknown-field-2 #f + :unknown-level-1 #f + :unknown-level-2 #f :entity-link #f :border? #f :want-level #f diff --git a/test/decompiler/reference/memory-usage-h_REF.gc b/test/decompiler/reference/memory-usage-h_REF.gc new file mode 100644 index 0000000000..609d177dd8 --- /dev/null +++ b/test/decompiler/reference/memory-usage-h_REF.gc @@ -0,0 +1,69 @@ +;;-*-Lisp-*- +(in-package goal) + +;; this file is debug only +(when *debug-segment* +;; definition of type memory-usage-info +(deftype memory-usage-info (structure) + ((name basic :offset-assert 0) + (count int32 :offset-assert 4) + (used int32 :offset-assert 8) + (total int32 :offset-assert 12) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + +;; definition for method 3 of type memory-usage-info +(defmethod inspect memory-usage-info ((obj memory-usage-info)) + (format #t "[~8x] ~A~%" obj 'memory-usage-info) + (format #t "~Tname: ~A~%" (-> obj name)) + (format #t "~Tcount: ~D~%" (-> obj count)) + (format #t "~Tused: ~D~%" (-> obj used)) + (format #t "~Ttotal: ~D~%" (-> obj total)) + obj + ) + +;; definition of type memory-usage-block +(deftype memory-usage-block (basic) + ((work-bsp basic :offset-assert 4) + (length int32 :offset-assert 8) + (data memory-usage-info 109 :inline :offset-assert 16) + ) + :method-count-assert 12 + :size-assert #x6e0 + :flag-assert #xc000006e0 + (:methods + (reset! (_type_) _type_ 9) + (calculate-total (_type_) int 10) + (dummy-11 () none 11) + ) + ) + +;; definition for method 3 of type memory-usage-block +(defmethod inspect memory-usage-block ((obj memory-usage-block)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Twork-bsp: ~A~%" (-> obj work-bsp)) + (format #t "~Tlength: ~D~%" (-> obj length)) + (format #t "~Tdata[109] @ #x~X~%" (-> obj data)) + obj + ) + +;; definition for symbol *mem-usage*, type memory-usage-block +(define *mem-usage* (the-as memory-usage-block (new 'debug 'memory-usage-block))) + +;; definition for symbol *dma-mem-usage*, type memory-usage-block +(define + *dma-mem-usage* + (the-as memory-usage-block (new 'debug 'memory-usage-block)) + ) + +;; definition for symbol *temp-mem-usage*, type symbol +(define *temp-mem-usage* #f) + +;; failed to figure out what this is: +(empty-form) + +) + diff --git a/test/decompiler/reference/settings-h_REF.gc b/test/decompiler/reference/settings-h_REF.gc new file mode 100644 index 0000000000..63e845f847 --- /dev/null +++ b/test/decompiler/reference/settings-h_REF.gc @@ -0,0 +1,226 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition of type setting-data +(deftype setting-data (structure) + ((border-mode basic :offset-assert 0) + (sfx-volume float :offset-assert 4) + (music-volume float :offset-assert 8) + (dialog-volume float :offset-assert 12) + (process-mask uint32 :offset-assert 16) + (common-page int32 :offset-assert 20) + (language int64 :offset-assert 24) + (screenx int32 :offset-assert 32) + (screeny int32 :offset-assert 36) + (vibration basic :offset-assert 40) + (play-hints basic :offset-assert 44) + (movie (pointer process) :offset-assert 48) + (talking (pointer process) :offset-assert 52) + (spooling (pointer process) :offset-assert 56) + (hint (pointer process) :offset-assert 60) + (ambient (pointer process) :offset-assert 64) + (video-mode basic :offset-assert 68) + (aspect-ratio basic :offset-assert 72) + (sound-flava uint8 :offset-assert 76) + (auto-save basic :offset-assert 80) + (music-volume-movie float :offset-assert 84) + (sfx-volume-movie float :offset-assert 88) + (music basic :offset-assert 92) + (bg-r float :offset-assert 96) + (bg-g float :offset-assert 100) + (bg-b float :offset-assert 104) + (bg-a float :offset-assert 108) + (bg-a-speed float :offset-assert 112) + (bg-a-force float :offset-assert 116) + (allow-progress basic :offset-assert 120) + (allow-pause basic :offset-assert 124) + (sound-flava-priority float :offset-assert 128) + (ocean-off basic :offset-assert 132) + (allow-look-around basic :offset-assert 136) + (ambient-volume float :offset-assert 140) + (ambient-volume-movie float :offset-assert 144) + (dialog-volume-hint float :offset-assert 148) + (dummy uint32 11 :offset-assert 152) + ) + :method-count-assert 10 + :size-assert #xc4 + :flag-assert #xa000000c4 + (:methods + (dummy-9 () none 9) + ) + ) + +;; definition for method 3 of type setting-data +(defmethod inspect setting-data ((obj setting-data)) + (format #t "[~8x] ~A~%" obj 'setting-data) + (format #t "~Tborder-mode: ~A~%" (-> obj border-mode)) + (format #t "~Tsfx-volume: ~f~%" (-> obj sfx-volume)) + (format #t "~Tmusic-volume: ~f~%" (-> obj music-volume)) + (format #t "~Tdialog-volume: ~f~%" (-> obj dialog-volume)) + (format #t "~Tprocess-mask: ~D~%" (-> obj process-mask)) + (format #t "~Tcommon-page: ~D~%" (-> obj common-page)) + (format #t "~Tlanguage: ~D~%" (-> obj language)) + (format #t "~Tscreenx: ~D~%" (-> obj screenx)) + (format #t "~Tscreeny: ~D~%" (-> obj screeny)) + (format #t "~Tvibration: ~A~%" (-> obj vibration)) + (format #t "~Tplay-hints: ~A~%" (-> obj play-hints)) + (let ((t9-12 format) + (a0-13 #t) + (a1-12 "~Tmovie: ~A~%") + (v1-0 (-> obj movie)) + ) + (t9-12 a0-13 a1-12 (if v1-0 + (-> v1-0 0 self) + ) + ) + ) + (let ((t9-13 format) + (a0-14 #t) + (a1-13 "~Ttalking: ~A~%") + (v1-2 (-> obj talking)) + ) + (t9-13 a0-14 a1-13 (if v1-2 + (-> v1-2 0 self) + ) + ) + ) + (let ((t9-14 format) + (a0-15 #t) + (a1-14 "~Tspooling: ~A~%") + (v1-4 (-> obj spooling)) + ) + (t9-14 a0-15 a1-14 (if v1-4 + (-> v1-4 0 self) + ) + ) + ) + (let ((t9-15 format) + (a0-16 #t) + (a1-15 "~Thint: ~A~%") + (v1-6 (-> obj hint)) + ) + (t9-15 a0-16 a1-15 (if v1-6 + (-> v1-6 0 self) + ) + ) + ) + (let ((t9-16 format) + (a0-17 #t) + (a1-16 "~Tambient: ~A~%") + (v1-8 (-> obj ambient)) + ) + (t9-16 a0-17 a1-16 (if v1-8 + (-> v1-8 0 self) + ) + ) + ) + (format #t "~Tvideo-mode: ~A~%" (-> obj video-mode)) + (format #t "~Taspect-ratio: ~A~%" (-> obj aspect-ratio)) + (format #t "~Tsound-flava: ~D~%" (-> obj sound-flava)) + (format #t "~Tauto-save: ~A~%" (-> obj auto-save)) + (format #t "~Tmusic-volume-movie: ~f~%" (-> obj music-volume-movie)) + (format #t "~Tsfx-volume-movie: ~f~%" (-> obj sfx-volume-movie)) + (format #t "~Tmusic: ~A~%" (-> obj music)) + (format #t "~Tbg-r: ~f~%" (-> obj bg-r)) + (format #t "~Tbg-g: ~f~%" (-> obj bg-g)) + (format #t "~Tbg-b: ~f~%" (-> obj bg-b)) + (format #t "~Tbg-a: ~f~%" (-> obj bg-a)) + (format #t "~Tbg-a-speed: ~f~%" (-> obj bg-a-speed)) + (format #t "~Tbg-a-force: ~f~%" (-> obj bg-a-force)) + (format #t "~Tallow-progress: ~A~%" (-> obj allow-progress)) + (format #t "~Tallow-pause: ~A~%" (-> obj allow-pause)) + (format #t "~Tsound-flava-priority: ~f~%" (-> obj sound-flava-priority)) + (format #t "~Tocean-off: ~A~%" (-> obj ocean-off)) + (format #t "~Tallow-look-around: ~A~%" (-> obj allow-look-around)) + (format #t "~Tambient-volume: ~f~%" (-> obj ambient-volume)) + (format #t "~Tambient-volume-movie: ~f~%" (-> obj ambient-volume-movie)) + (format #t "~Tdialog-volume-hint: ~f~%" (-> obj dialog-volume-hint)) + (format #t "~Tdummy[11] @ #x~X~%" (-> obj dummy)) + obj + ) + +;; definition of type setting-control +(deftype setting-control (basic) + ((current setting-data :inline :offset-assert 16) + (target setting-data :inline :offset-assert 224) + (default setting-data :inline :offset-assert 432) + (engine engine :offset-assert 628) + ) + :method-count-assert 14 + :size-assert #x278 + :flag-assert #xe00000278 + (:methods + (new (symbol type int) _type_ 0) + (dummy-9 () none 9) + (dummy-10 () none 10) + (dummy-11 () none 11) + (dummy-12 () none 12) + (dummy-13 () none 13) + ) + ) + +;; definition for method 3 of type setting-control +(defmethod inspect setting-control ((obj setting-control)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tcurrent: #~%" (-> obj current)) + (format #t "~Ttarget: #~%" (-> obj target)) + (format #t "~Tdefault: #~%" (-> obj default)) + (format #t "~Tengine: ~A~%" (-> obj engine)) + obj + ) + +;; definition for method 0 of type setting-control +(defmethod + new + setting-control + ((allocation symbol) (type-to-make type) (arg0 int)) + (let + ((s4-0 + (object-new allocation type-to-make (the-as int (-> type-to-make size))) + ) + ) + (set! + (-> s4-0 engine) + ((method-of-type engine new) allocation engine 'setting-control arg0) + ) + s4-0 + ) + ) + +;; definition of type scf-time +(deftype scf-time (structure) + ((stat uint8 :offset-assert 0) + (second uint8 :offset-assert 1) + (minute uint8 :offset-assert 2) + (hour uint8 :offset-assert 3) + (week uint8 :offset-assert 4) + (day uint8 :offset-assert 5) + (month uint8 :offset-assert 6) + (year uint8 :offset-assert 7) + ) + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; definition for method 3 of type scf-time +(defmethod inspect scf-time ((obj scf-time)) + (format #t "[~8x] ~A~%" obj 'scf-time) + (format #t "~Tstat: ~D~%" (-> obj stat)) + (format #t "~Tsecond: #x~X~%" (-> obj second)) + (format #t "~Tminute: #x~X~%" (-> obj minute)) + (format #t "~Thour: #x~X~%" (-> obj hour)) + (format #t "~Tweek: #x~X~%" (-> obj week)) + (format #t "~Tday: #x~X~%" (-> obj day)) + (format #t "~Tmonth: #x~X~%" (-> obj month)) + (format #t "~Tyear: #x~X~%" (-> obj year)) + obj + ) + +;; failed to figure out what this is: +(let ((v0-3 0)) + ) + + + + diff --git a/test/decompiler/reference/text-h_REF.gc b/test/decompiler/reference/text-h_REF.gc new file mode 100644 index 0000000000..65fea0e538 --- /dev/null +++ b/test/decompiler/reference/text-h_REF.gc @@ -0,0 +1,63 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition of type game-text +(deftype game-text (structure) + ((id uint32 :offset-assert 0) + (text string :offset-assert 4) + ) + :pack-me + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; definition for method 3 of type game-text +(defmethod inspect game-text ((obj game-text)) + (format #t "[~8x] ~A~%" obj 'game-text) + (format #t "~Tid: ~D~%" (-> obj id)) + (format #t "~Ttext: ~A~%" (-> obj text)) + obj + ) + +;; definition of type game-text-info +(deftype game-text-info (basic) + ((length int32 :offset-assert 4) + (language-id int32 :offset-assert 8) + (group-name string :offset-assert 12) + (data game-text :inline :dynamic :offset-assert 16) + ) + :method-count-assert 10 + :size-assert #x10 + :flag-assert #xa00000010 + (:methods + (dummy-9 () none 9) + ) + ) + +;; definition for method 3 of type game-text-info +(defmethod inspect game-text-info ((obj game-text-info)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tlength: ~D~%" (-> obj length)) + (format #t "~Tlanguage-id: ~D~%" (-> obj language-id)) + (format #t "~Tgroup-name: ~A~%" (-> obj group-name)) + (format #t "~Tdata[0] @ #x~X~%" (-> obj data)) + obj + ) + +;; definition for symbol *text-group-names*, type (array string) +(define + *text-group-names* + (the-as (array string) (new 'static 'boxed-array string 1 "common")) + ) + +;; definition for symbol *common-text-heap*, type kheap +(define *common-text-heap* (the-as kheap (new 'global 'kheap))) + +;; definition for symbol *common-text*, type symbol +(define *common-text* #f) + +;; failed to figure out what this is: +(let ((v0-3 0)) + ) + diff --git a/test/decompiler/reference/texture-h_REF.gc b/test/decompiler/reference/texture-h_REF.gc index 0cee59ae15..456125851d 100644 --- a/test/decompiler/reference/texture-h_REF.gc +++ b/test/decompiler/reference/texture-h_REF.gc @@ -46,35 +46,36 @@ ;; definition of type texture-pool (deftype texture-pool (basic) - ((top int32 :offset-assert 4) - (cur int32 :offset-assert 8) - (allocate-func basic :offset-assert 12) - (font-palette int32 :offset-assert 16) - (segment texture-pool-segment 4 :inline :offset-assert 20) - (segment-near texture-pool-segment :inline :offset 20) - (segment-common texture-pool-segment :inline :offset 28) - (common-page int32 32 :offset-assert 52) - (common-page-mask int32 :offset-assert 180) - (ids int32 126 :offset-assert 184) + ((top int32 :offset-assert 4) + (cur int32 :offset-assert 8) + (allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12) + (font-palette int32 :offset-assert 16) + (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) + (common-page texture-page 32 :offset-assert 52) + (common-page-mask int32 :offset-assert 180) + (ids uint32 126 :offset-assert 184) ) :method-count-assert 23 :size-assert #x2b0 :flag-assert #x17000002b0 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) - (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) - (dummy-15 () none 15) - (dummy-16 () none 16) + (new (symbol type) _type_ 0) + (initialize! (_type_) _type_ 9) + (print-usage (_type_) _type_ 10) + (dummy-11 (_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) + (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 () none 20) - (dummy-21 () none 21) - (dummy-22 () none 22) + (upload-one-common! (_type_) symbol 21) + (lookup-boot-common-id (_type_ int) int 22) ) ) @@ -85,16 +86,16 @@ (format #t "~Tcur: #x~X~%" (-> obj cur)) (format #t "~Tallocate-func: ~A~%" (-> obj allocate-func)) (format #t "~Tfont-palette: ~D~%" (-> obj font-palette)) - (format #t "~Tsegment[4] @ #x~X~%" (-> obj segment)) + (format #t "~Tsegment[4] @ #x~X~%" (-> obj segment-near)) (format #t "~Tsegment-near: #~%" - (-> obj segment) + (-> obj segment-near) ) (format #t "~Tsegment-common: #~%" - (-> obj segment 1) + (-> obj segment-common) ) (format #t "~Tcommon-page[32] @ #x~X~%" (-> obj common-page)) (format #t "~Tcommon-page-mask: ~D~%" (-> obj common-page-mask)) @@ -108,7 +109,7 @@ (h int16 :offset-assert 6) (num-mips uint8 :offset-assert 8) (tex1-control uint8 :offset-assert 9) - (psm uint8 :offset-assert 10) + (psm gs-psm :offset-assert 10) (mip-shift uint8 :offset-assert 11) (clutpsm uint16 :offset-assert 12) (dest uint16 7 :offset-assert 14) @@ -183,18 +184,18 @@ (size uint32 :offset-assert 24) (segment texture-page-segment 3 :inline :offset-assert 28) (pad uint32 16 :offset-assert 64) - (data uint8 :dynamic :offset-assert 128) + (data texture :dynamic :offset-assert 128) ) :method-count-assert 15 :size-assert #x80 :flag-assert #xf00000080 (:methods - (dummy-9 () none 9) - (dummy-10 () none 10) + (remove-from-heap (_type_ kheap) _type_ 9) + (get-leftover-block-count (_type_ int int) int 10) (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) + (relocate-dests! (_type_ int int) none 12) + (add-to-dma-buffer (_type_ dma-buffer int) none 13) + (upload-now! (_type_ int) none 14) ) ) @@ -215,7 +216,8 @@ ;; definition of type shader-ptr (deftype shader-ptr (uint32) - () + ((shader uint32 :offset 8 :size 24) + ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 @@ -223,7 +225,7 @@ ;; definition of type texture-link (deftype texture-link (structure) - ((next uint32 :offset-assert 0) + ((next shader-ptr 1 :offset-assert 0) ) :method-count-assert 9 :size-assert #x4 @@ -233,17 +235,18 @@ ;; definition for method 3 of type texture-link (defmethod inspect texture-link ((obj texture-link)) (format #t "[~8x] ~A~%" obj 'texture-link) - (format #t "~Tnext: #x~X~%" (-> obj next)) + (format #t "~Tnext: #x~X~%" (-> obj next 0)) obj ) ;; definition of type texture-page-dir-entry (deftype texture-page-dir-entry (structure) - ((length int16 :offset-assert 0) - (status uint16 :offset-assert 2) - (page basic :offset-assert 4) - (link uint32 :offset-assert 8) + ((length int16 :offset-assert 0) + (status uint16 :offset-assert 2) + (page texture-page :offset-assert 4) + (link texture-link :offset-assert 8) ) + :pack-me :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c @@ -261,7 +264,8 @@ ;; definition of type texture-page-dir (deftype texture-page-dir (basic) - ((pad uint8 16 :offset-assert 4) + ((length int32 :offset-assert 4) + (entries texture-page-dir-entry 1 :inline :offset-assert 8) ) :method-count-assert 10 :size-assert #x14 @@ -278,7 +282,7 @@ (source uint32 :offset-assert 12) (move uint32 :offset-assert 16) (entry texture-page-dir-entry :offset-assert 20) - (page basic :offset-assert 24) + (page texture-page :offset-assert 24) ) :method-count-assert 9 :size-assert #x1c @@ -311,17 +315,17 @@ ;; definition of type adgif-shader (deftype adgif-shader (structure) - ((quad uint128 5 :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 uint32 :offset 40) + ((quad uint128 5 :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) ) :method-count-assert 9 :size-assert #x50 @@ -405,6 +409,3 @@ (let ((v0-14 0)) ) - - - diff --git a/test/offline/offline_test_main.cpp b/test/offline/offline_test_main.cpp index 3a2728959a..9761312449 100644 --- a/test/offline/offline_test_main.cpp +++ b/test/offline/offline_test_main.cpp @@ -18,7 +18,8 @@ const std::unordered_set g_object_files_to_decompile = { "euler", /* geometry, trigonometry, */ "gsound-h", "timer-h", "timer", "vif-h", "dma-h", "video-h", "vu1-user-h", "dma", "dma-buffer", "dma-bucket", "dma-disasm", "pad", "gs", "display-h", "vector", "file-io", "loader-h", - "texture-h", "level-h", "math-camera-h", /* math-camera, "font-h",*/ "decomp-h", "display", + "texture-h", "level-h", "math-camera-h", /* math-camera, */ "font-h", "decomp-h", "display", + "connect", "text-h", "settings-h", "capture", "memory-usage-h", /* gap */ "mspace-h", "drawable-h", "drawable-group-h", /* gap */ @@ -40,8 +41,8 @@ const std::vector g_object_files_to_check_against_reference = { "matrix", "transform", "quaternion", "euler", /* geometry, trigonometry */ "gsound-h", "timer-h", /* timer, */ "vif-h", "dma-h", "video-h", "vu1-user-h", "dma", "dma-buffer", "dma-bucket", "dma-disasm", "pad", "gs", "display-h", "vector", "file-io", - "loader-h", "texture-h", "level-h", "math-camera-h", /* math-camera, "font-h",*/ "decomp-h", - "display", + "loader-h", "texture-h", "level-h", "math-camera-h", /* math-camera, */ "font-h", "decomp-h", + "display", "connect", "text-h", "settings-h", "capture", "memory-usage-h", /* gap */ "mspace-h", "drawable-h", "drawable-group-h", /* gap */ @@ -91,7 +92,7 @@ const std::unordered_set expected_skip_in_decompiler = { // dma "symlink2", "symlink3", "dma-sync-hang", // handwritten asm "vector=", // asm branching - // displyy + // display "vblank-handler", // asm "vif1-handler", "vif1-handler-debug", @@ -154,6 +155,12 @@ const std::unordered_set skip_in_compiling = { // bad decisions on float vs int128 "vector-degf", "vector-degmod", "vector-deg-diff", "vector-degi", + // connect + "(method 9 engine)", // methods-by-name stuff. + + // capture + "(method 3 gs-store-image-packet)", // print giftag weirdness + // sync-info "(method 15 sync-info)", // needs display stuff first "(method 15 sync-info-eased)", // needs display stuff first