diff --git a/decompiler/IR2/AtomicOpTypeAnalysis.cpp b/decompiler/IR2/AtomicOpTypeAnalysis.cpp index 3cf35adaa7..0ad9196887 100644 --- a/decompiler/IR2/AtomicOpTypeAnalysis.cpp +++ b/decompiler/IR2/AtomicOpTypeAnalysis.cpp @@ -190,7 +190,7 @@ TP_Type SimpleExpression::get_type(const TypeState& input, } // new for jak 2: if (env.version == GameVersion::Jak2 && in_type.is_integer_constant() && - in_type.get_integer_constant() <= UINT32_MAX) { + (s64)((s32)in_type.get_integer_constant()) == (s64)in_type.get_integer_constant()) { return TP_Type::make_from_ts("float"); } return in_type; @@ -649,6 +649,17 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input, } } + if (env.version == GameVersion::Jak2 && tc(dts, TypeSpec("symbol"), arg1_type) && + !m_args[0].is_int() && is_int_or_uint(dts, arg0_type)) { + if (arg0_type.is_integer_constant(jak2::SYM_TO_STRING_OFFSET)) { + // symbol -> GOAL String + // NOTE - the offset doesn't fit in a s16, so it's loaded into a register first. + // so we expect the arg to be a variable, and the type propagation will figure out the + // integer constant. + return TP_Type::make_from_ts(dts.ts.make_pointer_typespec("string")); + } + } + if (tc(dts, TypeSpec("structure"), arg1_type) && !m_args[0].is_int() && is_int_or_uint(dts, arg0_type)) { if (arg1_type.typespec() == TypeSpec("symbol") && diff --git a/decompiler/IR2/FormExpressionAnalysis.cpp b/decompiler/IR2/FormExpressionAnalysis.cpp index 8403bfa80c..8048597a87 100644 --- a/decompiler/IR2/FormExpressionAnalysis.cpp +++ b/decompiler/IR2/FormExpressionAnalysis.cpp @@ -97,6 +97,19 @@ Form* try_cast_simplify(Form* in, return in; } + if (env.version == GameVersion::Jak2) { + if (new_type == TypeSpec("float")) { + auto ic = get_goal_integer_constant(in, env); + if (ic) { + // ASSERT(*ic <= UINT32_MAX); + ASSERT((s64)*ic == (s64)(s32)*ic); + float f; + memcpy(&f, &ic.value(), sizeof(float)); + return pool.form(f); + } + } + } + if (new_type == TypeSpec("meters")) { auto fc = get_goal_float_constant(in); @@ -682,6 +695,15 @@ void SimpleExpressionElement::update_from_stack_identity(const Env& env, } } +bool u64_valid_for_float_constant(u64 in) { + u32 top = in >> 32; + if (top == 0 || top == UINT32_MAX) { + return true; + } else { + return false; + } +} + void SimpleExpressionElement::update_from_stack_gpr_to_fpr(const Env& env, FormPool& pool, FormStack& stack, @@ -712,12 +734,10 @@ void SimpleExpressionElement::update_from_stack_gpr_to_fpr(const Env& env, auto frm = pool.alloc_sequence_form(nullptr, src_fes); if (src_fes.size() == 1) { auto int_constant = get_goal_integer_constant(frm, env); - - if (int_constant && (*int_constant <= UINT32_MAX)) { + if (int_constant && u64_valid_for_float_constant(*int_constant)) { float flt; memcpy(&flt, &int_constant.value(), sizeof(float)); - result->push_back(pool.alloc_element(flt)); return; } @@ -964,7 +984,18 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env, // try to find symbol to string stuff auto arg0_int = get_goal_integer_constant(args.at(0), env); - if (arg0_int && (*arg0_int == DECOMP_SYM_INFO_OFFSET + 4) && + u64 symbol_to_string_offset = -1; + switch (env.version) { + case GameVersion::Jak1: + symbol_to_string_offset = DECOMP_SYM_INFO_OFFSET + 4; + break; + case GameVersion::Jak2: + symbol_to_string_offset = jak2::SYM_TO_STRING_OFFSET; + break; + default: + ASSERT(false); + } + if (arg0_int && (*arg0_int == symbol_to_string_offset) && arg1_type.typespec() == TypeSpec("symbol")) { result->push_back(pool.alloc_element(args.at(1))); return; @@ -2636,23 +2667,53 @@ bool try_to_rewrite_matrix_inline_ctor(const Env& env, FormPool& pool, FormStack // zeroing the rows: std::vector write_vars; - for (int i = 0; i < 4; i++) { - auto elt = matrix_entries->at(i + 1).elt; + if (env.version == GameVersion::Jak1) { + for (int i = 0; i < 4; i++) { + auto elt = matrix_entries->at(i + 1).elt; - auto matcher = Matcher::set( - Matcher::deref(Matcher::any_reg(0), false, - {DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i), - DerefTokenMatcher::string("quad")}), - Matcher::cast("uint128", Matcher::integer(0))); + auto matcher = Matcher::set( + Matcher::deref(Matcher::any_reg(0), false, + {DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i), + DerefTokenMatcher::string("quad")}), + Matcher::cast("uint128", Matcher::integer(0))); - auto mr = match(matcher, elt); - if (mr.matched) { - if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) { + auto mr = match(matcher, elt); + if (mr.matched) { + if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) { + return false; + } + write_vars.push_back(*mr.maps.regs.at(0)); + } else { + return false; + } + } + } else { + for (int i = 0; i < 4; i++) { + auto elt = matrix_entries->at(i + 1).elt; + + Matcher matcher; + if (i == 3) { + matcher = Matcher::set(Matcher::deref(Matcher::any_reg(0), false, + {DerefTokenMatcher::string("trans"), + DerefTokenMatcher::string("quad")}), + Matcher::cast("uint128", Matcher::integer(0))); + + } else { + matcher = Matcher::set( + Matcher::deref(Matcher::any_reg(0), false, + {DerefTokenMatcher::string("quad"), DerefTokenMatcher::integer(i)}), + Matcher::cast("uint128", Matcher::integer(0))); + } + + auto mr = match(matcher, elt); + if (mr.matched) { + if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) { + return false; + } + write_vars.push_back(*mr.maps.regs.at(0)); + } else { return false; } - write_vars.push_back(*mr.maps.regs.at(0)); - } else { - return false; } } diff --git a/decompiler/ObjectFile/ObjectFileDB_IR2.cpp b/decompiler/ObjectFile/ObjectFileDB_IR2.cpp index 8840852f89..16a40863aa 100644 --- a/decompiler/ObjectFile/ObjectFileDB_IR2.cpp +++ b/decompiler/ObjectFile/ObjectFileDB_IR2.cpp @@ -103,9 +103,7 @@ void ObjectFileDB::analyze_functions_ir2( if (!output_dir.string().empty()) { ir2_write_results(output_dir, config, imports, data); } else { - if (!skip_functions.empty()) { - data.output_with_skips = ir2_final_out(data, imports, skip_functions); - } + data.output_with_skips = ir2_final_out(data, imports, skip_functions); data.full_output = ir2_final_out(data, imports, {}); } diff --git a/decompiler/analysis/atomic_op_builder.cpp b/decompiler/analysis/atomic_op_builder.cpp index fdf2de9c4e..435a7d182b 100644 --- a/decompiler/analysis/atomic_op_builder.cpp +++ b/decompiler/analysis/atomic_op_builder.cpp @@ -308,6 +308,7 @@ std::unique_ptr make_asm_op(const Instruction& i0, int idx) { case InstructionKind::MSUBAS: case InstructionKind::MSUBS: case InstructionKind::ADDAS: + case InstructionKind::RSQRTS: // Moves / Loads / Stores case InstructionKind::CTC2: diff --git a/decompiler/config/jak2/all-types.gc b/decompiler/config/jak2/all-types.gc index 19698c8147..44e5221e3d 100644 --- a/decompiler/config/jak2/all-types.gc +++ b/decompiler/config/jak2/all-types.gc @@ -14,6 +14,8 @@ (define-extern integer type) (define-extern float type) (define-extern boolean type) ;; not actually added as a runtime type in jak2, but valid? supports it. +(define-extern uint16 type) +(define-extern uint32 type) (define-extern int64 type) (define-extern uint64 type) (define-extern process-tree type) @@ -52,6 +54,17 @@ (define-extern *listener-function* (function object)) (define-extern *enable-method-set* int) +(declare-type cpad-info basic) +(declare-type mouse-info basic) +(define-extern cpad-open (function cpad-info int cpad-info)) +(define-extern cpad-get-data (function cpad-info cpad-info)) +(define-extern scf-get-territory (function int)) ;; not actually a scf function... +(define-extern mouse-get-data (function mouse-info none)) +(define-extern file-stream-read (function file-stream pointer int int)) +(define-extern file-stream-open (function file-stream basic symbol file-stream)) +(define-extern file-stream-length (function file-stream int)) +(define-extern *kernel-boot-message* symbol) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; gcommon ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -77,7 +90,7 @@ ) (deftype vector (structure) - ((data float 4 :offset-assert 0) + ((data float 4 :score -1 :offset-assert 0) (x float :offset 0) (y float :offset 4) (z float :offset 8) @@ -162,7 +175,7 @@ (define-extern *trace-list* pair) (define-extern print-tree-bitmask (function int int symbol)) (define-extern breakpoint-range-set! (function uint uint uint int)) -(define-extern valid? (function object type basic basic object symbol)) +(define-extern valid? (function object type symbol symbol object symbol)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; gstring-h ;; @@ -231,7 +244,7 @@ (self process-tree :offset-assert 32) ) (:methods - (new (symbol type basic) _type_ 0) + (new (symbol type string) _type_ 0) (activate (_type_ process-tree basic pointer) process-tree 9) (deactivate (_type_) none 10) (init-from-entity! (_type_ entity-actor) none 11) ;; todo check @@ -254,7 +267,7 @@ (relocating-min int32 :offset-assert 32) (relocating-max int32 :offset-assert 36) (relocating-offset int32 :offset-assert 40) - (relocating-level object :offset-assert 44) ;; guessing here + (relocating-level level :offset-assert 44) ;; guessing here (low-memory-message symbol :offset-assert 48) ;; guessed by decompiler (login-object basic :offset-assert 52) ) @@ -271,37 +284,37 @@ (deftype clock (basic) - ((index int32 :offset-assert 4) - (mask uint32 :offset-assert 8) - (clock-ratio float :offset-assert 12) - (accum float :offset-assert 16) - (integral-accum float :offset-assert 20) - (frame-counter uint64 :offset-assert 24) - (old-frame-counter uint64 :offset-assert 32) - (integral-frame-counter uint64 :offset-assert 40) - (old-integral-frame-counter uint64 :offset-assert 48) - (sparticle-data vector :inline :offset-assert 64) - (seconds-per-frame float :offset-assert 80) - (frames-per-second float :offset-assert 84) - (time-adjust-ratio float :offset-assert 88) + ((index int32 :offset-assert 4) ;; which clock we are, in *display* + (mask process-mask :offset-assert 8) ;; mask for ticking + (clock-ratio float :offset-assert 12) ;; how fast to run. 1.0 = realtime. + (accum float :offset-assert 16) ;; fractional time for frame-counter (time-frame units) + (integral-accum float :offset-assert 20) ;; fractional time for integral (time-frame untis) + (frame-counter time-frame :offset-assert 24) ;; how much time has gone by since reset (time-frame units) + (old-frame-counter time-frame :offset-assert 32) ;; the frame-counter on the last engine iteration + (integral-frame-counter uint64 :offset-assert 40) ;; how many vsyncs have gone by since reset + (old-integral-frame-counter uint64 :offset-assert 48) ;; the integral-frame-counter on the last engine iteration + (sparticle-data vector :inline :offset-assert 64) ;; sparticle timescale info + (seconds-per-frame float :offset-assert 80) ;; how many seconds (not time-frames) should go by in 1 vsync + (frames-per-second float :offset-assert 84) ;; inverse of above + (time-adjust-ratio float :offset-assert 88) ;; 1, if the game runs at 60fps NTSC with clock-ratio = 1. ) :method-count-assert 15 :size-assert #x5c :flag-assert #xf0000005c (:methods (new (symbol type int) _type_ 0) - (dummy-9 (_type_ float) none 9) - (dummy-10 () none 10) - (dummy-11 () none 11) - (dummy-12 () none 12) - (dummy-13 () none 13) - (dummy-14 () none 14) + (update-rates! (_type_ float) float 9) + (advance-by! (_type_ float) clock 10) + (tick! (_type_) clock 11) + (save! (_type_ (pointer uint64)) int 12) + (load! (_type_ (pointer uint64)) int 13) + (reset! (_type_) none 14) ) ) (deftype thread (basic) - ((name basic :offset-assert 4) + ((name symbol :offset-assert 4) (process process :offset-assert 8) ;; guessed by decompiler (previous thread :offset-assert 12) ;; guessed by decompiler (suspend-hook (function cpu-thread none) :offset-assert 16) ;; guessed by decompiler @@ -349,7 +362,7 @@ :flag-assert #x1000000024 ;; Failed to read fields. (:methods - (new (symbol type int int basic) _type_ 0) + (new (symbol type int int string) _type_ 0) (dummy-13 () none 13) (get-process (_type_ type int) process 14) (return-process (_type_ process) none 15) @@ -388,7 +401,7 @@ :flag-assert #x1c00000068 ;; Failed to read fields. (:methods - (new (symbol type basic int int) _type_ 0) + (new (symbol type string int int) _type_ 0) (init (_type_ symbol int) none 16) (compact (dead-pool-heap int) none 17) (shrink-heap (dead-pool-heap process) dead-pool-heap 18) @@ -404,8 +417,6 @@ ) ) - - (deftype stack-frame (basic) ((name symbol :offset 4) (next stack-frame :offset 8) ;; which way does this point? @@ -500,7 +511,7 @@ (deftype process (process-tree) ((pool dead-pool) - (status basic :offset-assert 40) + (status symbol :offset-assert 40) (pid int32) (main-thread cpu-thread :offset-assert 48) (top-thread cpu-thread :offset-assert 52) @@ -518,28 +529,10 @@ (heap-cur pointer :offset-assert 104) (stack-frame-top stack-frame :offset-assert 108) (connection-list connectable :inline :offset-assert 112) - - ; (pool dead-pool :offset-assert 36) - ; (status basic :offset-assert 40) - ; (pid int32 :offset-assert 44) - ; (main-thread cpu-thread :offset-assert 48) - ; (top-thread thread :offset-assert 52) - ; (entity entity-actor :offset-assert 56) - ; (state state :offset-assert 60) - ; (trans-hook function :offset-assert 64) - ; (post-hook function :offset-assert 68) - ; (event-hook (function process int symbol event-message-block object) :offset-assert 72) - ; (allocated-length int32 :offset-assert 76) - ; (next-state state :offset-assert 80) - ; (heap-base pointer :offset-assert 84) - ; (heap-top pointer :offset-assert 88) - ; (heap-cur pointer :offset-assert 92) - ; (stack-frame-top stack-frame :offset-assert 96) - ; (connection-list connectable :inline :offset-assert 112) ;; can be a connection (stack uint8 :dynamic :offset-assert 128) ) (:methods - (new (symbol type basic int) _type_ 0) + (new (symbol type string int) _type_ 0) ) (:states dead-state @@ -592,7 +585,7 @@ (define-extern *global-search-name* basic) (define-extern *global-search-count* int) (define-extern process-by-name (function string process-tree process)) -(define-extern process-not-name (function object process-tree process)) +(define-extern process-not-name (function string process-tree process)) (define-extern process-count (function process-tree int)) (define-extern kill-by-name (function string process-tree symbol)) (define-extern kill-by-type (function type process-tree symbol)) @@ -617,7 +610,7 @@ (define-extern entity-deactivate-handler (function process entity-actor none)) (define-extern *listener-process* process) (define-extern *null-process* process) -(define-extern *vis-boot* basic) +(define-extern *vis-boot* symbol) (define-extern *kernel-clock* clock) (define-extern *16k-dead-pool* dead-pool) (define-extern *8k-dead-pool* dead-pool) @@ -693,7 +686,7 @@ (define-extern string-suffix= (function string string symbol)) (define-extern string-position (function string string int)) (define-extern string-charp= (function string (pointer uint8) symbol)) -(define-extern name= (function basic basic symbol)) +(define-extern name= (function object object symbol)) (define-extern copyn-string<-charp (function string (pointer uint8) int string)) (define-extern string<-charp (function string (pointer uint8) string)) (define-extern charp<-string (function (pointer uint8) string int)) @@ -770,6 +763,10 @@ ;; types-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(deftype part-id (uint32) + () + :flag-assert #x900000004 + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; vu1-macros ;; @@ -780,7 +777,32 @@ ;; math ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(deftype rgba (uint32) + ((r uint8 :offset 0) + (g uint8 :offset 8) + (b uint8 :offset 16) + (a uint8 :offset 24) + ) + :flag-assert #x900000004 + :no-runtime-type + ) + +(deftype float-type (uint32) + () + :flag-assert #x900000004 + :no-runtime-type + ) + +(deftype xyzw (uint128) + () + :flag-assert #x900000010 + ) + +(deftype xyzwh (uint128) + () + :flag-assert #x900000010 + ) + (deftype random-generator (basic) ((seed uint32 :offset-assert 4) ) @@ -788,455 +810,375 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -;; (define-extern truncate object) ;; (function float float) -;; (define-extern floor object) -;; (define-extern ceil object) -;; (define-extern integral? object) ;; (function float symbol) -;; (define-extern fractional-part object) ;; (function float float) -;; (define-extern sawtooth-wave object) -;; (define-extern triangle-wave object) -;; (define-extern log-x-plus-1-order9 object) -;; (define-extern logf object) -;; (define-extern log2f object) -;; (define-extern exp-slead object) ;; (pointer float) -;; (define-extern exp-strail object) ;; (pointer float) -;; (define-extern exp object) ;; (function float float) -;; (define-extern pow object) -;; (define-extern print-exp object) -;; (define-extern print-time object) -;; (define-extern log2 object) ;; (function int int) -;; (define-extern seek object) ;; (function float float float float) -;; (define-extern seek-ease object) -;; (define-extern seek-ease-in-out object) -;; (define-extern lerp object) ;; (function float float float float) -;; (define-extern lerp-scale-old object) -;; (define-extern lerp-scale object) ;; (function float float float float float float) -;; (define-extern lerp-clamp object) ;; (function float float float float) -;; (define-extern seekl object) ;; (function int int int int) -;; (define-extern rand-vu-init object) ;; (function float float) -;; (define-extern rand-vu object) ;; (function float) -;; (define-extern rand-vu-nostep object) ;; (function float) -;; (define-extern rand-vu-float-range object) ;; (function float float float) -;; (define-extern rand-vu-percent? object) ;; (function float symbol) -;; (define-extern rand-vu-int-range object) ;; (function int int int) -;; (define-extern rand-vu-int-count object) ;; (function int int) -;; (define-extern rand-vu-int-count-excluding object) -;; (define-extern rand-vu-int-range-exclude object) -;; (define-extern *random-generator* object) ;; random-generator -;; (define-extern rand-uint31-gen object) ;; (function random-generator uint) -;; (define-extern cube-root object) -;; (define-extern int-noise object) -;; (define-extern smooth-step object) -;; (define-extern smooth-interp object) +(define-extern truncate (function float float)) +(define-extern floor (function float float)) +(define-extern ceil (function float float)) +(define-extern integral? (function float symbol)) +(define-extern fractional-part (function float float)) +(define-extern sawtooth-wave (function float float)) +(define-extern triangle-wave (function float float)) +(define-extern log-x-plus-1-order9 (function float float)) +(define-extern logf (function float float)) +(define-extern log2f (function float float)) +(define-extern exp-slead (pointer float)) +(define-extern exp-strail (pointer float)) +(define-extern exp (function float float)) +(define-extern pow (function float float float)) +(define-extern print-exp (function float none)) +(define-extern print-time (function object time-frame none)) +(define-extern log2 (function int int)) +(define-extern seek (function float float float float)) +(define-extern seek-ease (function float float float float float float)) +(define-extern seek-ease-in-out (function float float float float float float float float)) +(define-extern lerp (function float float float float)) +(define-extern lerp-scale-old (function float float float float float float)) +(define-extern lerp-scale (function float float float float float float)) +(define-extern lerp-clamp (function float float float float)) +(define-extern seekl (function int int int int)) +(define-extern rand-vu-init (function float float)) +(define-extern rand-vu (function float)) +(define-extern rand-vu-nostep (function float)) +(define-extern rand-vu-float-range (function float float float)) +(define-extern rand-vu-percent? (function float symbol)) +(define-extern rand-vu-int-range (function int int int)) +(define-extern rand-vu-int-count (function int int)) +(define-extern rand-vu-int-count-excluding (function int int int)) +(define-extern rand-vu-int-range-exclude (function int int int int)) +(define-extern *random-generator* random-generator) +(define-extern rand-uint31-gen (function random-generator uint)) +(define-extern cube-root (function float float)) +(define-extern int-noise (function int float)) +(define-extern smooth-step (function float float)) +(define-extern smooth-interp (function float float float float float float)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; vector-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| -(deftype vector (structure) - () - :method-count-assert 9 - :size-assert #x10 - :flag-assert #x900000010 - ;; Failed to read fields. - ) -|# - -#| (deftype bit-array (basic) ((length int32 :offset-assert 4) (allocated-length int32 :offset-assert 8) + (_pad uint8 :offset-assert 12) + (bytes uint8 :dynamic :offset 12) ) :method-count-assert 13 :size-assert #xd :flag-assert #xd0000000d (:methods - ;; (new (symbol type int) _type_ 0) - (dummy-9 () none 9) ;; (get-bit (_type_ int) symbol 9) - (dummy-10 () none 10) ;; (clear-bit (_type_ int) int 10) - (dummy-11 () none 11) ;; (set-bit (_type_ int) int 11) - (dummy-12 () none 12) ;; (clear-all! (_type_) _type_ 12) + (new (symbol type int) _type_ 0) + (get-bit (_type_ int) symbol 9) + (clear-bit (_type_ int) int 10) + (set-bit (_type_ int) int 11) + (clear-all! (_type_) _type_ 12) ) ) -|# -#| + (deftype vector16ub (structure) - ((data UNKNOWN 16 :offset-assert 0) - (quad uint128 :offset-assert 0) + ((data uint8 16 :offset-assert 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype vector4ub (structure) - ((data uint8 4 :offset-assert 0) ;; guessed by decompiler - (x uint8 :offset-assert 0) - (y uint8 :offset-assert 1) - (z uint8 :offset-assert 2) - (w uint8 :offset-assert 3) - (clr uint32 :offset-assert 0) + ((data uint8 4 :offset-assert 0) + (x uint8 :offset 0) + (y uint8 :offset 1) + (z uint8 :offset 2) + (w uint8 :offset 3) + (clr uint32 :offset 0) ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype vector4b (structure) - ((data int8 4 :offset-assert 0) ;; guessed by decompiler - (x int8 :offset-assert 0) - (y int8 :offset-assert 1) - (z int8 :offset-assert 2) - (w int8 :offset-assert 3) - (clr int32 :offset-assert 0) + ((data int8 4 :offset-assert 0) + (x int8 :offset 0) + (y int8 :offset 1) + (z int8 :offset 2) + (w int8 :offset 3) + (clr int32 :offset 0) ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype vector2ub (structure) - ((data UNKNOWN 2 :offset-assert 0) - (x uint8 :offset-assert 0) - (y uint8 :offset-assert 1) - (clr uint16 :offset-assert 0) + ((data uint8 2 :offset-assert 0) + (x uint8 :offset 0) + (y uint8 :offset 1) + (clr uint16 :offset 0) ) :method-count-assert 9 :size-assert #x2 :flag-assert #x900000002 ) -|# -#| (deftype vector2b (structure) - ((data UNKNOWN 2 :offset-assert 0) - (x int8 :offset-assert 0) - (y int8 :offset-assert 1) - (clr int16 :offset-assert 0) + ((data int8 2 :offset-assert 0) + (x int8 :offset 0) + (y int8 :offset 1) + (clr int16 :offset 0) ) :method-count-assert 9 :size-assert #x2 :flag-assert #x900000002 ) -|# -#| (deftype vector2h (structure) - ((data int16 2 :offset-assert 0) ;; guessed by decompiler - (x int16 :offset-assert 0) - (y int16 :offset-assert 2) + ((data int16 2 :offset-assert 0) + (x int16 :offset 0) + (y int16 :offset 2) ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype vector2uh (structure) - ((data uint16 2 :offset-assert 0) ;; guessed by decompiler - (x uint16 :offset-assert 0) - (y uint16 :offset-assert 2) - (val uint32 :offset-assert 0) + ((data uint16 2 :offset-assert 0) + (x uint16 :offset 0) + (y uint16 :offset 2) + (val uint32 :offset 0) ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype vector3h (structure) - ((data int16 3 :offset-assert 0) ;; guessed by decompiler - (x int16 :offset-assert 0) - (y int16 :offset-assert 2) - (z int16 :offset-assert 4) + ((data int16 3 :offset-assert 0) + (x int16 :offset 0) + (y int16 :offset 2) + (z int16 :offset 4) ) :method-count-assert 9 :size-assert #x6 :flag-assert #x900000006 ) -|# -#| (deftype vector3uh (structure) - ((data UNKNOWN 3 :offset-assert 0) - (x uint16 :offset-assert 0) - (y uint16 :offset-assert 2) - (z uint16 :offset-assert 4) + ((data uint16 3 :offset-assert 0) + (x uint16 :offset 0) + (y uint16 :offset 2) + (z uint16 :offset 4) ) :method-count-assert 9 :size-assert #x6 :flag-assert #x900000006 ) -|# -#| (deftype vector2w (structure) - ((data int32 2 :offset-assert 0) ;; guessed by decompiler - (x int32 :offset-assert 0) - (y int32 :offset-assert 4) + ((data int32 2 :offset-assert 0) + (x int32 :offset 0) + (y int32 :offset 4) ) :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype vector3w (structure) - ((data int32 3 :offset-assert 0) ;; guessed by decompiler - (x int32 :offset-assert 0) - (y int32 :offset-assert 4) - (z int32 :offset-assert 8) + ((data int32 3 :offset-assert 0) + (x int32 :offset 0) + (y int32 :offset 4) + (z int32 :offset 8) ) :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c ) -|# -#| (deftype vector4w (structure) - ((data uint32 4 :offset-assert 0) ;; guessed by decompiler - (x int32 :offset-assert 0) - (y int32 :offset-assert 4) - (z int32 :offset-assert 8) - (w int32 :offset-assert 12) - (dword uint64 2 :offset-assert 0) ;; guessed by decompiler - (quad uint128 :offset-assert 0) + ((data uint32 4 :offset-assert 0) + (x int32 :offset 0) + (y int32 :offset 4) + (z int32 :offset 8) + (w int32 :offset 12) + (dword uint64 2 :offset 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype vector2 (structure) - ((data UNKNOWN 2 :offset-assert 0) - (x float :offset-assert 0) - (y float :offset-assert 4) + ((data float 2 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) ) + :allow-misaligned :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype vector3 (structure) - ((data UNKNOWN 3 :offset-assert 0) - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) + ((data float 3 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) + (z float :offset 8) ) :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c ) -|# -#| (deftype vector4 (structure) - ((data UNKNOWN 4 :offset-assert 0) - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (dword UNKNOWN 2 :offset-assert 0) - (quad uint128 :offset-assert 0) + ((data float 4 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) + (z float :offset 8) + (w float :offset 12) + (dword uint64 2 :offset 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype vector4w-2 (structure) - ((data int32 8 :offset-assert 0) ;; guessed by decompiler - (quad uint128 2 :offset-assert 0) ;; guessed by decompiler - (vector vector4w 2 :offset-assert 0) ;; guessed by decompiler + ((data int32 8 :offset-assert 0) + (quad uint128 2 :offset 0) + (vector vector4w 2 :inline :offset 0) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| (deftype vector4w-3 (structure) - ((data int32 12 :offset-assert 0) ;; guessed by decompiler - (quad uint128 3 :offset-assert 0) ;; guessed by decompiler - (vector vector4w 3 :offset-assert 0) ;; guessed by decompiler + ((data int32 12 :offset-assert 0) + (quad uint128 3 :offset 0) + (vector vector4w 3 :inline :offset 0) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype vector4w-4 (structure) - ((data int32 16 :offset-assert 0) ;; guessed by decompiler - (quad uint128 4 :offset-assert 0) ;; guessed by decompiler - (vector vector4w 4 :offset-assert 0) ;; guessed by decompiler + ((data int32 16 :offset-assert 0) + (quad uint128 4 :offset 0) + (vector vector4w 4 :inline :offset 0) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype vector4h (structure) - ((data int16 4 :offset-assert 0) ;; guessed by decompiler - (x int16 :offset-assert 0) - (y int16 :offset-assert 2) - (z int16 :offset-assert 4) - (w int16 :offset-assert 6) - (long uint64 :offset-assert 0) + ((data int16 4 :offset-assert 0) + (x int16 :offset 0) + (y int16 :offset 2) + (z int16 :offset 4) + (w int16 :offset 6) + (long uint64 :offset 0) ) :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype vector8h (structure) - ((data int16 8 :offset-assert 0) ;; guessed by decompiler - (quad uint128 :offset-assert 0) + ((data int16 8 :offset-assert 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype vector16b (structure) - ((data int8 16 :offset-assert 0) ;; guessed by decompiler - (quad uint128 :offset-assert 0) + ((data int8 16 :offset-assert 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype vector4s-3 (structure) - ((data float 12 :offset-assert 0) ;; guessed by decompiler - (quad uint128 3 :offset-assert 0) ;; guessed by decompiler - (vector vector 3 :offset-assert 0) ;; guessed by decompiler + ((data float 12 :offset-assert 0) + (quad uint128 3 :offset 0) + (vector vector 3 :inline :offset 0) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype vector-array (inline-array-class) - ((data vector :dynamic :offset-assert 16) ;; guessed by decompiler + ((data vector :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype rgbaf (vector) - ((data float 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (quad uint128 :offset-assert 0) - (r float :offset-assert 0) - (g float :offset-assert 4) - (b float :offset-assert 8) - (a float :offset-assert 12) + ((r float :offset 0) + (g float :offset 4) + (b float :offset 8) + (a float :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype plane (vector) - ((data float 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (quad uint128 :offset-assert 0) - (a float :offset-assert 0) - (b float :offset-assert 4) - (c float :offset-assert 8) - (d float :offset-assert 12) + ((a float :offset 0) + (b float :offset 4) + (c float :offset 8) + (d float :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype sphere (vector) - ((data float 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (quad uint128 :offset-assert 0) - (r float :offset-assert 12) + ((r float :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| +(deftype isphere (vec4s) + () + ) + (deftype box8s (structure) - ((data float 8 :offset-assert 0) ;; guessed by decompiler - (quad uint128 2 :offset-assert 0) ;; guessed by decompiler - (vector vector 2 :offset-assert 0) ;; guessed by decompiler - (min vector :inline :offset-assert 0) - (max vector :inline :offset-assert 16) + ((data float 8 :offset-assert 0) + (quad uint128 2 :offset 0) + (vector vector 2 :offset 0) + (min vector :inline :offset 0) + (max vector :inline :offset 16) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| (deftype box8s-array (inline-array-class) - ((data box8s :dynamic :offset-assert 16) ;; guessed by decompiler + ((data box8s :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype cylinder (structure) ((origin vector :inline :offset-assert 0) (axis vector :inline :offset-assert 16) @@ -1247,13 +1189,11 @@ :size-assert #x28 :flag-assert #xb00000028 (:methods - (dummy-9 () none 9) ;; (debug-draw (_type_ vector4w) none 9) - (dummy-10 () none 10) ;; (ray-capsule-intersect (_type_ vector vector) float 10) + (debug-draw (_type_ vector4w) none 9) + (ray-capsule-intersect (_type_ vector vector) float 10) ) ) -|# -#| (deftype cylinder-flat (structure) ((origin vector :inline :offset-assert 0) (axis vector :inline :offset-assert 16) @@ -1264,81 +1204,72 @@ :size-assert #x28 :flag-assert #xb00000028 (:methods - (dummy-9 () none 9) ;; (debug-draw (_type_ vector4w) none 9) - (dummy-10 () none 10) ;; (ray-flat-cyl-intersect (_type_ vector vector) float 10) + (debug-draw (_type_ vector4w) none 9) + (ray-flat-cyl-intersect (_type_ vector vector) float 10) ) ) -|# -#| (deftype vertical-planes (structure) - ((data uint128 4 :offset-assert 0) ;; guessed by decompiler + ((data uint128 4 :offset-assert 0) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype vertical-planes-array (basic) - ((length uint32 :offset-assert 4) - (data vertical-planes :dynamic :offset-assert 16) ;; guessed by decompiler + ((length uint32 :offset-assert 4) + (data vertical-planes :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype qword (structure) - ((data uint32 4 :offset-assert 0) ;; guessed by decompiler - (byte uint8 16 :offset-assert 0) ;; guessed by decompiler - (hword uint16 8 :offset-assert 0) ;; guessed by decompiler - (word uint32 4 :offset-assert 0) ;; guessed by decompiler - (dword uint64 2 :offset-assert 0) ;; guessed by decompiler - (quad uint128 :offset-assert 0) - (vector vector :inline :offset-assert 0) - (vector4w vector4w :inline :offset-assert 0) + ((data uint32 4 :offset-assert 0) + (byte uint8 16 :offset 0) + (hword uint16 8 :offset 0) + (word uint32 4 :offset 0) + (dword uint64 2 :offset 0) + (quad uint128 :offset 0) + (vector vector :inline :offset 0) + (vector4w vector4w :inline :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype vector3s (structure) - ((data float 3 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) + ((data float 3 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) + (z float :offset 8) ) :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c ) -|# -;; (define-extern *null-vector* object) ;; vector -;; (define-extern *identity-vector* object) ;; vector -;; (define-extern *x-vector* object) ;; vector -;; (define-extern *y-vector* object) ;; vector -;; (define-extern *z-vector* object) ;; vector -;; (define-extern *up-vector* object) ;; vector -;; (define-extern vector-dot object) ;; (function vector vector float) -;; (define-extern vector-dot-vu object) ;; (function vector vector float) -;; (define-extern vector4-dot object) ;; (function vector vector float) -;; (define-extern vector4-dot-vu object) ;; (function vector vector float) -;; (define-extern vector+! object) ;; (function vector vector vector vector) -;; (define-extern vector-! object) ;; (function vector vector vector vector) -;; (define-extern vector-zero! object) ;; (function vector vector) -;; (define-extern vector-reset! object) ;; (function vector vector) -;; (define-extern vector-copy! object) ;; (function vector vector vector) -;; (define-extern vector-length< object) -;; (define-extern vector-length> object) -;; (define-extern *zero-vector* object) ;; vector +(define-extern *null-vector* vector) +(define-extern *identity-vector* vector) +(define-extern *x-vector* vector) +(define-extern *y-vector* vector) +(define-extern *z-vector* vector) +(define-extern *up-vector* vector) +(define-extern vector-dot (function vector vector float)) +(define-extern vector-dot-vu (function vector vector float)) +(define-extern vector4-dot (function vector vector float)) +(define-extern vector4-dot-vu (function vector vector float)) +(define-extern vector+! (function vector vector vector vector)) +(define-extern vector-! (function vector vector vector vector)) +(define-extern vector-zero! (function vector vector)) +(define-extern vector-reset! (function vector vector)) +(define-extern vector-copy! (function vector vector vector)) +(define-extern vector-length< (function vector float symbol)) +(define-extern vector-length> (function vector float symbol)) +(define-extern *zero-vector* vector) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; gravity-h ;; @@ -1349,7 +1280,6 @@ ;; bounding-box-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype bounding-box (structure) ((min vector :inline :offset-assert 0) (max vector :inline :offset-assert 16) @@ -1358,23 +1288,22 @@ :size-assert #x20 :flag-assert #x1500000020 (:methods - (dummy-9 () none 9) ;; (add-spheres! (_type_ (inline-array sphere) int) int 9) - (dummy-10 () none 10) ;; (add-point! (_type_ vector3s) int 10) - (dummy-11 () none 11) ;; (set-from-point-offset! (_type_ vector3s vector3s) int 11) - (dummy-12 () none 12) ;; (set-from-point-offset-pad! (_type_ vector3s vector3s float) int 12) - (dummy-13 () none 13) ;; (set-from-sphere! (_type_ sphere) int 13) - (dummy-14 () none 14) ;; (set-from-spheres! (_type_ (inline-array sphere) int) int 14) - (dummy-15 () none 15) ;; (add-box! (_type_ bounding-box) int 15) - (dummy-16 () none 16) - (dummy-17 () none 17) - (dummy-18 () none 18) - (dummy-19 () none 19) - (dummy-20 () none 20) + (add-spheres! (_type_ (inline-array sphere) int) int 9) + (add-box! (_type_ bounding-box) int 10) + (add-point! (_type_ vector) none 11) + (intersects-line-segment? (_type_ vector vector) symbol 12) + (set-from-point-offset! (_type_ vector vector) none 13) + (set-from-point-offset-pad! (_type_ vector vector float) int 14) + (set-to-point! (_type_ vector vector float) none 15) + (set-from-sphere! (_type_ sphere) none 16) + (set-from-spheres! (_type_ (inline-array sphere) int) int 17) + (get-bounding-sphere (_type_ vector) vector 18) + (inside-xyz? (bounding-box vector) symbol 19) + (inside-xz? (bounding-box vector) symbol 20) ) ) -|# -#| + (deftype bounding-box4w (structure) ((min vector4w :inline :offset-assert 0) (max vector4w :inline :offset-assert 16) @@ -1383,9 +1312,9 @@ :size-assert #x20 :flag-assert #x900000020 ) -|# -#| + + (deftype bounding-box-both (structure) ((box bounding-box :inline :offset-assert 0) (box4w bounding-box4w :inline :offset-assert 32) @@ -1394,114 +1323,97 @@ :size-assert #x40 :flag-assert #x900000040 ) -|# -#| + + (deftype bounding-box-array (inline-array-class) - ((data UNKNOWN :dynamic :offset-assert 16) + ((data bounding-box :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; matrix-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype matrix (structure) - ((data float 16 :offset-assert 0) ;; guessed by decompiler - (vector vector 4 :offset-assert 0) ;; guessed by decompiler - (quad uint128 4 :offset-assert 0) ;; guessed by decompiler - (trans vector :inline :offset-assert 48) + ((data float 16 :offset-assert 0) + (vector vector 4 :offset 0) + (quad uint128 4 :offset 0) + (trans vector :inline :offset 48) ) :method-count-assert 10 :size-assert #x40 :flag-assert #xa00000040 (:methods - (dummy-9 () none 9) ;; (transform-vectors! (_type_ (inline-array vector) (inline-array vector) int) none 9) + (transform-vectors! (_type_ (inline-array vector) (inline-array vector) int) none 9) ) ) -|# -#| (deftype matrix3 (structure) - ((data float 12 :offset-assert 0) ;; guessed by decompiler - (vector vector 3 :offset-assert 0) ;; guessed by decompiler - (quad uint128 3 :offset-assert 0) ;; guessed by decompiler + ((data float 12 :offset-assert 0) + (vector vector 3 :offset 0) + (quad uint128 3 :offset 0) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype matrix4h (structure) - ((data int16 16 :offset-assert 0) ;; guessed by decompiler - (vector4h vector4h 4 :offset-assert 0) ;; guessed by decompiler - (long int64 4 :offset-assert 0) ;; guessed by decompiler + ((data int16 16 :offset-assert 0) + (vector4h vector4h 4 :offset 0) + (long int64 4 :offset 0) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -;; (define-extern matrix-copy! object) ;; (function matrix matrix matrix) +(define-extern matrix-copy! (function matrix matrix matrix)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; quaternion-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype quaternion (structure) - ((data float 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (vec vector :inline :offset-assert 0) - (quad uint128 :offset-assert 0) + ((data float 4 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) + (z float :offset 8) + (w float :offset 12) + (vec vector :inline :offset 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -;; (define-extern *unity-quaternion* object) ;; quaternion +(define-extern *unity-quaternion* quaternion) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; euler-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype euler-angles (vector) - ((data float 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (quad uint128 :offset-assert 0) - ) + () :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -;; (define-extern EulSafe object) ;; (array int32) -;; (define-extern EulNext object) ;; (array int32) +(define-extern EulSafe (array int32)) +(define-extern EulNext (array int32)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; transform-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype transform (structure) ((trans vector :inline :offset-assert 0) (rot vector :inline :offset-assert 16) @@ -1511,9 +1423,7 @@ :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype trs (basic) ((trans vector :inline :offset-assert 16) (rot vector :inline :offset-assert 32) @@ -1523,18 +1433,15 @@ :size-assert #x40 :flag-assert #x900000040 ) -|# - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; geometry-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype curve (structure) - ((cverts (inline-array vector) :offset-assert 0) ;; guessed by decompiler + ((cverts (inline-array vector) :offset-assert 0) (num-cverts int32 :offset-assert 4) - (knots (pointer float) :offset-assert 8) ;; guessed by decompiler + (knots (pointer float) :offset-assert 8) (num-knots int32 :offset-assert 12) (length float :offset-assert 16) ) @@ -1542,11 +1449,9 @@ :size-assert #x14 :flag-assert #x900000014 ) -|# -#| (deftype border-plane (basic) - ((name symbol :offset-assert 4) ;; guessed by decompiler + ((name symbol :offset-assert 4) (action basic :offset-assert 8) (slot int8 :offset-assert 12) (trans vector :inline :offset-assert 16) @@ -1556,11 +1461,10 @@ :size-assert #x30 :flag-assert #xb00000030 (:methods - (dummy-9 () none 9) ;; (debug-draw! (_type_) none 9) - (dummy-10 () none 10) ;; (point-past-plane? (_type_ vector) symbol 10) + (debug-draw! (_type_) none 9) + (point-past-plane? (_type_ vector) symbol 10) ) ) -|# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1572,30 +1476,25 @@ ;; transformq-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype transformq (transform) - ((quat quaternion :inline :offset-assert 16) + ((quat quaternion :inline :offset 16) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype trsq (trs) - ((quat quaternion :inline :offset-assert 32) + ((quat quaternion :inline :offset 32) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype trsqv (trsq) - ((pause-adjust-distance meters :offset-assert 4) - (nav-radius meters :offset-assert 8) + ((pause-adjust-distance meters :offset 4) + (nav-radius meters :offset 8) (transv vector :inline :offset-assert 64) (rotv vector :inline :offset-assert 80) (scalev vector :inline :offset-assert 96) @@ -1620,22 +1519,20 @@ (dummy-19 () none 19) ;; (set-heading-vec-clear-roll-pitch! (_type_ vector) quaternion 19) (dummy-20 () none 20) ;; (point-toward-point-clear-roll-pitch! (_type_ vector) quaternion 20) (dummy-21 () none 21) ;; (rot->dir-targ! (_type_) quaternion 21) - (dummy-22 () none 22) ;; (y-angle (_type_) float 22) - (dummy-23 () none 23) ;; (global-y-angle-to-point (_type_ vector) float 23) - (dummy-24 () none 24) ;; (relative-y-angle-to-point (_type_ vector) float 24) + (y-angle (_type_) float 22) + (global-y-angle-to-point (_type_ vector) float 23) + (relative-y-angle-to-point (_type_ vector) float 24) (dummy-25 () none 25) ;; (roll-relative-to-gravity (_type_) float 25) (dummy-26 () none 26) ;; (set-and-limit-velocity (_type_ int vector float) trsqv 26) (dummy-27 () none 27) ;; (get-quaternion (_type_) quaternion 27) ) ) -|# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; bounding-box ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype liang-barsky-line-clip-params (structure) ((te float :offset-assert 0) (tl float :offset-assert 4) @@ -1644,259 +1541,276 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -;; (define-extern box-vector-enside? object) ;; (function bounding-box vector symbol) -;; (define-extern box-vector-inside? object) ;; (function bounding-box vector symbol) -;; (define-extern liang-barsky-line-clipt object) +(define-extern box-vector-enside? (function bounding-box vector symbol)) +(define-extern box-vector-inside? (function bounding-box vector symbol)) +(define-extern liang-barsky-line-clipt (function liang-barsky-line-clip-params float float symbol)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; matrix ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| -(deftype matrix (structure) - () - :method-count-assert 10 - :size-assert #x40 - :flag-assert #xa00000040 - ;; Failed to read fields. - (:methods - (dummy-9 () none 9) ;; (transform-vectors! (_type_ (inline-array vector) (inline-array vector) int) none 9) - ) - ) -|# - -#| -(deftype matrix3 (structure) - () - :method-count-assert 9 - :size-assert #x30 - :flag-assert #x900000030 - ;; Failed to read fields. - ) -|# - -;; (define-extern matrix-identity! object) ;; (function matrix matrix) -;; (define-extern *identity-matrix* object) ;; matrix -;; (define-extern *hermite-matrix* object) -;; (define-extern matrix+! object) ;; (function matrix matrix matrix matrix) -;; (define-extern matrix-! object) ;; (function matrix matrix matrix matrix) -;; (define-extern matrix*! object) ;; (function matrix matrix matrix matrix) -;; (define-extern matrixp*! object) ;; (function matrix matrix matrix matrix) -;; (define-extern vector-matrix*! object) ;; (function vector vector matrix vector) -;; (define-extern vector-rotate*! object) ;; (function vector vector matrix vector) -;; (define-extern vector3s-matrix*! object) ;; (function vector3s vector3s matrix vector3s) -;; (define-extern vector3s-rotate*! object) ;; (function vector3s vector3s matrix vector3s) -;; (define-extern matrix-transpose! object) ;; (function matrix matrix matrix) -;; (define-extern matrix-inverse-of-rot-trans! object) ;; (function matrix matrix matrix) -;; (define-extern matrix-4x4-inverse! object) ;; (function matrix matrix matrix) -;; (define-extern matrix-translate! object) ;; (function matrix vector matrix) -;; (define-extern matrix-translate+! object) ;; (function matrix matrix vector matrix) -;; (define-extern matrix-scale! object) ;; (function matrix vector matrix) -;; (define-extern scale-matrix! object) ;; (function matrix vector matrix matrix) -;; (define-extern matrix-inv-scale! object) ;; (function matrix vector matrix) -;; (define-extern column-scale-matrix! object) ;; (function matrix vector matrix matrix) -;; (define-extern matrix-rotate-x! object) ;; (function matrix float matrix) -;; (define-extern matrix-rotate-y! object) ;; (function matrix float matrix) -;; (define-extern matrix-rotate-z! object) ;; (function matrix float matrix) -;; (define-extern matrix-rotate-zyx! object) ;; (function matrix vector matrix) -;; (define-extern matrix-rotate-xyz-2! object) -;; (define-extern matrix-rotate-xyz! object) ;; (function matrix vector matrix) -;; (define-extern matrix-rotate-zxy! object) ;; (function matrix vector matrix) -;; (define-extern matrix-rotate-yxz! object) ;; (function matrix vector matrix) -;; (define-extern matrix-rotate-yzx! object) ;; (function matrix vector matrix) -;; (define-extern matrix-rotate-yxy! object) ;; (function matrix vector matrix) -;; (define-extern matrix-rotate-yx! object) ;; (function matrix float float matrix) -;; (define-extern matrix-axis-sin-cos-vu! object) ;; (function matrix vector float float none) -;; (define-extern matrix-axis-sin-cos! object) ;; (function matrix vector float float matrix) -;; (define-extern matrix-axis-angle! object) ;; (function matrix vector float none) -;; (define-extern matrix-lerp! object) ;; (function matrix matrix matrix float matrix) -;; (define-extern matrix-3x3-determinant object) ;; (function matrix float) -;; (define-extern matrix3-determinant object) ;; (function matrix float) -;; (define-extern matrix-3x3-inverse! object) ;; (function matrix matrix matrix) -;; (define-extern matrix-3x3-inverse-transpose! object) ;; (function matrix matrix matrix) -;; (define-extern matrix3-inverse-transpose! object) ;; (function matrix matrix matrix) -;; (define-extern matrix-3x3-normalize! object) -;; (define-extern matrix-4x4-determinant object) ;; (function matrix float) -;; (define-extern matrix-4x4-inverse-transpose! object) ;; (function matrix matrix matrix) -;; (define-extern matrix-y-angle object) ;; (function matrix float) -;; (define-extern matrix->trans object) -;; (define-extern matrix<-trans object) -;; (define-extern matrix->scale object) -;; (define-extern matrix<-scale object) -;; (define-extern matrix->quat object) -;; (define-extern matrix<-quat object) -;; (define-extern matrix->transformq object) -;; (define-extern matrix-mirror! object) +(define-extern matrix-identity! (function matrix matrix)) +(define-extern *identity-matrix* matrix) +(define-extern *hermite-matrix* matrix) +(define-extern matrix+! (function matrix matrix matrix matrix)) +(define-extern matrix-! (function matrix matrix matrix matrix)) +(define-extern matrix*! (function matrix matrix matrix matrix)) +(define-extern matrixp*! (function matrix matrix matrix matrix)) +(define-extern vector-matrix*! (function vector vector matrix vector)) +(define-extern vector-rotate*! (function vector vector matrix vector)) +(define-extern vector3s-matrix*! (function vector3s vector3s matrix vector3s)) +(define-extern vector3s-rotate*! (function vector3s vector3s matrix vector3s)) +(define-extern matrix-transpose! (function matrix matrix matrix)) +(define-extern matrix-inverse-of-rot-trans! (function matrix matrix matrix)) +(define-extern matrix-4x4-inverse! (function matrix matrix matrix)) +(define-extern matrix-translate! (function matrix vector matrix)) +(define-extern matrix-translate+! (function matrix matrix vector matrix)) +(define-extern matrix-scale! (function matrix vector matrix)) +(define-extern scale-matrix! (function matrix vector matrix matrix)) +(define-extern matrix-inv-scale! (function matrix vector matrix)) +(define-extern column-scale-matrix! (function matrix vector matrix matrix)) +(define-extern matrix-rotate-x! (function matrix float matrix)) +(define-extern matrix-rotate-y! (function matrix float matrix)) +(define-extern matrix-rotate-z! (function matrix float matrix)) +(define-extern matrix-rotate-zyx! (function matrix vector matrix)) +(define-extern matrix-rotate-xyz-2! (function matrix vector matrix)) +(define-extern matrix-rotate-xyz! (function matrix vector matrix)) +(define-extern matrix-rotate-zxy! (function matrix vector matrix)) +(define-extern matrix-rotate-yxz! (function matrix vector matrix)) +(define-extern matrix-rotate-yzx! (function matrix vector matrix)) +(define-extern matrix-rotate-yxy! (function matrix vector matrix)) +(define-extern matrix-rotate-yx! (function matrix float float matrix)) +(define-extern matrix-axis-sin-cos-vu! (function matrix vector float float none)) +(define-extern matrix-axis-sin-cos! (function matrix vector float float matrix)) +(define-extern matrix-axis-angle! (function matrix vector float none)) +(define-extern matrix-lerp! (function matrix matrix matrix float matrix)) +(define-extern matrix-3x3-determinant (function matrix float)) +(define-extern matrix3-determinant (function matrix float)) +(define-extern matrix-3x3-inverse! (function matrix matrix matrix)) +(define-extern matrix-3x3-inverse-transpose! (function matrix matrix matrix)) +(define-extern matrix3-inverse-transpose! (function matrix matrix matrix)) +(define-extern matrix-3x3-normalize! (function matrix matrix matrix)) +(define-extern matrix-4x4-determinant (function matrix float)) +(define-extern matrix-4x4-inverse-transpose! (function matrix matrix matrix)) +(define-extern matrix-y-angle (function matrix float)) +(define-extern matrix->trans (function matrix vector vector)) +(define-extern matrix<-trans (function matrix vector matrix)) +(define-extern matrix->scale (function matrix vector vector)) +(define-extern matrix<-scale (function matrix vector matrix)) +(define-extern matrix->quat (function matrix quaternion quaternion)) +(define-extern matrix<-quat (function matrix quaternion matrix)) +(define-extern matrix->transformq (function transformq matrix transformq)) +(define-extern matrix-mirror! (function matrix vector vector matrix)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; transform ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern transform-matrix-calc! object) ;; (function transform matrix matrix) -;; (define-extern transform-matrix-parent-calc! object) ;; (function transform matrix vector matrix) -;; (define-extern trs-matrix-calc! object) ;; (function trs matrix matrix) +(define-extern transform-matrix-calc! (function transform matrix matrix)) +(define-extern transform-matrix-parent-calc! (function transform matrix vector matrix)) +(define-extern trs-matrix-calc! (function trs matrix matrix)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; quaternion ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| -(deftype quaternion (structure) - () - :method-count-assert 9 - :size-assert #x10 - :flag-assert #x900000010 - ;; Failed to read fields. - ) -|# - -;; (define-extern quaternion-axis-angle! object) ;; (function quaternion float float float float quaternion) -;; (define-extern quaternion-vector-angle! object) ;; (function quaternion vector float quaternion) -;; (define-extern vector-angle<-quaternion! object) ;; (function vector quaternion vector) -;; (define-extern quaternion-look-at! object) -;; (define-extern quaternion-zero! object) ;; (function quaternion quaternion) -;; (define-extern quaternion-identity! object) ;; (function quaternion quaternion) -;; (define-extern quaternion-i! object) ;; (function quaternion quaternion) -;; (define-extern quaternion-j! object) ;; (function quaternion quaternion) -;; (define-extern quaternion-k! object) ;; (function quaternion quaternion) -;; (define-extern quaternion-copy! object) ;; (function quaternion quaternion quaternion) -;; (define-extern quaternion-set! object) ;; (function quaternion float float float float quaternion) -;; (define-extern quaternion+! object) ;; (function quaternion quaternion quaternion quaternion) -;; (define-extern quaternion-! object) ;; (function quaternion quaternion quaternion quaternion) -;; (define-extern quaternion-negate! object) ;; (function quaternion quaternion quaternion) -;; (define-extern quaternion-conjugate! object) ;; (function quaternion quaternion quaternion) -;; (define-extern quaternion-float*! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-float/! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-norm2 object) ;; (function quaternion float) -;; (define-extern quaternion-norm object) ;; (function quaternion float) -;; (define-extern quaternion-normalize! object) ;; (function quaternion quaternion) -;; (define-extern quaternion-inverse! object) ;; (function quaternion quaternion quaternion) -;; (define-extern quaternion-dot object) ;; (function quaternion quaternion float) -;; (define-extern quaternion*! object) ;; (function quaternion quaternion quaternion quaternion) -;; (define-extern quaternion-right-mult-matrix! object) ;; (function matrix quaternion matrix) -;; (define-extern quaternion-left-mult-matrix! object) ;; (function matrix quaternion matrix) -;; (define-extern quaternion->matrix object) ;; (function matrix quaternion matrix) -;; (define-extern quaternion->matrix-2 object) -;; (define-extern matrix->quaternion object) ;; (function quaternion matrix quaternion) -;; (define-extern matrix-with-scale->quaternion object) ;; (function quaternion matrix quaternion) -;; (define-extern quaternion-vector-len object) ;; (function quaternion float) -;; (define-extern quaternion-log! object) ;; (function quaternion quaternion quaternion) -;; (define-extern quaternion-exp! object) ;; (function quaternion quaternion quaternion) -;; (define-extern quaternion-slerp! object) ;; (function quaternion quaternion quaternion float quaternion) -;; (define-extern quaternion-pseudo-slerp! object) ;; (function quaternion quaternion quaternion float quaternion) -;; (define-extern quaternion-pseudo-seek object) -;; (define-extern quaternion-smooth-seek! object) -;; (define-extern quaternion-zxy! object) ;; (function quaternion vector quaternion) -;; (define-extern vector-x-quaternion! object) ;; (function vector quaternion vector) -;; (define-extern vector-y-quaternion! object) ;; (function vector quaternion vector) -;; (define-extern vector-z-quaternion! object) ;; (function vector quaternion vector) -;; (define-extern quaternion-x-angle object) -;; (define-extern quaternion-y-angle object) ;; (function quaternion float) -;; (define-extern quaternion-z-angle object) -;; (define-extern quaternion-vector-y-angle object) ;; (function quaternion vector float) -;; (define-extern quaternion-rotate-local-x! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-rotate-local-y! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-rotate-local-z! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-rotate-y! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-rotate-x! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-rotate-z! object) ;; (function quaternion quaternion float quaternion) -;; (define-extern quaternion-delta-y object) ;; (function quaternion quaternion float) -;; (define-extern quaternion-rotate-y-to-vector! object) ;; (function quaternion quaternion quaternion float quaternion) -;; (define-extern vector-rotate-x! object) -;; (define-extern vector-rotate-y! object) ;; (function vector vector float vector) -;; (define-extern vector-rotate-z! object) -;; (define-extern vector-y-angle object) ;; (function vector float) -;; (define-extern vector-x-angle object) ;; (function vector float) -;; (define-extern quaternion<-rotate-y-vector object) -;; (define-extern quaternion-validate object) ;; (function quaternion none) -;; (define-extern quaternion-xz-angle object) ;; (function quaternion float) +(define-extern quaternion-axis-angle! (function quaternion float float float float quaternion)) +(define-extern quaternion-vector-angle! (function quaternion vector float quaternion)) +(define-extern vector-angle<-quaternion! (function vector quaternion vector)) +(define-extern quaternion-look-at! (function vector vector vector quaternion)) +(define-extern quaternion-zero! (function quaternion quaternion)) +(define-extern quaternion-identity! (function quaternion quaternion)) +(define-extern quaternion-i! (function quaternion quaternion)) +(define-extern quaternion-j! (function quaternion quaternion)) +(define-extern quaternion-k! (function quaternion quaternion)) +(define-extern quaternion-copy! (function quaternion quaternion quaternion)) +(define-extern quaternion-set! (function quaternion float float float float quaternion)) +(define-extern quaternion+! (function quaternion quaternion quaternion quaternion)) +(define-extern quaternion-! (function quaternion quaternion quaternion quaternion)) +(define-extern quaternion-negate! (function quaternion quaternion quaternion)) +(define-extern quaternion-conjugate! (function quaternion quaternion quaternion)) +(define-extern quaternion-float*! (function quaternion quaternion float quaternion)) +(define-extern quaternion-float/! (function quaternion quaternion float quaternion)) +(define-extern quaternion-norm2 (function quaternion float)) +(define-extern quaternion-norm (function quaternion float)) +(define-extern quaternion-normalize! (function quaternion quaternion)) +(define-extern quaternion-inverse! (function quaternion quaternion quaternion)) +(define-extern quaternion-dot (function quaternion quaternion float)) +(define-extern quaternion*! (function quaternion quaternion quaternion quaternion)) +(define-extern quaternion-right-mult-matrix! (function matrix quaternion matrix)) +(define-extern quaternion-left-mult-matrix! (function matrix quaternion matrix)) +(define-extern quaternion->matrix (function matrix quaternion matrix)) +(define-extern quaternion->matrix-2 (function matrix quaternion matrix)) +(define-extern matrix->quaternion (function quaternion matrix quaternion)) +(define-extern matrix-with-scale->quaternion (function quaternion matrix quaternion)) +(define-extern quaternion-vector-len (function quaternion float)) +(define-extern quaternion-log! (function quaternion quaternion quaternion)) +(define-extern quaternion-exp! (function quaternion quaternion quaternion)) +(define-extern quaternion-slerp! (function quaternion quaternion quaternion float quaternion)) +(define-extern quaternion-pseudo-slerp! (function quaternion quaternion quaternion float quaternion)) +(define-extern quaternion-pseudo-seek (function quaternion quaternion quaternion float quaternion)) +(define-extern quaternion-smooth-seek! (function quaternion quaternion quaternion float quaternion)) +(define-extern quaternion-zxy! (function quaternion vector quaternion)) +(define-extern vector-x-quaternion! (function vector quaternion vector)) +(define-extern vector-y-quaternion! (function vector quaternion vector)) +(define-extern vector-z-quaternion! (function vector quaternion vector)) +(define-extern quaternion-x-angle (function quaternion float)) +(define-extern quaternion-y-angle (function quaternion float)) +(define-extern quaternion-z-angle (function quaternion float)) +(define-extern quaternion-vector-y-angle (function quaternion vector float)) +(define-extern quaternion-rotate-local-x! (function quaternion quaternion float quaternion)) +(define-extern quaternion-rotate-local-y! (function quaternion quaternion float quaternion)) +(define-extern quaternion-rotate-local-z! (function quaternion quaternion float quaternion)) +(define-extern quaternion-rotate-y! (function quaternion quaternion float quaternion)) +(define-extern quaternion-rotate-x! (function quaternion quaternion float quaternion)) +(define-extern quaternion-rotate-z! (function quaternion quaternion float quaternion)) +(define-extern quaternion-delta-y (function quaternion quaternion float)) +(define-extern quaternion-rotate-y-to-vector! (function quaternion quaternion quaternion float quaternion)) +(define-extern vector-rotate-x! (function vector vector float vector)) +(define-extern vector-rotate-y! (function vector vector float vector)) +(define-extern vector-rotate-z! (function vector vector float vector)) +(define-extern vector-y-angle (function vector float)) +(define-extern vector-x-angle (function vector float)) +(define-extern quaternion<-rotate-y-vector (function quaternion vector quaternion)) +(define-extern quaternion-validate (function quaternion none)) +(define-extern quaternion-xz-angle (function quaternion float)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; euler ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern set-eul! object) ;; (function euler-angles float float float int euler-angles) -;; (define-extern eul->matrix object) ;; (function matrix euler-angles matrix) -;; (define-extern matrix->eul object) ;; (function euler-angles matrix int euler-angles) -;; (define-extern eul->quat object) ;; (function quaternion euler-angles quaternion) -;; (define-extern quat->eul object) ;; (function euler-angles quaternion int euler-angles) +(define-extern set-eul! (function euler-angles float float float int euler-angles)) +(define-extern eul->matrix (function matrix euler-angles matrix)) +(define-extern matrix->eul (function euler-angles matrix int euler-angles)) +(define-extern eul->quat (function quaternion euler-angles quaternion)) +(define-extern quat->eul (function euler-angles quaternion int euler-angles)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; trigonometry ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern radmod object) ;; (function float float) -;; (define-extern deg- object) ;; (function float float float) -;; (define-extern deg-diff object) ;; (function float float float) -;; (define-extern deg-seek object) ;; (function float float float float) -;; (define-extern deg-seek-smooth object) ;; (function float float float float float) -;; (define-extern deg-lerp-clamp object) ;; (function float float float float) -;; (define-extern binary-table object) ;; (array float) -;; (define-extern sincos-table object) ;; (array float) -;; (define-extern sin object) ;; (function float float) -;; (define-extern sin-rad object) ;; (function float float) -;; (define-extern *sin-poly-vec* object) ;; vector -;; (define-extern *sin-poly-vec2* object) ;; vector -;; (define-extern vector-sin-rad! object) ;; (function vector vector vector) -;; (define-extern cos-rad object) ;; (function float float) -;; (define-extern *cos-poly-vec* object) ;; vector -;; (define-extern vector-cos-rad! object) ;; (function vector vector vector) -;; (define-extern vector-sincos-rad! object) ;; (function vector vector vector int) -;; (define-extern sincos-rad! object) ;; (function (pointer float) float int) -;; (define-extern sincos! object) ;; (function (pointer float) float int) -;; (define-extern vector-rad<-vector-deg! object) ;; (function vector vector none) -;; (define-extern vector-rad<-vector-deg/2! object) ;; (function vector vector int) -;; (define-extern vector-sincos! object) ;; (function vector vector vector int) -;; (define-extern tan-rad object) ;; (function float float) -;; (define-extern cos object) ;; (function float float) -;; (define-extern tan object) ;; (function float float) -;; (define-extern atan0 object) ;; (function float float float) -;; (define-extern atan-series-rad object) ;; (function float float) -;; (define-extern atan-rad object) ;; (function float float) -;; (define-extern sign-bit object) ;; (function int int) -;; (define-extern sign-float object) -;; (define-extern sign object) ;; (function float float) -;; (define-extern atan2-rad object) ;; (function float float float) -;; (define-extern atan object) ;; (function float float float) -;; (define-extern asin object) ;; (function float float) -;; (define-extern acos object) ;; (function float float) -;; (define-extern acos-rad object) ;; (function float float) -;; (define-extern sinerp object) ;; (function float float float float) -;; (define-extern sinerp-clamp object) ;; (function float float float float) -;; (define-extern coserp object) ;; (function float float float float) -;; (define-extern coserp-clamp object) ;; (function float float float float) -;; (define-extern coserp180 object) ;; (function float float float float) -;; (define-extern coserp180-clamp object) ;; (function float float float float) -;; (define-extern ease-in-out object) ;; (function int int float) +(define-extern radmod (function float float)) +(define-extern deg- (function float float float)) +(define-extern deg-diff (function float float float)) +(define-extern deg-seek (function float float float float)) +(define-extern deg-seek-smooth (function float float float float float)) +(define-extern deg-lerp-clamp (function float float float float)) +(define-extern binary-table (array float)) +(define-extern sincos-table (array float)) +(define-extern sin (function float float)) +(define-extern sin-rad (function float float)) +(define-extern *sin-poly-vec* vector) +(define-extern *sin-poly-vec2* vector) +(define-extern vector-sin-rad! (function vector vector vector)) +(define-extern cos-rad (function float float)) +(define-extern *cos-poly-vec* vector) +(define-extern vector-cos-rad! (function vector vector vector)) +(define-extern vector-sincos-rad! (function vector vector vector int)) +(define-extern sincos-rad! (function (pointer float) float int)) +(define-extern sincos! (function (pointer float) float int)) +(define-extern vector-rad<-vector-deg! (function vector vector none)) +(define-extern vector-rad<-vector-deg/2! (function vector vector int)) +(define-extern vector-sincos! (function vector vector vector int)) +(define-extern tan-rad (function float float)) +(define-extern cos (function float float)) +(define-extern tan (function float float)) +(define-extern atan0 (function float float float)) +(define-extern atan-series-rad (function float float)) +(define-extern atan-rad (function float float)) +(define-extern sign-bit (function int int)) +(define-extern sign-float (function float float)) +(define-extern sign (function float float)) +(define-extern atan2-rad (function float float float)) +(define-extern atan (function float float float)) +(define-extern asin (function float float)) +(define-extern acos (function float float)) +(define-extern acos-rad (function float float)) +(define-extern sinerp (function float float float float)) +(define-extern sinerp-clamp (function float float float float)) +(define-extern coserp (function float float float float)) +(define-extern coserp-clamp (function float float float float)) +(define-extern coserp180 (function float float float float)) +(define-extern coserp180-clamp (function float float float float)) +(define-extern ease-in-out (function int int float)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; gsound-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum sound-command + :type uint16 + ; (load-bank) + ; (load-music) + ; (unload-bank) + ; (play) + ; (pause-sound) + ; (stop-sound) + ; (continue-sound) + ; (set-param) + ; (set-master-volume) + ; (pause-group) + ; (stop-group) + ; (continue-group) + ; (get-irx-version) + ; (set-falloff-curve) + ; (set-sound-falloff) + ; (reload-info) + ; (set-language) + ; (set-flava) + ; (set-reverb) + ; (set-ear-trans) + ; (shutdown) + ; (list-sounds) + ; (unload-music) + ; (set-fps) + ) + +(defenum sound-group + :bitfield #t + :type uint8 + ; (sfx) + ; (music) + ; (dialog) + ; (sog3) + ; (ambient) + ; (sog5) + ; (sog6) + ; (sog7) + ) + +(defenum sound-mask + :bitfield #t + :type uint16 + ; (volume) + ; (pitch) + ; (bend) + ; (unused) + ; (time) + ; (trans) + ; (fo-min) + ; (fo-max) + ; (fo-curve) + ) + + (deftype sound-stream-name (structure) - ((name UNKNOWN 48 :offset-assert 0) + ((name uint8 48 :offset-assert 0) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype sound-rpc-cmd (structure) - ((rsvd1 uint16 :offset-assert 0) - (command uint16 :offset-assert 2) ;; sound-command + ((rsvd1 uint16 :offset-assert 0) + (command sound-command :offset-assert 2) ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype sound-play-params (structure) ((mask uint16 :offset-assert 0) (pitch-mod int16 :offset-assert 2) @@ -1906,27 +1820,44 @@ (fo-curve int8 :offset-assert 10) (priority int8 :offset-assert 11) (volume int32 :offset-assert 12) - (trans UNKNOWN 3 :offset-assert 16) + (trans int32 3 :offset-assert 16) (group uint8 :offset-assert 28) - (reg UNKNOWN 3 :offset-assert 29) + (reg uint8 3 :offset-assert 29) ) + :allow-misaligned :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| +(deftype sound-name (uint128) + ((lo uint64 :offset 0) + (hi uint64 :offset 64) + ) + :flag-assert #x900000010 + ) + +(deftype sound-id (uint32) + () + (:methods + (unused-9 () none 9) + ) + :flag-assert #xa00000004 + ) + +(deftype sound-bank-id (uint32) + () + :flag-assert #x900000004 + ) + (deftype sound-rpc-bank-cmd (sound-rpc-cmd) - ((bank-name uint128 :offset-assert 16) ;; sound-name + ((bank-name sound-name :offset-assert 16) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| (deftype sound-rpc-test-cmd (sound-rpc-cmd) ((ee-addr uint32 :offset-assert 4) (param0 uint16 :offset-assert 8) @@ -1935,29 +1866,23 @@ :size-assert #xa :flag-assert #x90000000a ) -|# -#| (deftype sound-rpc-sound-cmd (sound-rpc-cmd) - ((id sound-id :offset-assert 4) ;; guessed by decompiler + ((id sound-id :offset-assert 4) ) :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype sound-rpc-group-cmd (sound-rpc-cmd) - ((group uint8 :offset-assert 4) ;; sound-group + ((group sound-group :offset-assert 4) ) :method-count-assert 9 :size-assert #x5 :flag-assert #x900000005 ) -|# -#| (deftype sound-rpc-load-bank (sound-rpc-bank-cmd) ((ee-addr uint32 :offset-assert 32) ) @@ -1965,65 +1890,51 @@ :size-assert #x24 :flag-assert #x900000024 ) -|# -#| (deftype sound-rpc-load-music (sound-rpc-bank-cmd) () :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| (deftype sound-rpc-unload-bank (sound-rpc-bank-cmd) () :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| (deftype sound-rpc-play (sound-rpc-sound-cmd) - ((name uint128 :offset-assert 16) ;; sound-name + ((name sound-name :offset-assert 16) (params sound-play-params :inline :offset-assert 32) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype sound-rpc-pause-sound (sound-rpc-sound-cmd) () :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype sound-rpc-stop-sound (sound-rpc-sound-cmd) () :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype sound-rpc-continue-sound (sound-rpc-sound-cmd) () :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype sound-rpc-set-param (sound-rpc-sound-cmd) ((params sound-play-params :inline :offset-assert 8) (auto-time int32 :offset-assert 40) @@ -2033,9 +1944,7 @@ :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype sound-rpc-set-master-volume (sound-rpc-group-cmd) ((volume int32 :offset-assert 8) ) @@ -2043,48 +1952,38 @@ :size-assert #xc :flag-assert #x90000000c ) -|# -#| (deftype sound-rpc-pause-group (sound-rpc-group-cmd) () :method-count-assert 9 :size-assert #x5 :flag-assert #x900000005 ) -|# -#| (deftype sound-rpc-stop-group (sound-rpc-group-cmd) () :method-count-assert 9 :size-assert #x5 :flag-assert #x900000005 ) -|# -#| (deftype sound-rpc-continue-group (sound-rpc-group-cmd) () :method-count-assert 9 :size-assert #x5 :flag-assert #x900000005 ) -|# -#| (deftype sound-rpc-get-irx-version (sound-rpc-cmd) ((major uint32 :offset-assert 4) (minor uint32 :offset-assert 8) - (ee-addr pointer :offset-assert 12) ;; guessed by decompiler + (ee-addr pointer :offset-assert 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype sound-rpc-set-language (sound-rpc-cmd) ((lang uint32 :offset-assert 4) ) @@ -2092,9 +1991,7 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype sound-rpc-set-stereo-mode (sound-rpc-cmd) ((mode int32 :offset-assert 4) ) @@ -2102,9 +1999,7 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype sound-rpc-set-reverb (sound-rpc-cmd) ((core uint8 :offset-assert 4) (reverb int32 :offset-assert 8) @@ -2115,22 +2010,18 @@ :size-assert #x14 :flag-assert #x900000014 ) -|# -#| (deftype sound-rpc-set-ear-trans (sound-rpc-cmd) - ((ear-trans1 UNKNOWN 3 :offset-assert 4) - (ear-trans0 UNKNOWN 3 :offset-assert 16) - (cam-trans vector3w 3 :offset-assert 28) ;; guessed by decompiler - (cam-angle int32 :offset-assert 40) + ((ear-trans1 int32 3 :offset-assert 4) + (ear-trans0 int32 3 :offset-assert 16) + (cam-trans int32 3 :offset-assert 28) + (cam-angle int32 :offset-assert 40) ) :method-count-assert 9 :size-assert #x2c :flag-assert #x90000002c ) -|# -#| (deftype sound-rpc-set-flava (sound-rpc-cmd) ((flava uint8 :offset-assert 4) (excitement uint8 :offset-assert 5) @@ -2139,9 +2030,7 @@ :size-assert #x6 :flag-assert #x900000006 ) -|# -#| (deftype sound-rpc-set-midi-reg (sound-rpc-cmd) ((reg int32 :offset-assert 4) (value int16 :offset-assert 8) @@ -2150,18 +2039,14 @@ :size-assert #xa :flag-assert #x90000000a ) -|# -#| (deftype sound-rpc-shutdown (sound-rpc-cmd) () :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype sound-rpc-set-fps (sound-rpc-cmd) ((fps uint8 :offset-assert 4) ) @@ -2169,88 +2054,89 @@ :size-assert #x5 :flag-assert #x900000005 ) -|# -#| (deftype sound-rpc-list-sounds (sound-rpc-cmd) () :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype sound-rpc-unload-music (sound-rpc-cmd) () :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype sound-rpc-union (structure) - ((data uint32 20 :offset-assert 0) ;; guessed by decompiler - (load-bank sound-rpc-load-bank :offset-assert 0) - (unload-bank sound-rpc-unload-bank :offset-assert 0) - (play sound-rpc-play :offset-assert 0) - (pause-sound sound-rpc-pause-sound :offset-assert 0) - (stop-sound sound-rpc-stop-sound :offset-assert 0) - (continue-sound sound-rpc-continue-sound :offset-assert 0) - (set-param sound-rpc-set-param :offset-assert 0) - (set-master-volume sound-rpc-set-master-volume :offset-assert 0) - (pause-group sound-rpc-pause-group :offset-assert 0) - (stop-group sound-rpc-stop-group :offset-assert 0) - (continue-group sound-rpc-continue-group :offset-assert 0) - (get-irx-version sound-rpc-get-irx-version :offset-assert 0) - (set-language sound-rpc-set-language :offset-assert 0) - (set-reverb sound-rpc-set-reverb :offset-assert 0) - (set-ear-trans sound-rpc-set-ear-trans :offset-assert 0) - (set-flava sound-rpc-set-flava :offset-assert 0) - (set-midi-reg sound-rpc-set-midi-reg :offset-assert 0) - (set-fps sound-rpc-set-fps :offset-assert 0) - (shutdown sound-rpc-shutdown :offset-assert 0) - (list-sounds sound-rpc-list-sounds :offset-assert 0) - (unload-music sound-rpc-unload-music :offset-assert 0) + ((data uint32 20 :offset-assert 0) + (load-bank sound-rpc-load-bank :offset 0) + (unload-bank sound-rpc-unload-bank :offset 0) + (play sound-rpc-play :offset 0) + (pause-sound sound-rpc-pause-sound :offset 0) + (stop-sound sound-rpc-stop-sound :offset 0) + (continue-sound sound-rpc-continue-sound :offset 0) + (set-param sound-rpc-set-param :offset 0) + (set-master-volume sound-rpc-set-master-volume :offset 0) + (pause-group sound-rpc-pause-group :offset 0) + (stop-group sound-rpc-stop-group :offset 0) + (continue-group sound-rpc-continue-group :offset 0) + (get-irx-version sound-rpc-get-irx-version :offset 0) + (set-language sound-rpc-set-language :offset 0) + (set-reverb sound-rpc-set-reverb :offset 0) + (set-ear-trans sound-rpc-set-ear-trans :offset 0) + (set-flava sound-rpc-set-flava :offset 0) + (set-midi-reg sound-rpc-set-midi-reg :offset 0) + (set-fps sound-rpc-set-fps :offset 0) + (shutdown sound-rpc-shutdown :offset 0) + (list-sounds sound-rpc-list-sounds :offset 0) + (unload-music sound-rpc-unload-music :offset 0) ) :method-count-assert 9 :size-assert #x50 :flag-assert #x900000050 ) -|# -#| (deftype sound-spec (basic) - ((mask uint16 :offset-assert 4) ;; sound-mask - (num float :offset-assert 8) - (group uint8 :offset-assert 12) ;; sound-group - (reg UNKNOWN 3 :offset-assert 13) + ((mask sound-mask :offset-assert 4) + (num float :offset-assert 8) + (group sound-group :offset-assert 12) + (reg uint8 3 :offset-assert 13) + (sound-name-char uint8 16 :offset-assert 16) + (sound-name sound-name :offset 16) + (trans int32 4 :offset-assert 32) + (volume int32 :offset-assert 48) + (pitch-mod int32 :offset-assert 52) + (bend int32 :offset-assert 56) + (fo-min int16 :offset-assert 60) + (fo-max int16 :offset-assert 62) + (fo-curve int8 :offset-assert 64) + (priority int8 :offset-assert 65) + (auto-time int32 :offset-assert 68) + (auto-from int32 :offset-assert 72) ) :method-count-assert 9 :size-assert #x4c :flag-assert #x90000004c - ;; Failed to read some fields. ) -|# -#| (deftype ambient-sound (basic) - ((spec sound-spec :offset-assert 4) ;; guessed by decompiler - (playing-id sound-id :offset-assert 8) ;; guessed by decompiler + ((spec sound-spec :offset-assert 4) + (playing-id sound-id :offset-assert 8) (trans vector :inline :offset-assert 16) - (name uint128 :offset-assert 32) ;; sound-name - (play-time uint64 :offset-assert 48) ;; time-frame - (time-base uint64 :offset-assert 56) ;; time-frame - (time-random uint64 :offset-assert 64) ;; time-frame + (name sound-name :offset-assert 32) + (play-time time-frame :offset-assert 48) + (time-base time-frame :offset-assert 56) + (time-random time-frame :offset-assert 64) (volume int32 :offset-assert 72) (pitch int32 :offset-assert 76) (falloff-near int32 :offset-assert 80) (falloff-far int32 :offset-assert 84) (falloff-mode int32 :offset-assert 88) - (params (pointer float) :offset-assert 92) ;; guessed by decompiler + (params (pointer float) :offset-assert 92) (param-count int32 :offset-assert 96) - (entity entity :offset-assert 100) ;; guessed by decompiler + (entity entity :offset-assert 100) (sound-count int32 :offset-assert 104) ) :method-count-assert 16 @@ -2267,174 +2153,240 @@ (dummy-15 () none 15) ) ) -|# -;; (define-extern *current-sound-id* object) ;; sound-id +(define-extern *current-sound-id* sound-id) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; timer-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum timer-clock-selection + :type uint8 + (busclk 0) + (busclk/16 1) + (busclk/256 2) + (hblank 3) + ) + +(deftype timer-mode (uint32) + ((clks timer-clock-selection :offset 0 :size 2) + (gate uint8 :offset 2 :size 1) ;; gate function enable + (gats uint8 :offset 3 :size 1) ;; gate selection: 0 = hblank, 1 = vblank + ;; gate mode: + ;; 0: count while gate signal is low + ;; 1: start when gate signal rises + ;; 2: start when gate signal falls + ;; 3: start when gate signal rises/falls + (gatm uint8 :offset 4 :size 2) + (zret uint8 :offset 6 :size 1) ;; zero return: clear counter when equal to reference value + (cue uint8 :offset 7 :size 1) ;; count-up enable + (cmpe uint8 :offset 8 :size 1) ;; compare-interrupt enable + (ovfe uint8 :offset 9 :size 1) ;; overflow-interrupt enable + (equf uint8 :offset 10 :size 1) ;; equal-flag + (ovff uint8 :offset 11 :size 1) ;; overflow-flag + ) + :method-count-assert 9 + :size-assert #x4 + :flag-assert #x900000004 + ) + (deftype timer-bank (structure) ((count uint32 :offset-assert 0) - (mode timer-mode :offset-assert 16) ;; guessed by decompiler - (comp uint32 :offset-assert 32) + (mode timer-mode :offset 16) + (comp uint32 :offset 32) ) :method-count-assert 9 :size-assert #x24 :flag-assert #x900000024 ) -|# -#| (deftype timer-hold-bank (timer-bank) - ((hold uint32 :offset-assert 48) + ((hold uint32 :offset 48) ) :method-count-assert 9 :size-assert #x34 :flag-assert #x900000034 ) -|# -#| (deftype stopwatch (basic) - ((prev-time-elapsed uint64 :offset-assert 8) ;; time-frame - (start-time uint64 :offset-assert 16) ;; time-frame - (begin-level int32 :offset-assert 24) + ((prev-time-elapsed time-frame :offset-assert 8) + (start-time time-frame :offset-assert 16) + (begin-level int32 :offset-assert 24) ) :method-count-assert 9 :size-assert #x1c :flag-assert #x90000001c ) -|# -;; (define-extern *ticks-per-frame* object) ;; int -;; (define-extern timer-init object) ;; (function timer-bank timer-mode int) +(define-extern *ticks-per-frame* int) +(define-extern timer-init (function timer-bank timer-mode int)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; vif-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype vif-stat (uint32) - () + ((vps uint8 :offset 0 :size 2) + (vew uint8 :offset 2 :size 1) + (mrk uint8 :offset 6 :size 1) + (vss uint8 :offset 8 :size 1) + (vfs uint8 :offset 9 :size 1) + (vis uint8 :offset 10 :size 1) + (int uint8 :offset 11 :size 1) + (er0 uint8 :offset 12 :size 1) + (er1 uint8 :offset 13 :size 1) + (fqc uint8 :offset 24 :size 4) + ) + :method-count-assert 9 + :size-assert #x4 + :flag-assert #x900000004 + ) + +(deftype vif-fbrst (uint32) + ((rst uint8 :offset 0 :size 1) + (fbk uint8 :offset 1 :size 1) + (stp uint8 :offset 2 :size 1) + (stc uint8 :offset 3 :size 1) + ) + :method-count-assert 9 + :size-assert #x4 + :flag-assert #x900000004 + ) + +(deftype vif-err (uint32) + ((mii uint8 :offset 0 :size 1) + (me0 uint8 :offset 1 :size 1) ;; PS2 hardware bug, must set this to 1 for correct operation. + (me1 uint8 :offset 2 :size 1) + ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 - ;; Failed to read some fields. ) -|# -#| (deftype vif-bank (structure) - ((stat uint32 :offset-assert 0) - (fbrst uint32 :offset-assert 16) - (err vif-err :offset-assert 32) ;; guessed by decompiler - (mark uint32 :offset-assert 48) - (cycle uint32 :offset-assert 64) - (mode uint32 :offset-assert 80) - (num uint32 :offset-assert 96) - (mask uint32 :offset-assert 112) - (code uint32 :offset-assert 128) - (itops uint32 :offset-assert 144) - (base uint32 :offset-assert 160) - (offset uint32 :offset-assert 176) - (tops uint32 :offset-assert 192) - (itop uint32 :offset-assert 208) - (top uint32 :offset-assert 224) - (r0 uint32 :offset-assert 256) - (r1 uint32 :offset-assert 272) - (r2 uint32 :offset-assert 288) - (r3 uint32 :offset-assert 304) - (c0 uint32 :offset-assert 320) - (c1 uint32 :offset-assert 336) - (c2 uint32 :offset-assert 352) - (c3 uint32 :offset-assert 368) + ((stat uint32 :offset-assert 0) + (fbrst uint32 :offset 16) + (err vif-err :offset 32) + (mark uint32 :offset 48) + (cycle uint32 :offset 64) + (mode uint32 :offset 80) + (num uint32 :offset 96) + (mask uint32 :offset 112) + (code uint32 :offset 128) + (itops uint32 :offset 144) + (base uint32 :offset 160) + (offset uint32 :offset 176) + (tops uint32 :offset 192) + (itop uint32 :offset 208) + (top uint32 :offset 224) + (r0 uint32 :offset 256) + (r1 uint32 :offset 272) + (r2 uint32 :offset 288) + (r3 uint32 :offset 304) + (c0 uint32 :offset 320) + (c1 uint32 :offset 336) + (c2 uint32 :offset 352) + (c3 uint32 :offset 368) ) :method-count-assert 9 :size-assert #x174 :flag-assert #x900000174 ) -|# - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; dma-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype dma-chcr (uint32) - () + ((dir uint8 :offset 0 :size 1) ;; 1 - from memory + (mod uint8 :offset 2 :size 2) ;; normal, chain, interleave + (asp uint8 :offset 4 :size 2) ;; none, 1, 2 + (tte uint8 :offset 6 :size 1) ;; transfer tag (sc only) + (tie uint8 :offset 7 :size 1) ;; tag interrupt + (str uint8 :offset 8 :size 1) ;; start! + (tag uint16 :offset 16) + ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 - ;; Failed to read some fields. ) -|# -#| (deftype dma-bank (structure) - ((chcr dma-chcr :offset-assert 0) ;; guessed by decompiler - (madr uint32 :offset-assert 16) - (qwc uint32 :offset-assert 32) + ((chcr dma-chcr :offset 0) + (madr uint32 :offset 16) + (qwc uint32 :offset 32) ) :method-count-assert 9 :size-assert #x24 :flag-assert #x900000024 ) -|# -#| (deftype dma-bank-source (dma-bank) - ((tadr uint32 :offset-assert 48) + ((tadr uint32 :offset 48) ) :method-count-assert 9 :size-assert #x34 :flag-assert #x900000034 ) -|# -#| (deftype dma-bank-vif (dma-bank-source) - ((as0 uint32 :offset-assert 64) - (as1 uint32 :offset-assert 80) + ((as0 uint32 :offset 64) + (as1 uint32 :offset 80) ) :method-count-assert 9 :size-assert #x54 :flag-assert #x900000054 ) -|# -#| (deftype dma-bank-spr (dma-bank-source) - ((sadr uint32 :offset-assert 128) + ((sadr uint32 :offset 128) ) :method-count-assert 9 :size-assert #x84 :flag-assert #x900000084 ) -|# -#| +(deftype dma-ctrl (uint32) + ((dmae uint8 :offset 0 :size 1) + (rele uint8 :offset 1 :size 1) + (mfd uint8 :offset 2 :size 2) + (sts uint8 :offset 4 :size 2) + (std uint8 :offset 6 :size 2) + (rcyc uint8 :offset 8 :size 3) + ) + :method-count-assert 9 + :size-assert #x4 + :flag-assert #x900000004 + ) + +(deftype dma-enable (uint32) + ((cpnd uint8 :offset 16 :size 1)) + :flag-assert #x900000004 + ) + +(deftype dma-sqwc (uint32) + ((sqwc uint8 :offset 0 :size 8) + (tqwc uint8 :offset 16 :size 8) + ) + :flag-assert #x900000004 + ) + (deftype dma-bank-control (structure) - ((ctrl dma-ctrl :offset-assert 0) ;; guessed by decompiler - (stat uint32 :offset-assert 16) - (pcr uint32 :offset-assert 32) - (sqwc dma-sqwc :offset-assert 48) ;; guessed by decompiler - (rbsr uint32 :offset-assert 64) - (rbor uint32 :offset-assert 80) - (stadr uint32 :offset-assert 96) - (enabler uint32 :offset-assert 5408) - (enablew uint32 :offset-assert 5520) + ((ctrl dma-ctrl :offset 0) + (stat uint32 :offset 16) + (pcr uint32 :offset 32) + (sqwc dma-sqwc :offset 48) + (rbsr uint32 :offset 64) + (rbor uint32 :offset 80) + (stadr uint32 :offset 96) + (enabler uint32 :offset 5408) + (enablew uint32 :offset 5520) ) :method-count-assert 9 :size-assert #x1594 :flag-assert #x900001594 ) -|# -#| (deftype vu-code-block (basic) ((name basic :offset-assert 4) (code uint32 :offset-assert 8) @@ -2445,59 +2397,165 @@ :size-assert #x14 :flag-assert #x900000014 ) -|# -#| -(deftype dma-tag (uint64) + +(deftype vu-stat (uint64) () + :flag-assert #x900000008 + ) + +(defenum dma-tag-id + :bitfield #f + :type uint8 + (refe 0) ;; addr=ADDR, ends after this transfer + (cnt 1) ;; addr=after tag, next-tag=after data + (next 2) ;; addr=after tag, next-tag=ADDR + (ref 3) ;; addr=ADDR, next-tag=after tag + (refs 4) ;; ref, but stall controled + (call 5) ;; + (ret 6) ;; + (end 7) ;; next, but ends. + ) + +(deftype dma-tag (uint64) + ((qwc uint16 :offset 0) ;; quadword count + (pce uint8 :offset 26 :size 2) ;; priority (source mode) + (id dma-tag-id :offset 28 :size 3) ;; ID (what the tag means) + (irq uint8 :offset 31 :size 1) ;; interrupt at the end? + (addr uint32 :offset 32 :size 31) ;; address (31 bits) + (spr uint8 :offset 63 :size 1) ;; spr or not flag. + ) :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 - ;; Failed to read some fields. ) -|# -#| (deftype dma-bucket (structure) - ((tag uint64 :offset-assert 0) ;; dma-tag - (last (pointer dma-tag) :offset-assert 8) ;; guessed by decompiler + ((tag dma-tag :offset-assert 0) + (last (pointer dma-tag) :offset-assert 8) (dummy uint32 :offset-assert 12) - (next uint32 :offset-assert 4) - (clear uint64 :offset-assert 8) - (vif0 uint32 :offset-assert 8) - (vif1 uint32 :offset-assert 12) + (next uint32 :offset 4) + (clear uint64 :offset 8) + (vif0 uint32 :offset 8) + (vif1 uint32 :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| +;; all these have mask (only applies to unpacks) and interrupt not set. +(defenum vif-cmd + :bitfield #f + :type uint8 + (nop 0) ;; no-op, can still have irq set. + (stcycl 1) ;; set write recycle register + (offset 2) ;; set offset register + (base 3) ;; set base register + (itop 4) ;; set data pointer register (itops) + (stmod 5) ;; set mode register + (mskpath3 6) ;; set path 3 mask + (mark 7) ;; set mark register + (pc-port 8) ;; special tag for PC Port data. + (flushe 16) ;; wait for end of microprogram + (flush 17) ;; wait for end of microprogram and transfer (path1/path2) + (flusha 19) ;; wait for end of microprogram and transfer (path1/path2/path3) + (mscal 20) ;; activate microprogram (call) + (mscalf 21) ;; flushe and activate (call) + (mscnt 23) ;; activate microprogram (continue) + (stmask 32) ;; set MASK register. + (strow 48) ;; set filling data + (stcol 49) ;; set filling data + (mpg 74) ;; transfer microprogram + (direct 80) ;; straight to GIF. + (directhl 81) + (unpack-s-32 96) + (unpack-s-16 97) + (unpack-s-8 98) + ;; 99 is invalid + (unpack-v2-32 100) + (unpack-v2-16 101) + (unpack-v2-8 102) + ;; 103 is invalid + (unpack-v3-32 104) + (unpack-v3-16 105) + (unpack-v3-8 106) + ;; 107 is invalid + (unpack-v4-32 108) + (unpack-v4-16 109) + (unpack-v4-8 110) + (unpack-v4-5 111) + (cmd-mask 239) ;; not sure what this is + ) + +(defenum vif-cmd-32 + :bitfield #f + :type uint32 + :copy-entries vif-cmd + ) + +(deftype vif-mask (uint32) + ((m0 uint8 :offset 0 :size 2) + (m1 uint8 :offset 2 :size 2) + (m2 uint8 :offset 4 :size 2) + (m3 uint8 :offset 6 :size 2) + (m4 uint8 :offset 8 :size 2) + (m5 uint8 :offset 10 :size 2) + (m6 uint8 :offset 12 :size 2) + (m7 uint8 :offset 14 :size 2) + (m8 uint8 :offset 16 :size 2) + (m9 uint8 :offset 18 :size 2) + (m10 uint8 :offset 20 :size 2) + (m11 uint8 :offset 22 :size 2) + (m12 uint8 :offset 24 :size 2) + (m13 uint8 :offset 26 :size 2) + (m14 uint8 :offset 28 :size 2) + (m15 uint8 :offset 30 :size 2) + ) + :flag-assert #x900000004 + ) + +(deftype vif-stcycl-imm (uint16) + ((cl uint8 :offset 0 :size 8) + (wl uint8 :offset 8 :size 8) + ) + :flag-assert #x900000002 + ) + +(deftype vif-unpack-imm (uint16) + ((addr uint16 :offset 0 :size 10) + (usn uint8 :offset 14 :size 1) + (flg uint8 :offset 15 :size 1) + ) + :flag-assert #x900000002 + ) + (deftype vif-tag (uint32) - () + ((imm uint16 :offset 0 :size 16) + (num uint8 :offset 16 :size 8) + (cmd vif-cmd :offset 24 :size 7) + (irq uint8 :offset 31 :size 1) + (msk uint8 :offset 28 :size 1) + ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 - ;; Failed to read some fields. ) -|# -;; (define-extern dma-sync-fast object) ;; (function dma-bank none) -;; (define-extern dma-send-no-scratch object) ;; (function dma-bank uint32 uint32 none) -;; (define-extern dma-sync-with-count object) ;; (function dma-bank (pointer int32) int) -;; (define-extern dma-count-until-done object) ;; (function dma-bank (pointer int32) int) +(define-extern dma-sync-fast (function dma-bank none)) +(define-extern dma-send-no-scratch (function dma-bank uint32 uint32 none)) +(define-extern dma-sync-with-count (function dma-bank (pointer int32) int)) +(define-extern dma-count-until-done (function dma-bank (pointer int32) int)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; video-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype video-params (structure) ((set-video-mode basic :offset-assert 0) (reset-video-mode basic :offset-assert 4) (display-fbp int32 :offset-assert 8) - (relative-x-scale float :offset-assert 16) + (relative-x-scale float :offset 16) (display-dx int32 :offset-assert 20) (display-dy int32 :offset-assert 24) (display-sy int32 :offset-assert 28) @@ -2508,39 +2566,405 @@ :size-assert #x28 :flag-assert #x900000028 ) -|# -;; (define-extern *video-params* object) +(define-extern *video-params* video-params) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; vu1-user-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum bucket-id + :type int32 + :bitfield #f + (bucket-0 0) + (bucket-1 1) + (bucket-2 2) + (bucket-3 3) + (bucket-4 4) + (bucket-5 5) + (bucket-6 6) + (bucket-7 7) ;; level 0 tex + (bucket-8 8) + (bucket-9 9) + (bucket-10 10) + (bucket-11 11) + (bucket-12 12) + (bucket-13 13) + (bucket-14 14) + (bucket-15 15) + (bucket-16 16) + (bucket-17 17) + (bucket-18 18) + (bucket-19 19) + (bucket-20 20) + (bucket-21 21) + (bucket-22 22) + (bucket-23 23) + (bucket-24 24) + (bucket-25 25) + (bucket-26 26) + (bucket-27 27) + (bucket-28 28) + (bucket-29 29) + (bucket-30 30) + (bucket-31 31) + (bucket-32 32) + (bucket-33 33) + (bucket-34 34) + (bucket-35 35) + (bucket-36 36) + (bucket-37 37) + (bucket-38 38) + (bucket-39 39) + (bucket-40 40) + (bucket-41 41) + (bucket-42 42) + (bucket-43 43) + (bucket-44 44) + (bucket-45 45) + (bucket-46 46) + (bucket-47 47) + (bucket-48 48) + (bucket-49 49) + (bucket-50 50) + (bucket-51 51) + (bucket-52 52) + (bucket-53 53) + (bucket-54 54) + (bucket-55 55) + (bucket-56 56) + (bucket-57 57) + (bucket-58 58) + (bucket-59 59) + (bucket-60 60) + (bucket-61 61) + (bucket-62 62) + (bucket-63 63) + (bucket-64 64) + (bucket-65 65) + (bucket-66 66) + (bucket-67 67) + (bucket-68 68) + (bucket-69 69) + (bucket-70 70) + (bucket-71 71) + (bucket-72 72) + (bucket-73 73) + (bucket-74 74) + (bucket-75 75) + (bucket-76 76) + (bucket-77 77) + (bucket-78 78) + (bucket-79 79) + (bucket-80 80) + (bucket-81 81) + (bucket-82 82) + (bucket-83 83) + (bucket-84 84) + (bucket-85 85) + (bucket-86 86) + (bucket-87 87) + (bucket-88 88) + (bucket-89 89) + (bucket-90 90) + (bucket-91 91) + (bucket-92 92) + (bucket-93 93) + (bucket-94 94) + (bucket-95 95) + (bucket-96 96) + (bucket-97 97) + (bucket-98 98) + (bucket-99 99) + (bucket-100 100) + (bucket-101 101) + (bucket-102 102) + (bucket-103 103) + (bucket-104 104) + (bucket-105 105) + (bucket-106 106) + (bucket-107 107) + (bucket-108 108) + (bucket-109 109) + (bucket-110 110) + (bucket-111 111) + (bucket-112 112) + (bucket-113 113) + (bucket-114 114) + (bucket-115 115) + (bucket-116 116) + (bucket-117 117) + (bucket-118 118) + (bucket-119 119) + (bucket-120 120) + (bucket-121 121) + (bucket-122 122) + (bucket-123 123) + (bucket-124 124) + (bucket-125 125) + (bucket-126 126) + (bucket-127 127) + (bucket-128 128) + (bucket-129 129) + (bucket-130 130) + (bucket-131 131) + (bucket-132 132) + (bucket-133 133) + (bucket-134 134) + (bucket-135 135) + (bucket-136 136) + (bucket-137 137) + (bucket-138 138) + (bucket-139 139) + (bucket-140 140) + (bucket-141 141) + (bucket-142 142) + (bucket-143 143) + (bucket-144 144) + (bucket-145 145) + (bucket-146 146) + (bucket-147 147) + (bucket-148 148) + (bucket-149 149) + (bucket-150 150) + (bucket-151 151) + (bucket-152 152) + (bucket-153 153) + (bucket-154 154) + (bucket-155 155) + (bucket-156 156) + (bucket-157 157) + (bucket-158 158) + (bucket-159 159) + (bucket-160 160) + (bucket-161 161) + (bucket-162 162) + (bucket-163 163) + (bucket-164 164) + (bucket-165 165) + (bucket-166 166) + (bucket-167 167) + (bucket-168 168) + (bucket-169 169) + (bucket-170 170) + (bucket-171 171) + (bucket-172 172) + (bucket-173 173) + (bucket-174 174) + (bucket-175 175) + (bucket-176 176) + (bucket-177 177) + (bucket-178 178) + (bucket-179 179) + (bucket-180 180) + (bucket-181 181) + (bucket-182 182) + (bucket-183 183) + (bucket-184 184) + (bucket-185 185) + (bucket-186 186) + (bucket-187 187) + (bucket-188 188) + (bucket-189 189) + (bucket-190 190) + (bucket-191 191) + (bucket-192 192) + (bucket-193 193) + (bucket-194 194) + (bucket-195 195) + (bucket-196 196) + (bucket-197 197) + (bucket-198 198) + (bucket-199 199) + (bucket-200 200) + (bucket-201 201) + (bucket-202 202) + (bucket-203 203) + (bucket-204 204) + (bucket-205 205) + (bucket-206 206) + (bucket-207 207) + (bucket-208 208) + (bucket-209 209) + (bucket-210 210) + (bucket-211 211) + (bucket-212 212) + (bucket-213 213) + (bucket-214 214) + (bucket-215 215) + (bucket-216 216) + (bucket-217 217) + (bucket-218 218) + (bucket-219 219) + (bucket-220 220) + (bucket-221 221) + (bucket-222 222) + (bucket-223 223) + (bucket-224 224) + (bucket-225 225) + (bucket-226 226) + (bucket-227 227) + (bucket-228 228) + (bucket-229 229) + (bucket-230 230) + (bucket-231 231) + (bucket-232 232) + (bucket-233 233) + (bucket-234 234) + (bucket-235 235) + (bucket-236 236) + (bucket-237 237) + (bucket-238 238) + (bucket-239 239) + (bucket-240 240) + (bucket-241 241) + (bucket-242 242) + (bucket-243 243) + (bucket-244 244) + (bucket-245 245) + (bucket-246 246) + (bucket-247 247) + (bucket-248 248) + (bucket-249 249) + (bucket-250 250) + (bucket-251 251) + (bucket-252 252) + (bucket-253 253) + (bucket-254 254) + (bucket-255 255) + (bucket-256 256) + (bucket-257 257) + (bucket-258 258) + (bucket-259 259) + (bucket-260 260) + (bucket-261 261) + (bucket-262 262) + (bucket-263 263) + (bucket-264 264) + (bucket-265 265) + (bucket-266 266) + (bucket-267 267) + (bucket-268 268) + (bucket-269 269) + (bucket-270 270) + (bucket-271 271) + (bucket-272 272) + (bucket-273 273) + (bucket-274 274) + (bucket-275 275) + (bucket-276 276) + (bucket-277 277) + (bucket-278 278) + (bucket-279 279) + (bucket-280 280) + (bucket-281 281) + (bucket-282 282) + (bucket-283 283) + (bucket-284 284) + (bucket-285 285) + (bucket-286 286) + (bucket-287 287) + (bucket-288 288) + (bucket-289 289) + (bucket-290 290) + (bucket-291 291) + (bucket-292 292) + (bucket-293 293) + (bucket-294 294) + (bucket-295 295) + (bucket-296 296) + (bucket-297 297) + (bucket-298 298) + (bucket-299 299) + (bucket-300 300) + (bucket-301 301) + (bucket-302 302) + (bucket-303 303) + (bucket-304 304) + (bucket-305 305) + (bucket-306 306) + (bucket-307 307) + (bucket-308 308) + (bucket-309 309) + (bucket-310 310) + (bucket-311 311) + (bucket-312 312) + (bucket-313 313) + (bucket-314 314) + (bucket-315 315) + (bucket-316 316) + (bucket-317 317) + (bucket-318 318) + (bucket-319 319) + (bucket-320 320) + (bucket-321 321) + (bucket-322 322) + (bucket-323 323) + (bucket-324 324) + (debug 325) + ) + +(defenum vu1-renderer-mask + :type uint64 + :bitfield #t + (rn0) + (rn1) + (rn2) + (rn3) + (rn4) + (rn5) + (rn6) + (rn7) + (rn8) + (rn9) + (rn10) + (rn11) + (rn12) + (rn13) + (rn14) + (rn15) + (rn16) + (rn17) + (rn18) + (rn19) + (rn20) + (rn21) + (rn22) + (rn23) + (rn24) + (rn25) + (rn26) + (rn27) + (rn28) + (rn29) + (rn30) + (rn31) + (rn32) + (rn33) + (rn34) + ) + (deftype dma-foreground-sink (basic) - ((bucket int32 :offset-assert 4) ;; bucket-id - (foreground-texture-page int8 :offset-assert 8) - (foreground-texture-level int8 :offset-assert 9) - (foreground-output-bucket int8 :offset-assert 10) + ((bucket bucket-id :offset-assert 4) + (foreground-texture-page int8 :offset-assert 8) + (foreground-texture-level int8 :offset-assert 9) + (foreground-output-bucket int8 :offset-assert 10) ) :method-count-assert 9 :size-assert #xb :flag-assert #x90000000b ) -|# -#| (deftype generic-bucket-state (structure) ((gifbuf-adr uint32 :offset-assert 0) (inbuf-adr uint32 :offset-assert 4) ) + :allow-misaligned :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype generic-dma-foreground-sink (dma-foreground-sink) ((state generic-bucket-state :inline :offset-assert 12) ) @@ -2548,14 +2972,11 @@ :size-assert #x14 :flag-assert #x900000014 ) -|# - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; profile-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype profile-segment (structure) ((name basic :offset-assert 0) (start-time int16 :offset-assert 4) @@ -2564,50 +2985,49 @@ (vu-count uint8 :offset-assert 9) (depth uint16 :offset-assert 10) (color uint32 :offset-assert 12) - (code-time uint16 :offset-assert 4) - (vu-time uint16 :offset-assert 6) + (code-time uint16 :offset 4) + (vu-time uint16 :offset 6) ) + :allow-misaligned :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| + (deftype profile-collapse (structure) ((count int32 :offset-assert 0) - (data UNKNOWN 48 :offset-assert 4) + (data profile-segment 48 :inline :offset-assert 4) ) :method-count-assert 9 :size-assert #x304 :flag-assert #x900000304 ) -|# -#| + (deftype profile-segment-array (basic) ((count int16 :offset-assert 4) (depth int8 :offset-assert 6) (max-depth int8 :offset-assert 7) (base-time int16 :offset-assert 8) - (segment UNKNOWN 9 :offset-assert 12) - (data UNKNOWN 512 :offset-assert 48) + (segment basic 9 :offset-assert 12) ;; todo + (data profile-segment 512 :inline :offset-assert 48) ) :method-count-assert 13 :size-assert #x2030 :flag-assert #xd00002030 (:methods - (dummy-9 () none 9) + (get-total-time (_type_) int 9) (dummy-10 () none 10) (dummy-11 () none 11) (dummy-12 () none 12) ) ) -|# -#| + + (deftype profile-array (structure) - ((data UNKNOWN 2 :offset-assert 0) + ((data profile-segment-array 2 :offset-assert 0) ;; guess ) :method-count-assert 12 :size-assert #x8 @@ -2618,153 +3038,148 @@ (dummy-11 () none 11) ) ) -|# -;; (define-extern *profile-gap-color* object) -;; (define-extern *profile-all-color* object) -;; (define-extern *profile-particles-color* object) -;; (define-extern *profile-target-color* object) -;; (define-extern *profile-target-post-color* object) -;; (define-extern *profile-joints-color* object) -;; (define-extern *profile-debug-color* object) -;; (define-extern *profile-draw-hook-color* object) -;; (define-extern *profile-sky-color* object) -;; (define-extern *profile-ocean-color* object) -;; (define-extern *profile-background-color* object) -;; (define-extern *profile-bsp-color* object) -;; (define-extern *profile-foreground-color* object) -;; (define-extern *profile-tfrag-color* object) -;; (define-extern *profile-instance-tie-color* object) -;; (define-extern *profile-instance-shrubbery-color* object) -;; (define-extern *profile-generic-tie-color* object) -;; (define-extern *profile-bones-color* object) -;; (define-extern *profile-generic-merc-color* object) -;; (define-extern *profile-shadow-color* object) -;; (define-extern *profile-update-actors-color* object) -;; (define-extern *profile-menu-hook-color* object) -;; (define-extern *profile-texture-color* object) -;; (define-extern *profile-effects-color* object) -;; (define-extern *profile-sprite-color* object) -;; (define-extern *profile-merc-color* object) -;; (define-extern *profile-actors-color* object) -;; (define-extern *profile-collide-color* object) -;; (define-extern *profile-nav-color* object) -;; (define-extern *profile-camera-color* object) -;; (define-extern *profile-blit-color* object) -;; (define-extern *profile-hud-color* object) -;; (define-extern *profile-emerc-color* object) -;; (define-extern *profile-array* object) -;; (define-extern *profile-collapse* object) -;; (define-extern *profile-interrupt-segment* object) -;; (define-extern *profile-interrupt-start* object) + +(define-extern *profile-gap-color* rgba) +(define-extern *profile-all-color* rgba) +(define-extern *profile-particles-color* rgba) +(define-extern *profile-target-color* rgba) +(define-extern *profile-target-post-color* rgba) +(define-extern *profile-joints-color* rgba) +(define-extern *profile-debug-color* rgba) +(define-extern *profile-draw-hook-color* rgba) +(define-extern *profile-sky-color* rgba) +(define-extern *profile-ocean-color* rgba) +(define-extern *profile-background-color* rgba) +(define-extern *profile-bsp-color* rgba) +(define-extern *profile-foreground-color* rgba) +(define-extern *profile-tfrag-color* rgba) +(define-extern *profile-instance-tie-color* rgba) +(define-extern *profile-instance-shrubbery-color* rgba) +(define-extern *profile-generic-tie-color* rgba) +(define-extern *profile-bones-color* rgba) +(define-extern *profile-generic-merc-color* rgba) +(define-extern *profile-shadow-color* rgba) +(define-extern *profile-update-actors-color* rgba) +(define-extern *profile-menu-hook-color* rgba) +(define-extern *profile-texture-color* rgba) +(define-extern *profile-effects-color* rgba) +(define-extern *profile-sprite-color* rgba) +(define-extern *profile-merc-color* rgba) +(define-extern *profile-actors-color* rgba) +(define-extern *profile-collide-color* rgba) +(define-extern *profile-nav-color* rgba) +(define-extern *profile-camera-color* rgba) +(define-extern *profile-blit-color* rgba) +(define-extern *profile-hud-color* rgba) +(define-extern *profile-emerc-color* rgba) +(define-extern *profile-array* profile-array) +(define-extern *profile-collapse* profile-collapse) +(define-extern *profile-interrupt-segment* profile-segment-array) +(define-extern *profile-interrupt-start* symbol) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; dma ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern dma-sync-hang object) ;; (function dma-bank none) -;; (define-extern dma-sync-crash object) ;; (function dma-bank none) -;; (define-extern dma-send object) ;; (function dma-bank uint uint none) -;; (define-extern dma-send-chain object) ;; (function dma-bank-source uint none) -;; (define-extern dma-send-chain-no-tte object) ;; (function dma-bank-source uint none) -;; (define-extern dma-send-chain-no-flush object) ;; (function dma-bank-source uint none) -;; (define-extern dma-send-to-spr object) ;; (function uint uint uint symbol none) -;; (define-extern dma-send-to-spr-no-flush object) ;; (function uint uint uint symbol none) -;; (define-extern dma-send-from-spr object) ;; (function uint uint uint symbol none) -;; (define-extern dma-send-from-spr-no-flush object) ;; (function uint uint uint symbol none) -;; (define-extern dma-initialize object) ;; (function none) -;; (define-extern clear-vu0-mem object) ;; (function none) -;; (define-extern clear-vu1-mem object) ;; (function none) -;; (define-extern dump-vu1-mem object) ;; (function none) -;; (define-extern dump-vu1-range object) ;; (function uint uint symbol) -;; (define-extern reset-vif1-path object) ;; (function none) -;; (define-extern ultimate-memcpy object) ;; (function pointer pointer uint none) -;; (define-extern symlink2 object) ;; (function none) -;; (define-extern symlink3 object) ;; (function none) +(define-extern dma-sync-hang (function dma-bank none)) +(define-extern dma-sync-crash (function dma-bank none)) +(define-extern dma-send (function dma-bank uint uint none)) +(define-extern dma-send-chain (function dma-bank-source uint none)) +(define-extern dma-send-chain-no-tte (function dma-bank-source uint none)) +(define-extern dma-send-chain-no-flush (function dma-bank-source uint none)) +(define-extern dma-send-to-spr (function uint uint uint symbol none)) +(define-extern dma-send-to-spr-no-flush (function uint uint uint symbol none)) +(define-extern dma-send-from-spr (function uint uint uint symbol none)) +(define-extern dma-send-from-spr-no-flush (function uint uint uint symbol none)) +(define-extern dma-initialize (function none)) +(define-extern clear-vu0-mem (function none)) +(define-extern clear-vu1-mem (function none)) +(define-extern dump-vu1-mem (function none)) +(define-extern dump-vu1-range (function uint uint symbol)) +(define-extern reset-vif1-path (function none)) +(define-extern ultimate-memcpy (function pointer pointer uint none)) +(define-extern symlink2 (function none)) +(define-extern symlink3 (function none)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; dma-buffer ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| + (deftype dma-packet (structure) - ((dma uint64 :offset-assert 0) ;; dma-tag - (vif0 vif-tag :offset-assert 8) ;; guessed by decompiler - (vif1 vif-tag :offset-assert 12) ;; guessed by decompiler - (quad uint128 :offset-assert 0) + ((dma dma-tag :offset-assert 0) + (vif0 vif-tag :offset-assert 8) + (vif1 vif-tag :offset-assert 12) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype dma-packet-array (inline-array-class) - ((data UNKNOWN :dynamic :offset-assert 16) + ((data dma-packet :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype dma-gif (structure) - ((gif UNKNOWN 2 :offset-assert 0) - (quad uint128 :offset-assert 0) + ((gif uint64 2 :offset-assert 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype dma-gif-packet (structure) ((dma-vif dma-packet :inline :offset-assert 0) - (gif uint64 2 :offset-assert 16) ;; guessed by decompiler - (quad uint128 2 :offset-assert 0) ;; guessed by decompiler + (gif uint64 2 :offset-assert 16) + (quad uint128 2 :offset 0) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) -|# -#| + (deftype dma-buffer (basic) ((allocated-length int32 :offset-assert 4) - (base pointer :offset-assert 8) ;; guessed by decompiler - (end pointer :offset-assert 12) ;; guessed by decompiler - (data uint64 1 :offset-assert 16) ;; guessed by decompiler + (base pointer :offset-assert 8) + (end pointer :offset-assert 12) + (data uint64 1 :offset-assert 16) + ) + (:methods + (new (symbol type int) _type_ 0) ) :method-count-assert 9 :size-assert #x18 :flag-assert #x900000018 ) -|# -;; (define-extern dma-buffer-inplace-new object) ;; (function dma-buffer int dma-buffer) -;; (define-extern dma-buffer-length object) ;; (function dma-buffer int) -;; (define-extern dma-buffer-free object) ;; (function dma-buffer int) -;; (define-extern dma-buffer-add-vu-function object) ;; (function dma-buffer vu-function int symbol) -;; (define-extern dma-buffer-send object) ;; (function dma-bank dma-buffer none) -;; (define-extern dma-buffer-send-chain object) ;; (function dma-bank-source dma-buffer none) + +(define-extern dma-buffer-inplace-new (function dma-buffer int dma-buffer)) +(define-extern dma-buffer-length (function dma-buffer int)) +(define-extern dma-buffer-free (function dma-buffer int)) +(define-extern dma-buffer-add-vu-function (function dma-buffer vu-function int symbol)) +(define-extern dma-buffer-send (function dma-bank dma-buffer none)) +(define-extern dma-buffer-send-chain (function dma-bank-source dma-buffer none)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; dma-bucket ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern dma-buffer-add-buckets object) ;; (function dma-buffer int (inline-array dma-bucket)) -;; (define-extern dma-buffer-patch-buckets object) ;; (function (inline-array dma-bucket) int (inline-array dma-bucket)) -;; (define-extern dma-bucket-insert-tag object) ;; (function (inline-array dma-bucket) bucket-id pointer (pointer dma-tag) pointer) +(define-extern dma-buffer-add-buckets (function dma-buffer int (inline-array dma-bucket))) +(define-extern dma-buffer-patch-buckets (function (inline-array dma-bucket) int (inline-array dma-bucket))) +(define-extern dma-bucket-insert-tag (function (inline-array dma-bucket) bucket-id pointer (pointer dma-tag) pointer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; dma-disasm ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype vif-disasm-element (structure) ((mask uint32 :offset-assert 0) (tag vif-cmd-32 :offset-assert 4) ;; guessed by decompiler @@ -2777,20 +3192,39 @@ :size-assert #x18 :flag-assert #x900000018 ) -|# -;; (define-extern *vif-disasm-table* object) ;; (array vif-disasm-element) -;; (define-extern disasm-vif-details object) ;; (function symbol (pointer uint8) vif-cmd int symbol) -;; (define-extern disasm-vif-tag object) ;; (function (pointer vif-tag) int symbol symbol int) -;; (define-extern disasm-dma-tag object) ;; (function dma-tag symbol none) -;; (define-extern *dma-disasm* object) ;; symbol -;; (define-extern disasm-dma-list object) ;; (function dma-packet symbol symbol symbol int symbol) +(define-extern *vif-disasm-table* (array vif-disasm-element)) +(define-extern disasm-vif-details (function symbol (pointer uint8) vif-cmd int symbol)) +(define-extern disasm-vif-tag (function (pointer vif-tag) int symbol symbol int)) +(define-extern disasm-dma-tag (function dma-tag symbol none)) +(define-extern *dma-disasm* symbol) +(define-extern disasm-dma-list (function dma-packet symbol symbol symbol int symbol)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pad ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum pad-buttons + :bitfield #t + :type uint32 + (select 0) + (l3 1) + (r3 2) + (start 3) + (up 4) + (right 5) + (down 6) + (left 7) + (l2 8) + (r2 9) + (l1 10) + (r1 11) + (triangle 12) + (circle 13) + (x 14) + (square 15) + ) + (deftype scf-time (structure) ((stat uint8 :offset-assert 0) (second uint8 :offset-assert 1) @@ -2805,9 +3239,7 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype hw-cpad (basic) ((valid uint8 :offset-assert 4) (status uint8 :offset-assert 5) @@ -2816,16 +3248,14 @@ (righty uint8 :offset-assert 9) (leftx uint8 :offset-assert 10) (lefty uint8 :offset-assert 11) - (abutton uint8 12 :offset-assert 12) ;; guessed by decompiler - (dummy uint8 12 :offset-assert 24) ;; guessed by decompiler + (abutton uint8 12 :offset-assert 12) + (dummy uint8 12 :offset-assert 24) ) :method-count-assert 9 :size-assert #x24 :flag-assert #x900000024 ) -|# -#| (deftype cpad-info (hw-cpad) ((number int32 :offset-assert 36) (cpad-file int32 :offset-assert 40) @@ -2839,556 +3269,1137 @@ (align uint8 6 :offset-assert 88) ;; guessed by decompiler (direct uint8 6 :offset-assert 94) ;; guessed by decompiler (buzz-val uint8 2 :offset-assert 100) ;; guessed by decompiler - (buzz-pause-val UNKNOWN 1 :offset-assert 102) + (buzz-pause-val uint8 1 :offset-assert 102) (buzz-pause-time uint8 :offset-assert 103) (buzz-time time-frame 2 :offset-assert 104) ;; guessed by decompiler (buzz basic :offset-assert 120) (buzz-act int32 :offset-assert 124) (change-time uint64 :offset-assert 128) ;; time-frame - (old-rightx UNKNOWN 2 :offset-assert 136) - (old-righty UNKNOWN 2 :offset-assert 138) - (old-leftx UNKNOWN 2 :offset-assert 140) - (old-lefty UNKNOWN 2 :offset-assert 142) + (old-rightx uint8 2 :offset-assert 136) + (old-righty uint8 2 :offset-assert 138) + (old-leftx uint8 2 :offset-assert 140) + (old-lefty uint8 2 :offset-assert 142) ) :method-count-assert 10 :size-assert #x90 :flag-assert #xa00000090 (:methods - ;; (new (symbol type int) _type_ 0) + (new (symbol type int) _type_ 0) (dummy-9 () none 9) ) ) -|# -#| (deftype cpad-list (basic) ((num-cpads int32 :offset-assert 4) - (cpads cpad-info 2 :offset-assert 8) ;; guessed by decompiler + (cpads cpad-info 2 :offset-assert 8) + ) + (:methods + (new (symbol type) _type_ 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype mouse-info (basic) - () + ((active symbol :offset-assert 4) + (cursor basic :offset-assert 8) + (valid symbol :offset-assert 12) + (id uint8 :offset-assert 16) + (status uint16 :offset-assert 18) + (button0 uint16 :offset-assert 20) + (deltax int8 :offset-assert 22) + (deltay int8 :offset-assert 23) + (wheel uint8 :offset-assert 24) + (change-time time-frame :offset-assert 32) + (button0-abs uint32 3 :offset-assert 40) + (button0-shadow-abs uint32 1 :offset-assert 52) + (button0-rel uint32 3 :offset-assert 56) + (pos vector 2 :inline :offset-assert 80) + (posx float :offset 80) + (posy float :offset 84) + (oldposx float :offset 96 :do-not-decompile) + (oldposy float :offset 100) + (speedx float :offset 92) + (speedy float :offset 108) + ) + (:methods + (new (symbol type) _type_ 0) + ) :method-count-assert 9 :size-assert #x70 :flag-assert #x900000070 - ;; Failed to read fields. ) -|# -;; (define-extern *cheat-mode* object) ;; symbol -;; (define-extern cpad-invalid! object) ;; (function cpad-info cpad-info) -;; (define-extern analog-input object) ;; (function int float float float float float) -;; (define-extern cpad-set-buzz! object) ;; (function cpad-info int int time-frame none) -;; (define-extern *cpad-list* object) ;; cpad-list -;; (define-extern *cpad-debug* object) ;; symbol -;; (define-extern service-cpads object) ;; (function cpad-list) -;; (define-extern buzz-stop! object) ;; (function int none) -;; (define-extern *mouse* object) -;; (define-extern service-mouse object) +(define-extern *cheat-mode* symbol) +(define-extern cpad-invalid! (function cpad-info cpad-info)) +(define-extern analog-input (function int float float float float float)) +(define-extern cpad-set-buzz! (function cpad-info int int time-frame none)) +(define-extern *cpad-list* cpad-list) +(define-extern *cpad-debug* symbol) +(define-extern service-cpads (function cpad-list)) +(define-extern buzz-stop! (function int none)) +(define-extern *mouse* mouse-info) +(define-extern service-mouse (function none)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; gs ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum gs-psm + :bitfield #f + :type uint8 + (ct32 0) + (ct24 1) + (ct16 2) + (ct16s 10) + (mt8 19) + (mt4 20) + (mt8h 27) + (mt4hl 36) + (mt4hh 44) + (mz32 48) + (mz24 49) + (mz16 50) + (mz16s 58) + ) + +(defenum gs-reg + :type uint8 + (prim 0) + (rgbaq 1) + (st 2) + (uv 3) + (xyzf2 4) + (xyz2 5) + (tex0-1 6) + (tex0-2 7) + (clamp-1 8) + (clamp-2 9) + (fog 10) + (xyzf3 12) + (xyz3 13) + (tex1-1 20) + (tex1-2 21) + (tex2-1 22) + (tex2-2 23) + (xyoffset-1 24) + (xyoffset-2 25) + (prmodecont 26) + (prmode 27) + (texclut 28) + (scanmsk 34) + (miptbp1-1 52) + (miptbp1-2 53) + (miptbp2-1 54) + (miptbp2-2 55) + (texa 59) + (fogcol 61) + (texflush 63) + (scissor-1 64) + (scissor-2 65) + (alpha-1 66) + (alpha-2 67) + (dimx 68) + (dthe 69) + (colclamp 70) + (test-1 71) + (test-2 72) + (pabe 73) + (fba-1 74) + (fba-2 75) + (frame-1 76) + (frame-2 77) + (zbuf-1 78) + (zbuf-2 79) + (bitbltbuf 80) + (trxpos 81) + (trxreg 82) + (trxdir 83) + (hwreg 84) + (signal 96) + (finish 97) + (label 98) + ) + +(defenum gs-reg64 + :type uint64 + :copy-entries gs-reg + ) + +(defenum gs-prim-type + :type uint8 + (point 0) + (line 1) + (line-strip 2) + (tri 3) + (tri-strip 4) + (tri-fan 5) + (sprite 6) + ) + + +(deftype gs-pmode (uint64) + ((en1 uint8 :offset 0 :size 1) + (en2 uint8 :offset 1 :size 1) + (crtmd uint8 :offset 2 :size 3) + (mmod uint8 :offset 5 :size 1) + (amod uint8 :offset 6 :size 1) + (slbg uint8 :offset 7 :size 1) + (alp uint8 :offset 8 :size 8) + ) + :flag-assert #x900000008 + ) + +(deftype gs-smode2 (uint64) + ((int uint8 :offset 0 :size 1) + (ffmd uint8 :offset 1 :size 1) + (dpms uint8 :offset 2 :size 2) + ) + :flag-assert #x900000008 + ) + +(deftype gs-display-fb (uint64) + ((fbp uint16 :offset 0 :size 9) + (fbw uint8 :offset 9 :size 6) + (psm gs-psm :offset 15 :size 5) + (dbx uint16 :offset 32 :size 11) + (dby uint16 :offset 43 :size 11) + ) + :flag-assert #x900000008 + ) + +;; the GS's DISPLAY registers make settings for the display position on the screen regarding +;; information on Rectangular Area Read Output Circuit n for the PCRTC. +;; write-only +(deftype gs-display (uint64) + ((dx uint16 :offset 0 :size 12) + (dy uint16 :offset 12 :size 11) + (magh uint8 :offset 23 :size 4) + (magv uint8 :offset 27 :size 2) + (dw uint16 :offset 32 :size 12) + (dh uint16 :offset 44 :size 11) + ) + :flag-assert #x900000008 + ) + +;; the GS's BGCOLOR register sets the background color of the PCRTC with RGB value. +;; write-only +(deftype gs-bgcolor (uint64) + ((r uint8 :offset 0) + (g uint8 :offset 8) + (b uint8 :offset 16) + ) + :flag-assert #x900000008 + ) + +;; the GS's CSR register sets and obtains various GS statuses. +;; read-write. the fields have different effects depending on whether they're being read from +;; or written to. +;; bits 5 and 6 (0x20 and 0x40) should be zero +(deftype gs-csr (uint64) + ((signal uint8 :offset 0 :size 1) + (finish uint8 :offset 1 :size 1) + (hsint uint8 :offset 2 :size 1) + (vsint uint8 :offset 3 :size 1) + (edwint uint8 :offset 4 :size 1) + (flush uint8 :offset 8 :size 1) + (reset uint8 :offset 9 :size 1) + (nfield uint8 :offset 12 :size 1) + (field uint8 :offset 13 :size 1) + (fifo uint8 :offset 14 :size 2) + (rev uint8 :offset 16 :size 8) + (id uint8 :offset 24 :size 8) + ) + :flag-assert #x900000008 + ) + (deftype gs-bank (structure) - ((pmode uint64 :offset-assert 0) ;; gs-pmode - (smode2 uint64 :offset-assert 32) ;; gs-smode2 - (dspfb1 uint64 :offset-assert 112) ;; gs-display-fb - (display1 uint64 :offset-assert 128) ;; gs-display - (dspfb2 uint64 :offset-assert 144) ;; gs-display-fb - (display2 uint64 :offset-assert 160) ;; gs-display - (extbuf uint64 :offset-assert 176) - (extdata uint64 :offset-assert 192) - (extwrite uint64 :offset-assert 208) - (bgcolor uint64 :offset-assert 224) ;; gs-bgcolor - (csr uint64 :offset-assert 4096) ;; gs-csr - (imr uint64 :offset-assert 4112) - (busdir uint64 :offset-assert 4160) + ((pmode gs-pmode :offset-assert 0) + (smode2 gs-smode2 :offset 32) + (dspfb1 gs-display-fb :offset 112) + (display1 gs-display :offset 128) + (dspfb2 gs-display-fb :offset 144) + (display2 gs-display :offset 160) + (extbuf uint64 :offset 176) + (extdata uint64 :offset 192) + (extwrite uint64 :offset 208) + (bgcolor gs-bgcolor :offset 224) + (csr gs-csr :offset 4096) + (imr uint64 :offset 4112) + (busdir uint64 :offset 4160) ) :method-count-assert 9 :size-assert #x1048 :flag-assert #x900001048 ) -|# -#| +(deftype gs-frame (uint64) + ((fbp uint16 :offset 0 :size 9) + (fbw uint8 :offset 16 :size 6) + (psm gs-psm :offset 24 :size 6) + (fbmsk uint32 :offset 32 :size 32) + ) + :flag-assert #x900000008 + ) + + +;; the GS's ZBUF registers make various settings regarding Z buffer. +(deftype gs-zbuf (uint64) + ((zbp uint16 :offset 0 :size 9) + (psm gs-psm :offset 24 :size 4) + (zmsk uint8 :offset 32 :size 1) + ) + :flag-assert #x900000008 + ) + +;; the GS's XYOFFSET registers set the offset value for converting from the primitive coordinate +;; system to the window coordinate system. +(deftype gs-xy-offset (uint64) + ((ofx uint16 :offset 0 :size 16) + (ofy uint16 :offset 32 :size 16) + ) + :flag-assert #x900000008 + ) + +;; the GS's SCISSOR registers specify the scissoring area. The coordinate values for +;; the upper-left/lower-right points of the enabled drawing area are specified by the window +;; coordinate system. +(deftype gs-scissor (uint64) + ((scax0 uint16 :offset 0 :size 11) + (scax1 uint16 :offset 16 :size 11) + (scay0 uint16 :offset 32 :size 11) + (scay1 uint16 :offset 48 :size 11) + ) + :flag-assert #x900000008 + ) + +;; the GS's PRMODECONT register sets whether to use primitive attributes (IIP, TME, FGE, ABE, +;; AA1, FST, CTXT, FIX) specified by the PRMODE register or the PRIM register. +(deftype gs-prmode-cont (uint64) + ((ac uint8 :offset 0 :size 1)) + :flag-assert #x900000008 + ) + +;; the GS's COLCLAMP register stores settings as to whether clamping for the RGB value of the +;; pixel is performed. +(deftype gs-color-clamp (uint64) + ((clamp uint8 :offset 0 :size 1)) + :flag-assert #x900000008 + ) + +;; the GS's DTHE register stores settings for dithering (performed/not performed). +(deftype gs-dthe (uint64) + ((dthe uint8 :offset 0 :size 1)) + :flag-assert #x900000008 + ) + +(defenum gs-atest + :type uint8 + (never 0) + (always 1) + (less 2) + (less-equal 3) + (equal 4) + (greater-equal 5) + (greater 6) + (not-equal 7) + ) +(defenum gs-ztest + :type uint8 + (never 0) + (always 1) + (greater-equal 2) + (greater 3) + ) +;; the GS's TEST register performs settings related to the pixel test. +(deftype gs-test (uint64) + ((ate uint8 :offset 0 :size 1) ;; alpha test enable + (atst gs-atest :offset 1 :size 3) ;; alpha test method + (aref uint8 :offset 4 :size 8) ;; alpha val reference + (afail uint8 :offset 12 :size 2) ;; processing method on alpha test fail + (date uint8 :offset 14 :size 1) ;; dest alpha test enable + (datm uint8 :offset 15 :size 1) ;; dest alpha test mode + (zte uint8 :offset 16 :size 1) ;; depth test enable + (ztst gs-ztest :offset 17 :size 2) ;; depth test method + ) + :flag-assert #x900000008 + ) + +(deftype gs-prim (uint64) + ((prim gs-prim-type :offset 0 :size 3) + (iip uint8 :offset 3 :size 1) + (tme uint8 :offset 4 :size 1) + (fge uint8 :offset 5 :size 1) + (abe uint8 :offset 6 :size 1) + (aa1 uint8 :offset 7 :size 1) + (fst uint8 :offset 8 :size 1) + (ctxt uint8 :offset 9 :size 1) + (fix uint8 :offset 10 :size 1) + ) + :flag-assert #x900000008 + ) + +;; gap! +;; the GS's RGBAQ register sets the RGBA value of the vertex and the Q value of the normalized +;; texture coordinates. +(deftype gs-rgbaq (uint64) + ((r uint8 :offset 0 :size 8) + (g uint8 :offset 8 :size 8) + (b uint8 :offset 16 :size 8) + (a uint8 :offset 24 :size 8) ;; 0x80 --> 1.0 + (q float :offset 32 :size 32) ;; affects some LOD behavior apparently? + ) + :flag-assert #x900000008 + ) + +;; GS XYZ registers +(deftype gs-xyz (uint64) + ((x uint16 :offset 0 :size 16) ;; Q4 fixed point + (y uint16 :offset 16 :size 16) ;; Q4 fixed point + (z uint32 :offset 32 :size 32) + ) + :flag-assert #x900000008 + ) + +;; the GS's UV register specifies the texel coordinate (UV) values of the vertex. +(deftype gs-uv (uint64) + ((u uint16 :offset 0 :size 14) ;; Q4 fixed point + (v uint16 :offset 16 :size 14) ;; Q4 fixed point + ) + :flag-assert #x900000008 + ) + +;; the GS's ST register sets the S and T values of the vertex texture coordinates. +;; The value Q is specified by the RGBAQ register. +(deftype gs-st (uint64) + ((s float :offset 0 :size 32) + (t float :offset 32 :size 32) + ) + :flag-assert #x900000008 + ) + +;; GS XYZF registers +(deftype gs-xyzf (uint64) + ((x uint16 :offset 0 :size 16) ;; Q4 fixed point + (y uint16 :offset 16 :size 16) ;; Q4 fixed point + (z uint32 :offset 32 :size 24) + (f uint8 :offset 56 :size 8) ;; fog coeff + ) + :flag-assert #x900000008 + ) + +;; the GS's TRXPOS register specifies the position and scanning direction of the rectangular area +;; in each buffer where buffer transmission is performed. +(deftype gs-trxpos (uint64) + ((ssax uint16 :offset 0 :size 11) + (ssay uint16 :offset 16 :size 11) + (dsax uint16 :offset 32 :size 11) + (dsay uint16 :offset 48 :size 11) + (dir uint8 :offset 59 :size 2) + ) + :flag-assert #x900000008 + ) + +;; the GS's TRXREG register specifies the size of the rectangular area, where the transmission +;; between buffers is implemented, in units of pixels. +;; The pixel mode must be the one set by the BITBLTBUF register. +(deftype gs-trxreg (uint64) + ((rrw uint16 :offset 0 :size 12) + (rrh uint16 :offset 32 :size 12) + ) + :flag-assert #x900000008 + ) + +;; the GS's TRXDIR register specifies the transmission direction in the transmission between +;; buffers, and activates transmission. +;; Appropriate settings must be made by the BITBLTBUF/TRXPOS/TRXREG before activating +;; the transmission. +(deftype gs-trxdir (uint64) + ((xdir uint8 :offset 0 :size 2)) + :flag-assert #x900000008 + ) + +;; the GS's BITBLTBUF register stores buffer-related settings for transmission source and +;; destination during transmission between buffers. +(deftype gs-bitbltbuf (uint64) + ((sbp uint16 :offset 0 :size 14) + (sbw uint8 :offset 16 :size 6) + (spsm uint8 :offset 24 :size 6) + (dbp uint16 :offset 32 :size 14) + (dbw uint8 :offset 48 :size 6) + (dpsm uint8 :offset 56 :size 6) + ) + :flag-assert #x900000008 + ) + +;; the GS's TEX0 registers set various kinds of information regarding the textures to be used. +(deftype gs-tex0 (uint64) + ((tbp0 uint16 :offset 0 :size 14) + (tbw uint8 :offset 14 :size 6) + (psm uint8 :offset 20 :size 6) + (tw uint8 :offset 26 :size 4) + (th uint8 :offset 30 :size 4) + (tcc uint8 :offset 34 :size 1) + (tfx uint8 :offset 35 :size 2) + (cbp uint16 :offset 37 :size 14) + (cpsm uint8 :offset 51 :size 4) + (csm uint8 :offset 55 :size 1) + (csa uint8 :offset 56 :size 5) + (cld uint8 :offset 61 :size 3) + ) + :flag-assert #x900000008 + ) + +;; the GS's TEX1 registers set information on the sampling method of the textures. +(deftype gs-tex1 (uint64) + ((lcm uint8 :offset 0 :size 1) + (mxl uint8 :offset 2 :size 3) + (mmag uint8 :offset 5 :size 1) + (mmin uint8 :offset 6 :size 3) + (mtba uint8 :offset 9 :size 1) + (l uint8 :offset 19 :size 2) + (k int16 :offset 32 :size 12) + ) + :flag-assert #x900000008 + ) + +;; the GS's TEXA register sets the Alpha value to be referred to when the Alpha value of the +;; texture is not an 8-bit value. +(deftype gs-texa (uint64) + ((ta0 uint8 :offset 0 :size 8) + (aem uint8 :offset 15 :size 1) + (ta1 uint8 :offset 32 :size 8) + ) + :flag-assert #x900000008 + ) + +;; the GS's TEXCLUT register specifies the CLUT position in the buffer when the CLUT storage mode +;; is CSM=1 (CSM2 mode). +(deftype gs-texclut (uint64) + ((cbw uint8 :offset 0 :size 6) + (cou uint8 :offset 6 :size 6) + (cov uint16 :offset 12 :size 10) + ) + :flag-assert #x900000008 + ) + +;; the GS's MIPTBP registers set the buffer pointer and buffer width of textures when performing +;; MIPMAP. +;; MIPTBP1 sets levels 1 to 3, MIPTBP2 sets levels 4 to 6. +(deftype gs-miptbp (uint64) + ((tbp1 uint16 :offset 0 :size 14) + (tbw1 uint8 :offset 14 :size 6) + (tbp2 uint16 :offset 20 :size 14) + (tbw2 uint8 :offset 34 :size 6) + (tbp3 uint16 :offset 40 :size 14) + (tbw3 uint8 :offset 54 :size 6) + ) + :flag-assert #x900000008 + ) + (deftype gs-adcmd (structure) - ((word UNKNOWN 4 :offset-assert 0) - (quad uint128 :offset-assert 0) - (data uint64 :offset-assert 0) - (cmds uint64 :offset-assert 8) - (cmd uint8 :offset-assert 8) - (x uint32 :offset-assert 0) - (y uint32 :offset-assert 4) - (z uint32 :offset-assert 8) - (w uint32 :offset-assert 12) + ((word uint32 4 :offset-assert 0) + (quad uint128 :offset 0) + (data uint64 :offset 0) + (cmds uint64 :offset 8) + (cmd uint8 :offset 8) + (x uint32 :offset 0) + (y uint32 :offset 4) + (z uint32 :offset 8) + (w uint32 :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype gs-alpha (uint64) - () - :method-count-assert 9 - :size-assert #x8 - :flag-assert #x900000008 - ;; Failed to read some fields. + ((a uint8 :offset 0 :size 2) + (b uint8 :offset 2 :size 2) + (c uint8 :offset 4 :size 2) + (d uint8 :offset 6 :size 2) + (fix uint8 :offset 32 :size 8) + ) + :flag-assert #x900000008 + ) + +(defenum gs-tex-wrap-mode + :type uint8 + (repeat 0) + (clamp 1) + (region-clamp 2) + (region-repeat 3) + ) + +(deftype gs-clamp (uint64) + ((wms gs-tex-wrap-mode :offset 0 :size 2) + (wmt gs-tex-wrap-mode :offset 2 :size 2) + (minu uint16 :offset 4 :size 10) + (maxu uint16 :offset 14 :size 10) + (minv uint16 :offset 24 :size 10) + (maxv uint16 :offset 34 :size 10) + ) + :flag-assert #x900000008 ) -|# -#| (deftype gs-fog (uint64) - () - :method-count-assert 9 - :size-assert #x8 - :flag-assert #x900000008 - ;; Failed to read some fields. + ((f uint8 :offset 56 :size 8)) + :flag-assert #x900000008 ) -|# -#| (deftype gs-fogcol (uint64) - () - :method-count-assert 9 - :size-assert #x8 - :flag-assert #x900000008 - ;; Failed to read some fields. + ((fcr uint8 :offset 0 :size 8) + (fcg uint8 :offset 8 :size 8) + (fcb uint8 :offset 16 :size 8) + ) + :flag-assert #x900000008 + ) + +(deftype gif-ctrl (uint32) + ((rst uint8 :offset 0 :size 1) + (pse uint8 :offset 3 :size 1) + ) + :flag-assert #x900000004 + ) + +(deftype gif-mode (uint32) + ((m3r uint8 :offset 0 :size 1) + (imt uint8 :offset 2 :size 1) + ) + :flag-assert #x900000004 + ) + +(deftype gif-stat (uint32) + ((m3r uint8 :offset 0 :size 1) + (m3p uint8 :offset 1 :size 1) + (imt uint8 :offset 2 :size 1) + (pse uint8 :offset 3 :size 1) + (ip3 uint8 :offset 5 :size 1) + (p3q uint8 :offset 6 :size 1) + (p2q uint8 :offset 7 :size 1) + (p1q uint8 :offset 8 :size 1) + (oph uint8 :offset 9 :size 1) + (apath uint8 :offset 10 :size 2) + (dir uint8 :offset 12 :size 1) + (fqc uint8 :offset 24 :size 5) + ) + :flag-assert #x900000004 + ) + +(deftype gif-cnt (uint32) + ((loopcnt uint16 :offset 0 :size 15) + (regcnt uint8 :offset 16 :size 4) + (vuaddr uint16 :offset 20 :size 10) + ) + :flag-assert #x900000004 + ) + +(deftype gif-p3cnt (uint32) + ((p3cnt uint16 :offset 0 :size 15)) + :flag-assert #x900000004 + ) + +(deftype gif-p3tag (uint32) + ((loopcnt uint16 :offset 0 :size 15) + (eop uint8 :offset 15 :size 1) + ) + :flag-assert #x900000004 ) -|# -#| (deftype gif-bank (structure) - ((ctrl gif-ctrl :offset-assert 0) ;; guessed by decompiler - (mode gif-mode :offset-assert 16) ;; guessed by decompiler - (stat gif-stat :offset-assert 32) ;; guessed by decompiler - (tag0 uint32 :offset-assert 64) - (tag1 uint32 :offset-assert 80) - (tag2 uint32 :offset-assert 96) - (tag3 uint32 :offset-assert 112) - (cnt gif-cnt :offset-assert 128) ;; guessed by decompiler - (p3cnt gif-p3cnt :offset-assert 144) ;; guessed by decompiler - (p3tag gif-p3tag :offset-assert 160) ;; guessed by decompiler + ((ctrl gif-ctrl :offset 0) + (mode gif-mode :offset 16) + (stat gif-stat :offset 32) + (tag0 uint32 :offset 64) + (tag1 uint32 :offset 80) + (tag2 uint32 :offset 96) + (tag3 uint32 :offset 112) + (cnt gif-cnt :offset 128) + (p3cnt gif-p3cnt :offset 144) + (p3tag gif-p3tag :offset 160) ) :method-count-assert 9 :size-assert #xa4 :flag-assert #x9000000a4 ) -|# -#| +(deftype gif-tag-prim (uint32) + () + :flag-assert #x900000004 + ) + +(deftype gif-tag-count (uint32) + () + :flag-assert #x900000004 + ) + +(defenum gif-reg-id + :type uint8 + (prim 0) + (rgbaq 1) + (st 2) + (uv 3) + (xyzf2 4) + (xyz2 5) + (tex0-1 6) + (tex0-2 7) + (clamp-1 8) + (clamp-2 9) + (fog 10) + (xyzf3 12) + (xyz3 13) + (a+d 14) + (nop 15) + ) + +(defenum gif-flag + :type uint8 + (packed 0) + (reg-list 1) + (image 2) + (disable 3) + ) + +(deftype gif-tag64 (uint64) + ((nloop uint16 :offset 0 :size 15) + (eop uint8 :offset 15 :size 1) + (id uint16 :offset 32 :size 14) + (pre uint8 :offset 46 :size 1) + (prim gs-prim :offset 47 :size 11) + (flg gif-flag :offset 58 :size 2) + (nreg uint8 :offset 60 :size 4)) + :flag-assert #x900000008 + ) +(deftype gif-tag (uint128) + ((nloop uint16 :offset 0 :size 15) + (eop uint8 :offset 15 :size 1) + (id uint16 :offset 32 :size 14) + (pre uint8 :offset 46 :size 1) + (prim uint16 :offset 47 :size 11) + (flg gif-flag :offset 58 :size 2) + (nreg uint8 :offset 60 :size 4) + (regs0 gif-reg-id :offset 64 :size 4) + (regs1 gif-reg-id :offset 68 :size 4) + (regs2 gif-reg-id :offset 72 :size 4) + (regs3 gif-reg-id :offset 76 :size 4) + (regs4 gif-reg-id :offset 80 :size 4) + (regs5 gif-reg-id :offset 84 :size 4) + (regs6 gif-reg-id :offset 88 :size 4) + (regs7 gif-reg-id :offset 92 :size 4) + (regs8 gif-reg-id :offset 96 :size 4) + (regs9 gif-reg-id :offset 100 :size 4) + (regs10 gif-reg-id :offset 104 :size 4) + (regs11 gif-reg-id :offset 108 :size 4) + (regs12 gif-reg-id :offset 112 :size 4) + (regs13 gif-reg-id :offset 116 :size 4) + (regs14 gif-reg-id :offset 120 :size 4) + (regs15 gif-reg-id :offset 124 :size 4) + ) + :flag-assert #x900000010 + ) + +(deftype gif-tag-regs (uint64) + ((regs0 gif-reg-id :offset 0 :size 4) + (regs1 gif-reg-id :offset 4 :size 4) + (regs2 gif-reg-id :offset 8 :size 4) + (regs3 gif-reg-id :offset 12 :size 4) + (regs4 gif-reg-id :offset 16 :size 4) + (regs5 gif-reg-id :offset 20 :size 4) + (regs6 gif-reg-id :offset 24 :size 4) + (regs7 gif-reg-id :offset 28 :size 4) + (regs8 gif-reg-id :offset 32 :size 4) + (regs9 gif-reg-id :offset 36 :size 4) + (regs10 gif-reg-id :offset 40 :size 4) + (regs11 gif-reg-id :offset 44 :size 4) + (regs12 gif-reg-id :offset 48 :size 4) + (regs13 gif-reg-id :offset 52 :size 4) + (regs14 gif-reg-id :offset 56 :size 4) + (regs15 gif-reg-id :offset 60 :size 4) + ) + ) + (deftype gs-gif-tag (structure) - ((qword qword :inline :offset-assert 0) ;; uint128 - (dword uint64 2 :offset-assert 0) ;; guessed by decompiler - (word uint32 4 :offset-assert 0) ;; guessed by decompiler - (tag uint64 :offset-assert 0) ;; gif-tag64 - (regs uint64 :offset-assert 8) ;; gif-tag-regs + ((qword uint128 :offset-assert 0 :score -1) ;; is "qword" and inline? in game + + (tag gif-tag64 :offset 0) + (regs gif-tag-regs :offset 8) + + (dword uint64 2 :offset 0) + (word uint32 4 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| -(deftype gif-tag (uint128) - () - :method-count-assert 9 - :size-assert #x10 - :flag-assert #x900000010 - ;; Failed to read fields. - ) -|# - -#| (deftype gif-packet (basic) ((reg-count int32 :offset-assert 4) - (gif-tag0 uint128 :offset-assert 16) - (args uint64 1 :offset-assert 32) ;; guessed by decompiler + + (gif-tag gs-gif-tag :inline :offset-assert 16) ;; note- added + (gif-tag0 uint128 :offset 16) + (args uint64 1 :offset-assert 32) ) + (:methods + (new (symbol type int) _type_ 0) + ) :method-count-assert 9 :size-assert #x28 :flag-assert #x900000028 ) -|# -#| (deftype draw-context (basic) ((orgx int32 :offset-assert 4) (orgy int32 :offset-assert 8) (orgz int32 :offset-assert 12) (width int32 :offset-assert 16) (height int32 :offset-assert 20) + (color rgba 4 :offset-assert 24) ) + (:methods + (new (symbol type int int int int rgba) _type_ 0) + ) :method-count-assert 9 :size-assert #x28 :flag-assert #x900000028 ;; Failed to read some fields. ) -|# -#| (deftype gs-packed-rgba (vector4w) - ((r int32 :offset-assert 0) - (g int32 :offset-assert 4) - (b int32 :offset-assert 8) - (a int32 :offset-assert 12) + ((r int32 :offset 0) + (g int32 :offset 4) + (b int32 :offset 8) + (a int32 :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype gs-packed-xyzw (vector) - ((data int32 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) ;; int32 - (y float :offset-assert 4) ;; int32 - (z float :offset-assert 8) ;; int32 - (w float :offset-assert 12) ;; int32 - (quad uint128 :offset-assert 0) - (ix int32 :offset-assert 0) - (iy int32 :offset-assert 4) - (iz int32 :offset-assert 8) - (iw int32 :offset-assert 12) + ((ix int32 :offset 0) + (iy int32 :offset 4) + (iz int32 :offset 8) + (iw int32 :offset 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype gs-packed-stq (vector) - ((data float 4 :offset-assert 0) ;; guessed by decompiler - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (quad uint128 :offset-assert 0) - (tex-s float :offset-assert 0) - (tex-t float :offset-assert 4) - (tex-q float :offset-assert 8) - (quad uint128 :offset-assert 0) + ((tex-s float :offset 0) + (tex-t float :offset 4) + (tex-q float :offset 8) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype gs-packed-uv (vector) - ((data UNKNOWN 4 :offset-assert 0) - (x float :offset-assert 0) - (y float :offset-assert 4) - (z float :offset-assert 8) - (w float :offset-assert 12) - (quad uint128 :offset-assert 0) - (u int16 :offset-assert 0) - (v int16 :offset-assert 4) - (quad uint128 :offset-assert 0) + ((u int16 :offset 0) + (v int16 :offset 4) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype gs-packed-gt (structure) - ((stq gs-packed-stq :inline :offset-assert 0) - (rgba gs-packed-rgba :inline :offset-assert 16) - (xyzw gs-packed-xyzw :inline :offset-assert 32) + ((stq gs-packed-stq :inline :offset 0) + (rgba gs-packed-rgba :inline :offset 16) + (xyzw gs-packed-xyzw :inline :offset 32) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype gs-packed-gt4 (structure) - ((data gs-packed-gt 4 :offset-assert 0) ;; guessed by decompiler + ((data gs-packed-gt 4 :inline :offset-assert 0) ;; guessed by decompiler ) :method-count-assert 9 :size-assert #xc0 :flag-assert #x9000000c0 ) -|# -;; (define-extern psm-size object) ;; (function gs-psm int) -;; (define-extern psm-page-height object) ;; (function gs-psm int) -;; (define-extern psm->string object) ;; (function gs-psm string) -;; (define-extern *fog-color* object) ;; rgba -;; (define-extern open-gif-packet object) ;; (function gif-packet gif-packet) -;; (define-extern add-reg-gif-packet object) ;; (function gif-packet int int none) -;; (define-extern close-gif-packet object) ;; (function gif-packet int gif-packet) -;; (define-extern draw-context-set-xy object) ;; (function draw-context int int none) +(define-extern psm-size (function gs-psm int)) +(define-extern psm-page-height (function gs-psm int)) +(define-extern psm->string (function gs-psm string)) +(define-extern *fog-color* rgba) +(define-extern open-gif-packet (function gif-packet gif-packet)) +(define-extern add-reg-gif-packet (function gif-packet int int none)) +(define-extern close-gif-packet (function gif-packet int gif-packet)) +(define-extern draw-context-set-xy (function draw-context int int none)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; display-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype display-frame (basic) ((buffer dma-buffer 11 :offset-assert 4) ;; guessed by decompiler - (calc-buf dma-buffer :offset-assert 8) ;; guessed by decompiler - (vu1-buf dma-buffer :offset-assert 8) ;; guessed by decompiler - (debug-buf dma-buffer :offset-assert 36) ;; guessed by decompiler - (global-buf dma-buffer :offset-assert 40) ;; guessed by decompiler - (bucket-group dma-bucket :offset-assert 44) ;; (inline-array dma-bucket) + (calc-buf dma-buffer :offset 8) + (vu1-buf dma-buffer :offset 8) + (debug-buf dma-buffer :offset 36) + (global-buf dma-buffer :offset 40) + (bucket-group dma-bucket :offset 44) ;; (inline-array dma-bucket) (profile-array profile-array :inline :offset-assert 48) (start-time uint64 :offset-assert 56) (run-time uint64 :offset-assert 64) ;; int64 ) + (:methods + (new (symbol type) _type_ 0) + ) :method-count-assert 9 :size-assert #x48 :flag-assert #x900000048 ) -|# -#| (deftype display (basic) - ((on-screen int32 :offset-assert 4) - (last-screen int32 :offset-assert 8) - (frames virtual-frame 2 :offset-assert 12) ;; guessed by decompiler - (bgcolor uint64 :offset-assert 24) - (pmode uint64 :offset-assert 32) - (clock UNKNOWN 13 :offset-assert 40) - (session-clock basic :offset-assert 40) - (game-clock basic :offset-assert 44) - (base-clock basic :offset-assert 48) - (real-clock basic :offset-assert 52) - (frame-clock basic :offset-assert 56) - (real-frame-clock basic :offset-assert 60) - (target-clock basic :offset-assert 64) - (entity-clock basic :offset-assert 68) - (part-clock basic :offset-assert 72) - (bg-clock basic :offset-assert 76) - (camera-clock basic :offset-assert 80) - (user0-clock basic :offset-assert 84) - (total-game-clock basic :offset-assert 88) - (time-factor float :offset-assert 92) - (dog-ratio float :offset-assert 96) - (vblank-start-time UNKNOWN 2 :offset-assert 104) - (total-run-time uint64 :offset-assert 120) - (run-half-speed basic :offset-assert 128) - (dog-count float :offset-assert 132) - (vu1-enable-user uint64 :offset-assert 136) - (vu1-enable-user-menu uint64 :offset-assert 144) - (force-sync uint32 :offset-assert 152) + ((on-screen int32 :offset-assert 4) + (last-screen int32 :offset-assert 8) + (frames display-frame 2 :offset-assert 12) + (bgcolor uint64 :offset-assert 24) + (pmode gs-pmode :offset-assert 32) + (clock clock 13 :offset-assert 40) + (session-clock clock :offset 40) + (game-clock clock :offset 44) + (base-clock clock :offset 48) + (real-clock clock :offset 52) + (frame-clock clock :offset 56) + (real-frame-clock clock :offset 60) + (target-clock clock :offset 64) + (entity-clock clock :offset 68) + (part-clock clock :offset 72) + (bg-clock clock :offset 76) + (camera-clock clock :offset 80) + (user0-clock clock :offset 84) + (total-game-clock clock :offset 88) + (time-factor float :offset-assert 92) + (dog-ratio float :offset-assert 96) + (vblank-start-time uint64 2 :offset-assert 104) + (total-run-time uint64 :offset-assert 120) + (run-half-speed basic :offset-assert 128) + (dog-count float :offset-assert 132) + (vu1-enable-user vu1-renderer-mask :offset-assert 136) + (vu1-enable-user-menu vu1-renderer-mask :offset-assert 144) + (force-sync uint32 :offset-assert 152) ) :method-count-assert 10 :size-assert #x9c :flag-assert #xa0000009c (:methods - ;; (new (symbol type int int int int int) _type_ 0) + (new (symbol type int int int int int) _type_ 0) (dummy-9 () none 9) ;; (set-time-ratios (_type_ float) float 9) ) ) -|# -;; (define-extern *pre-draw-hook* object) ;; (function object none) -;; (define-extern *post-draw-hook* object) ;; (function dma-buffer none) +(define-extern *pre-draw-hook* (function object none)) +(define-extern *post-draw-hook* (function dma-buffer none)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; geometry ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern vector-flatten! object) ;; (function vector vector vector vector) -;; (define-extern vector-reflect! object) ;; (function vector vector vector vector) -;; (define-extern vector-reflect-flat! object) ;; (function vector vector vector vector) -;; (define-extern vector-reflect-flat-above! object) ;; (function vector vector vector vector) -;; (define-extern vector-reflect-flat-gravity! object) -;; (define-extern vector-segment-distance-point! object) ;; (function vector vector vector vector float) -;; (define-extern vector-line-distance object) ;; (function vector vector vector float) -;; (define-extern vector-line-distance-point! object) ;; (function vector vector vector vector float) -;; (define-extern vector-segment-overlap object) -;; (define-extern line-sphere-intersection? object) -;; (define-extern vector-orient-by-quat! object) ;; (function vector vector quaternion vector) -;; (define-extern vector-inv-orient-by-quat! object) -;; (define-extern forward-down->inv-matrix object) ;; (function matrix vector vector matrix) -;; (define-extern forward-down-nopitch->inv-matrix object) ;; (function matrix vector vector matrix) -;; (define-extern forward-up->inv-matrix object) -;; (define-extern forward-up-nopitch->inv-matrix object) ;; (function matrix vector vector matrix) -;; (define-extern forward-up-nopitch->quaternion object) ;; (function quaternion vector vector quaternion) -;; (define-extern forward-up->quaternion object) ;; (function quaternion vector vector quaternion) -;; (define-extern quaternion-from-two-vectors! object) ;; (function quaternion vector vector quaternion) -;; (define-extern quaternion-from-two-vectors-partial! object) -;; (define-extern quaternion-from-two-vectors-max-angle! object) ;; (function quaternion vector vector float quaternion) -;; (define-extern quaternion-from-two-vectors-max-angle-partial! object) -;; (define-extern matrix-from-two-vectors! object) ;; (function matrix vector vector matrix) -;; (define-extern matrix-from-two-vectors-max-angle! object) ;; (function matrix vector vector float matrix) -;; (define-extern matrix-from-two-vectors-smooth! object) -;; (define-extern matrix-from-two-vectors-the-long-way-smooth! object) -;; (define-extern quaternion-from-two-vectors-smooth! object) -;; (define-extern matrix-from-two-vectors-max-angle-partial! object) ;; (function matrix vector vector float float matrix) -;; (define-extern matrix-from-two-vectors-partial-linear! object) ;; (function matrix vector vector float matrix) -;; (define-extern matrix-remove-z-rot object) ;; (function matrix matrix matrix) -;; (define-extern matrix-rot-diff! object) ;; (function vector matrix matrix float) -;; (define-extern quaternion-seek object) ;; (function quaternion quaternion quaternion float float quaternion) -;; (define-extern vector-deg-seek object) ;; (function vector vector vector float vector) -;; (define-extern vector-deg-slerp object) ;; (function vector vector vector float vector) -;; (define-extern vector-vector-deg-slerp! object) ;; (function vector vector vector float vector vector) -;; (define-extern normal-of-plane object) ;; (function vector vector vector vector vector) -;; (define-extern vector-3pt-cross! object) ;; (function vector vector vector vector vector) -;; (define-extern closest-pt-in-triangle object) ;; (function vector vector matrix vector none) -;; (define-extern point-in-triangle-cross object) ;; (function vector vector vector vector vector symbol) -;; (define-extern point-in-plane-<-point+normal! object) ;; (function vector vector vector vector) -;; (define-extern circle-circle-xz-intersect object) ;; (function sphere sphere vector vector int) -;; (define-extern circle-test object) ;; (function none) -;; (define-extern vector-circle-tangent-new object) ;; (function vector vector vector vector none) -;; (define-extern vector-circle-tangent object) ;; (function vector vector vector vector none) -;; (define-extern find-knot-span object) ;; (function int int float (inline-array vector) int) -;; (define-extern calculate-basis-functions-vector! object) ;; (function vector int float (pointer float) vector) -;; (define-extern curve-evaluate! object) ;; (function vector float (inline-array vector) int (pointer float) int vector) -;; (define-extern curve-get-pos! object) ;; (function vector float curve vector) -;; (define-extern curve-length object) ;; (function curve float) -;; (define-extern curve-copy! object) ;; (function curve curve curve) -;; (define-extern curve-closest-point object) ;; (function curve vector float float int float float) -;; (define-extern vector-plane-distance object) ;; (function vector plane vector float) -;; (define-extern intersect-ray-plane object) +(define-extern vector-flatten! (function vector vector vector vector)) +(define-extern vector-reflect! (function vector vector vector vector)) +(define-extern vector-reflect-flat! (function vector vector vector vector)) +(define-extern vector-reflect-flat-above! (function vector vector vector vector)) +(define-extern vector-reflect-flat-gravity! (function vector vector vector vector vector)) +(define-extern vector-segment-distance-point! (function vector vector vector vector float)) +(define-extern vector-line-distance (function vector vector vector float)) +(define-extern vector-line-distance-point! (function vector vector vector vector float)) +(define-extern vector-segment-overlap (function vector vector vector float)) +(define-extern line-sphere-intersection? (function vector vector vector symbol)) +(define-extern vector-orient-by-quat! (function vector vector quaternion vector)) +(define-extern vector-inv-orient-by-quat! (function vector vector quaternion vector)) +(define-extern forward-down->inv-matrix (function matrix vector vector matrix)) +(define-extern forward-down-nopitch->inv-matrix (function matrix vector vector matrix)) +(define-extern forward-up->inv-matrix (function matrix vector vector matrix)) +(define-extern forward-up-nopitch->inv-matrix (function matrix vector vector matrix)) +(define-extern forward-up-nopitch->quaternion (function quaternion vector vector quaternion)) +(define-extern forward-up->quaternion (function quaternion vector vector quaternion)) +(define-extern quaternion-from-two-vectors! (function quaternion vector vector quaternion)) +(define-extern quaternion-from-two-vectors-partial! (function quaternion vector vector float quaternion)) +(define-extern quaternion-from-two-vectors-max-angle! (function quaternion vector vector float quaternion)) +(define-extern quaternion-from-two-vectors-max-angle-partial! (function quaternion vector vector float float quaternion)) +(define-extern matrix-from-two-vectors! (function matrix vector vector matrix)) +(define-extern matrix-from-two-vectors-max-angle! (function matrix vector vector float matrix)) +(define-extern matrix-from-two-vectors-smooth! (function matrix vector vector float int matrix)) +(define-extern matrix-from-two-vectors-the-long-way-smooth! (function matrix vector vector float int matrix)) +(define-extern quaternion-from-two-vectors-smooth! (function quaternion vector vector float int quaternion)) +(define-extern matrix-from-two-vectors-max-angle-partial! (function matrix vector vector float float matrix)) +(define-extern matrix-from-two-vectors-partial-linear! (function matrix vector vector float matrix)) +(define-extern matrix-remove-z-rot (function matrix matrix matrix)) +(define-extern matrix-rot-diff! (function vector matrix matrix float)) +(define-extern quaternion-seek (function quaternion quaternion quaternion float float quaternion)) +(define-extern vector-deg-seek (function vector vector vector float vector)) +(define-extern vector-deg-slerp (function vector vector vector float vector)) +(define-extern vector-vector-deg-slerp! (function vector vector vector float vector vector)) +(define-extern normal-of-plane (function vector vector vector vector vector)) +(define-extern vector-3pt-cross! (function vector vector vector vector vector)) +(define-extern closest-pt-in-triangle (function vector vector matrix vector none)) +(define-extern point-in-triangle-cross (function vector vector vector vector vector symbol)) +(define-extern point-in-plane-<-point+normal! (function vector vector vector vector)) +(define-extern circle-circle-xz-intersect (function sphere sphere vector vector int)) +(define-extern circle-test (function none)) +(define-extern vector-circle-tangent-new (function vector vector vector vector none)) +(define-extern vector-circle-tangent (function vector vector vector vector none)) +(define-extern find-knot-span (function int int float (inline-array vector) int)) +(define-extern calculate-basis-functions-vector! (function vector int float (pointer float) vector)) +(define-extern curve-evaluate! (function vector float (inline-array vector) int (pointer float) int vector)) +(define-extern curve-get-pos! (function vector float curve vector)) +(define-extern curve-length (function curve float)) +(define-extern curve-copy! (function curve curve curve)) +(define-extern curve-closest-point (function curve vector float float int float float)) +(define-extern vector-plane-distance (function vector plane vector float)) +(define-extern intersect-ray-plane (function vector vector vector vector float)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; timer ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern timer-count object) ;; (function timer-bank uint) -;; (define-extern disable-irq object) ;; (function none) -;; (define-extern enable-irq object) ;; (function none) -;; (define-extern stopwatch-init object) ;; (function stopwatch int) -;; (define-extern stopwatch-reset object) ;; (function stopwatch int) -;; (define-extern stopwatch-start object) ;; (function stopwatch int) -;; (define-extern stopwatch-stop object) ;; (function stopwatch none) -;; (define-extern stopwatch-begin object) ;; (function stopwatch int) -;; (define-extern stopwatch-end object) ;; (function stopwatch none) -;; (define-extern stopwatch-elapsed-ticks object) ;; (function stopwatch time-frame) -;; (define-extern stopwatch-elapsed-seconds object) ;; (function stopwatch float) +(define-extern timer-count (function timer-bank uint)) +(define-extern disable-irq (function none)) +(define-extern enable-irq (function none)) +(define-extern stopwatch-init (function stopwatch int)) +(define-extern stopwatch-reset (function stopwatch int)) +(define-extern stopwatch-start (function stopwatch int)) +(define-extern stopwatch-stop (function stopwatch none)) +(define-extern stopwatch-begin (function stopwatch int)) +(define-extern stopwatch-end (function stopwatch none)) +(define-extern stopwatch-elapsed-ticks (function stopwatch time-frame)) +(define-extern stopwatch-elapsed-seconds (function stopwatch float)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; vector ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern vector-cross! object) ;; (function vector vector vector vector) -;; (define-extern vector-xz-cross! object) -;; (define-extern vector+float! object) ;; (function vector vector float vector) -;; (define-extern vector*! object) ;; (function vector vector vector vector) -;; (define-extern vector+*! object) ;; (function vector vector vector float vector) -;; (define-extern vector-*! object) ;; (function vector vector vector float vector) -;; (define-extern vector/! object) ;; (function vector vector vector vector) -;; (define-extern vector-float*! object) ;; (function vector vector float vector) -;; (define-extern vector-average! object) ;; (function vector vector vector vector) -;; (define-extern vector+float*! object) ;; (function vector vector vector float vector) -;; (define-extern vector--float*! object) ;; (function vector vector vector float vector) -;; (define-extern vector-float/! object) ;; (function vector vector float vector) -;; (define-extern vector-negate! object) ;; (function vector vector vector) -;; (define-extern vector-negate-in-place! object) ;; (function vector vector) -;; (define-extern vector= object) ;; (function vector vector symbol) -;; (define-extern vector-delta object) ;; (function vector vector float) -;; (define-extern vector-seek! object) ;; (function vector vector float vector) -;; (define-extern vector-smooth-seek! object) -;; (define-extern vector-seek-2d-xz-smooth! object) ;; (function vector vector float float vector) -;; (define-extern vector-seek-2d-yz-smooth! object) ;; (function vector vector float float vector) -;; (define-extern vector-seek-3d-smooth! object) ;; (function vector vector float float vector) -;; (define-extern seek-with-smooth object) ;; (function float float float float float float) -;; (define-extern vector-identity! object) ;; (function vector vector) -;; (define-extern vector-seconds object) ;; (function vector vector vector) -;; (define-extern vector-seconds! object) ;; (function vector vector) -;; (define-extern vector-v! object) ;; (function vector vector) -;; (define-extern vector-v+! object) ;; (function vector vector vector vector) -;; (define-extern vector-v*float+! object) ;; (function vector vector vector float vector) -;; (define-extern vector-v++! object) ;; (function vector vector vector) -;; (define-extern vector-v*float! object) ;; (function vector vector float vector) -;; (define-extern vector-v*float++! object) ;; (function vector vector float vector) -;; (define-extern vector-to-ups! object) ;; (function vector vector vector) -;; (define-extern vector-from-ups! object) ;; (function vector vector vector) -;; (define-extern vector-length object) ;; (function vector float) -;; (define-extern vector-length-squared object) ;; (function vector float) -;; (define-extern vector-xz-length-squared object) ;; (function vector float) -;; (define-extern vector-xz-length object) ;; (function vector float) -;; (define-extern vector-vector-distance object) ;; (function vector vector float) -;; (define-extern vector-vector-distance-squared object) ;; (function vector vector float) -;; (define-extern vector-vector-xz-distance object) ;; (function vector vector float) -;; (define-extern vector-vector-xy-distance object) -;; (define-extern vector-vector-xz-distance-squared object) ;; (function vector vector float) -;; (define-extern vector-normalize! object) ;; (function vector float vector) -;; (define-extern vector-normalize-ret-len! object) ;; (function vector float float) -;; (define-extern vector-normalize-copy! object) ;; (function vector vector float vector) -;; (define-extern vector-xz-normalize! object) ;; (function vector float vector) -;; (define-extern vector-xz-normalize-copy! object) -;; (define-extern vector-length-max! object) ;; (function vector float vector) -;; (define-extern vector-xz-length-max! object) ;; (function vector float vector) -;; (define-extern vector-rotate-around-x! object) -;; (define-extern vector-rotate-around-y! object) ;; (function vector vector float vector) -;; (define-extern vector-rotate90-around-y! object) -;; (define-extern vector-rotate-around-z! object) -;; (define-extern rotate-y<-vector+vector object) ;; (function vector vector float) -;; (define-extern rotate-x<-vector+vector object) -;; (define-extern rotate-z<-vector+vector object) -;; (define-extern vector-cvt.w.s! object) ;; (function vector vector vector) -;; (define-extern vector-cvt.s.w! object) ;; (function vector vector vector) -;; (define-extern rot-zxy-from-vector! object) ;; (function vector vector vector) -;; (define-extern rot-zyx-from-vector! object) ;; (function vector vector vector) -;; (define-extern vector-lerp! object) ;; (function vector vector vector float vector) -;; (define-extern vector-lerp-clamp! object) ;; (function vector vector vector float vector) -;; (define-extern vector4-lerp! object) ;; (function vector vector vector float vector) -;; (define-extern vector4-lerp-clamp! object) ;; (function vector vector vector float vector) -;; (define-extern vector-degi object) ;; (function vector vector vector) -;; (define-extern vector-degf object) ;; (function vector vector vector) -;; (define-extern vector-degmod object) ;; (function vector vector vector) -;; (define-extern vector-deg-diff object) ;; (function vector vector vector none) -;; (define-extern vector-deg-lerp-clamp! object) ;; (function vector vector vector float vector) -;; (define-extern vector3s-copy! object) ;; (function vector vector vector) -;; (define-extern vector3s+! object) ;; (function vector vector vector vector) -;; (define-extern vector3s*float! object) ;; (function vector vector float vector) -;; (define-extern vector3s-! object) ;; (function vector vector vector vector) -;; (define-extern vector4-add! object) -;; (define-extern vector4-sub! object) -;; (define-extern vector4-mul! object) -;; (define-extern vector4-scale! object) -;; (define-extern vector4-madd! object) -;; (define-extern vector4-msub! object) -;; (define-extern vector4-array-add! object) -;; (define-extern vector4-array-sub! object) -;; (define-extern vector4-array-mul! object) -;; (define-extern vector4-array-scale! object) -;; (define-extern vector4-array-madd! object) -;; (define-extern vector4-array-msub! object) -;; (define-extern vector4-array-lerp! object) -;; (define-extern spheres-overlap? object) ;; (function sphere sphere symbol) -;; (define-extern sphere<-vector! object) ;; (function sphere vector sphere) -;; (define-extern sphere<-vector+r! object) ;; (function sphere vector float sphere) -;; (define-extern rand-vu-sphere-point! object) ;; (function vector float vector) -;; (define-extern vector-vector-angle-safe object) +(define-extern vector-cross! (function vector vector vector vector)) +(define-extern vector-xz-cross! (function vector vector vector vector)) +(define-extern vector+float! (function vector vector float vector)) +(define-extern vector*! (function vector vector vector vector)) +(define-extern vector+*! (function vector vector vector float vector)) +(define-extern vector-*! (function vector vector vector float vector)) +(define-extern vector/! (function vector vector vector vector)) +(define-extern vector-float*! (function vector vector float vector)) +(define-extern vector-average! (function vector vector vector vector)) +(define-extern vector+float*! (function vector vector vector float vector)) +(define-extern vector--float*! (function vector vector vector float vector)) +(define-extern vector-float/! (function vector vector float vector)) +(define-extern vector-negate! (function vector vector vector)) +(define-extern vector-negate-in-place! (function vector vector)) +(define-extern vector= (function vector vector symbol)) +(define-extern vector-delta (function vector vector float)) +(define-extern vector-seek! (function vector vector float vector)) +(define-extern vector-smooth-seek! (function vector vector float vector)) +(define-extern vector-seek-2d-xz-smooth! (function vector vector float float vector)) +(define-extern vector-seek-2d-yz-smooth! (function vector vector float float vector)) +(define-extern vector-seek-3d-smooth! (function vector vector float float vector)) +(define-extern seek-with-smooth (function float float float float float float)) +(define-extern vector-identity! (function vector vector)) +(define-extern vector-seconds (function vector vector vector)) +(define-extern vector-seconds! (function vector vector)) +(define-extern vector-v! (function vector vector)) +(define-extern vector-v+! (function vector vector vector vector)) +(define-extern vector-v*float+! (function vector vector vector float vector)) +(define-extern vector-v++! (function vector vector vector)) +(define-extern vector-v*float! (function vector vector float vector)) +(define-extern vector-v*float++! (function vector vector float vector)) +(define-extern vector-to-ups! (function vector vector vector)) +(define-extern vector-from-ups! (function vector vector vector)) +(define-extern vector-length (function vector float)) +(define-extern vector-length-squared (function vector float)) +(define-extern vector-xz-length-squared (function vector float)) +(define-extern vector-xz-length (function vector float)) +(define-extern vector-vector-distance (function vector vector float)) +(define-extern vector-vector-distance-squared (function vector vector float)) +(define-extern vector-vector-xz-distance (function vector vector float)) +(define-extern vector-vector-xy-distance (function vector vector float)) +(define-extern vector-vector-xz-distance-squared (function vector vector float)) +(define-extern vector-normalize! (function vector float vector)) +(define-extern vector-normalize-ret-len! (function vector float float)) +(define-extern vector-normalize-copy! (function vector vector float vector)) +(define-extern vector-xz-normalize! (function vector float vector)) +(define-extern vector-xz-normalize-copy! (function vector vector float vector)) +(define-extern vector-length-max! (function vector float vector)) +(define-extern vector-xz-length-max! (function vector float vector)) +(define-extern vector-rotate-around-x! (function vector vector float vector)) +(define-extern vector-rotate-around-y! (function vector vector float vector)) +(define-extern vector-rotate90-around-y! (function vector vector vector)) +(define-extern vector-rotate-around-z! (function vector vector float vector)) +(define-extern rotate-y<-vector+vector (function vector vector float)) +(define-extern rotate-x<-vector+vector (function vector vector float)) +(define-extern rotate-z<-vector+vector (function vector vector float)) +(define-extern vector-cvt.w.s! (function vector vector vector)) +(define-extern vector-cvt.s.w! (function vector vector vector)) +(define-extern rot-zxy-from-vector! (function vector vector vector)) +(define-extern rot-zyx-from-vector! (function vector vector vector)) +(define-extern vector-lerp! (function vector vector vector float vector)) +(define-extern vector-lerp-clamp! (function vector vector vector float vector)) +(define-extern vector4-lerp! (function vector vector vector float vector)) +(define-extern vector4-lerp-clamp! (function vector vector vector float vector)) +(define-extern vector-degi (function vector vector vector)) +(define-extern vector-degf (function vector vector vector)) +(define-extern vector-degmod (function vector vector vector)) +(define-extern vector-deg-diff (function vector vector vector none)) +(define-extern vector-deg-lerp-clamp! (function vector vector vector float vector)) +(define-extern vector3s-copy! (function vector vector vector)) +(define-extern vector3s+! (function vector vector vector vector)) +(define-extern vector3s*float! (function vector vector float vector)) +(define-extern vector3s-! (function vector vector vector vector)) +(define-extern vector4-add! (function vector4 vector4 vector4 none)) +(define-extern vector4-sub! (function vector4 vector4 vector4 none)) +(define-extern vector4-mul! (function vector4 vector4 vector4 none)) +(define-extern vector4-scale! (function vector4 vector4 float none)) +(define-extern vector4-madd! (function vector4 vector4 vector4 float none)) +(define-extern vector4-msub! (function vector4 vector4 vector4 float none)) +(define-extern vector4-array-add! (function (inline-array vector4) (inline-array vector4) (inline-array vector4) int none)) +(define-extern vector4-array-sub! (function (inline-array vector4) (inline-array vector4) (inline-array vector4) int none)) +(define-extern vector4-array-mul! (function (inline-array vector4) (inline-array vector4) (inline-array vector4) int none)) +(define-extern vector4-array-scale! (function (inline-array vector4) (inline-array vector4) float int none)) +(define-extern vector4-array-madd! (function (inline-array vector4) (inline-array vector4) (inline-array vector4) float int none)) +(define-extern vector4-array-msub! (function (inline-array vector4) (inline-array vector4) (inline-array vector4) float int none)) +(define-extern vector4-array-lerp! (function (inline-array vector4) (inline-array vector4) (inline-array vector4) float int none)) +(define-extern spheres-overlap? (function sphere sphere symbol)) +(define-extern sphere<-vector! (function sphere vector sphere)) +(define-extern sphere<-vector+r! (function sphere vector float sphere)) +(define-extern rand-vu-sphere-point! (function vector float vector)) +(define-extern vector-vector-angle-safe (function vector vector float)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; file-io ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum file-kind + :bitfield #f + (level-bt 0) ;; aka bsp-header. + (art-group 1) + (tpage 2) + (dir-tpage 3) + (level-vs 4) + (tx 5) + (vis 6) + (map 7) + ) + (deftype file-stream (basic) - () + ((flags uint32 :offset-assert 4) + (mode symbol :offset-assert 8) + (name string :offset-assert 12) + (file uint32 :offset-assert 16) + ) + (:methods + (new (symbol type string symbol) _type_) + ) :method-count-assert 9 :size-assert #x14 :flag-assert #x900000014 - ;; Failed to read fields. ) -|# -#| (deftype file-info (basic) - ((file-type symbol :offset-assert 4) ;; guessed by decompiler + ((file-type (pointer string) :offset-assert 4) ;; guessed by decompiler (file-name basic :offset-assert 8) (major-version uint32 :offset-assert 12) (minor-version uint32 :offset-assert 16) @@ -3400,46 +4411,73 @@ :size-assert #x20 :flag-assert #x900000020 ) -|# -;; (define-extern file-stream-read-string object) ;; (function file-stream string string) -;; (define-extern *file-temp-string* object) ;; string -;; (define-extern make-file-name object) ;; (function file-kind string int symbol string) -;; (define-extern make-vfile-name object) ;; (function file-kind string string) -;; (define-extern file-info-correct-version? object) ;; (function file-info file-kind int symbol) +(define-extern file-stream-read-string (function file-stream string string)) +(define-extern *file-temp-string* string) +(define-extern make-file-name (function file-kind string int symbol string)) +(define-extern make-vfile-name (function file-kind string string)) +(define-extern file-info-correct-version? (function file-info file-kind int symbol)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; loader-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(declare-type art-group basic) +(define-extern art-group type) + +(deftype load-dir (basic) + ;; copied from jak1. + ((lev level :offset-assert 4) + (string-array (array string) :offset-assert 8) ;; these are the names + (data-array (array basic) :score -50 :offset-assert 12) ;; this is the file data. + ) + :method-count-assert 11 + :size-assert #x10 + :flag-assert #xb00000010 + ;; Failed to read fields. + (:methods + (new (symbol type int level) _type_ 0) + (dummy-9 () none 9) ;; (load-to-heap-by-name (_type_ string symbol kheap int) art-group 9) + (dummy-10 () none 10) ;; (set-loaded-art (_type_ art-group) art-group 10) + ) + ) + +(deftype load-dir-art-group (load-dir) + ((art-group-array (array art-group) :offset 12) + ) + :flag-assert #xb00000010 + (:methods + (new (symbol type int level) _type_ 0) + ) + ) + (deftype external-art-buffer (basic) ((index int32 :offset-assert 4) (other external-art-buffer :offset-assert 8) ;; guessed by decompiler (status symbol :offset-assert 12) ;; guessed by decompiler (locked? symbol :offset-assert 16) ;; guessed by decompiler - (login? basic :offset-assert 20) + (login? symbol :offset-assert 20) (frame-lock symbol :offset-assert 24) ;; guessed by decompiler - (init-heap basic :offset-assert 28) + (init-heap function :offset-assert 28) (heap kheap :inline :offset-assert 32) (pending-load-file string :offset-assert 48) ;; guessed by decompiler (pending-load-file-part int32 :offset-assert 52) - (pending-load-file-owner uint64 :offset-assert 56) ;; handle + (pending-load-file-owner handle :offset-assert 56) (pending-load-file-priority float :offset-assert 64) (load-file string :offset-assert 68) ;; guessed by decompiler (load-file-part int32 :offset-assert 72) - (load-file-owner uint64 :offset-assert 80) ;; handle + (load-file-owner handle :offset-assert 80) (load-file-priority float :offset-assert 88) (buf pointer :offset-assert 92) ;; guessed by decompiler (len int32 :offset-assert 96) (art-group art-group :offset-assert 100) ;; guessed by decompiler - (art-data uint32 :offset-assert 100) + (art-data uint32 :offset 100) ) :method-count-assert 16 :size-assert #x68 :flag-assert #x1000000068 (:methods - ;; (new (symbol type int) _type_ 0) + (new (symbol type int function symbol) _type_ 0) (dummy-9 () none 9) ;; (set-pending-file (_type_ string int handle float) int 9) (dummy-10 () none 10) ;; (update (_type_) int 10) (dummy-11 () none 11) ;; (inactive? (_type_) symbol 11) @@ -3449,14 +4487,12 @@ (dummy-15 () none 15) ;; (unlock! (_type_) symbol 15) ) ) -|# -#| (deftype spool-anim (basic) - ((name string :offset-assert 16) ;; guessed by decompiler + ((name string :offset 16) ;; guessed by decompiler (anim-name basic :offset-assert 20) (parts int32 :offset-assert 24) - (hint-id int32 :offset-assert 24) + (hint-id int32 :offset 24) (priority float :offset-assert 28) (owner uint64 :offset-assert 32) ;; handle (command-list pair :offset-assert 40) ;; guessed by decompiler @@ -3465,18 +4501,16 @@ :size-assert #x2c :flag-assert #x90000002c ) -|# -#| (deftype external-art-control (basic) ((buffer external-art-buffer 2 :offset-assert 4) ;; guessed by decompiler - (rec spool-anim 3 :offset-assert 20) ;; guessed by decompiler - (spool-lock uint64 :offset-assert 160) ;; handle - (reserve-buffer external-art-buffer :offset-assert 168) ;; guessed by decompiler - (reserve-buffer-count int16 :offset-assert 172) ;; int32 + (rec spool-anim 3 :inline :offset-assert 16) ;; guessed by decompiler + (spool-lock handle :offset-assert 160) + (reserve-buffer external-art-buffer :offset-assert 168) + (reserve-buffer-count int16 :offset-assert 172) (dma-reserve-buffer-count int16 :offset-assert 174) - (active-stream string :offset-assert 176) ;; guessed by decompiler - (queue-stream basic :offset-assert 180) + (active-stream string :offset-assert 176) + (queue-stream (array spool-anim) :offset-assert 180) (frame-mask uint32 :offset-assert 184) (dma-reserve-heap kheap :inline :offset-assert 192) ) @@ -3494,73 +4528,73 @@ (dummy-15 () none 15) ;; (none-reserved? (_type_) symbol 15) ) ) -|# -#| + (deftype subtitle-range (basic) - () + ((start-frame float :offset-assert 4) + (end-frame float :offset-assert 8) + (message object 8 :offset-assert 12) + ) :method-count-assert 9 :size-assert #x2c :flag-assert #x90000002c ;; Failed to read fields. ) -|# -#| + (deftype subtitle-image (basic) ((width uint16 :offset-assert 4) (height uint16 :offset-assert 6) - (palette UNKNOWN 16 :offset-assert 16) - (data UNKNOWN :dynamic :offset-assert 80) + (palette rgba 16 :offset 16) + (data uint8 :dynamic :offset-assert 80) ) :method-count-assert 9 :size-assert #x50 :flag-assert #x900000050 ) -|# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; texture-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(declare-type texture-page basic) + (deftype texture-id (uint32) - () + ((index uint16 :offset 8 :size 12) + (page uint16 :offset 20 :size 12) + ) :method-count-assert 9 :size-assert #x4 :flag-assert #x900000004 - ;; Failed to read some fields. ) -|# -#| (deftype texture-pool-segment (structure) ((dest uint32 :offset-assert 0) (size uint32 :offset-assert 4) ) + :allow-misaligned + :pack-me :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype texture-pool (basic) - ((top int32 :offset-assert 4) - (cur int32 :offset-assert 8) - (allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12) ;; guessed by decompiler - (font-palette int32 :offset-assert 16) - (segment texture-pool-segment 4 :offset-assert 20) ;; guessed by decompiler - (segment-near texture-pool-segment :inline :offset-assert 20) - (segment-common texture-pool-segment :inline :offset-assert 28) - (common-page texture-page 32 :offset-assert 52) ;; guessed by decompiler - (common-page-mask int32 :offset-assert 180) - (update-sprites-flag basic :offset-assert 184) - (update-flag basic :offset-assert 188) - (texture-enable-user uint64 :offset-assert 192) - (texture-enable-user-menu uint64 :offset-assert 200) - (ids uint32 128 :offset-assert 208) ;; guessed by decompiler + ((top int32 :offset-assert 4) + (cur int32 :offset-assert 8) + (allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12) ;; guessed by decompiler + (font-palette int32 :offset-assert 16) + (segment texture-pool-segment 4 :inline :offset-assert 20) ;; guessed by decompiler + (segment-near texture-pool-segment :inline :offset 20) + (segment-common texture-pool-segment :inline :offset 28) + (common-page texture-page 32 :offset-assert 52) ;; guessed by decompiler + (common-page-mask int32 :offset-assert 180) + (update-sprites-flag basic :offset-assert 184) + (update-flag basic :offset-assert 188) + (texture-enable-user uint64 :offset-assert 192) + (texture-enable-user-menu uint64 :offset-assert 200) + (ids uint32 128 :offset-assert 208) ;; guessed by decompiler ) :method-count-assert 26 :size-assert #x2d0 @@ -3586,89 +4620,79 @@ (dummy-25 () none 25) ) ) -|# -#| (deftype texture-mask (structure) ((mask vector4w :inline :offset-assert 0) - (dist float :offset-assert 12) - (long UNKNOWN 2 :offset-assert 0) - (quad uint128 :offset-assert 0) + (dist float :offset 12) + (long uint64 2 :offset 0) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype texture-masks (structure) - ((data UNKNOWN 3 :offset-assert 0) + ((data texture-mask 3 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype texture-masks-array (inline-array-class) - ((data UNKNOWN :dynamic :offset-assert 16) + ((data texture-masks :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (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) ;; gs-psm + (psm gs-psm :offset-assert 10) (mip-shift uint8 :offset-assert 11) (clutpsm uint16 :offset-assert 12) - (dest uint16 7 :offset-assert 14) ;; guessed by decompiler + (dest uint16 7 :offset-assert 14) (clutdest uint16 :offset-assert 28) - (width uint8 7 :offset-assert 30) ;; guessed by decompiler - (name string :offset-assert 40) ;; guessed by decompiler + (width uint8 7 :offset-assert 30) + (name string :offset-assert 40) (size uint32 :offset-assert 44) (uv-dist float :offset-assert 48) - (pad UNKNOWN 3 :offset-assert 52) - (masks texture-masks :inline :offset-assert 64) ;; uint32 3 + (pad uint32 3 :offset-assert 52) + (masks texture-masks :inline :offset-assert 64) ) :method-count-assert 9 :size-assert #x70 :flag-assert #x900000070 ) -|# -#| (deftype texture-page-segment (structure) ((block-data pointer :offset-assert 0) ;; guessed by decompiler (size uint32 :offset-assert 4) (dest uint32 :offset-assert 8) ) + :allow-misaligned + :pack-me :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c ) -|# -#| (deftype texture-page (basic) - ((info file-info :offset-assert 4) ;; guessed by decompiler - (name basic :offset-assert 8) - (id uint32 :offset-assert 12) - (length int32 :offset-assert 16) - (mip0-size uint32 :offset-assert 20) - (size uint32 :offset-assert 24) - (segment texture-page-segment 3 :offset-assert 28) ;; guessed by decompiler - (dram-size uint32 :offset-assert 64) - (pad uint32 15 :offset-assert 68) ;; guessed by decompiler - (data texture :dynamic :offset-assert 128) ;; guessed by decompiler + ((info file-info :offset-assert 4) + (name basic :offset-assert 8) + (id uint32 :offset-assert 12) + (length int32 :offset-assert 16) + (mip0-size uint32 :offset-assert 20) + (size uint32 :offset-assert 24) + (segment texture-page-segment 3 :inline :offset-assert 28) + (dram-size uint32 :offset-assert 64) + (pad uint32 15 :offset-assert 68) + (data texture :dynamic :offset-assert 128) ) :method-count-assert 14 :size-assert #x80 @@ -3681,9 +4705,14 @@ (dummy-13 () none 13) ;; (add-to-dma-buffer (_type_ dma-buffer int) int 13) ) ) -|# -#| +(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 shader-ptr :offset-assert 0) ;; guessed by decompiler ) @@ -3691,72 +4720,72 @@ :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype texture-page-dir-entry (structure) ((length int16 :offset-assert 0) (status uint16 :offset-assert 2) - (page texture-page :offset-assert 4) ;; guessed by decompiler - (link texture-link :offset-assert 8) ;; guessed by decompiler + (page texture-page :offset-assert 4) + (link texture-link :offset-assert 8) ) + :pack-me + :allow-misaligned :method-count-assert 9 :size-assert #xc :flag-assert #x90000000c ) -|# -#| (deftype texture-relocate-later (basic) - ((memcpy symbol :offset-assert 4) ;; guessed by decompiler + ((memcpy symbol :offset-assert 4) (dest uint32 :offset-assert 8) (source uint32 :offset-assert 12) (move uint32 :offset-assert 16) (entry texture-page-dir-entry :offset-assert 20) - (page texture-page :offset-assert 24) ;; guessed by decompiler + (page texture-page :offset-assert 24) ) :method-count-assert 9 :size-assert #x1c :flag-assert #x90000001c ) -|# -#| +(defenum link-test-flags + :type uint32 + :bitfield #t + ; (needs-log-in 8) + ; (bit-9 9) + ) + + (deftype adgif-shader (structure) - ((quad qword 5 :offset-assert 0) ;; guessed by decompiler - (prims gs-reg64 10 :offset-assert 0) ;; guessed by decompiler - (reg-0 uint8 :offset-assert 8) - (reg-1 uint8 :offset-assert 24) - (reg-2 uint8 :offset-assert 40) - (reg-3 uint8 :offset-assert 56) - (reg-4 uint8 :offset-assert 72) - (tex0 uint64 :offset-assert 0) ;; gs-tex0 - (tex1 uint64 :offset-assert 16) ;; gs-tex1 - (miptbp1 uint64 :offset-assert 32) ;; gs-miptbp - (clamp uint64 :offset-assert 48) ;; gs-clamp - (clamp-reg uint64 :offset-assert 56) ;; gs-reg64 - (alpha uint64 :offset-assert 64) ;; gs-alpha - (link-test link-test-flags :offset-assert 8) ;; guessed by decompiler - (texture-id texture-id :offset-assert 24) ;; guessed by decompiler - (next shader-ptr :offset-assert 40) ;; guessed by decompiler + ((quad qword 5 :offset-assert 0) + (prims gs-reg64 10 :offset 0) + (reg-0 uint8 :offset 8) + (reg-1 uint8 :offset 24) + (reg-2 uint8 :offset 40) + (reg-3 uint8 :offset 56) + (reg-4 uint8 :offset 72) + (tex0 gs-tex0 :offset 0) + (tex1 gs-tex1 :offset 16) + (miptbp1 gs-miptbp :offset 32) + (clamp gs-clamp :offset 48) + (clamp-reg gs-reg64 :offset 56) + (alpha gs-alpha :offset 64) + (link-test link-test-flags :offset 8) + (texture-id texture-id :offset 24) + (next shader-ptr :offset 40) ) :method-count-assert 9 :size-assert #x50 :flag-assert #x900000050 ) -|# -#| (deftype adgif-shader-array (inline-array-class) - ((data adgif-shader :dynamic :offset-assert 16) ;; guessed by decompiler + ((data adgif-shader :inline :dynamic :offset-assert 16) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype texture-base (structure) ((vram-page uint32 :offset-assert 0) (vram-block uint32 :offset-assert 4) @@ -3766,76 +4795,83 @@ :size-assert #xc :flag-assert #x90000000c ) -|# -#| (deftype texture-page-translate-item (structure) - ((bucket int32 :offset-assert 0) - (level-index uint32 :offset-assert 4) - (level-texture-page uint32 :offset-assert 8) - (texture-user uint32 :offset-assert 12) + ((bucket bucket-id :offset-assert 0) + (level-index uint32 :offset-assert 4) + (level-texture-page uint32 :offset-assert 8) + (texture-user uint32 :offset-assert 12) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -;; (define-extern *texture-masks* object) -;; (define-extern *texture-masks-array* object) -;; (define-extern texture-mip->segment object) ;; (function int int int) -;; (define-extern *texture-relocate-later* object) ;; texture-relocate-later -;; (define-extern *texture-page-dir* object) ;; texture-page-dir -;; (define-extern ct32-24-block-table object) ;; (array int32) -;; (define-extern mz32-24-block-table object) ;; (array int32) -;; (define-extern ct16-block-table object) ;; (array int32) -;; (define-extern ct16s-block-table object) ;; (array int32) -;; (define-extern mz16-block-table object) ;; (array int32) -;; (define-extern mz16s-block-table object) ;; (array int32) -;; (define-extern mt8-block-table object) ;; (array int32) -;; (define-extern mt4-block-table object) ;; (array int32) -;; (define-extern *texture-page-translate* object) -;; (define-extern *eyes-texture-base* object) -;; (define-extern *skull-gem-texture-base* object) -;; (define-extern *ocean-texture-base* object) -;; (define-extern *ocean-envmap-texture-base* object) -;; (define-extern *grey-scale-base* object) -;; (define-extern *map-texture-base* object) +(deftype texture-page-dir (basic) + ((length int32) + (entries texture-page-dir-entry 1 :inline) + ) + (:methods + (relocate (_type_ kheap (pointer uint8)) none :replace 7) + (unlink-textures-in-heap! (_type_ kheap) int 9) + ) + :flag-assert #xa00000014 + ) + +(define-extern *texture-masks* texture-masks) +(define-extern *texture-masks-array* texture-masks-array) +(define-extern texture-mip->segment (function int int int)) +(define-extern *texture-relocate-later* texture-relocate-later) +(define-extern *texture-page-dir* texture-page-dir) +(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-translate* (array texture-page-translate-item)) +(define-extern *eyes-texture-base* texture-base) +(define-extern *skull-gem-texture-base* texture-base) +(define-extern *ocean-texture-base* texture-base) +(define-extern *ocean-envmap-texture-base* texture-base) +(define-extern *grey-scale-base* texture-base) +(define-extern *map-texture-base* texture-base) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; texture-anim-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype texture-anim-layer (structure) - ((extra vector :inline :offset-assert 240) - (func basic :offset-assert 256) - (func-id basic :offset-assert 256) - (init-func basic :offset-assert 260) - (init-func-id basic :offset-assert 260) - (tex basic :offset-assert 264) - (start-time float :offset-assert 268) - (end-time float :offset-assert 272) - (tex-name basic :offset-assert 276) - (test uint64 :offset-assert 280) - (alpha uint64 :offset-assert 288) - (clamp uint64 :offset-assert 296) - (start-color vector :inline :offset-assert 80) - (start-scale vector2 :inline :offset-assert 96) - (start-offset vector2 :inline :offset-assert 104) - (start-st-scale vector2 :inline :offset-assert 112) - (start-st-offset vector2 :inline :offset-assert 120) - (start-qs vector :inline :offset-assert 128) - (start-rot deg :offset-assert 144) - (start-st-rot deg :offset-assert 148) - (end-color vector :inline :offset-assert 160) - (end-scale vector2 :inline :offset-assert 176) - (end-offset vector2 :inline :offset-assert 184) - (end-st-scale vector2 :inline :offset-assert 192) - (end-st-offset vector2 :inline :offset-assert 200) - (end-qs vector :inline :offset-assert 208) - (end-rot deg :offset-assert 224) - (end-st-rot deg :offset-assert 228) + ((extra vector :inline :offset 240) + (func basic :offset 256) + (func-id basic :offset 256) + (init-func basic :offset 260) + (init-func-id basic :offset 260) + (tex basic :offset 264) + (start-time float :offset 268) + (end-time float :offset 272) + (tex-name basic :offset 276) + (test uint64 :offset 280) + (alpha uint64 :offset 288) + (clamp uint64 :offset 296) + (start-color vector :inline :offset 80) + (start-scale vector2 :inline :offset 96) + (start-offset vector2 :inline :offset 104) + (start-st-scale vector2 :inline :offset 112) + (start-st-offset vector2 :inline :offset 120) + (start-qs vector :inline :offset 128) + (start-rot degrees :offset 144) + (start-st-rot degrees :offset 148) + (end-color vector :inline :offset 160) + (end-scale vector2 :inline :offset 176) + (end-offset vector2 :inline :offset 184) + (end-st-scale vector2 :inline :offset 192) + (end-st-offset vector2 :inline :offset 200) + (end-qs vector :inline :offset 208) + (end-rot degrees :offset 224) + (end-st-rot degrees :offset 228) ) :method-count-assert 11 :size-assert #x130 @@ -3845,15 +4881,13 @@ (dummy-10 () none 10) ) ) -|# -#| (deftype texture-anim (structure) ((num-layers uint32 :offset-assert 0) (func basic :offset-assert 4) - (func-id basic :offset-assert 4) + (func-id basic :offset 4) (init-func basic :offset-assert 8) - (init-func-id basic :offset-assert 8) + (init-func-id basic :offset 8) (tex basic :offset-assert 12) (tex-name basic :offset-assert 16) (extra vector :inline :offset-assert 32) @@ -3864,7 +4898,7 @@ (test uint64 :offset-assert 64) (alpha uint64 :offset-assert 72) (clamp uint64 :offset-assert 80) - (data UNKNOWN :dynamic :offset-assert 88) + (data uint8 :dynamic :offset-assert 88) ) :method-count-assert 11 :size-assert #x58 @@ -3874,15 +4908,9 @@ (dummy-10 () none 10) ) ) -|# -#| (deftype texture-anim-array (array) - ((type basic :offset-assert 0) - (length int32 :offset-assert 4) - (allocated-length int32 :offset-assert 8) - (content-type basic :offset-assert 12) - ) + () :method-count-assert 11 :size-assert #x10 :flag-assert #xb00000010 @@ -3891,9 +4919,7 @@ (dummy-10 () none 10) ) ) -|# -#| (deftype texture-anim-work (structure) ((erase-tmpl dma-gif-packet :inline :offset-assert 0) (draw-tmpl dma-gif-packet :inline :offset-assert 32) @@ -3905,161 +4931,139 @@ (corner2 vector :inline :offset-assert 192) (corner3 vector :inline :offset-assert 208) (const vector :inline :offset-assert 224) - (random UNKNOWN 8 :offset-assert 240) + (random vector 8 :inline :offset-assert 240) (random-index uint8 :offset-assert 368) ) :method-count-assert 9 :size-assert #x171 :flag-assert #x900000171 ) -|# -#| (deftype clut16x16 (structure) - ((clut UNKNOWN 256 :offset-assert 0) + ((clut rgba 256 :offset-assert 0) ) :method-count-assert 9 :size-assert #x400 :flag-assert #x900000400 ) -|# -#| (deftype noise8x8 (structure) - ((image UNKNOWN 64 :offset-assert 0) + ((image uint8 64 :offset-assert 0) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype noise16x16 (structure) - ((image UNKNOWN 256 :offset-assert 0) + ((image uint8 256 :offset-assert 0) ) :method-count-assert 9 :size-assert #x100 :flag-assert #x900000100 ) -|# -#| (deftype noise32x32 (structure) - ((image UNKNOWN 1024 :offset-assert 0) + ((image uint8 1024 :offset-assert 0) ) :method-count-assert 9 :size-assert #x400 :flag-assert #x900000400 ) -|# -#| (deftype noise64x64 (structure) - ((image UNKNOWN 4096 :offset-assert 0) + ((image uint8 4096 :offset-assert 0) ) :method-count-assert 9 :size-assert #x1000 :flag-assert #x900001000 ) -|# -#| (deftype noise128x128 (structure) - ((image UNKNOWN 16384 :offset-assert 0) + ((image uint8 16384 :offset-assert 0) ) :method-count-assert 9 :size-assert #x4000 :flag-assert #x900004000 ) -|# -#| + (deftype fog8x256 (structure) - ((image UNKNOWN 256 :offset-assert 0) + ((image uint8 256 :offset-assert 0) ) :method-count-assert 9 :size-assert #x100 :flag-assert #x900000100 ) -|# -#| + (deftype fog-texture-work (structure) - ((corner UNKNOWN 4 :offset-assert 0) - (const vector :inline :offset-assert 64) - (min-corner vector :inline :offset-assert 80) - (max-corner vector :inline :offset-assert 96) - (fog-near float :offset-assert 112) - (fog-far float :offset-assert 116) - (fog-delta float :offset-assert 120) - (alpha-near float :offset-assert 124) - (alpha-far float :offset-assert 128) - (alpha-delta float :offset-assert 132) - (color uint32 :offset-assert 136) + ((corner vector 4 :inline :offset-assert 0) + (const vector :inline :offset-assert 64) + (min-corner vector :inline :offset-assert 80) + (max-corner vector :inline :offset-assert 96) + (fog-near float :offset-assert 112) + (fog-far float :offset-assert 116) + (fog-delta float :offset-assert 120) + (alpha-near float :offset-assert 124) + (alpha-far float :offset-assert 128) + (alpha-delta float :offset-assert 132) + (color uint32 :offset-assert 136) ) :method-count-assert 9 :size-assert #x8c :flag-assert #x90000008c ) -|# -;; (define-extern *clut-translate* object) +(define-extern *clut-translate* (pointer uint32)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; lights-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype vu-lights (structure) - ((direction vector 3 :offset-assert 0) ;; guessed by decompiler - (color vector 3 :offset-assert 48) ;; guessed by decompiler - (ambient vector :inline :offset-assert 96) + ((direction vector 3 :inline :offset-assert 0) + (color vector 3 :inline :offset-assert 48) + (ambient vector :inline :offset-assert 96) ) :method-count-assert 9 :size-assert #x70 :flag-assert #x900000070 ) -|# -#| (deftype light (structure) ((direction vector :inline :offset-assert 0) (color rgbaf :inline :offset-assert 16) (extra vector :inline :offset-assert 32) - (level float :offset-assert 32) - (luminance float :offset-assert 40) - (priority float :offset-assert 44) - (bytes UNKNOWN 4 :offset-assert 36) - (mask uint16 :offset-assert 36) - (palette-index int8 :offset-assert 39) + (level float :offset 32) + (luminance float :offset 40) + (priority float :offset 44) + (bytes uint8 4 :offset 36) + (mask uint16 :offset 36) + (palette-index int8 :offset 39) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype light-sphere (structure) ((name basic :offset-assert 0) (bsphere vector :inline :offset-assert 16) (direction vector :inline :offset-assert 32) (color vector :inline :offset-assert 48) - (decay-start float :offset-assert 4) - (ambient-point-ratio float :offset-assert 8) - (brightness float :offset-assert 12) - (bytes UNKNOWN 4 :offset-assert 60) - (mask uint16 :offset-assert 60) - (palette-index int8 :offset-assert 63) + (decay-start float :offset 4) + (ambient-point-ratio float :offset 8) + (brightness float :offset 12) + (bytes uint8 4 :offset 60) + (mask uint16 :offset 60) + (palette-index int8 :offset 63) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype light-hash-bucket (structure) ((index uint16 :offset-assert 0) (count uint16 :offset-assert 2) @@ -4068,14 +5072,12 @@ :size-assert #x4 :flag-assert #x900000004 ) -|# -#| (deftype light-hash (basic) ((num-lights uint16 :offset-assert 4) (num-indices uint16 :offset-assert 6) (num-buckets uint16 :offset-assert 8) - (bucket-step UNKNOWN 2 :offset-assert 10) + (bucket-step uint16 2 :offset-assert 10) (base-trans vector :inline :offset-assert 16) (axis-scale vector :inline :offset-assert 32) (dimension-array vector4w :inline :offset-assert 48) @@ -4087,9 +5089,7 @@ :size-assert #x4c :flag-assert #x90000004c ) -|# -#| (deftype light-hash-work (structure) ((ones vector4w :inline :offset-assert 0) ) @@ -4097,9 +5097,7 @@ :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype light-group (structure) ((dir0 light :inline :offset-assert 0) (dir1 light :inline :offset-assert 48) @@ -4110,62 +5108,52 @@ :size-assert #xc0 :flag-assert #x9000000c0 ) -|# -;; (define-extern *light-hash* object) +(define-extern *light-hash* light-hash-work) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mood-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype mood-channel (structure) - ((data UNKNOWN 24 :offset-assert 0) - (vecs UNKNOWN 6 :offset-assert 0) + ((data float 24 :offset-assert 0) + (vecs vector4 6 :inline :offset 0) ) :method-count-assert 9 :size-assert #x60 :flag-assert #x900000060 ) -|# -#| (deftype mood-channel-group (structure) - ((data UNKNOWN 4 :offset-assert 0) + ((data mood-channel 4 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x180 :flag-assert #x900000180 ) -|# -#| (deftype mood-fog (structure) ((fog-color vector :inline :offset-assert 0) (fog-dists vector :inline :offset-assert 16) - (fog-start meters :offset-assert 16) - (fog-end meters :offset-assert 20) - (fog-max float :offset-assert 24) - (fog-min float :offset-assert 28) + (fog-start meters :offset 16) + (fog-end meters :offset 20) + (fog-max float :offset 24) + (fog-min float :offset 28) (erase-color vector :inline :offset-assert 32) ) :method-count-assert 9 :size-assert #x30 :flag-assert #x900000030 ) -|# -#| (deftype mood-fog-table (structure) - ((data mood-fog 8 :offset-assert 0) ;; guessed by decompiler + ((data mood-fog 8 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x180 :flag-assert #x900000180 ) -|# -#| (deftype mood-color (structure) ((lgt-color vector :inline :offset-assert 0) (amb-color vector :inline :offset-assert 16) @@ -4174,39 +5162,31 @@ :size-assert #x20 :flag-assert #x900000020 ) -|# -#| (deftype mood-direction-table (structure) - ((data UNKNOWN 4 :offset-assert 0) + ((data vector 4 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype mood-color-table (structure) - ((data UNKNOWN 8 :offset-assert 0) + ((data mood-color 8 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x100 :flag-assert #x900000100 ) -|# -#| (deftype mood-sky-table (structure) - ((data UNKNOWN 8 :offset-assert 0) + ((data vector 8 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x80 :flag-assert #x900000080 ) -|# -#| (deftype mood-clouds (structure) ((cloud-min float :offset-assert 0) (cloud-max float :offset-assert 4) @@ -4215,58 +5195,51 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype mood-weather (structure) - ((data UNKNOWN 2 :offset-assert 0) - (cloud float :offset-assert 0) - (fog float :offset-assert 4) + ((data float 2 :offset-assert 0) + (cloud float :offset 0) + (fog float :offset 4) ) + :pack-me + :allow-misaligned :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype mood-iweather (structure) - ((data UNKNOWN 2 :offset-assert 0) - (cloud int32 :offset-assert 0) - (fog int32 :offset-assert 4) + ((data int32 2 :offset-assert 0) + (cloud int32 :offset 0) + (fog int32 :offset 4) ) + :allow-misaligned :method-count-assert 9 :size-assert #x8 :flag-assert #x900000008 ) -|# -#| (deftype mood-range (structure) - ((data UNKNOWN 4 :offset-assert 0) - (min-cloud float :offset-assert 0) - (max-cloud float :offset-assert 4) - (min-fog float :offset-assert 8) - (max-fog float :offset-assert 12) - (quad uint128 :offset-assert 0) + ((data float 4 :offset-assert 0) + (min-cloud float :offset 0) + (max-cloud float :offset 4) + (min-fog float :offset 8) + (max-fog float :offset 12) + (quad uint128 :offset 0) ) :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype mood-filters-table (structure) - ((data UNKNOWN 8 :offset-assert 0) + ((data vector 8 :inline :offset-assert 0) ) :method-count-assert 9 :size-assert #x80 :flag-assert #x900000080 ) -|# -#| (deftype mood-table (basic) ((mood-fog-table mood-fog-table :offset-assert 4) (mood-color-table mood-color-table :offset-assert 8) @@ -4279,9 +5252,7 @@ :size-assert #x1c :flag-assert #x90000001c ) -|# -#| (deftype mood-context-core (structure) ((current-fog mood-fog :inline :offset-assert 0) (current-sky-color vector :inline :offset-assert 48) @@ -4293,59 +5264,49 @@ :size-assert #x70 :flag-assert #x900000070 ) -|# -#| (deftype mood-context-core2 (mood-context-core) - ((light-group UNKNOWN 8 :offset-assert 112) + ((light-group light-group 8 :inline :offset-assert 112) ) :method-count-assert 9 :size-assert #x670 :flag-assert #x900000670 ) -|# -#| (deftype mood-context-core3 (mood-context-core2) - ((times UNKNOWN 8 :offset-assert 1648) + ((times vector 8 :inline :offset-assert 1648) ) :method-count-assert 9 :size-assert #x6f0 :flag-assert #x9000006f0 ) -|# -#| (deftype mood-context (mood-context-core3) - ((itimes vector4w 4 :offset-assert 1776) ;; guessed by decompiler - (state uint8 32 :offset-assert 1840) ;; guessed by decompiler + ((itimes vector4w 4 :inline :offset-assert 1776) + (state uint32 32 :offset-assert 1840) ) :method-count-assert 9 :size-assert #x7b0 :flag-assert #x9000007b0 ) -|# -#| (deftype mood-control-work (structure) ((weather mood-weather :inline :offset-assert 0) (iweather mood-iweather :inline :offset-assert 8) (interp mood-weather :inline :offset-assert 16) - (index UNKNOWN 4 :offset-assert 24) + (index int32 4 :offset-assert 24) (color-interp float :offset-assert 40) - (color-index UNKNOWN 2 :offset-assert 44) + (color-index int32 2 :offset-assert 44) (channel-interp float :offset-assert 52) - (channel-index UNKNOWN 2 :offset-assert 56) + (channel-index int32 2 :offset-assert 56) (cloud-interp float :offset-assert 64) - (cloud-index UNKNOWN 2 :offset-assert 68) + (cloud-index int32 2 :offset-assert 68) ) :method-count-assert 9 :size-assert #x4c :flag-assert #x90000004c ) -|# -#| (deftype mood-control (mood-table) ((mood-clouds mood-clouds :offset-assert 28) (current-interp mood-weather :inline :offset-assert 32) @@ -4369,10 +5330,10 @@ (lightning-count2 uint32 :offset-assert 152) (rain-id uint32 :offset-assert 156) (sound-pitch float :offset-assert 160) - (fogs UNKNOWN 9 :offset-assert 164) - (colors UNKNOWN 3 :offset-assert 200) - (channels UNKNOWN 3 :offset-assert 212) - (clouds UNKNOWN 9 :offset-assert 224) + (fogs mood-fog 9 :offset-assert 164) ;; these 4 are guesses + (colors mood-color 3 :offset-assert 200) + (channels mood-channel 3 :offset-assert 212) + (clouds mood-clouds 9 :offset-assert 224) ) :method-count-assert 19 :size-assert #x104 @@ -4390,34 +5351,167 @@ (dummy-18 () none 18) ) ) -|# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; level-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(declare-type bsp-header basic) + +(defenum vis-info-flag + :type uint32 + :bitfield #t + (dummy0 0) + (dummy1 1) + (dummy2 2) + (dummy3 3) + (dummy4 4) + (dummy5 5) + (dummy6 6) + (dummy7 7) + (dummy8 8) + (dummy9 9) + (dummy10 10) + (dummy11 11) + (dummy12 12) + (dummy13 13) + (dummy14 14) + (dummy15 15) + (dummy16 16) + (dummy17 17) + (dummy18 18) + (dummy19 19) + (dummy20 20) + (dummy21 21) + (dummy22 22) + (dummy23 23) + (dummy24 24) + (dummy25 25) + (dummy26 26) + (dummy27 27) + (dummy28 28) + (in-iop 29) + (loading 30) + (vis-valid 31) + ) + (deftype level-vis-info (basic) - () + ((level level :offset-assert 4) + (from-level level :offset-assert 8) + (from-bsp bsp-header :offset-assert 12) + (flags vis-info-flag :offset-assert 16) + (length uint32 :offset-assert 20) + (allocated-length uint32 :offset-assert 24) + (dictionary-length uint32 :offset-assert 28) + (dictionary uint32 :offset-assert 32) + (string-block uint32 :offset-assert 36) + (ramdisk uint32 :offset-assert 40) + (vis-bits uint32 :offset-assert 44) + (current-vis-string uint32 :offset-assert 48) + (vis-string uint32 :dynamic :offset-assert 52) + ) :method-count-assert 9 :size-assert #x34 :flag-assert #x900000034 - ;; Failed to read fields. ) -|# -#| + +(defenum task-mask + :type uint32 + :bitfield #t + (task0 0) ;; 0x1 + (task1 1) ;; 0x2 + (task2 2) ;; 0x4 + (task3 3) ;; 0x8 + (task4 4) ;; 0x10 + (task5 5) ;; 0x20 + (task6 6) ;; 0x40 + (task7 7) ;; 0x80 + (done 8) ;; 0x100 + (dummy0 9) ;; 0x200 + (dummy1 10) ;; 0x400 + (dummy2 11) ;; 0x800 + (special 12) ;; 0x1000 + (primary0 13) ;; 0x2000 + (ctywide 14) ;; 0x4000 + (never 15) ;; 0x8000 + (movie0 16) ;; 0x10000 + (movie1 17) ;; 0x20000 + (movie2 18) ;; 0x40000 + ) + (deftype level-load-info (basic) - () + ((name-list string 6 :offset-assert 4) + (index int16 :offset-assert 28) + (task-level uint8 :offset-assert 30) + (name string :offset 4) + (visname string :offset 8) + (nickname string :offset 12) + (dbname string :offset 16) + (taskname string :offset 20) + (packages pair :offset-assert 32) ;; guess on type + (memory-mode uint32 :offset-assert 36) + (music-bank basic :offset-assert 40) + (ambient-sounds basic :offset-assert 44) + (sound-reverb float :offset-assert 48) + (mood-func basic :offset-assert 52) + (mood-init basic :offset-assert 56) + (ocean basic :offset-assert 60) + (sky basic :offset-assert 64) + (use-camera-other basic :offset-assert 68) + (part-engine-max int32 :offset-assert 72) + (city-map-bits uint64 :offset-assert 80) + (continues basic :offset-assert 88) + (tasks basic :offset-assert 92) + (priority int32 :offset-assert 96) + (load-commands basic :offset-assert 100) + (alt-load-commands basic :offset-assert 104) + (bsp-mask uint64 :offset-assert 112) + (buzzer int32 :offset-assert 120) + (buttom-height meters :offset-assert 124) + (run-packages basic :offset-assert 128) + (prev-level basic :offset-assert 132) + (next-level basic :offset-assert 136) + (wait-for-load symbol :offset-assert 140) + (login-func basic :offset-assert 144) + (activate-func basic :offset-assert 148) + (deactivate-func basic :offset-assert 152) + (kill-func basic :offset-assert 156) + (borrow-size uint16 2 :offset-assert 160) + (borrow-level symbol 2 :offset-assert 164) + (borrow-display? basic 2 :offset-assert 172) + (base-task-mask task-mask :offset-assert 180) + (texture-anim basic 10 :offset-assert 184) + (texture-anim-tfrag basic :offset 184) + (texture-anim-pris basic :offset 188) + (texture-anim-shrub basic :offset 192) + (texture-anim-alpha basic :offset 196) + (texture-anim-water basic :offset 200) + (texture-anim-twarp basic :offset 204) + (texture-anim-pris2 basic :offset 208) + (texture-anim-sprite basic :offset 212) + (texture-anim-map basic :offset 216) + (texture-anim-sky basic :offset 220) + (draw-priority float :offset-assert 224) + (level-flags uint32 :offset-assert 228) + (fog-height float :offset-assert 232) + (bigmap-id uint32 :offset-assert 236) + (ocean-near-translucent? symbol :offset-assert 240) + (ocean-far? symbol :offset-assert 244) + (mood-range mood-range :inline :offset-assert 256) + (max-rain float :offset-assert 272) + (fog-mult float :offset-assert 276) + (ocean-alpha float :offset-assert 280) + (extra-sound-bank basic :offset-assert 284) + ) :method-count-assert 9 :size-assert #x120 :flag-assert #x900000120 ;; Failed to read fields. ) -|# -#| +(declare-type drawable basic) (deftype login-state (basic) ((state int32 :offset-assert 4) (pos uint32 :offset-assert 8) @@ -4428,11 +5522,83 @@ :size-assert #x50 :flag-assert #x900000050 ) -|# -#| (deftype level (basic) - () + ((name symbol :offset-assert 4) + (load-name basic :offset-assert 8) + (nickname basic :offset-assert 12) + (index int32 :offset-assert 16) + (status symbol :offset-assert 20) + (borrow-level basic 2 :offset-assert 24) + (borrow-from-level basic :offset-assert 32) + (heap kheap :inline :offset-assert 48) + (borrow-heap kheap 2 :inline :offset-assert 64) + (bsp bsp-header :offset-assert 96) + (art-group basic :offset-assert 100) + (info basic :offset-assert 104) + (texture-page texture-page 18 :offset-assert 108) + (loaded-texture-page texture-page 16 :offset-assert 180) + (loaded-texture-page-count int32 :offset-assert 244) + (entity basic :offset-assert 248) + (closest-object float :offset-assert 252) + ;; ???? + (upload-size int32 18 :offset 324) + (inside-boxes symbol :offset-assert 396) + (display? symbol :offset-assert 400) + (render? symbol :offset-assert 404) + (meta-inside? symbol :offset-assert 408) + (force-inside? symbol :offset-assert 412) + (mood-context mood-context :inline :offset-assert 416) + (mood-func basic :offset-assert 2384) + (mood-init basic :offset-assert 2388) + (vis-bits pointer :offset-assert 2392) + (all-visible? symbol :offset-assert 2396) + (force-all-visible? symbol :offset-assert 2400) + (linking basic :offset-assert 2404) + (vis-info level-vis-info 8 :offset-assert 2408) + (vis-self-index int32 :offset-assert 2440) + (vis-adj-index int32 :offset-assert 2444) + (vis-buffer uint8 2048 :offset-assert 2448) + (mem-usage-block basic :offset-assert 4496) + (mem-usage int32 :offset-assert 4500) + (code-memory-start pointer :offset-assert 4504) + (code-memory-end pointer :offset-assert 4508) + (load-start-time time-frame :offset-assert 4512) + (load-stop-time time-frame :offset-assert 4520) + (load-buffer basic 2 :offset-assert 4528) + (load-buffer-size uint32 :offset-assert 4536) + (load-buffer-last uint32 :offset-assert 4540) + (load-buffer-mode uint32 :offset-assert 4544) + (display-start-time time-frame :offset-assert 4552) + (memory-mask uint32 :offset-assert 4560) + (task-mask task-mask :offset-assert 4564) + (tfrag-gs-test uint64 :offset-assert 4568) + (texture-dirty-masks texture-mask 10 :inline :offset-assert 4576) + (texture-mask texture-mask 18 :inline :offset-assert 4736) + (sky-mask texture-mask :inline :offset-assert 5024) + (tfrag-masks basic :offset-assert 5040) + (tfrag-dists pointer :offset-assert 5044) + (shrub-masks basic :offset-assert 5048) + (shrub-dists pointer :offset-assert 5052) + (alpha-masks basic :offset-assert 5056) + (alpha-dists pointer :offset-assert 5060) + (water-masks basic :offset-assert 5064) + (water-dists pointer :offset-assert 5068) + (tfrag-last-calls int32 6 :offset-assert 5072) + (texture-anim-array texture-anim-array 10 :offset-assert 5096) + (light-hash basic :offset-assert 5136) + (draw-priority float :offset-assert 5140) + (draw-index int32 :offset-assert 5144) + (part-engine basic :offset-assert 5148) + (user-object basic 4 :offset-assert 5152) + (loaded-text-info-count int32 :offset-assert 5168) + (loaded-text-info object 8 :offset-assert 5172) + (level-type basic :offset-assert 5204) + (load-order int64 :offset-assert 5208) + + ;; ?? + (pad int8 12) + ) :method-count-assert 30 :size-assert #x146c :flag-assert #x1e0000146c @@ -4461,11 +5627,47 @@ (dummy-29 () none 29) ) ) -|# -#| +(declare-type entity-links structure) + (deftype level-group (basic) - () + ((length int32 :offset-assert 4) + ;; not in inspect, copied from jak1 + (log-in-level-bsp bsp-header :offset-assert 8) + (loading-level level :offset-assert 12) + ;; + (entity-link entity-links :offset 16) + (border? symbol :offset-assert 20) + (vis? symbol :offset-assert 24) + (want-level basic :offset-assert 28) + (receiving-level basic :offset-assert 32) + (load-commands pair :offset-assert 36) + (play? symbol :offset-assert 40) + (target-pos vector 2 :inline :offset-assert 48) + (camera-pos vector 2 :inline :offset-assert 80) + (heap kheap :inline :offset-assert 112) + (sound-bank basic 4 :offset-assert 128) + (disk-load-timing? symbol :offset-assert 144) + (load-level basic :offset-assert 148) + (load-size uint32 :offset-assert 152) + (load-time float :offset-assert 156) + (load-login-time float :offset-assert 160) + (draw-level-count int32 :offset-assert 164) + (draw-level basic 7 :offset-assert 168) + (draw-index-map uint8 7 :offset-assert 196) + (load-order uint64 :offset-assert 208) + ;; ? + (pad uint8 30) + (level level 7 :inline :offset-assert 256) + (level0 level :inline :offset 256) + (level1 level :inline :offset 5488) + (level2 level :inline :offset 10720) + (level3 level :inline :offset 15952) + (level4 level :inline :offset 21184) + (level5 level :inline :offset 26416) + (default-level level :inline :offset 31648) + (pad2 uint8 4) + ) :method-count-assert 31 :size-assert #x9014 :flag-assert #x1f00009014 @@ -4495,38 +5697,34 @@ (dummy-30 () none 30) ) ) -|# -;; (define-extern *level* object) ;; level-group -;; (define-extern *draw-index* object) -;; (define-extern *level-index* object) +(define-extern *level* level-group) +(define-extern *draw-index* int) +(define-extern *level-index* int) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; capture-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype gs-store-image-packet (structure) - ((vifcode vif-tag 4 :offset-assert 0) ;; guessed by decompiler - (giftag uint128 :offset-assert 16) ;; gif-tag - (bitbltbuf uint64 :offset-assert 32) ;; gs-bitbltbuf - (bitbltbuf-addr uint64 :offset-assert 40) ;; gs-reg64 - (trxpos uint64 :offset-assert 48) ;; gs-trxpos - (trxpos-addr uint64 :offset-assert 56) ;; gs-reg64 - (trxreg uint64 :offset-assert 64) ;; gs-trxreg - (trxreg-addr uint64 :offset-assert 72) ;; gs-reg64 - (finish uint64 :offset-assert 80) ;; int64 - (finish-addr uint64 :offset-assert 88) ;; gs-reg64 - (trxdir uint64 :offset-assert 96) ;; gs-trxdir - (trxdir-addr uint64 :offset-assert 104) ;; gs-reg64 + ((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 ) -|# -#| (deftype screen-shot-work (structure) ((count int16 :offset-assert 0) (size int16 :offset-assert 2) @@ -4538,16 +5736,14 @@ :size-assert #x10 :flag-assert #x900000010 ) -|# -;; (define-extern *screen-shot-work* object) -;; (define-extern *image-name* object) +(define-extern *screen-shot-work* screen-shot-work) +(define-extern *image-name* string) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; math-camera-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype vis-gif-tag (structure) ((fog0 uint32 :offset-assert 0) (strip uint32 :offset-assert 4) @@ -4558,9 +5754,7 @@ :size-assert #x10 :flag-assert #x900000010 ) -|# -#| (deftype cull-info (structure) ((x-fact float :offset-assert 0) (y-fact float :offset-assert 4) @@ -4579,17 +5773,16 @@ (yz-dir-bz float :offset-assert 56) (yz-cross-ab float :offset-assert 60) ) + :allow-misaligned :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 ) -|# -#| (deftype math-camera (basic) ((d meters :offset-assert 4) (f meters :offset-assert 8) - (fov deg :offset-assert 12) ;; degrees + (fov degrees :offset-assert 12) (x-ratio float :offset-assert 16) (y-ratio float :offset-assert 20) (x-pix float :offset-assert 24) @@ -4624,16 +5817,16 @@ (inv-hmge-scale vector :inline :offset-assert 800) (hvdf-off vector :inline :offset-assert 816) (guard vector :inline :offset-assert 832) - (vis-gifs vis-gif-tag 4 :offset-assert 848) ;; guessed by decompiler - (giftex uint128 :offset-assert 848) ;; vis-gif-tag - (gifgr uint128 :offset-assert 864) ;; vis-gif-tag - (giftex-trans uint128 :offset-assert 880) ;; vis-gif-tag - (gifgr-trans uint128 :offset-assert 896) ;; vis-gif-tag + (vis-gifs vis-gif-tag 4 :inline :offset-assert 848) ;; guessed by decompiler + (giftex uint128 :offset 848) ;; vis-gif-tag + (gifgr uint128 :offset 864) ;; vis-gif-tag + (giftex-trans uint128 :offset 880) ;; vis-gif-tag + (gifgr-trans uint128 :offset 896) ;; vis-gif-tag (pfog0 float :offset-assert 912) (pfog1 float :offset-assert 916) (trans vector :inline :offset-assert 928) - (plane plane 4 :offset-assert 944) ;; guessed by decompiler - (guard-plane plane 4 :offset-assert 1008) ;; guessed by decompiler + (plane plane 4 :inline :offset-assert 944) ;; guessed by decompiler + (guard-plane plane 4 :inline :offset-assert 1008) ;; guessed by decompiler (shrub-mat matrix :inline :offset-assert 1072) (quat-other quaternion :inline :offset-assert 1136) (trans-other vector :inline :offset-assert 1152) @@ -4641,8 +5834,8 @@ (camera-temp-other matrix :inline :offset-assert 1232) (camera-rot-other matrix :inline :offset-assert 1296) (inv-camera-rot-other matrix :inline :offset-assert 1360) - (plane-other UNKNOWN 4 :offset-assert 1424) - (guard-plane-other UNKNOWN 4 :offset-assert 1488) + (plane-other plane 4 :inline :offset-assert 1424) + (guard-plane-other plane 4 :inline :offset-assert 1488) (mirror-trans vector :inline :offset-assert 1552) (mirror-normal vector :inline :offset-assert 1568) (fov-correction-factor float :offset-assert 1584) @@ -4651,14 +5844,12 @@ :size-assert #x634 :flag-assert #x900000634 ) -|# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; math-camera ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype fog-corrector (structure) ((fog-end float :offset-assert 0) (fog-start float :offset-assert 4) @@ -4667,37 +5858,33 @@ :size-assert #x8 :flag-assert #x900000008 ) -|# -;; (define-extern fog-corrector-setup object) ;; (function fog-corrector math-camera none) -;; (define-extern *math-camera-fog-correction* object) ;; fog-corrector -;; (define-extern update-math-camera object) ;; (function math-camera symbol symbol math-camera) -;; (define-extern *math-camera* object) ;; math-camera -;; (define-extern math-cam-start-smoothing object) ;; (function float float quaternion) -;; (define-extern move-target-from-pad object) ;; (function transform int transform) -;; (define-extern transform-point-vector! object) ;; (function vector vector symbol) -;; (define-extern transform-point-qword! object) ;; (function vector4w vector symbol) -;; (define-extern transform-point-vector-scale! object) ;; (function vector vector float) -;; (define-extern reverse-transform-point! object) -;; (define-extern init-for-transform object) ;; (function matrix none) +(define-extern fog-corrector-setup (function fog-corrector math-camera none)) +(define-extern *math-camera-fog-correction* fog-corrector) +(define-extern update-math-camera (function math-camera symbol symbol float math-camera)) +(define-extern *math-camera* math-camera) +(define-extern math-cam-start-smoothing (function float float quaternion)) +(define-extern move-target-from-pad (function transform int transform)) +(define-extern transform-point-vector! (function vector vector symbol)) +(define-extern transform-point-qword! (function vector4w vector symbol)) +(define-extern transform-point-vector-scale! (function vector vector float)) +(define-extern reverse-transform-point! (function vector vector vector vector none)) +(define-extern init-for-transform (function matrix none)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; font-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype char-verts (structure) - ((pos vector 4 :offset-assert 0) ;; guessed by decompiler - (color vector 4 :offset-assert 64) ;; guessed by decompiler - (tex-st vector 4 :offset-assert 128) ;; guessed by decompiler + ((pos vector 4 :inline :offset-assert 0) ;; guessed by decompiler + (color vector 4 :inline :offset-assert 64) ;; guessed by decompiler + (tex-st vector 4 :inline :offset-assert 128) ;; guessed by decompiler ) :method-count-assert 9 :size-assert #xc0 :flag-assert #x9000000c0 ) -|# -#| (deftype char-color (structure) ((color rgba 4 :offset-assert 0) ;; guessed by decompiler ) @@ -4705,9 +5892,16 @@ :size-assert #x10 :flag-assert #x900000010 ) -|# -#| +(defenum font-color + :type uint32 + ) + +(defenum font-flags + :type uint32 + :bitfield #t + ) + (deftype font-context (basic) ((origin vector :inline :offset-assert 16) (strip-gif vector :inline :offset-assert 32) @@ -4725,36 +5919,35 @@ :size-assert #x54 :flag-assert #x1500000054 (:methods - ;; (new (symbol type matrix int int float font-color font-flags) _type_ 0) - (dummy-9 () none 9) ;; (set-mat! (font-context matrix) font-context 9) - (dummy-10 () none 10) ;; (set-origin! (font-context int int) font-context 10) - (dummy-11 () none 11) ;; (set-depth! (font-context int) font-context 11) - (dummy-12 () none 12) ;; (set-w! (font-context float) font-context 12) - (dummy-13 () none 13) ;; (set-width! (font-context int) font-context 13) - (dummy-14 () none 14) ;; (set-height! (font-context int) font-context 14) - (dummy-15 () none 15) ;; (set-projection! (font-context float) font-context 15) - (dummy-16 () none 16) ;; (set-color! (font-context font-color) font-context 16) - (dummy-17 () none 17) ;; (set-flags! (font-context font-flags) font-context 17) - (dummy-18 () none 18) ;; (set-start-line! (font-context uint) font-context 18) - (dummy-19 () none 19) ;; (set-scale! (font-context float) font-context 19) - (dummy-20 () none 20) + (new (symbol type matrix int int int font-color font-flags) _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 font-color) font-context 16) + (set-flags! (font-context font-flags) font-context 17) + (set-start-line! (font-context uint) font-context 18) + (set-scale! (font-context float) font-context 19) + (set-alpha! (font-context float) font-context 20) ) ) -|# -#| + (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) ;; guessed by decompiler - (small-font-0-tmpl UNKNOWN 2 :offset-assert 80) - (small-font-1-tmpl UNKNOWN 2 :offset-assert 96) - (small-font-2-tmpl UNKNOWN 2 :offset-assert 112) - (small-font-3-tmpl UNKNOWN 2 :offset-assert 128) - (large-font-0-tmpl UNKNOWN 2 :offset-assert 144) - (large-font-1-tmpl UNKNOWN 2 :offset-assert 160) - (large-font-2-tmpl UNKNOWN 2 :offset-assert 176) - (large-font-3-tmpl UNKNOWN 2 :offset-assert 192) + (small-font-0-tmpl uint64 2 :offset-assert 80) + (small-font-1-tmpl uint64 2 :offset-assert 96) + (small-font-2-tmpl uint64 2 :offset-assert 112) + (small-font-3-tmpl uint64 2 :offset-assert 128) + (large-font-0-tmpl uint64 2 :offset-assert 144) + (large-font-1-tmpl uint64 2 :offset-assert 160) + (large-font-2-tmpl uint64 2 :offset-assert 176) + (large-font-3-tmpl uint64 2 :offset-assert 192) (size1-small vector :inline :offset-assert 208) (size2-small vector :inline :offset-assert 224) (size3-small vector :inline :offset-assert 240) @@ -4772,17 +5965,17 @@ (size-st2 vector :inline :offset-assert 432) (size-st3 vector :inline :offset-assert 448) (save vector :inline :offset-assert 464) - (save-color vector 4 :offset-assert 480) ;; guessed by decompiler + (save-color vector 4 :inline :offset-assert 480) ;; guessed by decompiler (current-verts char-verts :inline :offset-assert 544) (src-verts char-verts :inline :offset-assert 736) (dest-verts char-verts :inline :offset-assert 928) - (justify vector 64 :offset-assert 1120) ;; guessed by decompiler + (justify vector 64 :inline :offset-assert 1120) ;; guessed by decompiler (color-shadow vector4w :inline :offset-assert 2144) - (color-table char-color 40 :offset-assert 2160) ;; guessed by decompiler - (current-font-0-tmpl UNKNOWN 2 :offset-assert 2800) - (current-font-1-tmpl UNKNOWN 2 :offset-assert 2816) - (current-font-2-tmpl UNKNOWN 2 :offset-assert 2832) - (current-font-3-tmpl UNKNOWN 2 :offset-assert 2848) + (color-table char-color 40 :inline :offset-assert 2160) ;; guessed by decompiler + (current-font-0-tmpl uint64 2 :offset-assert 2800) + (current-font-1-tmpl uint64 2 :offset-assert 2816) + (current-font-2-tmpl uint64 2 :offset-assert 2832) + (current-font-3-tmpl uint64 2 :offset-assert 2848) (last-color font-color :offset-assert 2864) ;; guessed by decompiler (save-last-color font-color :offset-assert 2868) ;; guessed by decompiler (buf basic :offset-assert 2872) @@ -4794,10 +5987,10 @@ :size-assert #xb58 :flag-assert #x900000b58 ) -|# -;; (define-extern *font-default-matrix* object) ;; matrix -;; (define-extern *font-work* object) ;; font-work + +(define-extern *font-default-matrix* matrix) +(define-extern *font-work* font-work) ;; (define-extern font-set-tex0 object) ;; (function (pointer gs-tex0) texture uint uint uint none) ;; (define-extern set-font-color object) @@ -4823,7 +6016,7 @@ ;; profile ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| + (deftype profile-work (structure) ((sprite-tmpl dma-gif-packet :inline :offset-assert 0) (line-tmpl dma-gif-packet :inline :offset-assert 32) @@ -4833,14 +6026,13 @@ :size-assert #x44 :flag-assert #x900000044 ) -|# -;; (define-extern *profile-work* object) -;; (define-extern *profile-x* object) ;; int -;; (define-extern *profile-y* object) ;; int -;; (define-extern *profile-w* object) ;; int -;; (define-extern *profile-h* object) ;; int -;; (define-extern *profile-ticks* object) ;; symbol +(define-extern *profile-work* profile-work) +(define-extern *profile-x* int) +(define-extern *profile-y* int) +(define-extern *profile-w* int) +(define-extern *profile-h* int) +(define-extern *profile-ticks* symbol) ;; (define-extern profile-texture-test object) ;; (define-extern profile-tfrag-test object) ;; (define-extern profile-tie-test object) @@ -4852,9 +6044,9 @@ ;; display ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern get-current-time object) ;; (function time-frame) -;; (define-extern get-integral-current-time object) ;; (function time-frame) -;; (define-extern set-display object) ;; (function display int int int int int display) +(define-extern get-current-time (function time-frame)) +(define-extern get-integral-current-time (function time-frame)) +(define-extern set-display (function display int int int int int display)) ;; (define-extern allocate-dma-buffers object) ;; (function display display) ;; (define-extern *font-context* object) ;; font-context ;; (define-extern draw-sprite2d-xy object) ;; (function dma-buffer int int int int rgba none) @@ -4868,7 +6060,7 @@ ;; (define-extern set-display-gs-state-offset object) ;; (function dma-buffer int int int int int int int dma-buffer) ;; (define-extern reset-display-gs-state object) ;; (function display dma-buffer int display) ;; (define-extern *vu0-dma-list* object) ;; dma-buffer -;; (define-extern *display* object) ;; display +(define-extern *display* display) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; connect ;; @@ -5528,9 +6720,105 @@ ;; settings-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| +(defenum language-enum + :type int64 + (english) + (french) + (german) + (spanish) + (italian) + (japanese) + (korean) + (uk-english) + ) + (deftype user-setting-data (structure) - () + ((border-mode symbol) + (process-mask process-mask) + (language language-enum :offset 16) + (movie (pointer process) :offset 40) + (talking (pointer process)) + (spooling (pointer process)) + (hint (pointer process)) + (ambient (pointer process) :offset-assert 56) + (video-mode symbol) + (aspect-ratio symbol :offset-assert 64) + (auto-save symbol :offset 72) + (bg-r float :offset-assert 76) + (bg-g float) + (bg-b float) + (bg-a float) + (bg-a-speed float) + (bg-a-force float) + (allow-progress symbol :offset-assert 100) + (allow-pause symbol :offset-assert 104) + (movie-name symbol :offset 120) + (weather symbol :offset-assert 124) + (task-mask task-mask :offset 136) + (duck symbol :offset 144) + (attack symbol) + (gun symbol) + (board symbol) + (jump symbol) + (speed-mult float) + (features uint64) + (sfx-volume float) + (sfx-movie-volume float :offset-assert 180) + (music-volume float) + (music-volume-movie float) + (dialog-volume float) + (dialog-volume-hint float) + (ambient-volume float) + (ambient-volume-move float) + (sound-flava uint8) + (sound-flava-priority float :offset-assert 212) + (mode-sound-bank uint32) + (sound-excitement float) + (sound-reverb float) + (stereo-mode int32) + (music symbol) + (sound-stinger int32 :offset-assert 236) + (spool-anim symbol) + (sound-mode uint32) + (task-manager (pointer process)) + (task symbol) + (airlock symbol :offset-assert 256) + (minimap uint16) + (sound-tune uint32) + (allow-continue symbol) + (spotlight-color rgba) + (subtitle symbol :offset-assert 276) + (borrow symbol) + (doorway symbol) + (gen symbol) + (half-speed symbol) + (gun-buoy symbol) + (double-jump symbol) + (pilot symbol) + (pilot-exit symbol) + (exclusive-task int32 :offset-assert 312) + (speech-control symbol) + (vehicle-hijacking symbol) + (darkjak symbol) + (endlessfall symbol) + (rain float) + (snow float) + (exclusive-load symbol) + (render symbol) + (allow-timeout symbol) + (mirror symbol) + (movie-skip-frame float) + (allow-blackout symbol) + (race-minimap int32 :offset-assert 364) + (extra-bank symbol) + (beard symbol) + (ignore-target symbol) + (subtitle-language language-enum) + (sound-bank-load symbol) + (allow-error symbol) + (under-water-pitch-mod float :offset-assert 400) + (dummy object 31) + ) :method-count-assert 11 :size-assert #x210 :flag-assert #xb00000210 @@ -5540,11 +6828,105 @@ (dummy-10 () none 10) ) ) -|# -#| +(defenum cam-slave-options + :type uint64 + :bitfield #t + (BUTT_CAM) + (SAME_SIDE) + (MOVE_SPHERICAL) + (ALLOW_Z_ROT) + (JUMP_PITCHES) + (COLLIDE) + (FIND_HIDDEN_TARGET) + (DRAG) + (PLAYER_MOVING_CAMERA) + (LINE_OF_SIGHT) + (MOVEMENT_BLOCKED) + (SHRINK_MAX_ANGLE) + (GOTO_GOOD_POINT) + (BIKE_MODE) + (NO_ROTATE) + (STICKY_ANGLE) + (BLOCK_RIGHT_STICK) + (ALLOW_SHIFT_BUTTONS) + (GUN_CAM) + (WIDE_FOV) + (RAPID_TRACKING) + (EASE_SPLINE_IDX) + (VERTICAL_FOLLOW_MATCHES_CAMERA) + (HAVE_BUTT_HANDLE) + ) + +(defenum cam-master-options + :type uint64 + :bitfield #t + (HAVE_TARGET) ;; 1 + (SET_COMBINER_AXIS) ;; 2 + (FLIP_COMBINER) ;; 4 + (HAVE_EASE_TO_POS) ;; 8 + (IN_BASE_REGION) ;; 10 + (IGNORE_ANALOG) ;; 20 + (READ_BUTTONS) ;; 40 + (IMMEDIATE_STRING_MIN_MAX) ;; 80 + ) + (deftype cam-setting-data (structure) - () + ((fov degrees) + (pov-handle handle :offset 16) + (pov-bone int32) + (pov-offset vector :inline) + (string-default symbol :offset-assert 48) + (string-max-length meters) + (string-min-length meters) + (string-max-height meters) + (string-min-height meters) + (string-cliff-height meters) + (string-camera-ceiling meters) + (gun-max-height meters) + (gun-min-height meters) + (string-local-down vector :inline) + (slave-options cam-slave-options) + (matrix-blend-max-angle degrees :offset-assert 120) + (matrix-blend-max-partial float) + (string-spline-max-move meters) + (string-spline-accel meters) + (string-spline-max-move-player meters) + (string-spline-accel-player meters) + (string-startup-vector vector :inline) + (string-use-startup-vector symbol) + (look-at-point vector :inline :offset-assert 176) + (use-look-at-point symbol) + (target-height meters) + (foot-offset meters) + (head-offset meters) + (teleport-on-entity-change symbol) + (entity-name string) + (entity-or-mode-changed symbol) + (master-options cam-master-options) + (entity-mask uint32 :offset-assert 232) + (mode-name symbol) + (real-entity-name string) + (cam-mode symbol) + (interp-time uint32) + (no-intro symbol) + (use-point-of-interest symbol) + (point-of-interest vector :inline :offset-assert 272) + (handle-of-interest handle) + (mouse-tumble-point vector :inline) + (use-mouse-tumble-point symbol) + (mouse-input symbol) + (cpad1-skip-buttons symbol) + (butt-handle handle) + (butt-angle float) + (extra-follow-height float) + (1Tinterp-time-priority uint32) + (string-max-length-default symbol) + (string-min-length-default symbol) + (string-max-height-default symbol) + (string-min-height-default symbol :offset-assert 368) + (dummy object 102) + ) :method-count-assert 11 :size-assert #x30c :flag-assert #xb0000030c @@ -5554,9 +6936,8 @@ (dummy-10 () none 10) ) ) -|# -#| +(declare-type engine basic) (deftype setting-control (basic) ((user-current user-setting-data :inline :offset-assert 16) (user-target user-setting-data :inline :offset-assert 544) @@ -5568,7 +6949,7 @@ (engine-pers basic :offset-assert 3952) (engine-hi basic :offset-assert 3956) (sound-stinger-time uint64 :offset-assert 3960) - (sound-stinger-change-time UNKNOWN 4 :offset-assert 3968) + (sound-stinger-change-time uint64 4 :offset-assert 3968) (sound-excitement-change-time uint64 :offset-assert 4000) (sound-excitement-targ float :offset-assert 4008) (sound-excitement-level uint32 :offset-assert 4012) @@ -5590,7 +6971,6 @@ (dummy-18 () none 18) ) ) -|# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5740,7 +7120,6 @@ ;; main-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype frame-stats (structure) ((field-time time-frame 2 :offset-assert 0) ;; guessed by decompiler (field int32 :offset-assert 16) @@ -5749,18 +7128,16 @@ :size-assert #x14 :flag-assert #x900000014 ) -|# -#| (deftype screen-filter (basic) ((draw? basic :offset-assert 4) (bucket int32 :offset-assert 8) - (color vector :inline :offset-assert 16) ;; rgba + (color vector :inline :offset-assert 16) (color-src vector :inline :offset-assert 32) (color-dest vector :inline :offset-assert 48) (extra vector :inline :offset-assert 64) - (speed float :offset-assert 64) - (current-interp float :offset-assert 68) + (speed float :offset 64) + (current-interp float :offset 68) ) :method-count-assert 12 :size-assert #x50 @@ -5771,15 +7148,13 @@ (dummy-11 () none 11) ) ) -|# -#| (deftype col-rend (basic) - ((draw? basic :offset-assert 4) - (outline? basic :offset-assert 8) - (show-back-faces? basic :offset-assert 12) - (show-normals? basic :offset-assert 16) - (ghost-hidden? basic :offset-assert 20) + ((draw? symbol :offset-assert 4) + (outline? symbol :offset-assert 8) + (show-back-faces? symbol :offset-assert 12) + (show-normals? symbol :offset-assert 16) + (ghost-hidden? symbol :offset-assert 20) (show-only uint32 :offset-assert 24) (cspec uint32 :offset-assert 28) (track uint8 :offset-assert 32) @@ -5794,122 +7169,122 @@ (dummy-9 () none 9) ) ) -|# -;; (define-extern *stats-poly* object) ;; symbol -;; (define-extern *stats-memory* object) ;; symbol -;; (define-extern *stats-memory-short* object) ;; symbol -;; (define-extern *stats-memory-level-index* object) -;; (define-extern *stats-collide* object) ;; symbol -;; (define-extern *stats-bsp* object) ;; symbol -;; (define-extern *stats-buffer* object) ;; symbol -;; (define-extern *stats-target* object) ;; symbol -;; (define-extern *stats-profile-bars* object) -;; (define-extern *stats-perf* object) -;; (define-extern *artist-all-visible* object) ;; symbol -;; (define-extern *artist-flip-visible* object) ;; symbol -;; (define-extern *artist-fix-visible* object) ;; symbol -;; (define-extern *artist-fix-frustum* object) ;; symbol -;; (define-extern *artist-error-spheres* object) ;; symbol -;; (define-extern *artist-use-menu-subdiv* object) ;; symbol -;; (define-extern *display-profile* object) ;; symbol -;; (define-extern *display-sidekick-stats* object) ;; symbol -;; (define-extern *display-quad-stats* object) ;; symbol -;; (define-extern *display-tri-stats* object) ;; symbol -;; (define-extern *display-ground-stats* object) ;; symbol -;; (define-extern *display-collision-marks* object) ;; symbol -;; (define-extern *display-collide-cache* object) ;; symbol -;; (define-extern *display-render-collision* object) ;; symbol -;; (define-extern *display-hipri-collision-marks* object) ;; symbol -;; (define-extern *display-edge-collision-marks* object) ;; symbol -;; (define-extern *display-geo-marks* object) ;; symbol -;; (define-extern *display-target-marks* object) ;; symbol -;; (define-extern *target-rc-board-controls* object) -;; (define-extern *display-collide-history* object) ;; int -;; (define-extern *display-xyz-axes* object) ;; symbol -;; (define-extern *display-cam-collide-history* object) ;; symbol -;; (define-extern *record-cam-collide-history* object) ;; symbol -;; (define-extern *display-cam-master-marks* object) ;; symbol -;; (define-extern *display-cam-other* object) ;; symbol -;; (define-extern *display-camera-marks* object) ;; symbol -;; (define-extern *camera-no-mip-correction* object) ;; symbol -;; (define-extern *display-cam-los-info* object) ;; symbol -;; (define-extern *display-cam-los-debug* object) ;; symbol -;; (define-extern *display-cam-los-marks* object) ;; symbol -;; (define-extern *display-cam-coll-marks* object) ;; symbol -;; (define-extern *display-camera-info* object) ;; symbol -;; (define-extern *display-camera-old-stats* object) ;; symbol -;; (define-extern *display-camera-last-attacker* object) ;; symbol -;; (define-extern *display-file-info* object) ;; symbol -;; (define-extern *display-actor-marks* object) ;; symbol -;; (define-extern *display-sprite-info* object) ;; symbol -;; (define-extern *display-sprite-marks* object) -;; (define-extern *display-sprite-spheres* object) -;; (define-extern *display-entity-errors* object) ;; symbol -;; (define-extern *display-instance-info* object) ;; symbol -;; (define-extern *display-deci-count* object) ;; symbol -;; (define-extern *sync-dma* object) ;; symbol -;; (define-extern *display-strip-lines* object) ;; int -;; (define-extern *display-battle-marks* object) -;; (define-extern *display-joint-axes* object) -;; (define-extern *display-nav-marks* object) ;; symbol -;; (define-extern *display-nav-network* object) -;; (define-extern *display-path-marks* object) ;; symbol -;; (define-extern *display-vol-marks* object) ;; symbol -;; (define-extern *display-water-marks* object) ;; symbol -;; (define-extern *display-nav-mesh* object) -;; (define-extern *display-actor-pointer* object) -;; (define-extern *display-actor-vis* object) ;; symbol -;; (define-extern *display-actor-graph* object) ;; symbol -;; (define-extern *display-traffic-height-map* object) -;; (define-extern *display-trail-graph* object) -;; (define-extern *display-color-bars* object) -;; (define-extern *display-bug-report* object) -;; (define-extern *display-level-border* object) ;; symbol -;; (define-extern *display-memcard-info* object) ;; symbol -;; (define-extern *display-split-boxes* object) ;; symbol -;; (define-extern *display-split-box-info* object) ;; symbol -;; (define-extern *display-texture-distances* object) -;; (define-extern *display-texture-download* object) ;; symbol -;; (define-extern *display-art-control* object) ;; symbol -;; (define-extern *display-gui-control* object) -;; (define-extern *display-level-spheres* object) ;; symbol -;; (define-extern *time-of-day-fast* object) ;; symbol -;; (define-extern *display-iop-info* object) ;; symbol -;; (define-extern *ambient-sound-class* object) ;; symbol -;; (define-extern *slow-frame-rate* object) ;; symbol -;; (define-extern *display-region-marks* object) -;; (define-extern *execute-regions* object) -;; (define-extern *debug-pause* object) ;; symbol -;; (define-extern *debug-view-anims* object) -;; (define-extern *debug-unkillable* object) -;; (define-extern *debug-actor* object) -;; (define-extern *gun-marks* object) -;; (define-extern *bug-report-output-mode* object) -;; (define-extern *display-scene-control* object) -;; (define-extern *display-bot-marks* object) -;; (define-extern *display-race-marks* object) -;; (define-extern *race-record-path* object) -;; (define-extern *select-race* object) -;; (define-extern *select-race-path* object) -;; (define-extern *bot-record-path* object) -;; (define-extern *subdivide-draw-mode* object) ;; int -;; (define-extern *subdivide-scissor-draw-mode* object) -;; (define-extern *subdivide-foreground-draw-mode* object) -;; (define-extern *subdivide-ocean-draw-mode* object) -;; (define-extern *ocean-height-hack* object) -;; (define-extern *dproc* object) ;; process -;; (define-extern *run* object) ;; symbol -;; (define-extern *teleport* object) ;; symbol -;; (define-extern *teleport-count* object) ;; int -;; (define-extern *draw-hook* object) ;; (function none) -;; (define-extern *debug-hook* object) ;; (function none) -;; (define-extern *menu-hook* object) ;; (function debug-menu-context) -;; (define-extern *progress-hook* object) ;; (function none) -;; (define-extern *dma-timeout-hook* object) ;; (function none) -;; (define-extern *frame-stats* object) ;; frame-stats -;; (define-extern *col-rend* object) -;; (define-extern debug-actor? object) +(define-extern *stats-poly* symbol) +(define-extern *stats-memory* symbol) +(define-extern *stats-memory-short* symbol) +(define-extern *stats-memory-level-index* int) +(define-extern *stats-collide* symbol) +(define-extern *stats-bsp* symbol) +(define-extern *stats-buffer* symbol) +(define-extern *stats-target* symbol) +(define-extern *stats-profile-bars* symbol) +(define-extern *stats-perf* symbol) +(define-extern *artist-all-visible* symbol) +(define-extern *artist-flip-visible* symbol) +(define-extern *artist-fix-visible* symbol) +(define-extern *artist-fix-frustum* symbol) +(define-extern *artist-error-spheres* symbol) +(define-extern *artist-use-menu-subdiv* symbol) +(define-extern *display-profile* symbol) +(define-extern *display-sidekick-stats* symbol) +(define-extern *display-quad-stats* symbol) +(define-extern *display-tri-stats* symbol) +(define-extern *display-ground-stats* symbol) +(define-extern *display-collision-marks* symbol) +(define-extern *display-collide-cache* symbol) +(define-extern *display-render-collision* symbol) +(define-extern *display-hipri-collision-marks* symbol) +(define-extern *display-edge-collision-marks* symbol) +(define-extern *display-geo-marks* symbol) +(define-extern *display-target-marks* symbol) +(define-extern *target-rc-board-controls* symbol) +(define-extern *display-collide-history* int) +(define-extern *display-xyz-axes* symbol) +(define-extern *display-cam-collide-history* symbol) +(define-extern *record-cam-collide-history* symbol) +(define-extern *display-cam-master-marks* symbol) +(define-extern *display-cam-other* symbol) +(define-extern *display-camera-marks* symbol) +(define-extern *camera-no-mip-correction* symbol) +(define-extern *display-cam-los-info* symbol) +(define-extern *display-cam-los-debug* symbol) +(define-extern *display-cam-los-marks* symbol) +(define-extern *display-cam-coll-marks* symbol) +(define-extern *display-camera-info* symbol) +(define-extern *display-camera-old-stats* symbol) +(define-extern *display-camera-last-attacker* symbol) +(define-extern *display-file-info* symbol) +(define-extern *display-actor-marks* symbol) +(define-extern *display-sprite-info* symbol) +(define-extern *display-sprite-marks* symbol) +(define-extern *display-sprite-spheres* symbol) +(define-extern *display-entity-errors* symbol) +(define-extern *display-instance-info* symbol) +(define-extern *display-deci-count* symbol) +(define-extern *sync-dma* symbol) +(define-extern *display-strip-lines* int) +(define-extern *display-battle-marks* symbol) +(define-extern *display-joint-axes* symbol) +(define-extern *display-nav-marks* symbol) +(define-extern *display-nav-network* symbol) +(define-extern *display-path-marks* symbol) +(define-extern *display-vol-marks* symbol) +(define-extern *display-water-marks* symbol) +(define-extern *display-nav-mesh* symbol) +(define-extern *display-actor-pointer* symbol) +(define-extern *display-actor-vis* symbol) +(define-extern *display-actor-graph* symbol) +(define-extern *display-traffic-height-map* symbol) +(define-extern *display-trail-graph* symbol) +(define-extern *display-color-bars* symbol) +(define-extern *display-bug-report* symbol) +(define-extern *display-level-border* symbol) +(define-extern *display-memcard-info* symbol) +(define-extern *display-split-boxes* symbol) +(define-extern *display-split-box-info* symbol) +(define-extern *display-texture-distances* symbol) +(define-extern *display-texture-download* symbol) +(define-extern *display-art-control* symbol) +(define-extern *display-gui-control* symbol) +(define-extern *display-level-spheres* symbol) +(define-extern *time-of-day-fast* symbol) +(define-extern *display-iop-info* symbol) +(define-extern *ambient-sound-class* symbol) +(define-extern *slow-frame-rate* symbol) +(define-extern *display-region-marks* symbol) +(define-extern *execute-regions* symbol) +(define-extern *debug-pause* symbol) +(define-extern *debug-view-anims* symbol) +(define-extern *debug-unkillable* symbol) +(define-extern *debug-actor* object) +(define-extern *gun-marks* symbol) +(define-extern *bug-report-output-mode* symbol) +(define-extern *display-scene-control* int) +(define-extern *display-bot-marks* int) +(define-extern *display-race-marks* int) +(define-extern *race-record-path* symbol) +(define-extern *select-race* int) +(define-extern *select-race-path* int) +(define-extern *bot-record-path* int) +(define-extern *subdivide-draw-mode* int) +(define-extern *subdivide-scissor-draw-mode* int) +(define-extern *subdivide-foreground-draw-mode* int) +(define-extern *subdivide-ocean-draw-mode* int) +(define-extern *ocean-height-hack* int) +(define-extern *dproc* process) +(define-extern *run* symbol) +(define-extern *teleport* symbol) +(define-extern *teleport-count* int) +(define-extern *draw-hook* (function none)) +(define-extern *debug-hook* pair) +(declare-type debug-menu-context basic) +(define-extern *menu-hook* (function debug-menu-context)) +(define-extern *progress-hook* (function none)) +(define-extern *dma-timeout-hook* (function none)) +(define-extern *frame-stats* frame-stats) +(define-extern *col-rend* col-rend) +(define-extern debug-actor? (function object symbol)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mspace-h ;; @@ -6323,6 +7698,9 @@ ;; game-task-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defenum game-task + :type uint8 + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; task-control-h ;; @@ -9324,7 +10702,6 @@ ;; game-info-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype game-bank (basic) ((life-max-default float :offset-assert 4) (life-start-default float :offset-assert 8) @@ -9336,15 +10713,20 @@ :size-assert #x18 :flag-assert #x900000018 ) -|# -#| +(deftype actor-id (uint32) + () + :method-count-assert 9 + :size-assert #x4 + :flag-assert #x900000004 + ) + (deftype highscore-info (structure) ((flags uint8 :offset-assert 0) - (award-scores UNKNOWN 3 :offset-assert 4) - (bronze-score float :offset-assert 4) - (silver-score float :offset-assert 8) - (gold-score float :offset-assert 12) + (award-scores float 3 :offset-assert 4) + (bronze-score float :offset 4) + (silver-score float :offset 8) + (gold-score float :offset 12) ) :method-count-assert 10 :size-assert #x10 @@ -9353,9 +10735,7 @@ (dummy-9 () none 9) ) ) -|# -#| (deftype level-buffer-state (structure) ((name symbol :offset-assert 0) ;; guessed by decompiler (display? symbol :offset-assert 4) ;; guessed by decompiler @@ -9366,7 +10746,6 @@ :size-assert #x10 :flag-assert #x900000010 ) -|# #| (deftype load-state (basic) @@ -14607,22 +15986,21 @@ ;; entity-h ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -#| (deftype entity-perm (structure) ((user-object object 2 :offset-assert 0) ;; guessed by decompiler - (user-uint64 uint64 :offset-assert 0) - (user-float float 2 :offset-assert 0) ;; guessed by decompiler - (user-int32 int32 2 :offset-assert 0) ;; guessed by decompiler - (user-uint32 uint32 2 :offset-assert 0) ;; guessed by decompiler - (user-int16 int16 4 :offset-assert 0) ;; guessed by decompiler - (user-uint16 uint16 4 :offset-assert 0) ;; guessed by decompiler - (user-int8 int8 8 :offset-assert 0) ;; guessed by decompiler - (user-uint8 uint8 8 :offset-assert 0) ;; guessed by decompiler - (status uint16 :offset-assert 8) ;; entity-perm-status - (dummy uint8 1 :offset-assert 10) ;; guessed by decompiler - (task uint8 :offset-assert 11) ;; game-task - (aid actor-id :offset-assert 12) ;; guessed by decompiler - (quad uint128 :offset-assert 0) + (user-uint64 uint64 :offset 0) + (user-float float 2 :offset 0) ;; guessed by decompiler + (user-int32 int32 2 :offset 0) ;; guessed by decompiler + (user-uint32 uint32 2 :offset 0) ;; guessed by decompiler + (user-int16 int16 4 :offset 0) ;; guessed by decompiler + (user-uint16 uint16 4 :offset 0) ;; guessed by decompiler + (user-int8 int8 8 :offset 0) ;; guessed by decompiler + (user-uint8 uint8 8 :offset 0) ;; guessed by decompiler + (status uint16 :offset 8) ;; entity-perm-status + (dummy uint8 1 :offset 10) ;; guessed by decompiler + (task uint8 :offset 11) ;; game-task + (aid actor-id :offset 12) ;; guessed by decompiler + (quad uint128 :offset 0) ) :method-count-assert 10 :size-assert #x10 @@ -14631,11 +16009,23 @@ (dummy-9 () none 9) ;; (update-perm! (_type_ symbol entity-perm-status) _type_ 9) ) ) -|# -#| + (deftype entity-links (structure) - () + ((prev-link entity-links :offset-assert 0) + (next-link entity-links :offset-assert 4) + (entity entity :offset-assert 8) + (process process :offset-assert 12) + (level level :offset-assert 16) + (vis-id int32 :offset-assert 20) + (kill-mask task-mask :offset-assert 24) + (vis-dist meters :offset-assert 28) + (trans vector :inline :offset-assert 32) + (perm entity-perm :inline :offset-assert 48) + (status uint16 :offset 56) + (aid uint32 :offset 60) + (task uint8 :offset 59) + ) :method-count-assert 10 :size-assert #x40 :flag-assert #xa00000040 @@ -14644,7 +16034,7 @@ (dummy-9 () none 9) ;; (birth? (_type_ vector) symbol 9) ) ) -|# + #| (deftype entity-perm-array (inline-array-class) @@ -18150,7 +19540,7 @@ |# ;; (define-extern *sprite-distorter-sine-tables* object) ;; sprite-distorter-sine-tables -;; (define-extern sprite-distorter-generate-tables object) ;; (function none) +(define-extern sprite-distorter-generate-tables (function none)) ;; (define-extern sprite-distort-vu1-block object) ;; vu-function ;; (define-extern sprite-init-distorter object) ;; (function dma-buffer uint none) ;; (define-extern sprite-draw-distorters object) ;; (function dma-buffer none) @@ -18402,7 +19792,7 @@ ;; (define-extern history-draw-and-update object) ;; (function pos-history int vector symbol) ;; (define-extern dma-timeout-cam object) ;; (function vector) ;; (define-extern display-file-info object) ;; (function int) -;; (define-extern add-debug-cursor object) +(define-extern add-debug-cursor (function symbol bucket-id int int int none)) ;; (define-extern *boundary-polygon* object) ;; (inline-array lbvtx) ;; (define-extern init-boundary-regs object) ;; (function none) ;; (define-extern add-boundary-shader object) ;; (function texture-id dma-buffer none) @@ -19825,7 +21215,7 @@ ;; (define-extern drawable-load object) ;; (function drawable kheap drawable) ;; (define-extern art-load object) ;; (function string kheap art) ;; (define-extern art-group-load-check object) ;; (function string kheap int art-group) -;; (define-extern external-art-buffer-init object) +(define-extern external-art-buffer-init function) ;; (define-extern *preload-spool-anims* object) ;; symbol ;; (define-extern ja-play-spooled-anim object) ;; (function spool-anim art-joint-anim art-joint-anim (function process-drawable symbol) int :behavior process-drawable) ;; (define-extern ja-abort-spooled-anim object) ;; (function spool-anim art-joint-anim int int :behavior process-drawable) @@ -19978,8 +21368,8 @@ ;; settings ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern get-current-language object) -;; (define-extern *setting-control* object) ;; setting-control +(define-extern get-current-language (function language-enum)) +(define-extern *setting-control* setting-control) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mood-tables ;; @@ -21308,9 +22698,9 @@ ;; (define-extern *print-login* object) ;; symbol ;; (define-extern load-buffer-resize object) ;; (define-extern level-update-after-load object) ;; (function level login-state level) -;; (define-extern bg object) ;; (function symbol int) -;; (define-extern play object) ;; (function symbol symbol int) -;; (define-extern play-boot object) +(define-extern bg (function symbol int)) +(define-extern play (function symbol symbol int)) +(define-extern play-boot (function none)) ;; (define-extern update-sound-banks object) ;; (function int) ;; (define-extern show-level object) ;; (function symbol int) (define-extern *default-level* level) @@ -22452,7 +23842,7 @@ ;; (define-extern vector<-cspace+vector! object) ;; (function vector cspace vector vector) ;; (define-extern cspace-children object) ;; (function process-drawable int pair) ;; (define-extern cspace-inspect-tree object) ;; (function process-drawable cspace int int object object) -;; (define-extern execute-math-engine object) ;; (function int) +(define-extern execute-math-engine (function int)) ;; (define-extern draw-joint-axes object) ;; (define-extern draw-root object) ;; (define-extern empty-state object) ;; (state process) @@ -23135,7 +24525,7 @@ ;; (define-extern reset-target-state object) ;; (function symbol target :behavior target) ;; (define-extern target-init object) ;; (define-extern tobot-init object) -;; (define-extern stop object) ;; (function symbol int) +(define-extern stop (function symbol int)) ;; (define-extern start object) ;; (function symbol continue-point target) ;; (define-extern tobot-start object) ;; (define-extern tobot-stop object) @@ -24140,27 +25530,27 @@ ;; main ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (define-extern set-letterbox-frames object) ;; (function time-frame none) +(define-extern set-letterbox-frames (function time-frame none)) ;; (define-extern letterbox object) ;; (function none) ;; (define-extern set-blackout-frames object) ;; (function time-frame none) ;; (define-extern blackout object) ;; (function none) ;; (define-extern paused? object) ;; (function symbol) ;; (define-extern movie? object) ;; (function symbol) ;; (define-extern demo? object) -;; (define-extern *last-master-mode* object) ;; symbol +(define-extern *last-master-mode* symbol) ;; (define-extern set-master-mode object) ;; (function symbol none) ;; (define-extern pause-allowed? object) ;; (function symbol) ;; (define-extern toggle-pause object) ;; (function int) -;; (define-extern *screen-filter* object) ;; screen-filter -;; (define-extern *cheat-temp* object) ;; (pointer int32) -;; (define-extern *master-exit* object) ;; symbol -;; (define-extern *progress-cheat* object) ;; symbol -;; (define-extern *first-boot* object) ;; symbol +(define-extern *screen-filter* screen-filter) +(define-extern *cheat-temp* (pointer int32)) +(define-extern *master-exit* symbol) +(define-extern *progress-cheat* symbol) +(define-extern *first-boot* symbol) ;; (define-extern main-cheats object) ;; (function int) ;; (define-extern end-display object) ;; (define-extern display-loop-main object) -;; (define-extern display-loop object) ;; (function int :behavior process) -;; (define-extern on object) ;; (function symbol process) +(define-extern display-loop (function int :behavior process)) +(define-extern on (function symbol process)) ;; (define-extern off object) ;; (function int) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -24284,6 +25674,7 @@ ) |# +(declare-type entity-actor entity) #| (deftype entity-actor (entity) () @@ -24319,7 +25710,7 @@ ;; (define-extern *compact-actors* object) ;; symbol ;; (define-extern *vis-actors* object) ;; symbol ;; (define-extern entity-by-name object) ;; (function string entity) -;; (define-extern entity-by-type object) ;; (function type entity-actor) +(define-extern entity-by-type (function type entity-actor)) ;; (define-extern entity-by-aid object) ;; (function uint entity) ;; (define-extern entity-actor-from-level-name object) ;; (define-extern entity-nav-mesh-by-aid object) diff --git a/decompiler/config/jak2/anonymous_function_types.jsonc b/decompiler/config/jak2/anonymous_function_types.jsonc index c9b62c03b6..1f91f9c9f9 100644 --- a/decompiler/config/jak2/anonymous_function_types.jsonc +++ b/decompiler/config/jak2/anonymous_function_types.jsonc @@ -6,5 +6,11 @@ [26, "(function process symbol)"], [23, "(function process symbol)"], [17, "(function process symbol)"] + ], + "level": [ + [5, "(function none)"] + ], + "main": [ + [3, "(function none :behavior process)"] ] } \ No newline at end of file diff --git a/decompiler/config/jak2/hacks.jsonc b/decompiler/config/jak2/hacks.jsonc index 7c07e25eed..1d3d5f48ab 100644 --- a/decompiler/config/jak2/hacks.jsonc +++ b/decompiler/config/jak2/hacks.jsonc @@ -37,7 +37,7 @@ "(anon-function 54 script)", "(anon-function 52 script)", "(anon-function 49 script)", "(anon-function 33 script)", "debug-menu-func-decode", "scene-player-init", "(method 77 spyder)", "(method 77 flamer)", "(method 77 grenadier)", "(method 224 bot)", "(method 77 rapid-gunner)", // until loop without nop: - "rand-vu-int-count-excluding", "rand-vu-int-range-exclude", "(method 9 history)", "history-print", "history-draw", + "(method 9 history)", "history-print", "history-draw", "(method 9 sparticle-launcher)", "(method 18 tracking-spline)", "cam-string-find-position-rel!", "cam-layout-entity-volume-info-create", "process-drawable-shock-skel-effect", "target-history-print", "display-list-control", "anim-test-anim-list-handler", "anim-test-sequence-list-handler", "anim-tester-get-playing-item", "(method 9 mysql-nav-graph)", "(method 58 nav-graph-editor)", @@ -47,7 +47,7 @@ // actual asm "quad-copy!", "return-from-thread", "return-from-thread-dead", "reset-and-call", "(method 10 cpu-thread)", "(method 11 cpu-thread)", "(method 0 catch-frame)", "throw-dispatch", "throw", "run-function-in-process", - "set-to-run-bootstrap", "return-from-exception", + "set-to-run-bootstrap", "return-from-exception", "exp", "symlink2", "blerc-a-fragment", "blerc-execute", "foreground-check-longest-edge-asm", "generic-light-proc", "shadow-add-single-edges","shadow-add-facing-single-tris", "shadow-add-double-tris", "shadow-add-double-edges", @@ -95,7 +95,15 @@ }, "blocks_ending_in_asm_branch": { + "closest-pt-in-triangle": [17], + // this one is all asm branches + "circle-circle-xz-intersect": [ + 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14 + ], + "find-knot-span": [0, 1, 2, 3, 5, 6, 7, 8, 9], + + "curve-evaluate!": [0, 2, 5, 6, 7, 8, 9] }, // Sometimes the game might use format strings that are fetched dynamically, diff --git a/decompiler/config/jak2/label_types.jsonc b/decompiler/config/jak2/label_types.jsonc index 9e26dfeeb6..fad2c11641 100644 --- a/decompiler/config/jak2/label_types.jsonc +++ b/decompiler/config/jak2/label_types.jsonc @@ -1 +1,67 @@ -{} \ No newline at end of file +{ + "profile": [ + ["L14", "profile-work"] + ], + + "math": [ + ["L103", "(pointer float)", 32], + ["L102", "(pointer float)", 32] + ], + + // possible for auto-labeling + "vector-h": [ + ["L36", "vector"], + ["L35", "vector"], + ["L34", "vector"], + ["L33", "vector"], + ["L32", "vector"], + ["L31", "vector"], + ["L30", "vector"] + ], + + "matrix": [ + ["L65", "matrix"] + ], + "quaternion-h": [ + ["L1", "quaternion"] + ], + "quaternion": [ + ["L85", "vector"], + ["L84", "vector"], + ["L83", "vector"], + ["L82", "vector"], + ["L81", "vector"], + ["L80", "vector"], + ["L79", "vector"], + ["L78", "vector"] + ], + "trigonometry": [ + ["L93", "vector"], + ["L92", "vector"], + ["L91", "vector"] + ], + "video-h": [ + ["L1", "video-params"] + ], + "geometry": [ + ["L132", "vector"] + ], + "texture-h": [ + ["L10", "texture-base"], + ["L9", "texture-base"], + ["L8", "texture-base"], + ["L7", "texture-base"], + ["L6", "texture-base"], + ["L5", "texture-base"] + ], + "texture-anim-h": [ + ["L1", "(pointer uint32)", 64] + ], + "main-h": [ + ["L3", "frame-stats"] + ], + "font-h": [ + ["L20", "matrix"], + ["L19", "font-work"] + ] +} \ No newline at end of file diff --git a/decompiler/config/jak2/stack_structures.jsonc b/decompiler/config/jak2/stack_structures.jsonc index 34c387cbf9..188f8acd8e 100644 --- a/decompiler/config/jak2/stack_structures.jsonc +++ b/decompiler/config/jak2/stack_structures.jsonc @@ -1,4 +1,266 @@ { + // possible for automatic detection: + "(method 23 trsqv)": [[16, "vector"]], + "(method 24 trsqv)": [[16, "vector"]], + "(method 18 bounding-box)": [[16, "vector"], [32, "vector"]], + "(method 12 bounding-box)": [[16, "liang-barsky-line-clip-params"]], + "matrixp*!": [[16, "matrix"]], + "vector3s-matrix*!": [[16, "vector"]], + "vector3s-rotate*!": [[16, "vector"]], + + "matrix-rotate-zyx!": [ + [16, "matrix"], + [80, "matrix"] + ], + "matrix-rotate-xyz!": [ + [16, "vector"], + [32, "vector"], + [80, "matrix"] + ], + "matrix-rotate-zxy!": [ + [16, "matrix"], + [80, "matrix"] + ], + "matrix-rotate-yxz!": [ + [16, "matrix"], + [80, "matrix"] + ], + "matrix-rotate-yzx!": [ + [16, "matrix"], + [80, "matrix"] + ], + "matrix-rotate-yxy!": [ + [16, "vector"], + [32, "vector"], + [48, "vector"] + ], + "matrix-rotate-yx!": [[16, "matrix"]], + "transform-matrix-calc!": [ + [16, "matrix"], + [80, "matrix"] + ], + "transform-matrix-parent-calc!": [ + [16, "matrix"], + [80, "matrix"] + ], + "matrix->quat": [ + [16, "matrix"] + ], + "matrix<-quat": [ + [16, "vector"], + [32, "matrix"] + ], + "matrix->transformq": [ + [16, "matrix"] + ], + "matrix-rotate-xyz-2!": [ + [16, "matrix"], + [80, "matrix"] + ], + "matrix-with-scale->quaternion": [[16, "matrix"]], + "quaternion-exp!": [[16, "vector"]], + "quaternion-slerp!": [[16, "vector"]], + "quaternion-zxy!": [ + [16, "vector"], + [32, "vector"], + [48, "vector"] + ], + "vector-x-quaternion!": [[16, "matrix"]], + "vector-y-quaternion!": [[16, "matrix"]], + "vector-z-quaternion!": [[16, "matrix"]], + "quaternion-x-angle": [[16, "vector"]], + "quaternion-y-angle": [[16, "vector"]], + "quaternion-z-angle": [[16, "vector"]], + "quaternion-rotate-local-x!": [[16, "quaternion"]], + "quaternion-rotate-local-y!": [[16, "quaternion"]], + "quaternion-rotate-local-z!": [[16, "quaternion"]], + "quaternion-rotate-y!": [[16, "quaternion"]], + "quaternion-rotate-x!": [ + [16, "quaternion"], + [32, "vector"] + ], + "quaternion-rotate-z!": [ + [16, "quaternion"], + [32, "vector"] + ], + "quaternion-delta-y": [ + [16, "vector"], + [32, "vector"] + ], + "quaternion-rotate-y-to-vector!": [ + [16, "quaternion"], + [32, "vector"], + [48, "quaternion"] + ], + "quaternion-xz-angle": [ + [16, "matrix"], + [80, "vector"] + ], + "vector-rotate-x!": [ + [16, "quaternion"], + [32, "matrix"] + ], + "vector-rotate-y!": [ + [16, "quaternion"], + [32, "matrix"] + ], + "vector-rotate-z!": [ + [16, "quaternion"], + [32, "matrix"] + ], + "quaternion-axis-angle!": [ + [16, "vector"] + ], + "quaternion-vector-angle!": [ + [16, "vector"] + ], + "quaternion-look-at!": [ + [16, "matrix"] + ], + "quaternion-pseudo-seek": [ + [16, "quaternion"], + [32, "quaternion"] + ], + "quaternion-smooth-seek!": [ + [16, ["inline-array", "quaternion", 2]] + ], + "eul->matrix": [[16, "vector"]], + "eul->quat": [[16, "matrix"]], + "quat->eul": [[16, "matrix"]], + + "vector-sincos!": [[16, "vector"]], + "vector-reflect-flat-gravity!": [[16, "vector"], [32, "vector"]], + "vector-line-distance": [ + [16, "vector"], + [32, "vector"], + [48, "vector"], + [64, "vector"] + ], + "vector-line-distance-point!": [ + [16, "vector"], + [32, "vector"], + [48, "vector"], + [64, "vector"] + ], + "forward-up-nopitch->inv-matrix": [[16, "vector"]], + "forward-up-nopitch->quaternion": [[16, "matrix"]], + "forward-up->quaternion": [ + [16, "matrix"], + [80, "vector"] + ], + "quaternion-from-two-vectors!": [[16, "vector"]], + "quaternion-from-two-vectors-max-angle!": [[16, "vector"]], + "matrix-from-two-vectors!": [[16, "vector"]], + "matrix-from-two-vectors-max-angle!": [[16, "vector"]], + "matrix-from-two-vectors-max-angle-partial!": [[16, "vector"]], + "matrix-from-two-vectors-partial-linear!": [[16, "vector"]], + "matrix-remove-z-rot": [ + [16, "vector"], + [32, "matrix"] + ], + "matrix-rot-diff!": [ + [16, "quaternion"], + [32, "quaternion"], + [48, "quaternion"] + ], + "quaternion-seek": [ + [16, "matrix"], + [80, "matrix"], + [144, "quaternion"] + ], + "vector-segment-overlap": [ + [16, "vector"], + [32, "vector"], + [48, "vector"], + [64, "vector"] + ], + "line-sphere-intersection?": [ + [16, "vector"], + [32, "vector"], + [48, "vector"] + ], + "forward-up->inv-matrix": [ + [16, "vector"] + ], + "quaternion-from-two-vectors-partial!": [ + [16, "vector"] + ], + "quaternion-from-two-vectors-max-angle-partial!": [ + [16, "vector"] + ], + "matrix-from-two-vectors-smooth!": [ + [16, "vector"] + ], + "matrix-from-two-vectors-the-long-way-smooth!": [ + [16, "vector"] + ], + "quaternion-from-two-vectors-smooth!": [ + [16, "matrix"] + ], + "vector-deg-seek": [[16, "matrix"]], + "vector-deg-slerp": [ + [16, "matrix"], + [80, "vector"], + [96, "vector"] + ], + "circle-test": [ + [16, "sphere"], + [32, "sphere"], + [48, "vector"], + [64, "vector"] + ], + "vector-vector-deg-slerp!": [ + [16, "vector"], + [32, "vector"], + [48, "quaternion"], + [64, "quaternion"], + [80, "quaternion"], + [96, "vector"] + ], + "vector-circle-tangent-new": [ + [16, "sphere"], + [32, "vector"], + [48, "vector"] + ], + "vector-circle-tangent": [ + [16, "sphere"], + [32, "vector"], + [48, "vector"], + [64, "vector"] + ], + "curve-length": [ + [16, "vector"], + [32, "vector"] + ], + "curve-closest-point": [ + [16, "vector"], + [32, "vector"] + ], + "closest-pt-in-triangle": [ + [16, "vector"], + [32, "vector"], + [48, "vector"] + ], + "vector-plane-distance": [[16, "vector"]], + "vector-smooth-seek!": [[16, "vector"]], + "vector-vector-angle-safe": [[16, "vector"], [32, "vector"]], + "move-target-from-pad": [ + [16, "vector"], + [32, "vector"], + [48, "matrix"] + ], + "reverse-transform-point!": [ + [16, "vector"], + [32, "vector"], + [48, "vector"] + ], + "init-for-transform": [ + [16, "matrix"], + [80, "matrix"], + [144, "vector4s-3"], + [192, "vector"], + [208, "vector4s-3"] + ], "placeholder-do-not-add-below!": [] } diff --git a/decompiler/config/jak2/type_casts.jsonc b/decompiler/config/jak2/type_casts.jsonc index e41bbd92cc..cb89fad732 100644 --- a/decompiler/config/jak2/type_casts.jsonc +++ b/decompiler/config/jak2/type_casts.jsonc @@ -65,5 +65,117 @@ [101, "t9", "(function object object object object object object none)"] ], "send-event-function": [[[7, 15], "a0", "process"]], + + "logf": [ + [12, "f0", "float"], + [12, "f1", "float"], + [19, "f0", "float"], + [19, "f1", "float"] + ], + + "log2f": [ + [12, "f0", "float"], + [12, "f1", "float"], + [19, "f0", "float"], + [19, "f1", "float"] + ], + + "log2": [[3, "v1", "int"]], + + "cube-root": [ + [[0,33], "f0", "float"], + [[0,33], "f1", "float"], + [[0,33], "f2", "float"] + ], + + "vector-x-quaternion!": [[10, "v1", "(pointer uint128)"]], + "vector-y-quaternion!": [[10, "v1", "(pointer uint128)"]], + "vector-z-quaternion!": [[10, "v1", "(pointer uint128)"]], + "dma-buffer-add-vu-function": [[[9, 33], "t2", "dma-packet"]], + "dma-buffer-add-buckets": [ + [[1, 4], "v1", "dma-bucket"], + [5, "v1", "pointer"], + [[9, 11], "v1", "dma-bucket"], + [11, "v1", "pointer"] + ], + "dma-buffer-patch-buckets": [ + [[6,8], "a0", "(inline-array dma-bucket)"], + [8, "a3", "pointer"], + [14, "a0", "(inline-array dma-bucket)"], + [3, "a0", "(inline-array dma-bucket)"], + [36, "a0", "(inline-array dma-bucket)"], + [10, "a0", "(inline-array dma-bucket)"], + [18, "a0", "(inline-array dma-bucket)"], + [[29,33], "a0", "dma-packet"], + [34, "a0", "(inline-array dma-bucket)"] + ], + "dma-bucket-insert-tag": [ + [[2, 6], "v1", "dma-bucket"], + [3, "a0", "dma-bucket"] + ], + + "disasm-vif-details": [ + [[62, 94], "s3", "(pointer uint32)"], + [[98, 130], "s3", "(pointer uint16)"], + [[134, 164], "s3", "(pointer uint32)"], + [[168, 198], "s3", "(pointer uint16)"], + [[202, 225], "s3", "(pointer uint16)"] + ], + "disasm-vif-tag": [ + [[81, 85], "t1", "vif-stcycl-imm"], + [242, "a0", "vif-unpack-imm"] + ], + "disasm-dma-list": [ + [25, "v1", "dma-tag"], + [153, "v1", "dma-packet"], + [189, "v1", "dma-packet"], + [229, "v1", "dma-packet"], + [258, "v1", "dma-packet"], + [302, "v1", "dma-packet"], + [308, "v1", "dma-packet"], + [152, "v1", "(pointer uint64)"], + [167, "v1", "(pointer uint64)"], + [176, "v1", "(pointer uint64)"], + [198, "v1", "(pointer uint64)"], + [207, "v1", "(pointer uint64)"], + [238, "v1", "(pointer uint64)"], + [247, "v1", "(pointer uint64)"], + [282, "v1", "(pointer uint64)"], + [291, "v1", "(pointer uint64)"], + [324, "v1", "(pointer uint64)"], + [334, "v1", "(pointer uint64)"] + ], + "calculate-basis-functions-vector!": [ + [[8, 20], "v1", "(pointer float)"], + [[0, 60], "f1", "float"] + ], + "curve-evaluate!": [[62, "s5", "pointer"]], + "vector4-array-add!": [ + [11, "s5", "(inline-array vector4)"], + [12, "s4", "(inline-array vector4)"], + [13, "gp", "(inline-array vector4)"]], + "vector4-array-sub!": [ + [11, "s5", "(inline-array vector4)"], + [12, "s4", "(inline-array vector4)"], + [13, "gp", "(inline-array vector4)"]], + "vector4-array-mul!": [ + [11, "s5", "(inline-array vector4)"], + [12, "s4", "(inline-array vector4)"], + [13, "gp", "(inline-array vector4)"]], + "vector4-array-scale!": [ + [11, "s5", "(inline-array vector4)"], + [12, "gp", "(inline-array vector4)"]], + "vector4-array-madd!": [ + [13, "s5", "(inline-array vector4)"], + [14, "s4", "(inline-array vector4)"], + [15, "gp", "(inline-array vector4)"]], + "vector4-array-msub!": [ + [13, "s5", "(inline-array vector4)"], + [14, "s4", "(inline-array vector4)"], + [15, "gp", "(inline-array vector4)"]], + "vector4-array-lerp!": [ + [13, "s5", "(inline-array vector4)"], + [14, "s4", "(inline-array vector4)"], + [15, "gp", "(inline-array vector4)"]], "placeholder-do-not-add-below": [] } diff --git a/decompiler/config/jak2_ntsc_v1.jsonc b/decompiler/config/jak2_ntsc_v1.jsonc index 458aae7d98..6d5eeff756 100644 --- a/decompiler/config/jak2_ntsc_v1.jsonc +++ b/decompiler/config/jak2_ntsc_v1.jsonc @@ -19,7 +19,7 @@ "disassemble_code": true, // Run the decompiler - "decompile_code": false, + "decompile_code": true, "find_functions": true, diff --git a/decompiler/util/data_decompile.cpp b/decompiler/util/data_decompile.cpp index ea1edef0fd..2e5fa94011 100644 --- a/decompiler/util/data_decompile.cpp +++ b/decompiler/util/data_decompile.cpp @@ -924,7 +924,7 @@ goos::Object decompile_structure(const TypeSpec& type, } // first, let's see if it's a value or reference - auto field_type_info = ts.lookup_type(field.type()); + auto field_type_info = ts.lookup_type_allow_partial_def(field.type()); if (!field_type_info->is_reference()) { // value type. need to get bytes. ASSERT(!field.is_inline()); diff --git a/goal_src/jak2/dgos/engine.gd b/goal_src/jak2/dgos/engine.gd new file mode 100644 index 0000000000..b63aaea6b7 --- /dev/null +++ b/goal_src/jak2/dgos/engine.gd @@ -0,0 +1,371 @@ +("ENGINE.CGO" + ("types-h.o" "types-h") + ("vu1-macros.o" "vu1-macros") + ("math.o" "math") + ("vector-h.o" "vector-h") + ("gravity-h.o" "gravity-h") + ("bounding-box-h.o" "bounding-box-h") + ("matrix-h.o" "matrix-h") + ("quaternion-h.o" "quaternion-h") + ("euler-h.o" "euler-h") + ("transform-h.o" "transform-h") + ("geometry-h.o" "geometry-h") + ("trigonometry-h.o" "trigonometry-h") + ("transformq-h.o" "transformq-h") + ("bounding-box.o" "bounding-box") + ("matrix.o" "matrix") + ("transform.o" "transform") + ("quaternion.o" "quaternion") + ("euler.o" "euler") + ("trigonometry.o" "trigonometry") + ("gsound-h.o" "gsound-h") + ("timer-h.o" "timer-h") + ("vif-h.o" "vif-h") + ("dma-h.o" "dma-h") + ("video-h.o" "video-h") + ("vu1-user-h.o" "vu1-user-h") + ("profile-h.o" "profile-h") + ("dma.o" "dma") + ("dma-buffer.o" "dma-buffer") + ("dma-bucket.o" "dma-bucket") + ("dma-disasm.o" "dma-disasm") + ("pad.o" "pad") + ("gs.o" "gs") + ("display-h.o" "display-h") + ("geometry.o" "geometry") + ("timer.o" "timer") + ("vector.o" "vector") + ("file-io.o" "file-io") + ("loader-h.o" "loader-h") + ("texture-h.o" "texture-h") + ("texture-anim-h.o" "texture-anim-h") + ("lights-h.o" "lights-h") + ("mood-h.o" "mood-h") + ("level-h.o" "level-h") + ("capture-h.o" "capture-h") + ("math-camera-h.o" "math-camera-h") + ("math-camera.o" "math-camera") + ("font-h.o" "font-h") + ("decomp-h.o" "decomp-h") + ("profile.o" "profile") + ("display.o" "display") + ("connect.o" "connect") + ("text-id-h.o" "text-id-h") + ("text-h.o" "text-h") + ("camera-defs-h.o" "camera-defs-h") + ("trail-h.o" "trail-h") + ("minimap-h.o" "minimap-h") + ("bigmap-h.o" "bigmap-h") + ("settings-h.o" "settings-h") + ("capture.o" "capture") + ("memory-usage-h.o" "memory-usage-h") + ("blit-displays-h.o" "blit-displays-h") + ("texture.o" "texture") + ("main-h.o" "main-h") + ("mspace-h.o" "mspace-h") + ("drawable-h.o" "drawable-h") + ("drawable-group-h.o" "drawable-group-h") + ("drawable-inline-array-h.o" "drawable-inline-array-h") + ("draw-node-h.o" "draw-node-h") + ("drawable-tree-h.o" "drawable-tree-h") + ("drawable-actor-h.o" "drawable-actor-h") + ("region-h.o" "region-h") + ("traffic-h.o" "traffic-h") + ("game-task-h.o" "game-task-h") + ("task-control-h.o" "task-control-h") + ("generic-h.o" "generic-h") + ("sky-h.o" "sky-h") + ("ocean-h.o" "ocean-h") + ("ocean-trans-tables.o" "ocean-trans-tables") + ("ocean-tables.o" "ocean-tables") + ("ocean-frames.o" "ocean-frames") + ("time-of-day-h.o" "time-of-day-h") + ("art-h.o" "art-h") + ("generic-vu1-h.o" "generic-vu1-h") + ("merc-h.o" "merc-h") + ("generic-merc-h.o" "generic-merc-h") + ("generic-tie-h.o" "generic-tie-h") + ("generic-work-h.o" "generic-work-h") + ("shadow-cpu-h.o" "shadow-cpu-h") + ("shadow-vu1-h.o" "shadow-vu1-h") + ("memcard-h.o" "memcard-h") + ("game-info-h.o" "game-info-h") + ("gui-h.o" "gui-h") + ("ambient-h.o" "ambient-h") + ("speech-h.o" "speech-h") + ("wind-h.o" "wind-h") + ("prototype-h.o" "prototype-h") + ("joint-h.o" "joint-h") + ("bones-h.o" "bones-h") + ("foreground-h.o" "foreground-h") + ("engines.o" "engines") + ("lightning-h.o" "lightning-h") + ("res-h.o" "res-h") + ("res.o" "res") + ("lights.o" "lights") + ("dynamics-h.o" "dynamics-h") + ("surface-h.o" "surface-h") + ("pat-h.o" "pat-h") + ("fact-h.o" "fact-h") + ("aligner-h.o" "aligner-h") + ("penetrate-h.o" "penetrate-h") + ("game-h.o" "game-h") + ("script-h.o" "script-h") + ("scene-h.o" "scene-h") + ("sync-info-h.o" "sync-info-h") + ("pov-camera-h.o" "pov-camera-h") + ("smush-control-h.o" "smush-control-h") + ("debug-h.o" "debug-h") + ("joint-mod-h.o" "joint-mod-h") + ("collide-func-h.o" "collide-func-h") + ("collide-mesh-h.o" "collide-mesh-h") + ("collide-shape-h.o" "collide-shape-h") + ("generic-obs-h.o" "generic-obs-h") + ("trajectory-h.o" "trajectory-h") + ("collide-target-h.o" "collide-target-h") + ("collide-touch-h.o" "collide-touch-h") + ("collide-edge-grab-h.o" "collide-edge-grab-h") + ("process-drawable-h.o" "process-drawable-h") + ("process-focusable.o" "process-focusable") + ("process-taskable-h.o" "process-taskable-h") + ("focus.o" "focus") + ("effect-control-h.o" "effect-control-h") + ("collide-frag-h.o" "collide-frag-h") + ("collide-hash-h.o" "collide-hash-h") + ("chain-physics-h.o" "chain-physics-h") + ("projectile-h.o" "projectile-h") + ("find-nearest-h.o" "find-nearest-h") + ("target-h.o" "target-h") + ("stats-h.o" "stats-h") + ("bsp-h.o" "bsp-h") + ("collide-cache-h.o" "collide-cache-h") + ("collide-h.o" "collide-h") + ("shrubbery-h.o" "shrubbery-h") + ("tie-h.o" "tie-h") + ("tfrag-h.o" "tfrag-h") + ("background-h.o" "background-h") + ("subdivide-h.o" "subdivide-h") + ("entity-h.o" "entity-h") + ("sprite-h.o" "sprite-h") + ("simple-sprite-h.o" "simple-sprite-h") + ("eye-h.o" "eye-h") + ("sparticle-launcher-h.o" "sparticle-launcher-h") + ("sparticle-h.o" "sparticle-h") + ("actor-link-h.o" "actor-link-h") + ("camera-h.o" "camera-h") + ("cam-debug-h.o" "cam-debug-h") + ("cam-interface-h.o" "cam-interface-h") + ("cam-update-h.o" "cam-update-h") + ("hud-h.o" "hud-h") + ("progress-h.o" "progress-h") + ("rpc-h.o" "rpc-h") + ("path-h.o" "path-h") + ("nav-mesh-h.o" "nav-mesh-h") + ("nav-control-h.o" "nav-control-h") + ("spatial-hash-h.o" "spatial-hash-h") + ("actor-hash-h.o" "actor-hash-h") + ("load-dgo.o" "load-dgo") + ("ramdisk.o" "ramdisk") + ("gsound.o" "gsound") + ("transformq.o" "transformq") + ("collide-func.o" "collide-func") + ("joint.o" "joint") + ("joint-mod.o" "joint-mod") + ("chain-physics.o" "chain-physics") + ("cylinder.o" "cylinder") + ("wind-work.o" "wind-work") + ("wind.o" "wind") + ("bsp.o" "bsp") + ("subdivide.o" "subdivide") + ("sprite.o" "sprite") + ("sprite-distort.o" "sprite-distort") + ("sprite-glow.o" "sprite-glow") + ("debug-sphere.o" "debug-sphere") + ("debug.o" "debug") + ("history.o" "history") + ("merc-vu1.o" "merc-vu1") + ("emerc-vu1.o" "emerc-vu1") + ("merc-blend-shape.o" "merc-blend-shape") + ("merc.o" "merc") + ("emerc.o" "emerc") + ("ripple.o" "ripple") + ("bones.o" "bones") + ("debug-foreground.o" "debug-foreground") + ("foreground.o" "foreground") + ("generic-vu0.o" "generic-vu0") + ("generic-vu1.o" "generic-vu1") + ("generic-effect.o" "generic-effect") + ("generic-merc.o" "generic-merc") + ("generic-tie.o" "generic-tie") + ("shadow-cpu.o" "shadow-cpu") + ("shadow-vu1.o" "shadow-vu1") + ("warp.o" "warp") + ("texture-anim.o" "texture-anim") + ("texture-anim-funcs.o" "texture-anim-funcs") + ("texture-anim-tables.o" "texture-anim-tables") + ("blit-displays.o" "blit-displays") + ("font-data.o" "font-data") + ("font.o" "font") + ("decomp.o" "decomp") + ("background.o" "background") + ("draw-node.o" "draw-node") + ("shrubbery.o" "shrubbery") + ("shrub-work.o" "shrub-work") + ("tfrag-near.o" "tfrag-near") + ("tfrag.o" "tfrag") + ("tfrag-methods.o" "tfrag-methods") + ("tfrag-work.o" "tfrag-work") + ("tie.o" "tie") + ("etie-vu1.o" "etie-vu1") + ("etie-near-vu1.o" "etie-near-vu1") + ("tie-near.o" "tie-near") + ("tie-work.o" "tie-work") + ("tie-methods.o" "tie-methods") + ("sync-info.o" "sync-info") + ("trajectory.o" "trajectory") + ("sparticle-launcher.o" "sparticle-launcher") + ("sparticle.o" "sparticle") + ("entity-table.o" "entity-table") + ("loader.o" "loader") + ("game-info.o" "game-info") + ("game-task.o" "game-task") + ("game-save.o" "game-save") + ("settings.o" "settings") + ("mood-tables.o" "mood-tables") + ("mood-tables2.o" "mood-tables2") + ("mood.o" "mood") + ("mood-funcs.o" "mood-funcs") + ("mood-funcs2.o" "mood-funcs2") + ("weather-part.o" "weather-part") + ("time-of-day.o" "time-of-day") + ("sky-data.o" "sky-data") + ("sky-tng.o" "sky-tng") + ("load-state.o" "load-state") + ("level-info.o" "level-info") + ("level.o" "level") + ("text.o" "text") + ("collide-hash.o" "collide-hash") + ("collide-probe.o" "collide-probe") + ("collide-frag.o" "collide-frag") + ("collide-mesh.o" "collide-mesh") + ("collide-touch.o" "collide-touch") + ("collide-edge-grab.o" "collide-edge-grab") + ("collide-shape.o" "collide-shape") + ("collide-shape-rider.o" "collide-shape-rider") + ("collide.o" "collide") + ("collide-planes.o" "collide-planes") + ("spatial-hash.o" "spatial-hash") + ("actor-hash.o" "actor-hash") + ("merc-death.o" "merc-death") + ("water-flow.o" "water-flow") + ("water-h.o" "water-h") + ("camera.o" "camera") + ("cam-interface.o" "cam-interface") + ("cam-master.o" "cam-master") + ("cam-states.o" "cam-states") + ("cam-states-dbg.o" "cam-states-dbg") + ("cam-combiner.o" "cam-combiner") + ("cam-update.o" "cam-update") + ("vol-h.o" "vol-h") + ("cam-layout.o" "cam-layout") + ("cam-debug.o" "cam-debug") + ("cam-start.o" "cam-start") + ("process-drawable.o" "process-drawable") + ("ambient.o" "ambient") + ("speech.o" "speech") + ("region.o" "region") + ("fma-sphere.o" "fma-sphere") + ("script.o" "script") + ("generic-obs.o" "generic-obs") + ("lightning.o" "lightning") + ("carry-h.o" "carry-h") + ("pilot-h.o" "pilot-h") + ("gun-h.o" "gun-h") + ("board-h.o" "board-h") + ("darkjak-h.o" "darkjak-h") + ("target-util.o" "target-util") + ("target-part.o" "target-part") + ("gun-part.o" "gun-part") + ("collide-reaction-target.o" "collide-reaction-target") + ("logic-target.o" "logic-target") + ("sidekick.o" "sidekick") + ("voicebox.o" "voicebox") + ("collectables-part.o" "collectables-part") + ("debug-part.o" "debug-part") + ("find-nearest.o" "find-nearest") + ("task-arrow.o" "task-arrow") + ("projectile.o" "projectile") + ("target-handler.o" "target-handler") + ("target-anim.o" "target-anim") + ("target.o" "target") + ("target2.o" "target2") + ("target-swim.o" "target-swim") + ("target-carry.o" "target-carry") + ("target-darkjak.o" "target-darkjak") + ("target-death.o" "target-death") + ("target-gun.o" "target-gun") + ("gun-util.o" "gun-util") + ("gun-blue-shot.o" "gun-blue-shot") + ("gun-yellow-shot.o" "gun-yellow-shot") + ("gun-red-shot.o" "gun-red-shot") + ("gun-dark-shot.o" "gun-dark-shot") + ("gun-states.o" "gun-states") + ("board-util.o" "board-util") + ("target-board.o" "target-board") + ("board-part.o" "board-part") + ("board-states.o" "board-states") + ("mech-h.o" "mech-h") + ("menu.o" "menu") + ("drawable.o" "drawable") + ("drawable-group.o" "drawable-group") + ("drawable-inline-array.o" "drawable-inline-array") + ("drawable-tree.o" "drawable-tree") + ("prototype.o" "prototype") + ("main-collide.o" "main-collide") + ("video.o" "video") + ("main.o" "main") + ("collide-cache.o" "collide-cache") + ("collide-debug.o" "collide-debug") + ("relocate.o" "relocate") + ("memory-usage.o" "memory-usage") + ("entity.o" "entity") + ("path.o" "path") + ("vol.o" "vol") + ("nav-mesh.o" "nav-mesh") + ("nav-control.o" "nav-control") + ("aligner.o" "aligner") + ("water.o" "water") + ("collectables.o" "collectables") + ("task-control.o" "task-control") + ("scene.o" "scene") + ("pov-camera.o" "pov-camera") + ("powerups.o" "powerups") + ("crates.o" "crates") + ("hud.o" "hud") + ("hud-classes.o" "hud-classes") + ("progress-static.o" "progress-static") + ("progress.o" "progress") + ("progress-draw.o" "progress-draw") + ("ocean.o" "ocean") + ("ocean-vu0.o" "ocean-vu0") + ("ocean-texture.o" "ocean-texture") + ("ocean-mid.o" "ocean-mid") + ("ocean-transition.o" "ocean-transition") + ("ocean-near.o" "ocean-near") + ("minimap.o" "minimap") + ("bigmap-data.o" "bigmap-data") + ("bigmap.o" "bigmap") + ("eye.o" "eye") + ("glist-h.o" "glist-h") + ("glist.o" "glist") + ("anim-tester.o" "anim-tester") + ("viewer.o" "viewer") + ("part-tester.o" "part-tester") + ("editable-h.o" "editable-h") + ("editable.o" "editable") + ("editable-player.o" "editable-player") + ("mysql-nav-graph.o" "mysql-nav-graph") + ("nav-graph-editor.o" "nav-graph-editor") + ("sampler.o" "sampler") + ("default-menu.o" "default-menu") + ) \ No newline at end of file diff --git a/goal_src/jak2/dgos/kernel.gd b/goal_src/jak2/dgos/kernel.gd new file mode 100644 index 0000000000..4df9a0e142 --- /dev/null +++ b/goal_src/jak2/dgos/kernel.gd @@ -0,0 +1,10 @@ +("KERNEL.CGO" + ("gcommon.o" "gcommon") + ("gstring-h.o" "gstring-h") + ("gkernel-h.o" "gkernel-h") + ("gkernel.o" "gkernel") + ("pskernel.o" "pskernel") + ("gstring.o" "gstring") + ("dgo-h.o" "dgo-h") + ("gstate.o" "gstate") + ) \ No newline at end of file diff --git a/goal_src/jak2/game.gp b/goal_src/jak2/game.gp index 911d56dc39..627f0b5c72 100644 --- a/goal_src/jak2/game.gp +++ b/goal_src/jak2/game.gp @@ -161,6 +161,404 @@ (cgo "KERNEL.CGO" "kernel.gd") +;;;;;;;;;;;;; +;; engine +;;;;;;;;;;;;; + +(goal-src-sequence + "engine/" + :deps + ("$OUT/obj/gcommon.o" + "$OUT/obj/gstate.o" + "$OUT/obj/gstring.o" + "$OUT/obj/gkernel.o" + ) +"util/types-h.gc" +"ps2/vu1-macros.gc" +"math/math.gc" +"math/vector-h.gc" +"physics/gravity-h.gc" +"geometry/bounding-box-h.gc" +"math/matrix-h.gc" +"math/quaternion-h.gc" +"math/euler-h.gc" +"math/transform-h.gc" +"geometry/geometry-h.gc" +"math/trigonometry-h.gc" +"math/transformq-h.gc" +"geometry/bounding-box.gc" +"math/matrix.gc" +"math/transform.gc" +"math/quaternion.gc" +"math/euler.gc" +"math/trigonometry.gc" +"sound/gsound-h.gc" +"ps2/timer-h.gc" +"ps2/vif-h.gc" +"dma/dma-h.gc" +"gfx/hw/video-h.gc" +"gfx/vu1-user-h.gc" +"util/profile-h.gc" +"dma/dma.gc" +"dma/dma-buffer.gc" +"dma/dma-bucket.gc" +"dma/dma-disasm.gc" +"ps2/pad.gc" +"gfx/hw/gs.gc" +"gfx/hw/display-h.gc" +"geometry/geometry.gc" +"ps2/timer.gc" +"math/vector.gc" +"load/file-io.gc" +"load/loader-h.gc" +"gfx/texture/texture-h.gc" +"gfx/texture/texture-anim-h.gc" +"gfx/lights-h.gc" +"gfx/mood/mood-h.gc" +"level/level-h.gc" +"util/capture-h.gc" +"gfx/math-camera-h.gc" +"gfx/math-camera.gc" +"gfx/font-h.gc" +"load/decomp-h.gc" +"util/profile.gc" +"gfx/hw/display.gc" +"engine/connect.gc" +"ui/text-id-h.gc" +"ui/text-h.gc" +"camera/camera-defs-h.gc" +) + +(goal-src-sequence + "levels/" + :deps ("$OUT/obj/camera-defs-h.o") + "city/common/trail-h.gc" + ) + +(goal-src-sequence + "engine/" + :deps + ("$OUT/obj/trail-h.o") +"ui/minimap-h.gc" +"ui/bigmap-h.gc" +"game/settings-h.gc" +"util/capture.gc" +"debug/memory-usage-h.gc" +"gfx/blit-displays-h.gc" +"gfx/texture/texture.gc" +"game/main-h.gc" +"anim/mspace-h.gc" +"draw/drawable-h.gc" +"draw/drawable-group-h.gc" +"draw/drawable-inline-array-h.gc" +"draw/draw-node-h.gc" +"draw/drawable-tree-h.gc" +"draw/drawable-actor-h.gc" +"level/region-h.gc" +"ai/traffic-h.gc" +"game/task/game-task-h.gc" +"game/task/task-control-h.gc" +"gfx/generic/generic-h.gc" +"gfx/sky/sky-h.gc" +"gfx/ocean/ocean-h.gc" +"gfx/ocean/ocean-trans-tables.gc" +"gfx/ocean/ocean-tables.gc" +"gfx/ocean/ocean-frames.gc" +"gfx/mood/time-of-day-h.gc" +"data/art-h.gc" +"gfx/generic/generic-vu1-h.gc" +"gfx/merc/merc-h.gc" +"gfx/merc/generic-merc-h.gc" +"gfx/tie/generic-tie-h.gc" +"gfx/generic/generic-work-h.gc" +"gfx/foreground/shadow-cpu-h.gc" +"gfx/foreground/shadow-vu1-h.gc" +"ps2/memcard-h.gc" +"game/game-info-h.gc" +"ui/gui-h.gc" +"ambient/ambient-h.gc" +"sound/speech-h.gc" +"gfx/background/wind-h.gc" +"gfx/background/prototype-h.gc" +"anim/joint-h.gc" +"gfx/foreground/bones-h.gc" +"gfx/foreground/foreground-h.gc" +"engine/engines.gc" +"gfx/lightning-h.gc" +"entity/res-h.gc" +"entity/res.gc" +"gfx/lights.gc" +"physics/dynamics-h.gc" +"target/surface-h.gc" +"collide/pat-h.gc" +"game/fact-h.gc" +"anim/aligner-h.gc" +"game/penetrate-h.gc" +"game/game-h.gc" +"util/script-h.gc" +"scene/scene-h.gc" +"util/sync-info-h.gc" +"camera/pov-camera-h.gc" +"util/smush-control-h.gc" +"debug/debug-h.gc" +"anim/joint-mod-h.gc" +"collide/collide-func-h.gc" +"collide/collide-mesh-h.gc" +"collide/collide-shape-h.gc" +"common_objs/generic-obs-h.gc" +"physics/trajectory-h.gc" +"collide/collide-target-h.gc" +"collide/collide-touch-h.gc" +"collide/collide-edge-grab-h.gc" +"process-drawable/process-drawable-h.gc" +"process-drawable/process-focusable.gc" +"process-drawable/process-taskable-h.gc" +"process-drawable/focus.gc" +"game/effect-control-h.gc" +"collide/collide-frag-h.gc" +"spatial-hash/collide-hash-h.gc" +"physics/chain-physics-h.gc" +"common_objs/projectile-h.gc" +"collide/find-nearest-h.gc" +"target/target-h.gc" +"debug/stats-h.gc" +"level/bsp-h.gc" +"collide/collide-cache-h.gc" +"collide/collide-h.gc" +"gfx/shrub/shrubbery-h.gc" +"gfx/tie/tie-h.gc" +"gfx/tfrag/tfrag-h.gc" +"gfx/background/background-h.gc" +"gfx/background/subdivide-h.gc" +"entity/entity-h.gc" +"gfx/sprite/sprite-h.gc" +"gfx/sprite/simple-sprite-h.gc" +"gfx/foreground/eye-h.gc" +"gfx/sprite/particles/sparticle-launcher-h.gc" +"gfx/sprite/particles/sparticle-h.gc" +"entity/actor-link-h.gc" +"camera/camera-h.gc" +"camera/cam-debug-h.gc" +"camera/cam-interface-h.gc" +"camera/cam-update-h.gc" +"ui/hud-h.gc" +"ui/progress/progress-h.gc" +"ps2/rpc-h.gc" +"geometry/path-h.gc" +"nav/nav-mesh-h.gc" +"nav/nav-control-h.gc" +"spatial-hash/spatial-hash-h.gc" +"spatial-hash/actor-hash-h.gc" +"load/load-dgo.gc" +"load/ramdisk.gc" +"sound/gsound.gc" +"math/transformq.gc" +"collide/collide-func.gc" +"anim/joint.gc" +"anim/joint-mod.gc" +"physics/chain-physics.gc" +"geometry/cylinder.gc" +"gfx/background/wind-work.gc" +"gfx/background/wind.gc" +"level/bsp.gc" +"gfx/background/subdivide.gc" +"gfx/sprite/sprite.gc" +"gfx/sprite/sprite-distort.gc" +"gfx/sprite/sprite-glow.gc" +"debug/debug-sphere.gc" +"debug/debug.gc" +"debug/history.gc" +"gfx/merc/merc-vu1.gc" +"gfx/merc/emerc-vu1.gc" +"gfx/merc/merc-blend-shape.gc" +"gfx/merc/merc.gc" +"gfx/merc/emerc.gc" +"gfx/foreground/ripple.gc" +"gfx/foreground/bones.gc" +"gfx/foreground/debug-foreground.gc" +"gfx/foreground/foreground.gc" +"gfx/generic/generic-vu0.gc" +"gfx/generic/generic-vu1.gc" +"gfx/generic/generic-effect.gc" +"gfx/generic/generic-merc.gc" +"gfx/generic/generic-tie.gc" +"gfx/foreground/shadow-cpu.gc" +"gfx/foreground/shadow-vu1.gc" +"gfx/warp.gc" +"gfx/texture/texture-anim.gc" +"gfx/texture/texture-anim-funcs.gc" +"gfx/texture/texture-anim-tables.gc" +"gfx/blit-displays.gc" +"data/font-data.gc" +"gfx/font.gc" +"load/decomp.gc" +"gfx/background/background.gc" +"draw/draw-node.gc" +"gfx/shrub/shrubbery.gc" +"gfx/shrub/shrub-work.gc" +"gfx/tfrag/tfrag-near.gc" +"gfx/tfrag/tfrag.gc" +"gfx/tfrag/tfrag-methods.gc" +"gfx/tfrag/tfrag-work.gc" +"gfx/tie/tie.gc" +"gfx/tie/etie-vu1.gc" +"gfx/tie/etie-near-vu1.gc" +"gfx/tie/tie-near.gc" +"gfx/tie/tie-work.gc" +"gfx/tie/tie-methods.gc" +"util/sync-info.gc" +"physics/trajectory.gc" +"gfx/sprite/particles/sparticle-launcher.gc" +"gfx/sprite/particles/sparticle.gc" +"entity/entity-table.gc" +"load/loader.gc" +"game/game-info.gc" +"game/task/game-task.gc" +"game/game-save.gc" +"game/settings.gc" +"gfx/mood/mood-tables.gc" +"gfx/mood/mood-tables2.gc" +"gfx/mood/mood.gc" +"gfx/mood/mood-funcs.gc" +"gfx/mood/mood-funcs2.gc" +"gfx/mood/weather-part.gc" +"gfx/mood/time-of-day.gc" +"gfx/sky/sky-data.gc" +"gfx/sky/sky-tng.gc" +"load/load-state.gc" +"level/level-info.gc" +"level/level.gc" +"ui/text.gc" +"spatial-hash/collide-hash.gc" +"collide/collide-probe.gc" +"collide/collide-frag.gc" +"collide/collide-mesh.gc" +"collide/collide-touch.gc" +"collide/collide-edge-grab.gc" +"collide/collide-shape.gc" +"collide/collide-shape-rider.gc" +"collide/collide.gc" +"collide/collide-planes.gc" +"spatial-hash/spatial-hash.gc" +"spatial-hash/actor-hash.gc" +"gfx/merc/merc-death.gc" +"common_objs/water-flow.gc" +"common_objs/water-h.gc" +"camera/camera.gc" +"camera/cam-interface.gc" +"camera/cam-master.gc" +"camera/cam-states.gc" +"camera/cam-states-dbg.gc" +"camera/cam-combiner.gc" +"camera/cam-update.gc" +"geometry/vol-h.gc" +"camera/cam-layout.gc" +"camera/cam-debug.gc" +"camera/cam-start.gc" +"process-drawable/process-drawable.gc" +"ambient/ambient.gc" +"sound/speech.gc" +"level/region.gc" +"anim/fma-sphere.gc" +"util/script.gc" +"common_objs/generic-obs.gc" +"gfx/lightning.gc" +"target/mech_suit/carry-h.gc" +"game/pilot-h.gc" +"target/gun/gun-h.gc" +"target/board/board-h.gc" +"target/darkjak-h.gc" +"target/target-util.gc" +"target/target-part.gc" +"target/gun/gun-part.gc" +"target/collide-reaction-target.gc" +"target/logic-target.gc" +"target/sidekick.gc" +"common_objs/voicebox.gc" +"common_objs/collectables-part.gc" +"debug/debug-part.gc" +"collide/find-nearest.gc" +"game/task/task-arrow.gc" +"common_objs/projectile.gc" +"target/target-handler.gc" +"target/target-anim.gc" +"target/target.gc" +"target/target2.gc" +"target/target-swim.gc" +"target/target-carry.gc" +"target/target-darkjak.gc" +"target/target-death.gc" +"target/target-gun.gc" +"target/gun/gun-util.gc" +"target/gun/gun-blue-shot.gc" +"target/gun/gun-yellow-shot.gc" +"target/gun/gun-red-shot.gc" +"target/gun/gun-dark-shot.gc" +"target/gun/gun-states.gc" +"target/board/board-util.gc" +"target/board/target-board.gc" +"target/board/board-part.gc" +"target/board/board-states.gc" +"target/mech_suit/mech-h.gc" +"debug/menu.gc" +"draw/drawable.gc" +"draw/drawable-group.gc" +"draw/drawable-inline-array.gc" +"draw/drawable-tree.gc" +"gfx/background/prototype.gc" +"collide/main-collide.gc" +"gfx/hw/video.gc" +"game/main.gc" +"collide/collide-cache.gc" +"collide/collide-debug.gc" +"entity/relocate.gc" +"debug/memory-usage.gc" +"entity/entity.gc" +"geometry/path.gc" +"geometry/vol.gc" +"nav/nav-mesh.gc" +"nav/nav-control.gc" +"anim/aligner.gc" +"common_objs/water.gc" +"common_objs/collectables.gc" +"game/task/task-control.gc" +"scene/scene.gc" +"camera/pov-camera.gc" +"common_objs/powerups.gc" +"common_objs/crates.gc" +"ui/hud.gc" +"ui/hud-classes.gc" +"ui/progress/progress-static.gc" +"ui/progress/progress.gc" +"ui/progress/progress-draw.gc" +"gfx/ocean/ocean.gc" +"gfx/ocean/ocean-vu0.gc" +"gfx/ocean/ocean-texture.gc" +"gfx/ocean/ocean-mid.gc" +"gfx/ocean/ocean-transition.gc" +"gfx/ocean/ocean-near.gc" +"ui/minimap.gc" +"ui/bigmap-data.gc" +"ui/bigmap.gc" +"gfx/foreground/eye.gc" +"util/glist-h.gc" +"util/glist.gc" +"debug/anim-tester.gc" +"debug/viewer.gc" +"debug/part-tester.gc" +"debug/editable-h.gc" +"debug/editable.gc" +"debug/editable-player.gc" +"debug/nav/mysql-nav-graph.gc" +"debug/nav/nav-graph-editor.gc" +"debug/sampler.gc" +"debug/default-menu.gc" + + ) + +(cgo "ENGINE.CGO" "engine.gd") + + ;;;;;;;;;;;;;;;;;;;;; ;; ISO Group ;;;;;;;;;;;;;;;;;;;;; @@ -173,4 +571,9 @@ ,@(reverse *all-mus*) ,@(reverse *all-vag*) ,@(reverse *all-cgos*)) - ) \ No newline at end of file + ) + +;; used for the type consistency test. +(group-list "all-code" + `(,@(reverse *all-gc*)) + ) diff --git a/goal_src/jak2/kernel-defs.gc b/goal_src/jak2/kernel-defs.gc index 7c531d76b6..2468fa510f 100644 --- a/goal_src/jak2/kernel-defs.gc +++ b/goal_src/jak2/kernel-defs.gc @@ -5,6 +5,26 @@ ;;;; kscheme - InitHeapAndSymbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defenum kmalloc-flags + :bitfield #t + (align-16 4) + (align-64 6) + (align-256 8) + (memset 12) + (top 13) + ) + +(defenum link-flag + :bitfield #t + :type int32 + (output-load-msg 0) + (output-load-true-msg 1) + (execute-login 2) + (print-login 3) + (force-debug 4) + (fast-link 5) + ) + ;; fixed symbols (define-extern #f symbol) (define-extern #t symbol) @@ -59,32 +79,32 @@ ;; InitHeapAndSymbol (define-extern _format (function _varargs_ object)) (define-extern method-set! (function type int object none)) ;; may actually return function. +(define-extern kmemopen (function kheap string none)) +(define-extern kmemclose (function none)) (define-extern *enable-method-set* int) (define-extern *listener-function* (function object)) (define-extern *debug-segment* symbol) +(define-extern dgo-load (function string kheap link-flag int none)) +(define-extern malloc (function symbol int pointer)) -(defenum kmalloc-flags - :bitfield #t - (align-16 4) - (align-64 6) - (align-256 8) - (memset 12) - (top 13) - ) +(declare-type cpad-info basic) +(define-extern cpad-open (function cpad-info int cpad-info)) +(define-extern cpad-get-data (function cpad-info cpad-info)) -(defenum link-flag - :bitfield #t - :type int32 - (output-load-msg 0) - (output-load-true-msg 1) - (execute-login 2) - (print-login 3) - (force-debug 4) - (fast-link 5) - ) +(declare-type mouse-info basic) +(define-extern mouse-get-data (function mouse-info none)) + + +(define-extern scf-get-territory (function int)) ;; not actually a scf function... +(define-extern __read-ee-timer (function uint)) +(define-extern __mem-move (function pointer pointer uint none)) + +(define-extern file-stream-read (function file-stream pointer int int)) +(define-extern file-stream-open (function file-stream basic symbol file-stream)) +(define-extern file-stream-length (function file-stream int)) ;; PC stuff diff --git a/goal_src/jak2/kernel/dgo-h.gc b/goal_src/jak2/kernel/dgo-h.gc index 16372eff4d..91cc1713f9 100644 --- a/goal_src/jak2/kernel/dgo-h.gc +++ b/goal_src/jak2/kernel/dgo-h.gc @@ -5,3 +5,25 @@ ;; name in dgo: dgo-h ;; dgos: KERNEL +;; I suspect that these are unused, and were for an older version of DGO. +;; All DGO stuff is handled on the IOP. + +(deftype dgo-entry (structure) + ((offset uint32 :offset-assert 0) + (length uint32 :offset-assert 4) + ) + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +(deftype dgo-file (basic) + ((num-go-files uint32 :offset-assert 4) + (total-length uint32 :offset-assert 8) + (rsvd uint32 :offset-assert 12) + (data uint8 :dynamic :offset-assert 16) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) diff --git a/goal_src/jak2/kernel/gcommon.gc b/goal_src/jak2/kernel/gcommon.gc index 0d8ea9a33b..36b1bf0160 100644 --- a/goal_src/jak2/kernel/gcommon.gc +++ b/goal_src/jak2/kernel/gcommon.gc @@ -24,36 +24,63 @@ ;; GOAL code to the frame profiler in C++. (defglobalconstant PC_PROFILER_ENABLE #t) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; GOAL language constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; distance from a symbol pointer to a (pointer string) +;; this relies on the memory layout of the symbol table +;; this must match SYM_TO_STRING_OFFSET in goal_constants.h +(defconstant SYM_TO_STRING_OFFSET #xff37) + +(defmacro symbol->string (sym) + "Convert a symbol to a goal string." + `(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym)))) + ) + +;; pointers larger than this are invalid by valid? +(defconstant END_OF_MEMORY #x8000000) + (defun identity ((arg0 object)) + "Return the input. Works for any 64-bit value." arg0 ) (defun 1/ ((arg0 float)) + "Floating point reciprocal" (declare (inline)) (/ 1.0 arg0) ) +;; These functions exist a function objects that wrap the compiler's built-in operators. + (defun + ((arg0 int) (arg1 int)) + "Add two integers (64-bit)." (+ arg0 arg1) ) (defun - ((arg0 int) (arg1 int)) + "Subtract two integers (64-bit)." (- arg0 arg1) ) (defun * ((arg0 int) (arg1 int)) + "Multiply two integers (32-bit)" (* arg0 arg1) ) (defun / ((arg0 int) (arg1 int)) + "Divide two integers (32-bit, signed)" (/ arg0 arg1) ) (defun mod ((arg0 int) (arg1 int)) + "Integer mod (signed, 32-bit)" (mod arg0 arg1) ) (defun rem ((arg0 int) (arg1 int)) + "Integer mod (signed, 32-bit). Even though it's called rem, it behaves the same as mod." (mod arg0 arg1) ) @@ -70,7 +97,7 @@ ) (defun abs ((a int)) - "Take the absolute value of an integer" + "Take the absolute value of a 64-bit signed integer" (declare (inline)) ;; OpenGOAL doesn't support abs, so we implement it here. (if (> a 0) @@ -80,30 +107,31 @@ ) (defun min ((a int) (b int)) - "Compute minimum." + "Compute minimum of two 64-bit signed integers." (declare (inline)) ;; OpenGOAL doesn't support min, so we implement it here. (if (> a b) b a) ) (defun max ((a int) (b int)) - "Compute maximum." + "Compute maximum of two 64-bit signed integer." (declare (inline)) ;; OpenGOAL doesn't support max so we implement it here. (if (> a b) a b) ) (defun logior ((arg0 int) (arg1 int)) + "Logical or (64-bit)" (logior arg0 arg1) ) (defun logand ((arg0 int) (arg1 int)) + "Logical and (64-bit)" (logand arg0 arg1) ) - (defun lognor ((a int) (b int)) - "Compute not or." + "Compute not or (64-bit)." ;; Note - MIPS has a 'nor' instruction, but x86 doesn't. ;; the OpenGOAL x86 compiler therefore doesn't have a nor operation, ;; so lognor is implemented by this inline function instead. @@ -112,18 +140,22 @@ ) (defun logxor ((arg0 int) (arg1 int)) + "Logical exclusive or (64-bit)" (logxor arg0 arg1) ) (defun lognot ((arg0 int)) + "Logical not (64-bit)" (lognot arg0) ) (defun false-func () + "Return #f." #f ) (defun true-func () + "Return #t." #t ) @@ -131,12 +163,15 @@ ;; format ;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The "format" function is implemented in C but is called _format. +;; This defines the format function to point to the same thing as _format. (define format _format) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; numeric types ;;;;;;;;;;;;;;;;;;;;;;;;;; +;; vec4s: 4 floats packed into a 128-bit integer register. This is rarely used. (deftype vec4s (uint128) ((x float :offset 0 :size 32) (y float :offset 32 :size 32) @@ -148,19 +183,8 @@ :flag-assert #x900000010 ) -(defmethod inspect vec4s ((obj vec4s)) - (when (not obj) - (return obj) - ) - (format #t "[~8x] ~A~%" obj 'vec4s) - (format #t "~1Tx: ~f~%" (-> obj x)) - (format #t "~1Ty: ~f~%" (-> obj y)) - (format #t "~1Tz: ~f~%" (-> obj z)) - (format #t "~1Tw: ~f~%" (-> obj w)) - obj - ) - (defmethod print vec4s ((obj vec4s)) + "Custom print for vec4s that prints the 4 values." (format #t "#" (-> obj x) (-> obj y) @@ -170,6 +194,20 @@ obj ) +;; vector: main 4-element floating point vector. +(deftype vector (structure) + ((data float 4 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) + (z float :offset 8) + (w float :offset 12) + (quad uint128 :offset 0) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + (defmacro print128 (value &key (stream #t)) "Print a 128-bit value" `(let ((temp (new 'stack-no-clear 'array 'uint64 2))) @@ -190,6 +228,8 @@ ) ) +;; bfloat: boxed float type. A floating point number with type information. +;; It's a heap allocated basic. (deftype bfloat (basic) ((data float :offset-assert 4) ) @@ -208,10 +248,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod asize-of type ((obj type)) + "Get the size in memory of a type. The value calculated here is wrong." (the-as int (logand (the-as uint #xfffffff0) (+ (* (-> obj allocated-length) 4) 43))) ) (defun basic-type? ((arg0 basic) (arg1 type)) + "Is the given basic an object of the given type?" (let ((v1-0 (-> arg0 type)) (a0-1 object) ) @@ -226,6 +268,7 @@ ) (defun type-type? ((arg0 type) (arg1 type)) + "Is the given type equal to, or a child of, the second type?" (let ((v1-0 object)) (if (= arg1 v1-0) (return #t) @@ -241,6 +284,7 @@ ) (defun type? ((arg0 object) (arg1 type)) + "Is the given object an object of the given type? Works for any boxed object (basic, symbol, binteger, pair)." (let ((v1-0 object) (a0-1 (rtype-of arg0)) ) @@ -258,6 +302,7 @@ ) (defun find-parent-method ((arg0 type) (arg1 int)) + "Go up the type tree and find the first parent type that has a different implementation for the given method." (local-vars (v0-0 function)) (let ((v1-2 (-> arg0 method-table arg1))) (until (!= v0-0 v1-2) @@ -275,6 +320,7 @@ ) (defun ref ((arg0 object) (arg1 int)) + "Get the n-th item in a linked list. No range checking." (dotimes (v1-0 arg1) (nop!) (nop!) @@ -284,6 +330,7 @@ ) (defmethod length pair ((obj pair)) + "Get the length of a linked list." (local-vars (v0-0 int)) (cond ((null? obj) @@ -303,10 +350,12 @@ ) (defmethod asize-of pair ((obj pair)) + "Get the size in memory of a pair." (the-as int (-> pair size)) ) (defun last ((arg0 object)) + "Get the last object in a list." (let ((v0-0 arg0)) (while (not (null? (cdr v0-0))) (nop!) @@ -318,6 +367,7 @@ ) (defun member ((arg0 object) (arg1 object)) + "Is obj in the list lst? Returns pair with obj as its car, or #f if not found." (let ((v1-0 arg1)) (while (not (or (null? v1-0) (= (car v1-0) arg0))) (set! v1-0 (cdr v1-0)) @@ -329,10 +379,11 @@ ) ;; need to forward declare this, we haven't loaded the string library yet. -(define-extern name= (function basic basic symbol)) +(define-extern name= (function object object symbol)) (defun nmember ((arg0 basic) (arg1 object)) - (while (not (or (null? arg1) (name= (the-as basic (car arg1)) arg0))) + "Is obj in the list lst? Check with the name= function." + (while (not (or (null? arg1) (name= (car arg1) arg0))) (set! arg1 (cdr arg1)) ) (if (not (null? arg1)) @@ -341,6 +392,8 @@ ) (defun assoc ((arg0 object) (arg1 object)) + "Is item in the association list alist? + Returns the key-value pair." (let ((v1-0 arg1)) (while (not (or (null? v1-0) (= (car (car v1-0)) arg0))) (set! v1-0 (cdr v1-0)) @@ -352,6 +405,9 @@ ) (defun assoce ((arg0 object) (arg1 object)) + "Is there an entry with key item in the association list alist? + Returns the key-value pair. + Treats a key of 'else like an else case" (let ((v1-0 arg1)) (while (not (or (null? v1-0) (= (car (car v1-0)) arg0) (= (car (car v1-0)) 'else))) (set! v1-0 (cdr v1-0)) @@ -363,6 +419,9 @@ ) (defun nassoc ((arg0 string) (arg1 object)) + "Is there an entry named item-name in the association list alist? + Checks name with nmember or name= so you can have multiple keys. + Returns the ([key|(key..)] . value) pair." (while (not (or (null? arg1) (let ((a1-1 (car (car arg1)))) (if (pair? a1-1) (nmember arg0 a1-1) @@ -379,6 +438,9 @@ ) (defun nassoce ((arg0 string) (arg1 object)) + "Is there an entry named item-name in the association list alist? + Checks name with nmember for multiple keys or name= for single. + Allows else as a single key that always matches" (while (not (or (null? arg1) (let ((s4-0 (car (car arg1)))) (if (pair? s4-0) (nmember arg0 s4-0) @@ -395,6 +457,7 @@ ) (defun append! ((arg0 object) (arg1 object)) + "Append back to front, return the combined list." (cond ((null? arg0) arg1 @@ -416,6 +479,7 @@ ) (defun delete! ((arg0 object) (arg1 object)) + "Remove the first occurance of item from lst (where item is actual a pair in the list)" (the-as pair (cond ((= arg0 (car arg1)) @@ -440,6 +504,7 @@ ) (defun delete-car! ((arg0 object) (arg1 object)) + "Remove the first first occurance of an element from the list where (car elt) is item." (cond ((= arg0 (car (car arg1))) (cdr arg1) @@ -462,12 +527,22 @@ ) (defun insert-cons! ((arg0 object) (arg1 object)) + "Update an association list to have the given (key . value) pair kv. + If it already exists in the list, remove it. + DANGER: this function allocates memory on the global heap." (let ((a3-0 (delete-car! (car arg0) arg1))) (cons arg0 a3-0) ) ) (defun sort ((arg0 pair) (arg1 (function object object object))) + "Sort a list, using compare-func to compare elements. + The comparison function can return either an integer or a true/false. + For integers, use a positive number to represent first > second + Ex: (sort lst -) will sort in ascending order + For booleans, you must explicitly use TRUE and not a truthy value. + Ex: (sort my-list (lambda ((x int) (y int)) (< x y))) will sort ascending. + NOTE: if you use an integer, don't accidentally return TRUE." (let ((s4-0 -1)) (while (nonzero? s4-0) (set! s4-0 0) @@ -491,6 +566,15 @@ arg0 ) +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; inline-array-class +;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This is used as base class for boxed inline arrays. +;; The heap-base of the _type_ object will be used to store the stride +;; This way, you don't pay the price of storing the stride in each object. +;; however, as far as we've seen, nothing actually reads the stride. + (deftype inline-array-class (basic) ((length int32 :offset-assert 4) (allocated-length int32 :offset-assert 8) @@ -505,6 +589,8 @@ ) (defmethod new inline-array-class ((allocation symbol) (type-to-make type) (arg0 int)) + "Allocate a new inline-array-class object with room for the given number of objects. + Both length and allocated-length are set to the given size" (let ((v0-0 (object-new allocation type-to-make @@ -521,14 +607,32 @@ ) (defmethod length inline-array-class ((obj inline-array-class)) + "Get the length of the inline-array-class. This is the length field, + not how much storage there is" (-> obj length) ) (defmethod asize-of inline-array-class ((obj inline-array-class)) + "Get the size in memory of an inline-array-class." (the-as int (+ (-> obj type size) (* (-> obj allocated-length) (the-as int (-> obj type heap-base))))) ) +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; array +;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; the GOAL array type is a boxed array. +;; it is a basic that knows its content type, currently used length, and allocated length. +;; It can hold: +;; any boxed object (gets 4 bytes, so bintegers get clipped to 32-bits) +;; any structure/reference/pointer +;; any integer/float +;; It cannot hold any inlined structures. + (defmethod new array ((allocation symbol) (type-to-make type) (arg0 type) (arg1 int)) + "Allocate a new array to hold len elements of type content-type. + The content should either be a numeric type (child of number) + or the content should be a reference (will get 4-bytes for a pointer)" (let ((v0-1 (object-new allocation type-to-make @@ -698,6 +802,7 @@ ) (defmethod inspect array ((obj array)) + "Inspect an array" (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) (format #t "~Tlength: ~D~%" (-> obj length)) @@ -773,10 +878,12 @@ ) (defmethod length array ((obj array)) + "Get the length of an array" (-> obj length) ) (defmethod asize-of array ((obj array)) + "Get the size in memory of an array" (the-as int (+ (-> obj type size) (* (-> obj allocated-length) (if (type-type? (-> obj content-type) number) @@ -788,7 +895,13 @@ ) ) +;;;;;;;;;;;;;;;;;;;;;;;; +;; memory manipulation +;;;;;;;;;;;;;;;;;;;;;;;; + (defun mem-copy! ((arg0 pointer) (arg1 pointer) (arg2 int)) + "Memory copy. Not a very efficient optimization, but has no restrictions. + Increasing address copy." (let ((v0-0 arg0)) (dotimes (v1-0 arg2) (set! (-> (the-as (pointer uint8) arg0)) (-> (the-as (pointer uint8) arg1))) @@ -800,6 +913,10 @@ ) (defun qmem-copy<-! ((arg0 pointer) (arg1 pointer) (arg2 int)) + "Memory copy by quadword. More efficient, but has restrictions: + - dst and src should be 16-byte aligned. + - size in bytes will be rounded up to 16-bytes + - Ascending address copy." (let ((v0-0 arg0)) (countdown (v1-1 (/ (+ arg2 15) 16)) (set! (-> (the-as (pointer uint128) arg0)) (-> (the-as (pointer uint128) arg1))) @@ -811,6 +928,10 @@ ) (defun qmem-copy->! ((arg0 pointer) (arg1 pointer) (arg2 int)) + "Memory copy by quadword (16-bytes). More efficient, but has restrictions: + - dst and src should be 16-byte aligned. + - size in bytes will be rounding up to nearest 16-bytes + - Descending address copy" (let ((v0-0 arg0)) (let* ((v1-1 (/ (+ arg2 15) 16)) (a0-1 (&+ arg0 (* v1-1 16))) @@ -828,6 +949,8 @@ ) (defun mem-set32! ((arg0 pointer) (arg1 int) (arg2 int)) + "Normal memset, but by 32-bit word. + NOTE: argument order is swapped from C" (let ((v0-0 arg0)) (dotimes (v1-0 arg1) (set! (-> (the-as (pointer int32) arg0)) arg2) @@ -839,6 +962,8 @@ ) (defun mem-or! ((arg0 pointer) (arg1 pointer) (arg2 int)) + "Set the dst to (logior dst src) byte by byte. + Not very efficient." (let ((v0-0 arg0)) (dotimes (v1-0 arg2) (logior! (-> (the-as (pointer uint8) arg0)) (-> (the-as (pointer uint8) arg1))) @@ -861,13 +986,38 @@ (* x (fact (+ x -1)))) ) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; printing +;;;;;;;;;;;;;;;;;;;;;;;; + +;; the column that will be printed to by format. (define *print-column* (the-as binteger 0)) +;; note: normal use of print/inspect will have the compiler pick the appropriate method +;; for non-basics. However, it may be useful to have print/inspect available as a function +;; as well, allowing you to use it as a function pointer. +;; in this case, we can only do the right thing on boxed objects. + (defun print ((arg0 object)) + "Print out any boxed object. Does NOT insert a newline." ((method-of-type (rtype-of arg0) print) arg0) ) +(defmacro printl (obj) + "Print out a boxed object and a newline. + Note: we define both a macro and a function on purpose. + The compiler will use the macro over the function, which will + allow it to pick the correct print method for non-boxed objects" + `(begin + (print ,obj) + (format #t "~%") + ,obj + ) + ) + (defun printl ((arg0 object)) + "Print out any boxed object and a newline at the end." (let ((a0-1 arg0)) ((method-of-type (rtype-of a0-1) print) a0-1) ) @@ -876,10 +1026,13 @@ ) (defun inspect ((arg0 object)) + "Inspect any boxed object." ((method-of-type (rtype-of arg0) inspect) arg0) ) (defun-debug mem-print ((arg0 (pointer uint32)) (arg1 int)) + "Print memory to runtime stdout by quadword. + Input count is in 32-bit words" (dotimes (s4-0 (/ arg1 4)) (format 0 @@ -894,9 +1047,11 @@ #f ) +;; unused (define *trace-list* '()) (defun print-tree-bitmask ((arg0 int) (arg1 int)) + "Print out a single entry for a process tree 'tree' diagram" (dotimes (s4-0 arg1) (if (zero? (logand arg0 1)) (format #t " ") @@ -908,9 +1063,229 @@ ) (defun breakpoint-range-set! ((arg0 uint) (arg1 uint) (arg2 uint)) + "Sets some debug register (COP0 Debug, dab, dabm) to break on memory access. + This is not supported in OpenGOAL." (break!) ) +;;;;;;;;;;;;;;;;;;;;;;; +;; valid +;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro start-of-symbol-table () + `(rlet ((st :reg r14 :reset-here #t :type uint)) + (the uint (- st 32768)) + ) + ) + +(defmacro end-of-symbol-table () + `(rlet ((st :reg r14 :reset-here #t :type uint)) + (the uint (+ st 32768)) + ) + ) + +(define-extern boolean type) ;; not really... but they use it here as if it was one. +(define-extern valid? (function object type symbol symbol object symbol)) + +(defun valid? ((arg0 object) (arg1 type) (arg2 symbol) (arg3 symbol) (arg4 object)) + "Check if the given object is valid. This will work for structures, pairs, basics, bintegers, symbols, and types. + If you set expected-type to #f, it just checks for a 4-byte aligned address that's in GOAL memory. + If you're checking a structure, set expected-type to structure. This requires 16-byte alignment + Note: packed inline structures in arrays or fields will not pass this check. + Otherwise, set it to the type you expect. More specific types will pass. + + If allow-false is #t, a #f will always pass. Otherwise, #f will fail (unless you're looking for a symbol). + Use allow-false if you want to allow a 'null' reference. + + The name is only used when printing out an error if the check fails. + Use a name of #f to suppress error prints. + " + (let ((v1-1 + (and (>= (the-as uint arg0) (start-of-symbol-table)) (< (the-as uint arg0) END_OF_MEMORY)) + ) + ) + (cond + ((not arg1) + (cond + ((logtest? (the-as int arg0) 3) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object (misaligned)~%" arg0 arg2) + ) + #f + ) + ((not v1-1) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object (bad address)~%" arg0 arg2) + ) + #f + ) + (else + #t + ) + ) + ) + ((and arg3 (not arg0)) + #t + ) + ((= arg1 structure) + (cond + ((logtest? (the-as int arg0) 15) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((or (not v1-1) (< (the-as uint arg0) (end-of-symbol-table))) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + (else + #t + ) + ) + ) + ((= arg1 pair) + (cond + ((not (pair? arg0)) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((not v1-1) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + (else + #t + ) + ) + ) + ((= arg1 binteger) + (cond + ((zero? (logand (the-as int arg0) 7)) + #t + ) + (else + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ) + ) + ((or (= arg1 symbol) (= arg1 boolean)) + (cond + ((zero? (logand (the-as int arg0) 1)) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((or (not v1-1) (< (the-as int arg0) (start-of-symbol-table))(>= (the-as int arg0) (end-of-symbol-table))) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + (else + #t + ) + ) + ) + ((!= (logand (the-as int arg0) 7) 4) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((not v1-1) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + ((and (= arg1 type) (!= (rtype-of arg0) type)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%" + arg0 + arg2 + arg1 + (rtype-of arg0) + ) + ) + #f + ) + ((and (!= arg1 type) (not (valid? (rtype-of arg0) type #f #t 0))) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%" + arg0 + arg2 + arg1 + (rtype-of arg0) + ) + ) + #f + ) + ((not (type? arg0 arg1)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (is type '~A' instead)~%" + arg0 + arg2 + arg1 + (rtype-of arg0) + ) + ) + #f + ) + ((= arg1 symbol) + (cond + ((>= (the-as uint arg0) (end-of-symbol-table)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (not in symbol table)~%" + arg0 + arg2 + arg1 + ) + ) + #f + ) + (else + #t + ) + ) + ) + ((< (the-as uint arg0) (end-of-symbol-table)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (inside symbol table)~%" + arg0 + arg2 + arg1 + ) + ) + #f + ) + (else + #t + ) + ) + ) + ) + ;;;;;;;;;;;;;;;;;;;; ;; Profiler Macros ;;;;;;;;;;;;;;;;;;;; @@ -957,4 +1332,58 @@ ,@body ) ) - ) \ No newline at end of file + ) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; Decompiler Macros +;;;;;;;;;;;;;;;;;;;;;;;; + +;; inserted by the decompiler for assembly branches. +(defmacro b! (pred destination &key (delay '()) &key (likely-delay '())) + "Branch!" + ;; evaluate the predicate + `(let ((should-branch ,pred)) + ;; normal delay slot: + ,delay + (when should-branch + ,likely-delay + (goto ,destination) + ) + ) + ) + +;; the decompiler may fail to recognize setting fields of a 128-bit bitfield +;; and will rely on this macro: +(defmacro copy-and-set-field (original field-name field-value) + `(let ((temp-copy ,original)) + (set! (-> temp-copy ,field-name) ,field-value) + temp-copy + ) + ) + +;; inserted by the decompiler if a c->goal bool conversion can't be compacted into a single +;; expression. +(defmacro cmove-#f-zero (dest condition src) + `(if (zero? ,condition) + (set! ,dest #f) + (set! ,dest ,src) + ) + ) + +(defmacro empty-form () + `(none) + ) + +;;;;;;;;;;;;;;;;;;;;;;; +;; PC Port asm macros +;;;;;;;;;;;;;;;;;;;;;;; +(#when PC_PORT + ;; SYNC is an EE instruction that waits for various memory access and DMA to be completed + ;; DMA will be instant in the PC port, so these are no longer necessary + (fake-asm .sync.l) + (fake-asm .sync.p) + ;; Copies the contents of a cop0 (system control) register to a gpr + (fake-asm .mfc0 dest src) + ;; Copies the contents of a gpr to a cop0 (system control) register + (fake-asm .mtc0 dest src) + ) diff --git a/goal_src/jak2/kernel/gkernel-h.gc b/goal_src/jak2/kernel/gkernel-h.gc index 01392d94c5..328f815caa 100644 --- a/goal_src/jak2/kernel/gkernel-h.gc +++ b/goal_src/jak2/kernel/gkernel-h.gc @@ -6,4 +6,686 @@ ;; dgos: KERNEL (defconstant *kernel-major-version* 2) -(defconstant *kernel-minor-version* 0) \ No newline at end of file +(defconstant *kernel-minor-version* 0) + +(defconstant DPROCESS_STACK_SIZE (#if PC_PORT #x8000 #x3800)) +(defconstant PROCESS_STACK_SIZE (#if PC_PORT #x6000 #x1c00)) + +(defconstant *tab-size* (the binteger 8)) +(defconstant *gtype-basic-offset* 4) + +;; if set, will attempt to detect memory corruption and stack overflow bugs +;; to some extent. +(defglobalconstant KERNEL_DEBUG #t) + +(defconstant *scratch-memory-top* (the pointer #x70004000)) + + +;; Each process has a bitmask. +;; The kernel can be configured to skip processes with certain mask bits set. +(defenum process-mask + :type uint32 + :bitfield #t + (execute 0) + (freeze 1) + (pause 2) + (menu 3) + (progress 4) + (actor-pause 5) + (sleep 6) + (sleep-code 7) + (process-tree 8) + (heap-shrunk 9) + (going 10) + (kernel-run 11) + (no-kill 12) + (movie 13) + (dark-effect 14) + (target 15) + (sidekick 16) + (crate 17) + (bit18 18) ;; unused? + (enemy 19) + (camera 20) + (platform 21) + (ambient 22) + (entity 23) + (projectile 24) + (bot 25) + (collectable 26) + (death 27) + (no-track 28) + (guard 29) + (vehicle 30) + (civilian 31) + ) + +;; forward declarations +(declare-type process-tree basic) +(declare-type process process-tree) +(declare-type entity basic) +(declare-type entity-actor entity) +(declare-type dead-pool basic) +(declare-type level basic) +(declare-type state basic) +(declare-type event-message-block structure) +(declare-type stack-frame basic) +(declare-type cpu-thread basic) + + +;; The state of the kernel, containing the masks to allow/deny certain processes, +;; the currently running process, and the currently relocating process. +(deftype kernel-context (basic) + ((prevent-from-run process-mask :offset-assert 4) + (require-for-run process-mask :offset-assert 8) + (allow-to-run process-mask :offset-assert 12) + (next-pid int32 :offset-assert 16) + (fast-stack-top pointer :offset-assert 20) + (current-process process :offset-assert 24) + (relocating-process basic :offset-assert 28) + (relocating-min int32 :offset-assert 32) + (relocating-max int32 :offset-assert 36) + (relocating-offset int32 :offset-assert 40) + (relocating-level level :offset-assert 44) + (low-memory-message symbol :offset-assert 48) + (login-object basic :offset-assert 52) + ) + :method-count-assert 9 + :size-assert #x38 + :flag-assert #x900000038 + ) + +;; The usual "time" type. +(deftype time-frame (int64) + () + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; times are stored in 300ths of a second. +;; this divides evenly into frames at both 50 and 60 fps. +;; typically these are stored as integers as more precision is not useful. +;; an unsigned 32-bit integer can store about 150 days +(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps + +;; this was usec in GOAL +(defmacro seconds (x) + "Convert number to seconds unit. + Returns uint." + (cond + ((integer? x) + (* TICKS_PER_SECOND x) + ) + ((float? x) + (* 1 (* 1.0 x TICKS_PER_SECOND)) + ) + (#t + `(the uint (* TICKS_PER_SECOND ,x)) + ) + ) + ) + +;; Each clock counts in 3 different ways: +;; +;; 1). A "frame counter", which, confusingly, doesn't count frames. +;; It counts elapsed time, in 1/300ths of a second. +;; This counts in real-time, even if the game is lagging. +;; +;; 2). A "integral-frame-counter", which counts the number of vsyncs. +;; This doens't count the number of frames the game actually manages to draw, +;; just the number of vsyncs. It counts at different rates in NTSC/PAL. +;; NOTE: changing clock-ratio will make this count faster/slower. This only counts real +;; vsyncs if clock-ratio is 1.0. +;; +;; 3). The "time ratio", which adjusts based on the actual achieved framerate. +;; Unlike the others, this isn't a incrementing counter, but instead ratios: +;; time-adjust-ratio, frames-per-second, seconds-per-frame. +;; +;; For the most part, users should just adjust per-frame values by time-adjust-ratio, and this will +;; compensate for pal/ntsc, lag, and clock-ratio scaling. +;; +;; The clock won't tick if its process-mask is prevent-from-run in the kernel. +;; A clock can change the rate it runs at with clock-ratio. +;; Note: both integral-frame-counter and seconds-per-frame/frames-per-second are affected by +;; clock-ratio, which is somewhat weird. +;; Changing clock-ratio will make integral-frame-counter not count actual vsyncs + +(deftype clock (basic) + ((index int32 :offset-assert 4) ;; which clock we are, in *display* + (mask process-mask :offset-assert 8) ;; mask for ticking + (clock-ratio float :offset-assert 12) ;; how fast to run. 1.0 = realtime. + (accum float :offset-assert 16) ;; fractional time for frame-counter (time-frame units) + (integral-accum float :offset-assert 20) ;; fractional time for integral (time-frame untis) + (frame-counter time-frame :offset-assert 24) ;; how much time has gone by since reset (time-frame units) + (old-frame-counter time-frame :offset-assert 32) ;; the frame-counter on the last engine iteration + (integral-frame-counter uint64 :offset-assert 40) ;; how many vsyncs have gone by since reset + (old-integral-frame-counter uint64 :offset-assert 48) ;; the integral-frame-counter on the last engine iteration + (sparticle-data vector :inline :offset-assert 64) ;; sparticle timescale info + (seconds-per-frame float :offset-assert 80) ;; how many seconds (not time-frames) should go by in 1 vsync + (frames-per-second float :offset-assert 84) ;; inverse of above + (time-adjust-ratio float :offset-assert 88) ;; 1, if the game runs at 60fps NTSC with clock-ratio = 1. + ) + :method-count-assert 15 + :size-assert #x5c + :flag-assert #xf0000005c + (:methods + (new (symbol type int) _type_ 0) + (update-rates! (_type_ float) float 9) + (advance-by! (_type_ float) clock 10) + (tick! (_type_) clock 11) + (save! (_type_ (pointer uint64)) int 12) + (load! (_type_ (pointer uint64)) int 13) + (reset! (_type_) none 14) + ) + ) + +(defmethod new clock ((allocation symbol) (type-to-make type) (arg0 int)) + "Create a new clock and initialize to a non-zero time." + (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> gp-0 index) arg0) + (set! (-> gp-0 frame-counter) (seconds 1000)) + (set! (-> gp-0 integral-frame-counter) (the-as uint 300000)) + (set! (-> gp-0 old-frame-counter) (+ (-> gp-0 frame-counter) -1)) + (set! (-> gp-0 old-integral-frame-counter) (+ (-> gp-0 integral-frame-counter) -1)) + (update-rates! gp-0 1.0) + gp-0 + ) + ) + +;; The basic node used to organize processes into a tree. +;; The process types themselves are children of the process-tree type +;; Typically, each instance of a game object is a process. +(deftype process-tree (basic) + ((name string :offset-assert 4) + (mask process-mask :offset-assert 8) + (clock clock :offset-assert 12) + (parent (pointer process-tree) :offset-assert 16) + (brother (pointer process-tree) :offset-assert 20) + (child (pointer process-tree) :offset-assert 24) + (ppointer (pointer process) :offset-assert 28) + (self process-tree :offset-assert 32) + ) + (:methods + (new (symbol type string) _type_ 0) + (activate (_type_ process-tree basic pointer) process-tree 9) + (deactivate (_type_) none 10) + (init-from-entity! (_type_ entity-actor) none 11) ;; todo check + (run-logic? (_type_) symbol 12) + (dummy-13 () none 13) + ) + :size-assert #x24 + :method-count-assert 14 + :no-runtime-type + ) + +;; Each process has a single "main" thread that is suspended and resumed. +;; The "thread" object is what holds the needed state to start, suspend, and resume execution. +;; Additionally, the kernel creates various temporary threads to run single functions. +;; These "temporary" threads are never suspended. + +;; unlike modern implementations, the "thread" objects store small "backup" stacks (often only 100's of bytes). +;; when a thread is suspended, it copies the stack from the execution stack to the backup stack. +;; this seems silly, but it has an advantage to reduce memory - typically threads suspend without a very deep call +;; stack, so the backup stack can be much, much smaller than a single large, shared execution stack. +(deftype thread (basic) + ((name symbol :offset-assert 4) + (process process :offset-assert 8) + (previous thread :offset-assert 12) + (suspend-hook (function cpu-thread none) :offset-assert 16) ;; called by user to suspend + (resume-hook (function cpu-thread none) :offset-assert 20) ;; called by kernel to resume + (pc pointer :offset-assert 24) ;; pc (x86 rip) to resume to + (sp pointer :offset-assert 28) ;; stack pointer of thread + (stack-top pointer :offset-assert 32) ;; stack to execute on + (stack-size int32 :offset-assert 36) ;; size of _suspend_ stack + ) + :method-count-assert 12 + :size-assert #x28 + :flag-assert #xc00000028 + (:methods + (stack-size-set! (_type_ int) none 9) + (thread-suspend (_type_) none 10) + (thread-resume (_type_) none 11) + ) + ) + +;; additional information to context switch +(deftype cpu-thread (thread) + ((rreg uint64 7 :offset-assert 40) ;; GPRs + (freg float 8 :offset-assert 96) ;; FPRs + (stack uint8 :dynamic :offset-assert 128) ;; backup stack (dynamically sized) + ) + :method-count-assert 12 + :size-assert #x80 + :flag-assert #xc00000080 + (:methods + (new (symbol type process symbol int pointer) _type_ 0) + ) + ) + +;; Base type for all actual processes. +;; this can be used directly, or child types can be made. +(deftype process (process-tree) + ((pool dead-pool ) ;; where to return us when we die + (status symbol :offset-assert 40) ;; used by kernel to track init/death + (pid int32 ) ;; globally unique ID, never reused for another + (main-thread cpu-thread :offset-assert 48) ;; suspendable main thread + (top-thread cpu-thread :offset-assert 52) ;; currently running thread + (entity entity :offset-assert 56) ;; if we were spawned from an entity, that entity + (level level :offset-assert 60) ;; if we're associated with a level, that level + (state state :offset-assert 64) ;; current state, if we're in one + (next-state state :offset-assert 68) ;; set if we have a pending (go) + (trans-hook function :offset-assert 72) ;; function to run before resuming + (post-hook function :offset-assert 76) ;; function to run after suspending + + ;; function to run if we receive an event + (event-hook (function process int symbol event-message-block object) :offset-assert 80) + + ;; process heap size + (allocated-length int32 :offset-assert 84) + + ;; ?? + (pad0 uint32 2) + + ;; process heap + (heap-base pointer :offset-assert 96) + (heap-top pointer :offset-assert 100) + (heap-cur pointer :offset-assert 104) + + ;; linked list of stack frames that have been created. + ;; note that these aren't created on every function call, only + ;; if the user explicitly creates a catch block or similar + (stack-frame-top stack-frame :offset-assert 108) + + ;; list of engines this process is connected to + (connection-list connectable :inline :offset-assert 112) + + ;; the process memory: contains child fields, then the process heap. + (stack uint8 :dynamic :offset-assert 128) + ) + (:methods + (new (symbol type string int) _type_ 0) + ) + (:states + dead-state + empty-state) + :size-assert #x80 + :method-count-assert 14 + :no-runtime-type ;; already defined by kscheme. Don't do it again. + ) + +;; dead-pool is the simplest way to store dead processes - it's just a tree of processes that +;; are inactive. +(deftype dead-pool (process-tree) + () + :method-count-assert 16 + :size-assert #x24 + :flag-assert #x1000000024 + (:methods + (new (symbol type int int string) _type_ 0) + (get-process (_type_ type int) process 14) + (return-process (_type_ process) none 15) + ) + ) + +;; dead-pool-heap is a special thing - it pretends to be a dead-pool, but secretly +;; creates and destroys processes on demand, as they are requested/returned. +;; to do this, it has a single large heap and memory allocator. +;; to prevent fragmentation of this heap, it has a relocate/compaction system +;; that moves processes in memory. + + +;; A dead-pool-heap-rec is a record for a process used by the handle system. +;; The kernel will make sure that: +;; - the dead-pool-heap-rec for a process will continue to point to that process until the process +;; is killed. +;; - the dead-pool-heap-rec itself is never moved in memory, and it always points to some process, or #f. +;; (it is always safe to do (-> rec process pid) and see if it still points to your process) +(deftype dead-pool-heap-rec (structure) + ((process process :offset-assert 0) + (prev dead-pool-heap-rec :offset-assert 4) + (next dead-pool-heap-rec :offset-assert 8) + ) + :pack-me + :method-count-assert 9 + :size-assert #xc + :flag-assert #x90000000c + ) + +;; the actual pool implementation +(deftype dead-pool-heap (dead-pool) + ((allocated-length int32 :offset-assert 36) + (compact-time uint32 :offset-assert 40) + (compact-count-targ uint32 :offset-assert 44) + (compact-count uint32 :offset-assert 48) + (fill-percent float :offset-assert 52) + (first-gap dead-pool-heap-rec :offset-assert 56) + (first-shrink dead-pool-heap-rec :offset-assert 60) + (heap kheap :inline :offset-assert 64) + (alive-list dead-pool-heap-rec :inline :offset-assert 80) + (last dead-pool-heap-rec :offset 84) + (dead-list dead-pool-heap-rec :inline :offset-assert 92) + (process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104) + ) + :method-count-assert 28 + :size-assert #x68 + :flag-assert #x1c00000068 + (:methods + (new (symbol type string int int) _type_ 0) + (init (_type_ symbol int) none 16) + (compact (dead-pool-heap int) none 17) + (shrink-heap (dead-pool-heap process) dead-pool-heap 18) + (churn (dead-pool-heap int) none 19) + (memory-used (_type_) int 20) + (memory-total (_type_) int 21) + (memory-free (dead-pool-heap) int 22) + (compact-time (dead-pool-heap) uint 23) + (gap-size (dead-pool-heap dead-pool-heap-rec) int 24) + (gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25) + (find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26) + (find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27) + ) + ) + +;; parent type for all kinds of stack-frames. +;; at least for jak 1, these are only used internally by the kernel +;; "next" brings you "up" the stack (toward the caller) +(deftype stack-frame (basic) + ((name symbol :offset 4) + (next stack-frame :offset 8) + ) + :size-assert #xc + :method-count-assert 9 + :flag-assert #x90000000c + ) + +;; a "catch" frame is a frame that can be "thrown" to. +;; the "throw" is a nonlocal control flow back to the state befor the "catch" block. +(deftype catch-frame (stack-frame) + ((sp int32 :offset-assert 12) + (ra int32 :offset-assert 16) + (freg float 6 :offset-assert 20) + (rreg uint128 8 :offset-assert 48) + ) + :method-count-assert 9 + :size-assert #xb0 + :flag-assert #x9000000b0 + (:methods + (new (symbol type symbol function (pointer uint64)) object 0) + ) + ) + +;; a "protect" frame is a way to indicate there's a "exit" function that should +;; run if there's a "throw" or "abandon". +(deftype protect-frame (stack-frame) + ((exit (function none) :offset-assert 12) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + (:methods + (new (symbol type (function none)) protect-frame 0) + ) + ) + +;; a handle is a safe way to refer to a process. It solves two problems: +;; - it allows you to find a process that moves in memory +;; - it allows you to tell if the original process has died. otherwise you may get confused +;; because there could be another process located at the exact same address. +(deftype handle (uint64) + ((process (pointer process) :offset 0 :size 32) ;; additional level of indirection to support moving processes + (pid int32 :offset 32 :size 32) ;; unique pid to check if it's the same process or not. + (u64 uint64 :offset 0 :size 64) + ) + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +(defmethod inspect handle ((obj handle)) + (when (not obj) + (return obj) + ) + (format #t "[~8x] ~A~%" obj 'handle) + (format #t "~1Tprocess: #x~X~%" (-> obj process)) + (format #t "~1Tpid: ~D~%" (-> obj pid)) + obj + ) + +(defmacro handle->process (handle) + "Convert a handle to a process. If the process no longer exists, returns #f." + `(let ((the-handle (the-as handle ,handle))) + (if (-> the-handle process) ;; if we don't point to a process, kernel sets this to #f + (let ((proc (-> (-> the-handle process)))) + (if (= (-> the-handle pid) (-> proc pid)) ;; make sure it's the same process + proc + ) + ) + ) + ) + ) + +(defmacro ppointer->process (ppointer) + "convert a (pointer process) to a process." + ;; this uses the self field, which seems to always just get set to the object. + ;; confirmed in Jak 1 that using self here is useless, not sure... + `(let ((the-pp ,ppointer)) + (the process-tree (if the-pp (-> the-pp 0 self))) + ) + ) + +(defmacro process->ppointer (proc) + "safely get a (pointer process) from a process, returning #f if invalid." + `(let ((the-proc ,proc)) + (if the-proc (-> the-proc ppointer)) + ) + ) + +(defmacro ppointer->handle (pproc) + "convert a ppointer to a handle. assumes the ppointer is valid." + `(let ((the-process (the-as (pointer process) ,pproc))) + (new 'static 'handle :process the-process :pid (-> the-process 0 pid)) + ) + ) + +(defmacro process->handle (proc) + "convert a process to a handle. if proc is #f, returns a #f handle." + `(ppointer->handle (process->ppointer ,proc)) + ) + +(defmethod print handle ((obj handle)) + (if (nonzero? obj) + (format #t "#" (handle->process obj) (-> obj pid)) + (format #t "#") + ) + obj + ) + +;; A "state" defines functions that a process should run when it is in that state. +;; the "code" function is executed by the main thread and can suspend/resume. +;; the "trans" function is executed before code is resumed +;; the "post" function is executed after code is suspended +;; the "enter" function is executed when the process first transitions to the state +;; the "exit" function is executed when the process exits the state (or dies) +;; the "event" function is executed when the process receives an event. +;; See gstate.gc for a lot more details on how this all works. +;; This type is just a container to hold those functions. +(deftype state (protect-frame) + ((code function :offset-assert 16) + (trans (function none) :offset-assert 20) + (post function :offset-assert 24) + (enter function :offset-assert 28) + (event (function process int symbol event-message-block object) :offset-assert 32) + ) + :method-count-assert 9 + :size-assert #x24 + :flag-assert #x900000024 + (:methods + (new (symbol + type + symbol + function + (function none) + function + (function none) + (function process int symbol event-message-block object)) + _type_ 0) + ) + ) + +;; data contained in an "event" sent from one process to another +;; in jak2, the events may be queued and sent at a later time, so the block +;; contains handles, to see if the to/from processes are still alive. +(deftype event-message-block (structure) + ((to-handle handle :offset-assert 0) ;; who to send to + (to (pointer process) :offset 0) + (form-handle handle :offset-assert 8) ;; who is doing the sending + (from (pointer process) :offset 8) + (param uint64 6 :offset-assert 16) ;; the data being sent + (message symbol :offset-assert 64) ;; the message name + (num-params int32 :offset-assert 68) + ) + :method-count-assert 9 + :size-assert #x48 + :flag-assert #x900000048 + ) + +;; a queue of messages. +(deftype event-message-block-array (inline-array-class) + ((data event-message-block :inline :dynamic :offset-assert 16) + ) + :method-count-assert 10 + :size-assert #x10 + :flag-assert #xa00000010 + (:methods + (send-all! (_type_) none 9) + ) + ) +(set! (-> event-message-block-array heap-base) (the-as uint 80)) + +;; the type returned by the C Kernel, contains the result of a SQL Query. +(deftype sql-result (basic) + ((len int32 :offset-assert 4) + (allocated-length uint32 :offset-assert 8) + (error symbol :offset-assert 12) + (data symbol :dynamic :offset-assert 16) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + (:methods + (new (symbol type uint) _type_ 0) + ) + ) + +(defmethod new sql-result ((allocation symbol) (type-to-make type) (arg0 uint)) + "Allocate a new sql-result with enough room for arg0 entries in data." + (let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* arg0 4)))))) + (set! (-> v0-0 allocated-length) arg0) + (set! (-> v0-0 error) 'error) + v0-0 + ) + ) + +(defmethod print sql-result ((obj sql-result)) + "Print a sql-result as an array of symbols." + (format #t "#(~A" (-> obj error)) + (dotimes (s5-0 (-> obj len)) + (format #t " ~A" (-> obj data s5-0)) + ) + (format #t ")") + obj + ) + +;; the result that the C Kernel will send us. +(define *sql-result* (the-as sql-result #f)) + +(defmacro defbehavior (name process-type bindings &rest body) + "define a new behavior. This is simply a function where self is bound to the process register, + which is assumed to have type process-type." + (if (and + (> (length body) 1) ;; more than one thing in function + (string? (first body)) ;; first thing is a string + ) + ;; then it's a docstring and we ignore it. + `(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@(cdr body))) + ;; otherwise don't ignore it. + `(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body)) + ) + ) + +(defmacro process-stack-used (proc) + ;; get how much stack the top thread of a process has used. + `(- (the int (-> ,proc top-thread stack-top)) + (the int (-> ,proc top-thread sp)) + ) + ) + +(defmacro process-stack-size (proc) + ;; get how much stack the top thread of a process has + `(-> ,proc top-thread stack-size) + ) + +(defmacro process-heap-used (proc) + ;; get how much heap a process has used. + `(- (-> ,proc allocated-length) + (- (the int (-> ,proc heap-top)) + (the int (-> ,proc heap-cur)) + ) + ) + ) + +(defmacro process-heap-size (proc) + ;; get how much heap a process has + `(the int (-> ,proc allocated-length)) + ) + +(defmacro break () + `(/ 0 0) + ) + +(defmacro with-pp (&rest body) + "execute the body with pp bound to the current process register." + `(rlet ((pp :reg r13 :reset-here #t :type process)) + ,@body) + ) + +(defmacro process-mask? (mask enum-value) + `(!= 0 (logand ,mask (process-mask ,enum-value))) + ) + +(defmacro process-mask-set! (mask &rest enum-value) + ;; sets the given bits in the process mask (with or) + `(set! ,mask (logior ,mask (process-mask ,@enum-value))) + ) + +(defmacro process-mask-clear! (mask &rest enum-value) + ;; sets the given bits in the process mask (with or) + `(set! ,mask (logand ,mask (lognot (process-mask ,@enum-value)))) + ) + +(defmacro suspend () + "suspend the current process, to be resumed on the next frame." + `(rlet ((pp :reg r13 :reset-here #t)) + ;; debug check for stack overflow here, where we can easily print the process name. + (#when (or KERNEL_DEBUG) + (rlet ((sp :reg rsp :reset-here #t :type int) + (off :reg r15 :type uint)) + (let* ((sp-goal (- sp off)) + (stack-top-goal (-> (the process pp) top-thread stack-top)) + (stack-used (&- stack-top-goal sp-goal)) + (stack-size (-> (the process pp) top-thread stack-size)) + ) + (when (> stack-used stack-size) + (format 0 "ERROR: suspend called without enough stack in proc:~%~A~%Stack: ~D/~D~%" pp stack-used stack-size) + ) + ) + ) + ) + ;; set to the current thread + (set! pp (-> (the process pp) top-thread)) + ;; call the suspend hook (put nothing as the argument) + ((-> (the cpu-thread pp) suspend-hook) (the cpu-thread 0)) + ;; the kernel will set pp (possibly to a new value, if we've been relocated) on resume. + ) + ) \ No newline at end of file diff --git a/goal_src/jak2/kernel/gkernel.gc b/goal_src/jak2/kernel/gkernel.gc index 3aa2896f53..eccd787527 100644 --- a/goal_src/jak2/kernel/gkernel.gc +++ b/goal_src/jak2/kernel/gkernel.gc @@ -5,10 +5,1623 @@ ;; name in dgo: gkernel ;; dgos: KERNEL -;; HACK kernel +;; Version constants (define *kernel-version* (the binteger (logior (ash *kernel-major-version* 16) *kernel-minor-version*))) +(define *irx-version* (the-as binteger #x200000)) + +;; Boot options +(define *kernel-boot-mode* 'listener) +(define *kernel-boot-level* #f) (define *use-old-listener-print* #f) + +;; Stats +(define *deci-count* 0) +(define *last-loado-length* 0) +(define *last-loado-global-usage* 0) +(define *last-loado-debug-usage* 0) + +;; forward declared stuff +(define-extern *kernel-clock* clock) +(define-extern *debug-dead-pool* dead-pool-heap) +(define-extern *null-process* process) +(define-extern *vis-boot* symbol) +(define-extern *listener-process* process) +(define-extern *active-pool* process-tree) +(define-extern *default-level* level) + + +(define-extern change-parent (function process-tree process-tree process-tree)) +(define-extern search-process-tree (function process-tree (function process-tree object) process-tree)) +(define-extern iterate-process-tree (function process-tree (function object object) kernel-context object)) +(define-extern execute-process-tree (function process-tree (function object object) kernel-context object)) +(define-extern inspect-process-tree (function process-tree int int symbol process-tree)) +(define-extern process-disconnect (function process int)) + +(defmethod relocate object ((obj object) (arg0 int)) + "Most general relocate method." + obj + ) + +;;;;;;;;;;;;;;;;;; +;; Package +;;;;;;;;;;;;;;;;;; + +(define *kernel-packages* '()) + +(defun load-package ((arg0 string) (arg1 kheap)) + "Load a package by name to the given heap." + (when (not (nmember arg0 *kernel-packages*)) + (kmemopen global arg0) + (dgo-load arg0 arg1 (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000) + (set! *kernel-packages* (cons arg0 *kernel-packages*)) + (kmemclose) + *kernel-packages* + ) + ) + +(defun unload-package ((arg0 string)) + "Mark a package as unloaded." + (let ((v1-0 (nmember arg0 *kernel-packages*))) + (if v1-0 + (set! *kernel-packages* (delete! (car v1-0) *kernel-packages*)) + ) + ) + *kernel-packages* + ) + +;;;;;;;;;;;;;;;;;; +;; Kernel Globals +;;;;;;;;;;;;;;;;;; + +;; the global kernel-context +(define *kernel-context* + (new 'static 'kernel-context + :prevent-from-run (process-mask execute sleep) + :next-pid 3 + :current-process #f + :relocating-process #f + :low-memory-message #t + ) + ) + +;; the main execution stack that's not on the scratchpad +(define *dram-stack* (the-as (pointer uint8) (malloc 'global DPROCESS_STACK_SIZE))) + +;; the top of the stack. +(defconstant *kernel-dram-stack* (&+ *dram-stack* DPROCESS_STACK_SIZE)) + +;; the top of the scratchpad stack +(set! (-> *kernel-context* fast-stack-top) (the-as pointer #x70004000)) + +(define *null-kernel-context* (new 'static 'kernel-context)) + +;;;;;;;;;;;;;;;;;;;;;;; +;; PC Port Scratchpad +;;;;;;;;;;;;;;;;;;;;;;; + +(#cond + (PC_PORT + ;; we'll create a fake scratchpad: + ;; make sure the scratchpad is 64kb aligned, and make it 32 kB so we can big stacks on it. + ;; some (partially buggy) code in generic tie relies on 64 kB alignment. + (let* ((mem (new 'global 'array 'uint8 (* 128 1024))) + ) + (define *fake-scratchpad-data* (the pointer (align-n mem (* 64 1024)))) + ) + + ;; use the same memory for the scratchpad stacks. + ;; defining it as a separate thing so we can split them for debugging stack corruption easily. + (define *fake-scratchpad-stack* *fake-scratchpad-data*) + + (defmacro scratchpad-start () + "Get the start of the scratchpad. At least 64kB aligned." + '*fake-scratchpad-data* + ) + ) + (else + (defmacro scratchpad-start () + #x70000000 + ) + ) + ) + +(defmacro scratchpad-end () + "Get the end of the scratchpad memory" + `(&+ (scratchpad-start) (* 16 1024)) + ) + +(defmacro in-scratchpad? (x) + "Is the given address in the scratchpad?" + `(and + (>= (the-as int ,x) (scratchpad-start)) + (< (the-as int ,x) (scratchpad-end)) + ) + ) + + +;;;;;;;;;;;;; +;; Thread +;;;;;;;;;;;;; + +(defmethod delete thread ((obj thread)) + "Restore the previous thread as the top-thread." + ;; make sure we aren't actually trying to delete the main thread. + (when (= obj (-> obj process main-thread)) + (break!) + ) + (set! (-> obj process top-thread) (the-as cpu-thread (-> obj previous))) + (none) + ) + +(defmethod print thread ((obj thread)) + (format #t "#<~A ~S of ~S pc: #x~X @ #x~X>" (-> obj type) (-> obj name) (-> obj process name) (-> obj pc) obj) + obj + ) + +(defmethod stack-size-set! thread ((obj thread) (arg0 int)) + "Modify the backup stack size of a thread. Must be called from the main thread, before any + allocations have been done on the process heap." + (let ((a2-0 (-> obj process))) + (cond + ((!= obj (-> a2-0 main-thread)) + (format 0 "ERROR: illegal attempt change stack size of ~A when the main-thread is not the top-thread.~%" a2-0) + ) + ((= (-> obj stack-size) arg0) + ) + ((= (-> a2-0 heap-cur) (+ (+ (-> obj stack-size) -4 (-> obj type size)) (the-as int obj))) + (set! (-> a2-0 heap-cur) (the-as pointer (+ (+ arg0 -4 (-> obj type size)) (the-as int obj)))) + (set! (-> obj stack-size) arg0) + ) + (else + (format 0 "ERROR: illegal attempt change stack size of ~A after more heap allocation has occured.~%" a2-0) + ) + ) + ) + (none) + ) + +(defmethod new cpu-thread ((allocation symbol) (type-to-make type) (parent-process process) (name symbol) (arg2 int) (stack-top pointer)) + "Create a new CPU thread. If there is no main thread, it will allocate the main thread on the process. + If there is already a main thread, it will allocate a temporary thread on the given stack. + Sets the thread as the top-thread of the process + This is a special new method which ignores the allocation symbol. + The stack-top is for the execution stack. + The stack-size is for the backup stack (applicable for main thread only)" + (let ((v0-0 (cond + ((-> parent-process top-thread) + ;; this is just a temporary thread, throw the thread on the bottom of the stack + (the cpu-thread (&+ stack-top (- PROCESS_STACK_SIZE *gtype-basic-offset*))) + ) + (else + ;; this is the main thread, allocate it from the process heap. + (let ((v1-2 (logand -16 (&+ (-> parent-process heap-cur) 15)))) + (set! (-> parent-process heap-cur) (&+ (&+ v1-2 (-> type-to-make size)) arg2)) + (the cpu-thread (&+ v1-2 4)) + ) + ) + ) + ) + ) + (set! (-> v0-0 type) type-to-make) + (set! (-> v0-0 name) name) + (set! (-> v0-0 process) parent-process) + (set! (-> v0-0 sp) stack-top) + (set! (-> v0-0 stack-top) stack-top) + (set! (-> v0-0 previous) (-> parent-process top-thread)) + (set! (-> parent-process top-thread) v0-0) + (set! (-> v0-0 suspend-hook) (method-of-object v0-0 thread-suspend)) + (set! (-> v0-0 resume-hook) (method-of-object v0-0 thread-resume)) + (set! (-> v0-0 stack-size) arg2) + v0-0 + ) + ) + +(defmethod asize-of cpu-thread ((obj cpu-thread)) + "Get the size in memory of a cpu-thread." + (the-as int (+ (-> obj type size) (-> obj stack-size))) + ) + +;;;;;;;;;;;;;;; +;; Process +;;;;;;;;;;;;;;; + +(defbehavior remove-exit process () + "Remove a single stack frame. + This can be used to skip an exit of a state, but it's a bit of a hack." + (if (-> self stack-frame-top) + (set! (-> self stack-frame-top) (-> self stack-frame-top next)) + ) + 0 + (none) + ) + +(defun-debug stream<-process-mask ((arg0 object) (arg1 process-mask)) + "Print a process mask." + (bit-enum->string process-mask arg1 arg0) + arg1 + ) + +(define *master-mode* 'game) +(define *pause-lock* #f) + +(defmethod print process-tree ((obj process-tree)) + "Print a process tree." + (format #t "#<~A ~S @ #x~X>" (-> obj type) (-> obj name) obj) + obj + ) + +(defmethod new process-tree ((allocation symbol) (type-to-make type) (arg0 string)) + "Allocate a new process-tree with the given name." + (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> v0-0 name) arg0) + (set! (-> v0-0 mask) (process-mask process-tree)) + (set! (-> v0-0 clock) *kernel-clock*) + (set! (-> v0-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 child) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 self) v0-0) + (set! (-> v0-0 ppointer) (the-as (pointer process) (&-> v0-0 self))) + v0-0 + ) + ) + +(defmethod inspect process-tree ((obj process-tree)) + "Inspect a process-tree" + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~S~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (stream<-process-mask #t (-> obj mask)) + (format #t ")~%") + (format #t "~Tclock: ~A~%" (-> obj clock)) + (format #t "~Tparent: ~A~%" (ppointer->process (-> obj parent))) + (format #t "~Tbrother: ~A~%" (ppointer->process (-> obj brother))) + (format #t "~Tchild: ~A~%" (ppointer->process (-> obj child))) + obj + ) + +(defmethod new process ((allocation symbol) (type-to-make type) (arg0 string) (arg1 int)) + "Allocate or initialize a process." + ;; check if we got a symbol (for a heap) or just a plain address. + (let ((v0-0 (if (logtest? (the-as int allocation) 1) + (object-new allocation type-to-make (the-as int (+ (-> process size) arg1))) ;; allocate on heap + (the process (+ (the-as int allocation) 4)) ;; just use it as an address, do an in-place initialization. + ) + ) + ) + (set! (-> v0-0 name) arg0) + (set! (-> v0-0 clock) *kernel-clock*) + (set! (-> v0-0 status) 'dead) + (set! (-> v0-0 pid) 0) + (set! (-> v0-0 pool) #f) + (set! (-> v0-0 allocated-length) arg1) + (set! (-> v0-0 top-thread) #f) + (set! (-> v0-0 main-thread) #f) + (let ((v1-6 (-> v0-0 stack))) + (set! (-> v0-0 heap-cur) v1-6) + (set! (-> v0-0 heap-base) v1-6) + ) + (set! (-> v0-0 heap-top) + (&-> v0-0 stack (-> v0-0 allocated-length)) + ) + (set! (-> v0-0 stack-frame-top) (the-as stack-frame (-> v0-0 heap-top))) ;; bug, probably kheap overlapping this. + (set! (-> v0-0 stack-frame-top) #f) + (set! (-> v0-0 state) #f) + (set! (-> v0-0 next-state) #f) + (set! (-> v0-0 entity) #f) + (set! (-> v0-0 level) #f) + (set! (-> v0-0 trans-hook) #f) + (set! (-> v0-0 post-hook) #f) + (set! (-> v0-0 event-hook) #f) + (set! (-> v0-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 child) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 self) v0-0) + (set! (-> v0-0 ppointer) (the-as (pointer process) (&-> v0-0 self))) + v0-0 + ) + ) + +(defun inspect-process-heap ((obj process)) + "Inspect each object on the process heap." + (let ((ptr (&+ (-> obj heap-base) *gtype-basic-offset*))) ; point to first basic + ;; loop over objects + (while (< (the int ptr) (the int (-> obj heap-cur))) + ;; inspect the object + (inspect (the basic ptr)) + ;; seek to the next object on the heap. + (&+! ptr (the int (align16 (asize-of (the basic ptr))))) + ) + ) + #f + ) + +(defmethod inspect process ((obj process)) + "Inspect process and all objects on the heap.. Autogenerated proces inspects will eventually call this one." + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~S~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (stream<-process-mask #t (-> obj mask)) + (format #t ")~%") + (format #t "~Tclock: ~A~%" (-> obj clock)) + (format #t "~Tstatus: ~A~%" (-> obj status)) + (format #t "~Tmain-thread: ~A~%" (-> obj main-thread)) + (format #t "~Ttop-thread: ~A~%" (-> obj top-thread)) + (format #t "~Tentity: ~A~%" (-> obj entity)) + (format #t "~Tlevel: ~A~%" (-> obj level)) + (format #t "~Tstate: ~A~%" (-> obj state)) + (format #t "~Tnext-state: ~A~%" (-> obj next-state)) + (format #t "~Ttrans-hook: ~A~%" (-> obj trans-hook)) + (format #t "~Tpost-hook: ~A~%" (-> obj post-hook)) + (format #t "~Tevent-hook: ~A~%" (-> obj event-hook)) + (format #t "~Tparent: ~A~%" (ppointer->process (-> obj parent))) + (format #t "~Tbrother: ~A~%" (ppointer->process (-> obj brother))) + (format #t "~Tchild: ~A~%" (ppointer->process (-> obj child))) + (format #t "~Tconnection-list: ~`connectable`P~%" (-> obj connection-list)) + (format #t "~Tstack-frame-top: ~A~%" (-> obj stack-frame-top)) + (format #t "~Theap-base: #x~X~%" (-> obj heap-base)) + (format #t "~Theap-top: #x~X~%" (-> obj heap-top)) + (format #t "~Theap-cur: #x~X~%" (-> obj heap-cur)) + (let ((s5-0 *print-column*)) + (set! *print-column* (+ *print-column* *tab-size*)) + (format #t "----~%") + (inspect-process-heap obj) + (format #t "----~%") + (set! *print-column* s5-0) + ) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Tstack[~D] @ #x~X~%" (-> obj allocated-length) (-> obj stack)) + obj + ) + +(defmethod asize-of process ((obj process)) + "Get the size in memory of a process." + (the-as int (+ (-> process size) (-> obj allocated-length))) + ) + +(defmethod print process ((obj process)) + "Print a process." + + ;; new: for jak 2, they don't print garbage stack/heap sizes when the process isn't + ;; activated yet. + (cond + ((and (-> obj top-thread) (!= (-> obj status) 'dead)) + (format #t "#<~A ~S ~A :state ~S " + (-> obj type) + (-> obj name) + (-> obj status) + (if (-> obj state) (-> obj state name)) + ) + (format #t ":stack ~D/~D :heap ~D/~D @ #x~X>" + (&- (-> obj top-thread stack-top) (the-as uint (-> obj top-thread sp))) + (-> obj main-thread stack-size) + (- (-> obj allocated-length) (&- (-> obj heap-top) (the-as uint (-> obj heap-cur)))) + (-> obj allocated-length) + obj + ) + ) + (else + (format #t "#<~A ~S ~A :state ~S @ #x~X" + (-> obj type) + (-> obj name) + (-> obj status) + (if (-> obj state) + (-> obj state name) + ) + obj + ) + ) + ) + obj + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Context Suspend And Resume - Kernel +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; the following functions are used for going from the kernel to threads and back. +;; saved registers: rbx, rbp, r10, r11, r12 + +;; DANGER - THE KERNEL DOES NOT SAVE ITS FLOATING POINT CONTEXT!!!! + +;; we use this to store a GOAL pointer to the kernel's stack pointer when executing user code. +;; to get back to the kernel, we use this global symbol. +(define-extern *kernel-sp* pointer) + +(defun return-from-thread () + "Context switch to the saved kernel context now. + This is intended to be jumped to with the ret instruction (return trampoline) + at the end of a normal function, so this should preserve rax. + To make sure this happens, all ops should be asm ops and we should have no + GOAL expressions." + (declare (asm-func none) + ;(print-asm) + ) + (rlet ((sp :reg rsp :type uint) + (off :reg r15 :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type uint) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + ) + ;; get the kernel stack pointer as a GOAL pointer (won't use a temp reg) + (.load-sym :sext #f sp *kernel-sp*) + ;; convert it back to a real pointer + (.add sp off) + + ;; restore saved registers... + ;; without coloring system because this is "cheating" and modifying saved registers without backing up. + (.pop :color #f s4) + (.pop :color #f s3) + (.pop :color #f s2) + (.pop :color #f s1) + (.pop :color #f s0) + ;; return to the kernel function that called the user code + ;; rax should still contain the return value. + (.ret) + ) + ) + +(defun return-from-thread-dead () + "Like return from thread, but we clean up our process with deactivate first. + The return register is not preserved here, instead we return the value of deactivate" + (declare (asm-func none) + ;(print-asm) + ) + (rlet ((pp :reg r13 :type process) + (sp :reg rsp :type uint) + (off :reg r15 :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type uint) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + ) + + ;; first call the deactivate method. + (deactivate pp) + ;; get the kernel stack pointer as a GOAL pointer + (.load-sym :sext #f sp *kernel-sp*) + ;; convert it back to a real pointer + (.add sp off) + + ;; restore saved registers... + ;; without coloring system because this is "cheating". + (.pop :color #f s4) + (.pop :color #f s3) + (.pop :color #f s2) + (.pop :color #f s1) + (.pop :color #f s0) + ;; return to the kernel function that called the user code + (.ret) + ) + ) + +(defun reset-and-call ((obj thread) (func function)) + "Make the given thread the top thread, reset the stack, and call the function. + Sets up a return trampoline so when the function returns it will return to the + kernel context. Will NOT deactivate on return, so this is intended for temporary threads. + NOTE: this should only be done from the kernel, running on the + kernel's stack." + (declare (asm-func object) + ) + + (rlet ((pp :reg r13 :type process) + (sp :reg rsp :type uint) + (off :reg r15 :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type uint) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + (temp :reg rax :type uint) + ) + + ;; set up the process pointer + (set! pp (-> obj process)) + ;; mark the process as running and set its top thread + (set! (-> pp status) 'running) + (set! (-> pp top-thread) (the cpu-thread obj)) + + ;; save the current kernel regs + (.push :color #f s0) + (.push :color #f s1) + (.push :color #f s2) + (.push :color #f s3) + (.push :color #f s4) + + ;; make rsp a GOAL pointer + (.sub sp off) + ;; and store it + (set! *kernel-sp* (the pointer sp)) ;; todo, asm form here? + + ;; setup the rsp for the new thread + (set! sp (the uint (-> obj stack-top))) + (.add sp off) + + ;; push the return trampoline to the stack for the user code to return to + (set! temp (the uint return-from-thread)) + (.add temp off) + (.push temp) ;; stack now 16 + 8 aligned + ;; and call the function! + (.add func off) + (.jr func) + ) + ) + +(defmethod thread-suspend cpu-thread ((unused cpu-thread)) + "Suspend the thread and return to the kernel." + + (declare (asm-func none)) + + ;; we begin this function with the thread object in pp. + ;; not sure why we do this, maybe at one point suspending didn't clobber + ;; temp registers? + (rlet ((obj :reg r13 :type cpu-thread) + (temp :reg rax :type uint) + (off :reg r15 :type uint) + (sp :reg rsp :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type uint) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + + (xmm8 :reg xmm8 :class fpr) + (xmm9 :reg xmm9 :class fpr) + (xmm10 :reg xmm10 :class fpr) + (xmm11 :reg xmm11 :class fpr) + (xmm12 :reg xmm12 :class fpr) + (xmm13 :reg xmm13 :class fpr) + (xmm14 :reg xmm14 :class fpr) + (xmm15 :reg xmm15 :class fpr) + ) + + ;; get the return address pushed by "call" in the suspend. + (.pop temp) + ;; convert to a GOAL address + (.sub temp off) + ;; store return address in thread + (set! (-> obj pc) (the pointer temp)) + + ;; convert our stack pointer to a GOAL address + (.sub sp off) + ;; store in thread. + (set! (-> obj sp) (the pointer sp)) + + ;; back up registers + (.mov :color #f temp s0) + (set! (-> obj rreg 0) temp) + (.mov :color #f temp s1) + (set! (-> obj rreg 1) temp) + (.mov :color #f temp s2) + (set! (-> obj rreg 2) temp) + (.mov :color #f temp s3) + (set! (-> obj rreg 3) temp) + (.mov :color #f temp s4) + (set! (-> obj rreg 4) temp) + + ;; back up fprs + (.mov :color #f temp xmm8) + (set! (-> obj freg 0) (the-as float temp)) + (.mov :color #f temp xmm9) + (set! (-> obj freg 1) (the-as float temp)) + (.mov :color #f temp xmm10) + (set! (-> obj freg 2) (the-as float temp)) + (.mov :color #f temp xmm11) + (set! (-> obj freg 3) (the-as float temp)) + (.mov :color #f temp xmm12) + (set! (-> obj freg 4) (the-as float temp)) + (.mov :color #f temp xmm13) + (set! (-> obj freg 5) (the-as float temp)) + (.mov :color #f temp xmm14) + (set! (-> obj freg 6) (the-as float temp)) + (.mov :color #f temp xmm15) + (set! (-> obj freg 7) (the-as float temp)) + + + + ;; get our process + (let ((proc (-> obj process))) + (when (> (process-stack-used proc) (-> obj stack-size)) + (break) ;; too much stack has been used and we can't suspend! + ;; if you hit this, try with DEBUG_PRINT_SUSPEND_FAIL set to #t (see gkernel-h.gc) + ;; it will print more info before reaching here. + ) + + ;; mark the process as suspended and copy the stack + (set! (-> proc status) 'suspended) + (let ((cur (the (pointer uint64) (-> obj stack-top))) + (save (&+ (the (pointer uint64) (-> obj stack)) (-> obj stack-size))) + ) + (while (> (the int cur) (the int sp)) + (set! cur (the (pointer uint64) (&- cur 8))) + (set! save (the (pointer uint64) (&- save 8))) + (set! (-> save) (-> cur)) + ) + ) + ) + + ;; actually setting pp to 0 + (set! obj (the cpu-thread 0)) + + ;; get the kernel stack pointer as a GOAL pointer + (.load-sym :sext #f sp *kernel-sp*) + ;; convert it back to a real pointer + (.add sp off) + + ;; restore saved registers... + ;; without coloring system because this is "cheating". + (.pop :color #f s4) + (.pop :color #f s3) + (.pop :color #f s2) + (.pop :color #f s1) + (.pop :color #f s0) + ;; return to the kernel function that called the user code + (.ret) + ) + (none) + ) + +(defmethod thread-resume cpu-thread ((thread-to-resume cpu-thread)) + "Resume a suspended thread. Call this from the kernel only. + This is also used to start a thread initialized with set-to-run. + As a result of MIPS/x86 differences, there is a hack for this." + (declare (asm-func none) + ;;(print-asm) + ) + + (rlet ((obj :reg r13 :type cpu-thread) + (temp :reg rax :type uint) + (off :reg r15 :type uint) + (sp :reg rsp :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type uint) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + (a4 :reg r8 :type uint) + (a5 :reg r9 :type uint) + + (temp-float :reg xmm0 :class fpr) + (xmm8 :reg xmm8 :class fpr) + (xmm9 :reg xmm9 :class fpr) + (xmm10 :reg xmm10 :class fpr) + (xmm11 :reg xmm11 :class fpr) + (xmm12 :reg xmm12 :class fpr) + (xmm13 :reg xmm13 :class fpr) + (xmm14 :reg xmm14 :class fpr) + (xmm15 :reg xmm15 :class fpr) + ) + + ;; save the current kernel regs + (.push :color #f s0) + (.push :color #f s1) + (.push :color #f s2) + (.push :color #f s3) + (.push :color #f s4) + + ;; make rsp a GOAL pointer + (.sub sp off) + ;; and store it + (set! *kernel-sp* (the pointer sp)) ;; todo, asm form here? + + ;; temp, stash thread in process-pointer + (set! obj thread-to-resume) + + ;; set stack pointer for the thread. leave it as a GOAL pointer for now.. + (set! sp (the uint (-> obj sp))) + + ;; restore the stack (sp is a GOAL pointer) + (let ((cur (the (pointer uint64) (-> obj stack-top))) + (restore (&+ (the (pointer uint64) (-> obj stack)) (-> obj stack-size))) + ) + (while (> (the int cur) (the int sp)) + (set! cur (the (pointer uint64) (&- cur 8))) + (set! restore (the (pointer uint64) (&- restore 8))) + (set! (-> cur) (-> restore)) + ) + ) + + ;; offset sp after we're done using it as a GOAL pointer. + (.add sp off) + + ;; setup process + (set! (-> (-> obj process) top-thread) obj) + (set! (-> (-> obj process) status) 'running) + + ;; restore reg + (set! temp (-> obj rreg 0)) + (.mov :color #f s0 temp) + (set! temp (-> obj rreg 1)) + (.mov :color #f s1 temp) + (set! temp (-> obj rreg 2)) + (.mov :color #f s2 temp) + (set! temp (-> obj rreg 3)) + (.mov :color #f s3 temp) + (set! temp (-> obj rreg 4)) + (.mov :color #f s4 temp) + (set! temp-float (-> obj freg 0)) + (.mov :color #f xmm8 temp-float) + (set! temp-float (-> obj freg 1)) + (.mov :color #f xmm9 temp-float) + (set! temp-float (-> obj freg 2)) + (.mov :color #f xmm10 temp-float) + (set! temp-float (-> obj freg 3)) + (.mov :color #f xmm11 temp-float) + (set! temp-float (-> obj freg 4)) + (.mov :color #f xmm12 temp-float) + (set! temp-float (-> obj freg 5)) + (.mov :color #f xmm13 temp-float) + (set! temp-float (-> obj freg 6)) + (.mov :color #f xmm14 temp-float) + (set! temp-float (-> obj freg 7)) + (.mov :color #f xmm15 temp-float) + + ;; hack for set-to-run-bootstrap. The set-to-run-bootstrap in MIPS + ;; expects to receive 7 values from the cpu thread's rregs. + ;; usually rreg holds saved registers, but on the first resume after + ;; a set-to-run, they hold arguments, and set-to-run-bootstrap copies them. + + ;; We only have 5 saved regs, so we need to cheat and directly pass + ;; two values in other registers + ;; so we load the a4/a5 argument registers with rreg 5 and rreg 6 + ;; In the case where we are doing a normal resume, the + ;; compiler should assume that these registers are overwritten anyway. + (set! temp (-> obj rreg 5)) + (.mov a4 temp) + (set! temp (-> obj rreg 6)) + (.mov a5 temp) + + ;; get the resume address + (set! temp (the uint (-> obj pc))) + (.add temp off) + + ;; setup the process + (set! obj (the cpu-thread (-> obj process))) + ;; resume! + (.jr temp) + (.add a4 a4) + (.add a5 a5) + ) + (none) + ) + +(defmethod new dead-pool ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int) (arg2 string)) + "Allocate a tree of dead processes." + (let ((s3-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> s3-0 name) arg2) + (set! (-> s3-0 mask) (process-mask process-tree)) + (set! (-> s3-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 child) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 self) s3-0) + (set! (-> s3-0 ppointer) (the-as (pointer process) (&-> s3-0 self))) + (dotimes (s2-1 arg0) + (let ((s1-0 (-> s3-0 child)) + (v1-5 ((method-of-type process new) allocation process "dead" arg1)) + ) + (set! (-> s3-0 child) (process->ppointer v1-5)) + (set! (-> v1-5 parent) (process->ppointer (the-as process s3-0))) + (set! (-> v1-5 pool) s3-0) + (set! (-> v1-5 brother) s1-0) + ) + ) + s3-0 + ) + ) + +(defmethod get-process dead-pool ((obj dead-pool) (arg0 type) (arg1 int)) + "Try to get a process from this dead pool. If it fails, try the debug dead pool and complain." + + ;; grab the first child + (let ((s4-0 (the-as object (-> obj child)))) + (when (and (not (the-as (pointer process-tree) s4-0)) *debug-segment* (!= obj *debug-dead-pool*)) + ;; didn't work, but we have the debug dead pool to try + ;; NOTE: this is a type bug here, s4-0 should be (pointer process), but this uses process. + (set! s4-0 (get-process *debug-dead-pool* arg0 arg1)) + + (if (the-as process s4-0) + ;; that worked. complain. + (format 0 "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" + arg0 + #f ;; (ppointer->process (the-as process s4-0)) bugged in original game + (-> obj name) + ) + ) + ;; this didn't work right in the original game, just crash here. + (break) + ) + + (cond + (s4-0 + ;; got a process somehow, set the type and return. + (set! (-> (the-as (pointer process) s4-0) 0 type) arg0) + (-> (the-as (pointer process) s4-0) 0) + ) + (else + ;; didn't work, complain and return #f. + (format 0 "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" + arg0 + (ppointer->process (the-as (pointer process) s4-0)) + (-> obj name) + ) + (the-as process #f) + ) + ) + ) + ) + +(defmethod return-process dead-pool ((obj dead-pool) (arg0 process)) + "Return a process to the dead pool." + (change-parent arg0 obj) + (none) + ) + +(defmethod new dead-pool-heap ((allocation symbol) (type-to-make type) (arg0 string) (arg1 int) (arg2 int)) + "Allocate a new dead-pool-heap" + (let ((s2-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* 12 arg1)))))) + (set! (-> s2-0 name) arg0) + (set! (-> s2-0 mask) (process-mask process-tree)) + (set! (-> s2-0 allocated-length) arg1) + (set! (-> s2-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> s2-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> s2-0 child) (the-as (pointer process-tree) #f)) + (set! (-> s2-0 self) s2-0) + (set! (-> s2-0 ppointer) (the-as (pointer process) (&-> s2-0 self))) + (init s2-0 allocation arg2) + s2-0 + ) + ) + +(defmethod init dead-pool-heap ((obj dead-pool-heap) (arg0 symbol) (arg1 int)) + "Initialize the heap." + + ;; setup the records in a linked list, all referring to *null-process*. + (countdown (v1-0 (-> obj allocated-length)) + (let ((a0-4 (-> obj process-list v1-0))) + (set! (-> a0-4 process) *null-process*) + (set! (-> a0-4 next) (-> obj process-list (+ v1-0 1))) + ) + ) + + ;; set the dead list to that list + (set! (-> obj dead-list next) (the-as dead-pool-heap-rec (-> obj process-list))) + + ;; clear alive list + (set! (-> obj alive-list process) #f) + + ;; terminate dead list. + (set! (-> obj process-list (+ (-> obj allocated-length) -1) next) #f) + (set! (-> obj alive-list prev) (-> obj alive-list)) + (set! (-> obj alive-list next) #f) + (set! (-> obj alive-list process) #f) + (set! (-> obj first-gap) (-> obj alive-list)) + (set! (-> obj first-shrink) #f) + + (cond + ((zero? arg1) + ;; explicit support for a 0 size heap. + (set! (-> obj heap base) (the-as pointer 0)) + (set! (-> obj heap current) (the-as pointer 0)) + (set! (-> obj heap top) (the-as pointer 0)) + (set! (-> obj heap top-base) (the-as pointer 0)) + 0 + ) + (else + ;; otherwise allocate a heap. + (set! (-> obj heap base) (malloc arg0 arg1)) + (set! (-> obj heap current) (-> obj heap base)) + (set! (-> obj heap top) (&+ (-> obj heap base) arg1)) + (set! (-> obj heap top-base) (-> obj heap top)) + ) + ) + (none) + ) + +(defmethod gap-location dead-pool-heap ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + "Get the location of the first possible gap after the given record." + (the-as pointer + (if (-> arg0 process) + ;; if we have a process, after that process + (+ (+ (-> arg0 process allocated-length) -4 (-> process size)) (the-as int (-> arg0 process))) + ;; no process, just the start of the dead pool's big heap. + (-> obj heap base) + ) + ) + ) + +(defmethod gap-size dead-pool-heap ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + "Get the size of the gap after the given record (possibly 0)" + (cond + ((-> arg0 process) + ;; record has a proc + (let ((v1-3 (&+ (&+ (the-as pointer (-> arg0 process)) (-> process size)) (-> arg0 process allocated-length)))) + (if (-> arg0 next) + ;; and there's a next process, just get the gap in between those + (&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3)) + ;; no next process, the gap is just the distance to the end of the dead pool's heap. + (&- (-> obj heap top) (the-as uint (&+ v1-3 4))) + ) + ) + ) + ((-> arg0 next) + ;; record has no proc, go from start of dead pool heap to the next process. + (&- (the-as pointer (-> arg0 next process)) (the-as uint (&+ (-> obj heap base) 4))) + ) + (else + ;; no processes at all, the gap is the entire heap. + (&- (-> obj heap top) (the-as uint (-> obj heap base))) + ) + ) + ) + +(defmethod find-gap dead-pool-heap ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + "Iterate through records, starting at the given one, and find the first one with a gap after it." + (while (and (-> arg0 next) (zero? (gap-size obj arg0))) + (set! arg0 (-> arg0 next)) + ) + arg0 + ) + +(defmethod inspect dead-pool-heap ((obj dead-pool-heap)) + "Inspect a dead-pool heap, printing proccesses and gaps." + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~A~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (stream<-process-mask #t (-> obj mask)) + (format #t ")~%") + (format #t "~Tparent: #x~X~%" (-> obj parent)) + (format #t "~Tbrother: #x~X~%" (-> obj brother)) + (format #t "~Tchild: #x~X~%" (-> obj child)) + (format #t "~Tppointer: #x~X~%" (-> obj ppointer)) + (format #t "~Tself: ~A~%" (-> obj self)) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Theap: #~%" (-> obj heap)) + (format #t "~Tfirst-gap: #~%" (-> obj first-gap)) + (format #t "~Tfirst-shrink: #~%" (-> obj first-shrink)) + (format #t "~Talive-list: #~%" (-> obj alive-list)) + (format #t "~Tlast: #~%" (-> obj alive-list prev)) + (format #t "~Tdead-list: #~%" (-> obj dead-list)) + (let* ((s5-0 (&- (-> obj heap top) (the-as uint (-> obj heap base)))) + (v1-3 (if (-> obj alive-list prev) + (gap-size obj (-> obj alive-list prev)) + s5-0 + ) + ) + ) + (format #t "~Tprocess-list[0] @ #x~X ~D/~D bytes used~%" (-> obj process-list) (- s5-0 v1-3) s5-0) + ) + (let ((s5-1 (-> obj alive-list)) + (s4-0 0) + ) + (while s5-1 + (if (-> s5-1 process) + (format #t "~T [~3D] # ~A~%" s4-0 s5-1 (-> s5-1 process)) + ) + (let ((s3-0 (gap-size obj s5-1))) + (if (nonzero? s3-0) + (format #t "~T gap: ~D bytes @ #x~X~%" s3-0 (gap-location obj s5-1)) + ) + ) + (set! s5-1 (-> s5-1 next)) + (+! s4-0 1) + ) + ) + obj + ) + +(defmethod asize-of dead-pool-heap ((obj dead-pool-heap)) + "Get the size in memory of a dead-pool-heap." + (the-as int (+ (-> obj type size) (* 12 (-> obj allocated-length)))) + ) + +(defmethod memory-used dead-pool-heap ((obj dead-pool-heap)) + "Get the amount of used memory. Gaps in between processes are considered used." + (if (-> obj alive-list prev) + (- (memory-total obj) (gap-size obj (-> obj alive-list prev))) + 0 + ) + ) + +(defmethod memory-total dead-pool-heap ((obj dead-pool-heap)) + "Get the total size of the heap." + (&- (-> obj heap top) (the-as uint (-> obj heap base))) + ) + +(defmethod memory-free dead-pool-heap ((obj dead-pool-heap)) + "Get the amount of free memory. Does not include gaps in between processes." + (let ((v1-0 (-> obj heap top))) + (if (-> obj alive-list prev) + (gap-size obj (-> obj alive-list prev)) + (&- v1-0 (the-as uint (-> obj heap base))) + ) + ) + ) + +(defmethod compact-time dead-pool-heap ((obj dead-pool-heap)) + "Not working, likely was supposed to return how long the compaction took." + ;; never set. + (-> obj compact-time) + ) + +(defmethod find-gap-by-size dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + "Find the first gap which is at least the given size." + (let ((gp-0 (-> obj first-gap))) + (while (and gp-0 (< (gap-size obj gp-0) arg0)) + (set! gp-0 (-> gp-0 next)) + ) + gp-0 + ) + ) + +(defmethod get-process dead-pool-heap ((obj dead-pool-heap) (arg0 type) (arg1 int)) + "Get a process!" + (let ((s4-0 (-> obj dead-list next)) + (s3-0 (the-as process #f)) + ) + ;; find a gap! + (let ((s1-0 (find-gap-by-size obj (the-as int (+ (-> process size) arg1))))) + (cond + ((and s4-0 s1-0 (nonzero? (-> obj heap base))) ;; have record, gap, and heap, we are good! + ;; get record + (set! (-> obj dead-list next) (-> s4-0 next)) + (let ((v1-6 (-> s1-0 next))) + (set! (-> s1-0 next) s4-0) + (set! (-> s4-0 next) v1-6) + (if v1-6 + (set! (-> v1-6 prev) s4-0) + ) + ) + (set! (-> s4-0 prev) s1-0) + (if (= s1-0 (-> obj alive-list prev)) + (set! (-> obj alive-list prev) s4-0) + ) + + ;; construct process in-place + (let ((a0-5 (gap-location obj s1-0))) + (set! s3-0 ((method-of-type process new) (the-as symbol a0-5) process "process" arg1)) + ) + + ;; link process to record + (set! (-> s4-0 process) s3-0) + (set! (-> s3-0 ppointer) (&-> s4-0 process)) + + ;; update gap/shrinks + (if (= (-> obj first-gap) s1-0) + (set! (-> obj first-gap) (find-gap obj s4-0)) + ) + (if (or (not (-> obj first-shrink)) (< (the-as int s3-0) (the-as int (-> obj first-shrink process)))) + (set! (-> obj first-shrink) s4-0) + ) + + ;; setup process + (set! (-> s3-0 parent) (-> obj ppointer)) + (set! (-> s3-0 pool) obj) + (set! (-> obj child) (&-> s4-0 process)) + ) + (else + (when (and *debug-segment* (!= obj *debug-dead-pool*)) + (set! s3-0 (get-process *debug-dead-pool* arg0 arg1)) + (if (and s3-0 *vis-boot*) + (format + 0 + "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" + arg0 + s3-0 + (-> obj name) + ) + ) + ) + ) + ) + ) + (if s3-0 + (set! (-> s3-0 type) arg0) + (format 0 "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" arg0 s3-0 (-> obj name)) + ) + s3-0 + ) + ) + +(defmethod return-process dead-pool-heap ((obj dead-pool-heap) (proc process)) + "Return a process to a dead pool heap" + + ;; check we are returning to the correct pool + (unless (eq? obj (-> proc pool)) + (format 0 "ERROR: process ~A does not belong to dead-pool-heap ~A.~%" proc obj) + ) + + ;; reclaim us. + (change-parent proc obj) + + ;; we don't maintain a real tree for a dead-pool-heap, so undo any change to child + ;; done by change-parent + (set! (-> obj child) #f) + + ;; we know our ppointer is really a rec for a dead-pool-heap process, so we can use + ;; this trick to quickly find our rec. + (let ((rec (the dead-pool-heap-rec (-> proc ppointer)))) + + ;; if we are at or below the first gap, update first gap. + (when (or (eq? (-> obj first-gap) rec) + (< (the int (gap-location obj rec)) (the int (gap-location obj (-> obj first-gap)))) + ) + (set! (-> obj first-gap) (-> rec prev)) + ) + + + ;; update the first-shrink. We aren't smart about this and just move it backward. + (when (eq? (-> obj first-shrink) rec) + (set! (-> obj first-shrink) (-> rec prev)) + (when (not (-> obj first-shrink process)) + (set! (-> obj first-shrink) #f)) + ) + + ;; remove us from list + (set! (-> rec prev next) (-> rec next)) + (cond + ((-> rec next) + ;; update links + (set! (-> rec next prev) (-> rec prev)) + ) + (else + ;; we were last, update that. + (set! (-> obj last) (-> rec prev)) + ) + ) + + ;; insert at the front of the dead list. + (set! (-> rec next) (-> obj dead-list next)) + (set! (-> obj dead-list next) rec) + (set! (-> rec process) *null-process*) + + (none) + ) + ) + +(defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (proc process)) + "Shrink the heap of a process. + This resizes the process heap to be the exact size it is currently using." + (when proc + ;; get our rec. + (let ((rec (the dead-pool-heap-rec (-> proc ppointer)))) + ;; check if it's ok to shrink + (unless (or (process-mask? (-> proc mask) heap-shrunk) ;; already shrunk + (and (not (-> proc next-state)) ;; uninitialized + (not (-> proc state))) ;; uninitialized + ) + ;; shrink! + (set! (-> proc allocated-length) (the int (&- (-> proc heap-cur) (-> proc stack)))) + (set! (-> proc heap-top) (&-> (-> proc stack) (-> proc allocated-length))) + + ;; update first gap + (when (< (the int proc) (the int (gap-location obj (-> obj first-gap)))) + (set! (-> obj first-gap) (find-gap obj rec)) + ) + + ;; mark us as shrunk + (process-mask-set! (-> proc mask) heap-shrunk) + ) + + ;; update first shrink + (when (eq? (-> obj first-shrink) rec) + (set! (-> obj first-shrink) (-> rec next)) + ) + ) + ) + obj + ) +(defmethod compact dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + "Relocate processes to remove gaps and increase free memory." + + ;; skip if we're an empty dead-pool-heap + (if (zero? (-> obj heap base)) + (return 0) + ) + + ;; if we're almost out of memory, increase the compaction amount. + (let* ((s4-0 (memory-free obj)) + (v1-5 (memory-total obj)) + (f0-2 (/ (the float s4-0) (the float v1-5))) + ) + (cond + ((< f0-2 0.1) + (set! arg0 1000) + ;; really low, complain. + (if (and *debug-segment* (-> *kernel-context* low-memory-message)) + (format *stdcon* "~3LLow Actor Memory~%~0L") + ) + ) + ((< f0-2 0.2) + (set! arg0 (* arg0 4)) + ) + ((< f0-2 0.3) + (set! arg0 (* arg0 2)) + ) + ) + ) + (set! (-> obj compact-count-targ) (the-as uint arg0)) + (set! (-> obj compact-count) (the-as uint 0)) + + ;; loop over compactions. + (while (nonzero? arg0) + (+! arg0 -1) + + ;; try to get something to shrink + (let ((v1-19 (-> obj first-shrink))) + (when (not v1-19) + (set! v1-19 (-> obj alive-list next)) + (set! (-> obj first-shrink) v1-19) + ) + (if v1-19 + ;; got something, shrink it. + (shrink-heap obj (-> v1-19 process)) + ) + ) + + ;; move to fill the gap. + (let ((s4-1 (-> obj first-gap))) + (when (-> s4-1 next) + (let ((s3-0 (-> s4-1 next process)) + (s2-0 (gap-size obj s4-1)) + ) + (when (nonzero? s2-0) + (when (< s2-0 0) + ;; bug, negative size. + (break!) + ) + ;; shrink before moving. + (shrink-heap obj s3-0) + ;; do the relocation! the relocate method of process does the actual memcpy. + (relocate s3-0 (- s2-0)) + ;; update gaps + (set! (-> obj first-gap) (find-gap obj s4-1)) + (+! (-> obj compact-count) 1) + ) + ) + ) + ) + ) + 0 + (none) + ) + +(defmethod churn dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + "Relocate processes to debug process relocation." + (while (nonzero? arg0) + (+! arg0 -1) + (let ((s4-0 (-> obj alive-list next))) + (when s4-0 + (if (or (= (-> obj first-gap) s4-0) + (< (the-as int (gap-location obj s4-0)) (the-as int (gap-location obj (-> obj first-gap)))) + ) + (set! (-> obj first-gap) (-> s4-0 prev)) + ) + (when (= (-> obj first-shrink) s4-0) + (set! (-> obj first-shrink) (-> s4-0 prev)) + (if (not (-> obj first-shrink process)) + (set! (-> obj first-shrink) #f) + ) + ) + (set! (-> s4-0 prev next) (-> s4-0 next)) + (if (-> s4-0 next) + (set! (-> s4-0 next prev) (-> s4-0 prev)) + (set! (-> obj alive-list prev) (-> s4-0 prev)) + ) + (let ((a1-3 (-> obj alive-list prev))) + (let ((v1-19 (-> a1-3 next))) + (set! (-> a1-3 next) s4-0) + (set! (-> s4-0 next) v1-19) + (if v1-19 + (set! (-> v1-19 prev) s4-0) + ) + ) + (set! (-> s4-0 prev) a1-3) + (set! (-> obj alive-list prev) s4-0) + (set! (-> s4-0 process) + (relocate (-> s4-0 process) (&- (gap-location obj a1-3) (the-as uint (&-> (-> s4-0 process) type)))) + ) + ) + ) + ) + ) + 0 + (none) + ) + +(defun method-state ((arg0 type) (arg1 basic)) + "Get a state by name from the method table of a type." + (dotimes (v1-0 (the-as int (-> arg0 allocated-length))) + (let ((a2-2 (the-as basic (-> arg0 method-table v1-0)))) + (if (and (nonzero? (the-as function a2-2)) + (= (-> (the-as function a2-2) type) state) + (= (-> (the-as state a2-2) name) arg1) + ) + (return (the-as state a2-2)) + ) + ) + ) + (the-as state #f) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Process Searching and Iterating +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; goal lambdas don't "capture" variables successfully, so this is a workaround. +(define *global-search-name* (the-as basic #f)) +(define *global-search-count* 0) + +(defun process-by-name ((arg0 string) (arg1 process-tree)) + "Get a process by name." + (set! *global-search-name* arg0) + (the-as process (search-process-tree + arg1 + (lambda ((arg0 process)) (string= (-> arg0 name) (the-as string *global-search-name*))) + ) + ) + ) + +(defun process-not-name ((arg0 string) (arg1 process-tree)) + "Get a process that doesn't have the given name." + (set! *global-search-name* (the-as basic arg0)) + (the-as + process + (search-process-tree + arg1 + (lambda ((arg0 process)) (not (string= (-> arg0 name) (the-as string *global-search-name*)))) + ) + ) + ) + +(defun process-count ((arg0 process-tree)) + "Count the number of processes in the given tree." + (set! *global-search-count* 0) + (iterate-process-tree + arg0 + (lambda ((arg0 process)) (set! *global-search-count* (+ *global-search-count* 1)) #t) + *null-kernel-context* + ) + *global-search-count* + ) + +(defun kill-by-name ((arg0 string) (arg1 process-tree)) + "Kill all processes with the given name." + (local-vars (a0-1 process)) + (while (begin (set! a0-1 (process-by-name arg0 arg1)) a0-1) + (deactivate a0-1) + ) + #f + ) + +(defun kill-by-type ((arg0 type) (arg1 process-tree)) + "Kill all processes with the given type." + (local-vars (a0-1 process-tree)) + (set! *global-search-name* arg0) + (while (begin + (set! a0-1 (search-process-tree arg1 (lambda ((arg0 process)) (= (-> arg0 type) *global-search-name*)))) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +(defun kill-not-name ((arg0 string) (arg1 process-tree)) + "Kill all processes, except for ones named this." + (local-vars (a0-1 process)) + (while (begin (set! a0-1 (process-not-name arg0 arg1)) a0-1) + (deactivate a0-1) + ) + #f + ) + +(defun kill-not-type ((arg0 type) (arg1 process-tree)) + "Kill all processes not of the given type." + (local-vars (a0-1 process-tree)) + (set! *global-search-name* arg0) + (while (begin + (set! a0-1 (search-process-tree arg1 (lambda ((arg0 process)) (!= (-> arg0 type) *global-search-name*)))) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +(defmethod run-logic? process ((obj process)) + "Should this process be run by the kernel?" + #t + ) + +(defun iterate-process-tree ((arg0 process-tree) (arg1 (function object object)) (arg2 kernel-context)) + "Iterate over the process tree, calling the function on each process." + (let ((s4-0 (or (logtest? (-> arg0 mask) (process-mask process-tree)) (arg1 arg0)))) + (cond + ((= s4-0 'dead) + ;; the function returned dead, don't look at children. + ) + (else + ;; iterate over children too. + (let ((v1-4 (-> arg0 child))) + (while v1-4 + (let ((s3-1 (-> v1-4 0 brother))) + (iterate-process-tree (-> v1-4 0) arg1 arg2) + (set! v1-4 s3-1) + ) + ) + ) + ) + ) + s4-0 + ) + ) + +(defun execute-process-tree ((arg0 process-tree) (arg1 (function object object)) (arg2 kernel-context)) + "Iterate over the process tree, running only if the mask doesn't prevent it. + Update the mask of the process-tree to have kernel-run if and only if we run at least one process." + + ;; start with this cleared + (logclear! (-> arg0 mask) (process-mask kernel-run)) + + ;; prevent run if: + ;; - we are a process-tree + ;; - we are prevent-from-run + ;; - we don't return #t for run-logic? + (let ((s3-0 (or (logtest? (-> arg0 mask) (process-mask process-tree)) + ;; prevent if not both (clear to run and run-logic? = #t) + (not (and (zero? (logand (-> arg2 prevent-from-run) (-> arg0 mask))) (run-logic? arg0))) + (begin (logior! (-> arg0 mask) (process-mask kernel-run)) (arg1 arg0)) + ) + ) + ) + (cond + ((= s3-0 'dead) + ;; don't check children if dead. + ) + (else + (let ((v1-12 (-> arg0 child))) + (while v1-12 + (let ((s4-1 (-> v1-12 0 brother))) + (execute-process-tree (-> v1-12 0) arg1 arg2) + (set! v1-12 s4-1) + ) + ) + ) + ) + ) + s3-0 + ) + ) + +(defun search-process-tree ((arg0 process-tree) (arg1 (function process-tree object))) + "Iterate process tree, returning the process that returns #t first." + (when (zero? (logand (-> arg0 mask) (process-mask process-tree))) + (if (arg1 arg0) + (return arg0) + ) + ) + (let ((v1-5 (-> arg0 child))) + (while v1-5 + (let ((s5-1 (-> v1-5 0 brother))) + (let ((v1-6 (search-process-tree (-> v1-5 0) arg1))) + (if v1-6 + (return v1-6) + ) + ) + (set! v1-5 s5-1) + ) + ) + ) + (the-as process-tree #f) + ) + +(defun kernel-dispatcher () + "Main entry point to GOAL from C++." + + ;; added + ;; outside of all profiler events, set a ROOT event + (profiler-instant-event "ROOT") + + ;; run any listener functions + (when *listener-function* + (set! *enable-method-set* (+ *enable-method-set* 1)) + (let ((t1-0 (reset-and-call (-> *listener-process* main-thread) *listener-function*))) + (if *use-old-listener-print* + (format #t "~D~%" t1-0 t1-0 t1-0) + (format #t "~D #x~X ~F ~A~%" t1-0 t1-0 t1-0 t1-0) + ) + ) + (set! *listener-function* #f) + (set! *enable-method-set* (+ *enable-method-set* -1)) + ) + + ;; for each active proces... + (execute-process-tree + *active-pool* + (lambda ((arg0 process)) + (let ((s5-0 *kernel-context*)) + (case (-> arg0 status) + (('waiting-to-run 'suspended) + ;; we'll run this process + (profiler-start-event (-> arg0 name)) + (set! (-> s5-0 current-process) arg0) + (cond + ((logtest? (-> arg0 mask) (process-mask pause)) + ;; we can be paused, write messages/debug-draw to buffers that aren't cleared + ;; when the game is paused. + (set! *stdcon* *stdcon1*) + (set! *debug-draw-pauseable* #t) + ) + (else + ;; not pausable, write to buffers that clear each frame. + (set! *stdcon* *stdcon0*) + (set! *debug-draw-pauseable* #f) + ) + ) + + ;; run the trans function. + (when (-> arg0 trans-hook) + (let ((s4-0 (new 'process 'cpu-thread arg0 'trans 256 (-> arg0 main-thread stack-top)))) + (reset-and-call s4-0 (-> arg0 trans-hook)) + (delete s4-0) + ) + (when (= (-> arg0 status) 'dead) ;; handle deactivates in trans + (set! (-> s5-0 current-process) #f) + (profiler-end-event) + (return 'dead) + ) + ) + + ;; run the main thread! + (if (logtest? (-> arg0 mask) (process-mask sleep-code)) + (set! (-> arg0 status) 'suspended) + ((-> arg0 main-thread resume-hook) (-> arg0 main-thread)) + ) + + + (cond + ((= (-> arg0 status) 'dead) ;; handle death in main thread. + (set! (-> s5-0 current-process) #f) + (profiler-end-event) + 'dead + ) + (else + ;; run post. + ;; NOTE: post always runs on the dram stack, so you can use ja-post and use the scratchpad for anims. + (when (-> arg0 post-hook) + (let ((s4-1 (new 'process 'cpu-thread arg0 'post 256 *kernel-dram-stack*))) + (reset-and-call s4-1 (-> arg0 post-hook)) + (delete s4-1) + ) + (when (= (-> arg0 status) 'dead) ;; handle death in post + (set! (-> s5-0 current-process) #f) + (profiler-end-event) + (return 'dead) + ) + (set! (-> arg0 status) 'suspended) + ) + ;; done with process. + (set! (-> s5-0 current-process) #f) + (profiler-end-event) + #f + ) + ) + ) + (('dead) + 'dead + ) + ) + ) + ) + *kernel-context* + ) + ) + +#| (defun kernel-dispatcher () "Run the kernel! This is the entry point from C++ to GOAL." @@ -31,4 +1644,817 @@ (set! *listener-function* #f) (+! *enable-method-set* -1) ) - ) \ No newline at end of file + ) + +|# + +(defun sync-dispatcher () + "Run just the listener function. Used for SQL query stuff." + (let ((t9-0 *listener-function*)) + (the-as object (when t9-0 + (set! *listener-function* #f) + (t9-0) + #f + ) + ) + ) + ) + +(defun inspect-process-tree ((arg0 process-tree) (arg1 int) (arg2 int) (arg3 symbol)) + "Print out a process tree diagram." + (print-tree-bitmask arg2 arg1) + (cond + (arg3 + (format #t "__________________~%") + (format + #t + "~S~A~%" + (if (zero? arg1) + "" + "+---" + ) + arg0 + ) + (let ((s2-0 *print-column*)) + (set! *print-column* (the binteger (* arg1 4))) + (inspect arg0) + (set! *print-column* s2-0) + ) + ) + (else + (format + #t + "~S~A~%" + (if (zero? arg1) + "" + "+---" + ) + arg0 + ) + ) + ) + (let ((s2-1 (-> arg0 child))) + (while s2-1 + (inspect-process-tree + (-> s2-1 0) + (+ arg1 1) + (if (not (-> s2-1 0 brother)) + arg2 + (logior arg2 (ash 1 (+ arg1 1))) + ) + arg3 + ) + (set! s2-1 (-> s2-1 0 brother)) + ) + ) + arg0 + ) + +(defmacro set-u128-as-u64! (dst src) + `(set! (-> (the (pointer uint64) (& ,dst))) + ,src + ) + ) + +(defmacro set-u64-from-u128! (dst src) + `(set! ,dst (-> (the (pointer uint64) (& ,src)))) + ) + +(defmacro the-super-u64-fucntion (func) + `(the-as (function uint uint uint uint uint uint object) ,func) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Stack Frame Stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; The GOAL kernel supports dynamic throw and catch. +;; The catch frames are managed per process (you can't throw to a frame outside your process) +;; But otherwise it is fully dynamic. + +(defmethod new catch-frame ((allocation symbol) (type-to-make type) (name symbol) (func function) (param-block (pointer uint64))) + "Run func in a catch frame with the given 8 parameters. + The return value is the result of the function. + The allocation must be an address. + Unlike the original, this only works on the first six parameters, but I think this doesn't matter." + (declare (asm-func object) + (allow-saved-regs) ;; very dangerous! + ) + + (rlet ((pp :reg r13 :type process) + (temp :reg rax :type uint) + (off :reg r15 :type uint) + (sp :reg rsp :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type (pointer uint64)) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + + (xmm8 :reg xmm8 :class fpr) + (xmm9 :reg xmm9 :class fpr) + (xmm10 :reg xmm10 :class fpr) + (xmm11 :reg xmm11 :class fpr) + (xmm12 :reg xmm12 :class fpr) + (xmm13 :reg xmm13 :class fpr) + (xmm14 :reg xmm14 :class fpr) + (xmm15 :reg xmm15 :class fpr) + ) + + ;; we treat the allocation as an address. + (let ((obj (the catch-frame (&+ (the pointer allocation) *gtype-basic-offset*)))) + ;; setup catch frame + (set! (-> obj type) type-to-make) + (set! (-> obj name) name) + ;; get the return address (the compiler won't touch the stack because we're an asm-func) + (.pop temp) + (.push temp) + ;; make it a GOAL address so it fits in 32 bits + (.sub temp off) + ;; store it + (set! (-> obj ra) (the int temp)) + + ;; todo, do we need a stack offset here? + ;; remember the stack pointer + (set! temp sp) + (.sub temp off) + (set! (-> obj sp) (the int temp)) + + ;; back up registers we care about + (.mov :color #f temp s0) + (set-u128-as-u64! (-> obj rreg 0) temp) + (.mov :color #f temp s1) + (set-u128-as-u64! (-> obj rreg 1) temp) + (.mov :color #f temp s2) + (set-u128-as-u64! (-> obj rreg 2) temp) + (.mov :color #f temp s3) + (set-u128-as-u64! (-> obj rreg 3) temp) + (.mov :color #f temp s4) + (set-u128-as-u64! (-> obj rreg 4) temp) + + (.mov :color #f temp xmm8) + (set! (-> obj freg 0) (the-as float temp)) + (.mov :color #f temp xmm9) + (set! (-> obj freg 1) (the-as float temp)) + (.mov :color #f temp xmm10) + (set! (-> obj freg 2) (the-as float temp)) + (.mov :color #f temp xmm11) + (set! (-> obj freg 3) (the-as float temp)) + (.mov :color #f temp xmm12) + (set! (-> obj freg 4) (the-as float temp)) + (.mov :color #f temp xmm13) + (set! (-> obj freg 5) (the-as float temp)) + (.mov :color #f temp xmm14) + (set! (-> obj freg 6) (the-as float temp)) + (.mov :color #f temp xmm15) + (set! (-> obj freg 7) (the-as float temp)) + + ;; push this stack frame + (set! (-> obj next) (-> pp stack-frame-top)) + (set! (-> pp stack-frame-top) obj) + + ;; help coloring, it isn't smart enough to realize it's "safe" to use these registers. + (.push :color #f s3) + (.push :color #f s2) + (.push :color #f s2) + (set! s3 (the uint func)) + (set! s2 param-block) + + ;; todo - are we aligned correctly here? + (let ((ret ((the-super-u64-fucntion s3) + (-> s2 0) + (-> s2 1) + (-> s2 2) + (-> s2 3) + (-> s2 4) + (-> s2 5) + )) + ) + (.pop :color #f s2) + (.pop :color #f s2) + (.pop :color #f s3) + (set! (-> pp stack-frame-top) (-> pp stack-frame-top next)) + (.ret) + (the object ret) + ) + ) + ) + ) + + +(defun throw-dispatch ((obj catch-frame) value) + "Throw the given value to the catch frame. + Only can throw a 64-bit value. The original could throw 128 bits." + (declare (asm-func none)) + + (rlet ((pp :reg r13 :type process) + (temp :reg rax :type uint) + (off :reg r15 :type uint) + (sp :reg rsp :type uint) + (s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type (pointer uint64)) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + + (temp-float :reg xmm0 :class fpr) + (xmm8 :reg xmm8 :class fpr) + (xmm9 :reg xmm9 :class fpr) + (xmm10 :reg xmm10 :class fpr) + (xmm11 :reg xmm11 :class fpr) + (xmm12 :reg xmm12 :class fpr) + (xmm13 :reg xmm13 :class fpr) + (xmm14 :reg xmm14 :class fpr) + (xmm15 :reg xmm15 :class fpr) + ) + + ;; pop everything we threw past + (set! (-> pp stack-frame-top) (-> obj next)) + + ;; restore regs we care about. + (set-u64-from-u128! temp (-> obj rreg 0)) + (.mov :color #f s0 temp) + (set-u64-from-u128! temp (-> obj rreg 1)) + (.mov :color #f s1 temp) + (set-u64-from-u128! temp (-> obj rreg 2)) + (.mov :color #f s2 temp) + (set-u64-from-u128! temp (-> obj rreg 3)) + (.mov :color #f s3 temp) + (set-u64-from-u128! temp (-> obj rreg 4)) + (.mov :color #f s4 temp) + + (set! temp-float (-> obj freg 0)) + (.mov :color #f xmm8 temp-float) + (set! temp-float (-> obj freg 1)) + (.mov :color #f xmm9 temp-float) + (set! temp-float (-> obj freg 2)) + (.mov :color #f xmm10 temp-float) + (set! temp-float (-> obj freg 3)) + (.mov :color #f xmm11 temp-float) + (set! temp-float (-> obj freg 4)) + (.mov :color #f xmm12 temp-float) + (set! temp-float (-> obj freg 5)) + (.mov :color #f xmm13 temp-float) + (set! temp-float (-> obj freg 6)) + (.mov :color #f xmm14 temp-float) + (set! temp-float (-> obj freg 7)) + (.mov :color #f xmm15 temp-float) + + ;; set stack pointer + (set! sp (the uint (-> obj sp))) + (.add sp off) + + ;; overwrite our return address + (.pop temp) + (set! temp (the uint (-> obj ra))) + (.add temp off) + (.push temp) + + ;; load the return register + (.mov temp value) + (.ret) + ) + ) + +(defun throw ((name symbol) value) + "Dynamic throw." + (rlet ((pp :reg r13 :type process)) + (let ((cur (-> pp stack-frame-top))) + (while cur + (when (and (eq? (-> cur name) name) (eq? (-> cur type) catch-frame)) + ;; match! + + (throw-dispatch (the catch-frame cur) value) + ) + + (if (eq? (-> cur type) protect-frame) + ;; call the cleanup function + ((-> (the protect-frame cur) exit)) + ) + (set! cur (-> cur next)) + ) + ) + ) + (format 0 "ERROR: throw could not find tag ~A~%" name) + (break) + ) + +(defmethod new protect-frame ((allocation symbol) (type-to-make type) (arg0 (function none))) + "Create a new protect frame, must be on the stack." + (with-pp + (let ((v0-0 (the-as protect-frame (+ (the-as int allocation) 4)))) + (set! (-> v0-0 type) type-to-make) + (set! (-> v0-0 name) 'protect-frame) + (set! (-> v0-0 exit) arg0) + (set! (-> v0-0 next) (-> pp stack-frame-top)) + (set! (-> pp stack-frame-top) v0-0) + v0-0 + ) + ) + ) + +(defun previous-brother ((arg0 process-tree)) + (let ((v1-0 (-> arg0 parent))) + (when v1-0 + (let ((v1-2 (-> v1-0 0 child))) + (if (= v1-2 arg0) + (return (the-as object #f)) + ) + (while v1-2 + (if (= (-> v1-2 0 brother) arg0) + (return (the-as object v1-2)) + ) + (set! v1-2 (-> v1-2 0 brother)) + ) + ) + (the-as (pointer process-tree) #f) + ) + ) + ) + +(defun change-parent ((arg0 process-tree) (arg1 process-tree)) + (let ((a2-0 (-> arg0 parent))) + (when a2-0 + (let ((v1-2 (-> a2-0 0 child))) + (cond + ((= (ppointer->process v1-2) arg0) + (set! (-> a2-0 0 child) (-> arg0 brother)) + ) + (else + (while (!= (ppointer->process (-> v1-2 0 brother)) arg0) + (nop!) + (nop!) + (nop!) + (set! v1-2 (-> v1-2 0 brother)) + ) + (set! (-> v1-2 0 brother) (-> arg0 brother)) + ) + ) + ) + ) + ) + (set! (-> arg0 parent) (-> arg1 ppointer)) + (set! (-> arg0 brother) (-> arg1 child)) + (set! (-> arg1 child) (-> arg0 ppointer)) + arg0 + ) + +(defun change-brother ((arg0 process-tree) (arg1 process-tree)) + (when (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1)) + (let ((a2-1 (-> arg0 parent))) + (when a2-1 + (let ((t0-0 (-> a2-1 0 child)) + (a3-1 (the-as (pointer process-tree) #f)) + (v1-4 (the-as (pointer process-tree) #f)) + ) + (if (= (ppointer->process t0-0) arg0) + (set! a3-1 a2-1) + ) + (if (= (ppointer->process t0-0) arg1) + (set! v1-4 a2-1) + ) + (while (and (-> t0-0 0 brother) (or (not a3-1) (not v1-4))) + (if (= (-> (ppointer->process t0-0) brother) arg1) + (set! v1-4 t0-0) + ) + (if (= (-> (ppointer->process t0-0) brother) arg0) + (set! a3-1 t0-0) + ) + (set! t0-0 (-> t0-0 0 brother)) + ) + (cond + ((or (not a3-1) (not v1-4)) + (return 0) + ) + ((= a3-1 a2-1) + (set! (-> a3-1 5) (the-as process-tree (-> arg0 brother))) + ) + (else + (set! (-> a3-1 4) (the-as process-tree (-> arg0 brother))) + ) + ) + (cond + ((= v1-4 a2-1) + (set! (-> arg0 brother) (the-as (pointer process-tree) (-> v1-4 5))) + (set! (-> v1-4 5) (the-as process-tree (-> arg0 ppointer))) + ) + (else + (set! (-> arg0 brother) (the-as (pointer process-tree) (-> v1-4 4))) + (set! (-> v1-4 4) (the-as process-tree (-> arg0 ppointer))) + ) + ) + ) + ) + ) + ) + arg0 + ) + +(defun change-to-last-brother ((arg0 process-tree)) + (when (and (-> arg0 brother) (-> arg0 parent)) + (let* ((a1-0 (-> arg0 parent)) + (v1-4 (-> a1-0 0 child)) + ) + (cond + ((= (-> v1-4 0) arg0) + (set! (-> a1-0 0 child) (-> arg0 brother)) + ) + (else + (while (!= (-> v1-4 0 brother 0) arg0) + (nop!) + (nop!) + (nop!) + (nop!) + (set! v1-4 (-> v1-4 0 brother)) + ) + (set! (-> v1-4 0 brother) (-> arg0 brother)) + ) + ) + (while (-> v1-4 0 brother) + (nop!) + (nop!) + (nop!) + (nop!) + (set! v1-4 (-> v1-4 0 brother)) + ) + (set! (-> v1-4 0 brother) (-> arg0 ppointer)) + ) + (set! (-> arg0 brother) (the-as (pointer process-tree) #f)) + ) + arg0 + ) + +(defmethod activate process ((obj process) (arg0 process-tree) (arg1 basic) (arg2 pointer)) + "Start a process!" + ;; if we got the scratchpad stack, move to the fake scratchpad. + (#when PC_PORT + (when (= arg2 *scratch-memory-top*) + (set! arg2 (&+ *fake-scratchpad-stack* (* 32 1024))) + ) + ) + (set! (-> obj mask) (logclear (-> arg0 mask) (process-mask sleep sleep-code process-tree heap-shrunk))) + + ;; inherit clock + (set! (-> obj clock) (-> arg0 clock)) + (set! (-> obj status) 'ready) + ;; get unique pid + (let ((v1-5 (-> *kernel-context* next-pid))) + (set! (-> obj pid) v1-5) + (set! (-> *kernel-context* next-pid) (+ v1-5 1)) + ) + (set! (-> obj top-thread) #f) + (set! (-> obj main-thread) #f) + (set! (-> obj name) (the-as string arg1)) + ;; adjust heap to leave a gap for child of process fields + (let ((v1-10 (&-> obj stack (-> obj type heap-base)))) + (set! (-> obj heap-cur) v1-10) + (set! (-> obj heap-base) v1-10) + ) + (set! (-> obj stack-frame-top) #f) + ;; clear the heap + (mem-set32! (-> obj stack) (the-as int (shr (-> obj type heap-base) 2)) 0) + (set! (-> obj trans-hook) #f) + (set! (-> obj post-hook) #f) + (set! (-> obj event-hook) #f) + (set! (-> obj state) #f) + (set! (-> obj next-state) #f) + (cond + ((logtest? (-> arg0 mask) (process-mask process-tree)) + ;; spawned with a tree as the parent, which doesn't have a level/entity. So pick defaults + (set! (-> obj entity) #f) + (set! (-> obj level) *default-level*) + ) + (else + ;; parent is another process, inherit level/entity. + (set! (-> obj entity) (-> (the-as process arg0) entity)) + (set! (-> obj level) (-> (the-as process arg0) level)) + ) + ) + (set! (-> obj connection-list next1) #f) + (set! (-> obj connection-list prev1) #f) + ;; set up main thread that can be suspended. + (set! (-> obj main-thread) (new 'process 'cpu-thread obj 'code 256 arg2)) + ;; move to the active pool + (change-parent obj arg0) + ) + + +(defun run-function-in-process ((obj process) (func function) a0 a1 a2 a3 a4 a5) + "Switch to the given process and run the function. This is used to initialize a process. + The function will run until it attempts to change state. At the first attempt to change state, + this function will return. The idea is that you use this when you want to initialize a process NOW. + This will then return the value of the function you called!" + (rlet ((pp :reg r13 :type process)) + + (let ((param-array (new 'stack-no-clear 'array 'uint64 6)) + ) + ;; copy params to the stack. + + (set! (-> param-array 0) (the uint64 a0)) + (set! (-> param-array 1) (the uint64 a1)) + (set! (-> param-array 2) (the uint64 a2)) + (set! (-> param-array 3) (the uint64 a3)) + (set! (-> param-array 4) (the uint64 a4)) + (set! (-> param-array 5) (the uint64 a5)) + + (let* ((old-pp pp) + (func-val (begin + ;; set the process + (set! pp obj) + ;; set us as initializing + (set! (-> pp status) 'initialize) + ;; run! + (the object (new 'stack 'catch-frame 'initialize func param-array)) + ))) + ;; the function returned, either through a throw or through actually returning. + ;; the status will give us a clue of what happened. + (case (-> pp status) + (('initialize) + ;; we returned and didn't change status. + (set! (-> pp status) 'initialize-dead) + ;; this means we died, and we should be deactivated. + (deactivate pp) + ) + (('initialize-go) + ;; we returned with a (suspend) or (go) ? not sure + ;; either way, we're ready for next time! + (set! (-> pp status) 'waiting-to-run) + (when (eq? (-> pp pool type) dead-pool-heap) + ;; we can shrink the heap now. + (shrink-heap (the dead-pool-heap (-> pp pool)) pp) + ) + ) + (else + (format 0 "GOT UNKNOWN INIT: ~A~%" (-> pp status)) + ) + ) + ;; restore the old pp + (set! pp old-pp) + func-val + ) + ) + ) + ) + +(defun set-to-run-bootstrap () + "This function is a clever hack. + To reset a thread to running a new function, we stash the arguments as saved registers. + These are then restored by thread-resume on the next run of the kernel. + This stub remaps these saved registers to argument registers. + It also creates a return trampoline to return-from-thread-dead, so if the main thread returns, the + process is properly cleaned up by deactivate." + (declare (asm-func none) + ;;(print-asm) + ) + + (rlet ((s0 :reg rbx :type uint) + (s1 :reg rbp :type uint) + (s2 :reg r10 :type uint) + (s3 :reg r11 :type uint) + (s4 :reg r12 :type uint) + (a0 :reg rdi :type uint) ; ok + (a1 :reg rsi :type uint) ; ok + (a2 :reg rdx :type uint) ; ok + (a3 :reg rcx :type uint) ; ok + (off :reg r15 :type uint) + (a4 :reg r8 :type uint) + (a5 :reg r9 :type uint) + (temp :reg rax) + ) + + + (.mov temp return-from-thread-dead) + (.add temp off) + (.push temp) + + ;; stack is 16 + 8 aligned now + + (.mov :color #f a0 s1) + (.mov :color #f a1 s2) + (.mov :color #f a2 s3) + (.mov :color #f a3 s4) + + (.add :color #f s0 off) + (.jr :color #f s0) + + (.add a4 a4) + (.add a5 a5) + ) + + ) + + +(defun set-to-run ((thread cpu-thread) (func function) a0 a1 a2 a3 a4 a5) + "Set the given thread to call the given function with the given arguments next time it resumes. + Only for main threads. + Once the function returns, the process deactivates." + (let ((proc (-> thread process))) + (set! (-> proc status) 'waiting-to-run) + + ;; we store arguments and the function to call in saved registers + (set! (-> thread rreg 0) (the uint func)) + (set! (-> thread rreg 1) (the uint a0)) + (set! (-> thread rreg 2) (the uint a1)) + (set! (-> thread rreg 3) (the uint a2)) + (set! (-> thread rreg 4) (the uint a3)) + (set! (-> thread rreg 5) (the uint a4)) + (set! (-> thread rreg 6) (the uint a5)) + + ;; and have the thread first call set-to-run-bootstrap, which will properly call + ;; the function with the arguments and install a return trampoline for + ;; deactivating and returning to the kernel on return. + (set! (-> thread pc) (the pointer set-to-run-bootstrap)) + ;; reset sp. + (set! (-> thread sp) (-> thread stack-top)) + ) + ) + +(defmethod deactivate process-tree ((obj process-tree)) + (none) + ) + +;; The defstate macro isn't defined yet, so we do it manually. +(define dead-state + (the (state process) (new 'static 'state + :name 'dead-state + :next #f + :exit #f + :code #f + :trans #f + :post #f + :enter #f + :event #f))) + +(set! (-> dead-state code) (the (function none :behavior process) nothing)) +(define entity-deactivate-handler (the-as (function process entity-actor none) nothing)) + +(defmethod deactivate process ((obj process)) + "Kill a process." + (with-pp + ;; only if we're not already dead + (when (!= (-> obj status) 'dead) + ;; set our next-state to dead. We'll run the exit function of the current state, and it can look at this + ;; to tell that process is being killed. + (set! (-> obj next-state) dead-state) + + ;; clean up entity stuff. + (if (-> obj entity) + (entity-deactivate-handler obj (the-as entity-actor (-> obj entity))) + ) + + ;; clean up stack frames. This will run the exit function of the current state + (let ((s5-0 pp)) + ;; set process pointer to the deactivating process, to allow deactivations from another process. + (set! pp obj) + (let ((s4-0 (-> pp stack-frame-top))) + (while (the-as protect-frame s4-0) + (case (-> s4-0 type) + ((protect-frame state) + ;; run exit function! + ((-> (the-as protect-frame s4-0) exit)) + ) + ) + (set! s4-0 (-> (the-as protect-frame s4-0) next)) + ) + ) + (set! pp s5-0) + ) + + ;; clean up connection/engine stuff + (if (!= 0 (the uint process-disconnect)) + (process-disconnect obj) + ) + + ;; kill our children + (let ((v1-12 (-> obj child))) + (while v1-12 + (let ((s5-1 (-> v1-12 0 brother))) + (deactivate (-> v1-12 0)) + (set! v1-12 s5-1) + ) + ) + ) + + ;; return process memory to the pool + (return-process (-> obj pool) obj) + + ;; clear fields to avoid confusion + (set! (-> obj state) #f) + (set! (-> obj next-state) #f) + (set! (-> obj entity) #f) + (set! (-> obj pid) 0) + + ;; now we have to leave this function... + (cond + ;; if you deactivated yourself, sneak a 'dead into our status, + ;; then go back to the kernel dispatcher immediately. + ((= (-> *kernel-context* current-process) obj) + (set! (-> obj status) 'dead) + (let ((temp (the uint return-from-thread))) + (rlet ((off :reg r15 :type uint)) + (+! temp off) + (.push temp) + (.ret) + ) + ) + ) + ;; if you deactivated yourself while initializing, we should go back to + ;; the place where initialize was called in another process, not all the way back to the kernel. + ((= (-> obj status) 'initialize) + (set! (-> obj status) 'dead) + ;; the initialization code is protected in a catch block. + (throw 'initialize #f) + ) + ) + + ;; if you deactivated somebody else, just return as normal + (set! (-> obj status) 'dead) + ) + 0 + (none) + ) + ) + +;;;;;;;;;;;;;;;;;;; +;; Kernel globals +;;;;;;;;;;;;;;;;;;; + +(kmemopen global "process-buffers") + +;; set up the listener process to run functions sent from the REPL. +(let ((v0-43 (new 'global 'process "listener" 2048))) + (set! *listener-process* v0-43) + (let ((gp-0 v0-43)) + (set! (-> gp-0 status) 'ready) + (set! (-> gp-0 pid) 1) + (set! (-> gp-0 main-thread) (new 'process 'cpu-thread gp-0 'main 256 (&-> *dram-stack* 14336))) + ) + ) + +;; an always dead process used as a placeholder +(define *null-process* (new 'global 'process "null" 16)) +;; do we have visibility data? This will control warnings about actor memory +;; and choose which DGOs to load. +(define *vis-boot* #f) +;; the default clock +(define *kernel-clock* (new 'static 'clock)) +;; fixed size dead-pools. +(define *16k-dead-pool* (new 'global 'dead-pool 2 #x4000 "*16k-dead-pool*")) +(define *8k-dead-pool* (new 'global 'dead-pool 2 8192 "*8k-dead-pool*")) +(define *4k-dead-pool* (new 'global 'dead-pool 4 4096 "*4k-dead-pool*")) +;; special dead pools +(define *target-dead-pool* (new 'global 'dead-pool 2 #xc000 "*target-dead-pool*")) +(define *camera-dead-pool* (new 'global 'dead-pool 7 4096 "*camera-dead-pool*")) +(define *camera-master-dead-pool* (new 'global 'dead-pool 1 8192 "*camera-master-dead-pool*")) +;; heap dead pools +(when *debug-segment* + (define *debug-dead-pool* (new 'debug 'dead-pool-heap "*debug-dead-pool*" 768 #x100000)) + ) +(define *nk-dead-pool* (new 'global 'dead-pool-heap "*nk-dead-pool*" 768 #x181000)) +;; more special dead pools +(define *default-dead-pool* (the-as dead-pool *nk-dead-pool*)) +(define *pickup-dead-pool* (the-as dead-pool *nk-dead-pool*)) +(define *city-dead-pool* (new 'loading-level 'dead-pool-heap "*city-dead-pool*" 256 0)) +(define *dead-pool-list* '(*4k-dead-pool* + *8k-dead-pool* + *16k-dead-pool* + *nk-dead-pool* + *target-dead-pool* + *camera-dead-pool* + *camera-master-dead-pool* + ) + ) + +;; root tree node for all active processes. +(define *active-pool* (new 'global 'process-tree "active-pool")) + +;; categories within the active pool. +(change-parent (define *display-pool* (new 'global 'process-tree "display-pool")) *active-pool*) + +(change-parent (define *camera-pool* (new 'global 'process-tree "camera-pool")) *active-pool*) +(set! (-> *camera-pool* mask) (process-mask freeze pause menu progress process-tree camera)) + +(change-parent (define *target-pool* (new 'global 'process-tree "target-pool")) *active-pool*) +(set! (-> *target-pool* mask) (process-mask freeze pause menu progress process-tree)) + +(change-parent (define *entity-pool* (new 'global 'process-tree "entity-pool")) *active-pool*) +(set! (-> *entity-pool* mask) (process-mask freeze pause menu progress process-tree entity)) + +(change-parent (define *mid-pool* (new 'global 'process-tree "mid-pool")) *active-pool*) + +(change-parent (define *pusher-pool* (new 'global 'process-tree "pusher-pool")) *active-pool*) +(set! (-> *pusher-pool* mask) (process-mask freeze pause menu progress process-tree entity)) + +(change-parent (define *bg-pool* (new 'global 'process-tree "bg-pool")) *active-pool*) +(set! (-> *bg-pool* mask) (process-mask freeze pause menu progress process-tree)) + +(change-parent (define *default-pool* (new 'global 'process-tree "default-pool")) *active-pool*) +(set! (-> *default-pool* mask) (process-mask freeze pause menu progress process-tree)) + +(kmemclose) + +(defmacro ps (&key (detail #f)) + `(inspect-process-tree *active-pool* 0 0 ,detail) + ) + + diff --git a/goal_src/jak2/kernel/gstate.gc b/goal_src/jak2/kernel/gstate.gc index 664d614790..c655116b25 100644 --- a/goal_src/jak2/kernel/gstate.gc +++ b/goal_src/jak2/kernel/gstate.gc @@ -1,7 +1,511 @@ -;;-*-Lisp-*- +;-*-Lisp-*- (in-package goal) ;; name: gstate.gc ;; name in dgo: gstate ;; dgos: KERNEL +#| +Summary of state system: + +A process can be put into a state, using enter-state, or the go macro. +This will set up the process to run the appropriate handler functions defined by the state. +The state handlers are: +- enter : gets run before trans on the first time the state is used. Can be #f. Must return. +- trans : gets run before code each time the code is run. Can be #f. Must return. +- code : main thread. Can suspend. If it returns, the process dies +- exit : gets run when leaving a state. must return. +- event : not sure of the details here yet. + +You can use "go" to change the state of a process. This causes the process main thread execution to be abandoned. +If the main thread has exits/protects on the stack frame, they will be run first to clean up. + +There are several ways to "go" +- go during init: when a process is being initialized with run-function-in-process, you can "go". + this causes the run-function-in-process to return immediately, and the next time the process is dispatched + it will go into the other state. This will automatically set the process to waiting-to-run, + and shrink the process heap, if appropriate + +- go from outside the process. You can temporarily set pp to another process, and have that + process go to another state. The actual go will occur the next time the process is scheduled. + Use the go-process macro to do this. + +- go from a non-main thread in the right process. You can do a go from a temporary thread, like trans or post. + If you do it from post, the go returns and the rest of the post runs. If you do it from any other thread, the temporary thread + is immediately abandonded. Like the previous two, it will defer the actual go until the next time the + process runs. + +- go from the main thread of the main process. This causes the (-> pp state) to change, the stack frames + to be cleaned up, and the old state's exit to be called. It will reset the stack, then run the code. + Unlike the others, this means you "go" immediately. + +The compiler has two special hooks related to states: go-hook and define-state-hook. +These take care of doing a go and a state definition and properly checking types. + +The define-state-hook takes a state object and handlers and defines a global symbol +with the appropriate state type. + +The go-hook calls enter state and sets (-> proc next-state) for the given process. +It type checks the arguments for the entry function. + +|# + +(defmacro go (next-state &rest args) + "Change the state of the current process. + This will only return if this is called within the post thread. + Otherwise, execution stops here and the kernel will run the next state next time." + `(with-pp + (go-hook pp ,next-state ,@args) + ) + ) + +(defmacro go-virtual (state-name &key (proc self) &rest args) + "Same as go, but use a virtual state." + `(go (method-of-object ,proc ,state-name) ,@args) + ) + +(defmacro go-process (proc next-state &rest args) + "Make another process go." + `(with-pp + (protect (pp) + (set! pp ,proc) + (go-hook pp ,next-state ,@args) + ) + ) + ) + +;; run the given function in a process right now. +;; will return to here when: +;; - you return +;; - you deactivate +;; - you go +;; - you throw to 'initialize +(defmacro run-now-in-process (proc func &rest args) + "Run a function in another process right now." + `((the (function _varargs_ object) run-function-in-process) + ,proc ,func ,@args + ) + ) + +;; sets the main thread of the given process to run the given thing. +;; this resets the main thread stack back to the top +(defmacro run-next-time-in-process (proc func &rest args) + "Set up a process to run a function the next time it is scheduled." + `((the (function _varargs_ object) set-to-run) + (-> ,proc main-thread) ,func ,@args + ) + ) + +(defmacro process-spawn-function (proc-type func &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args) + "Start a new process that runs a function on its main thread. + Returns a pointer to the new process (or #f? on error)." + + (with-gensyms (new-proc) + `(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size)))) + (when ,new-proc + ((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name (symbol->string proc-type)) ,stack) + (run-next-time-in-process ,new-proc ,func ,@args) + (the (pointer ,proc-type) (-> ,new-proc ppointer)) + ) + ) + ) + ) + +(defmacro process-spawn (proc-type &key (init #f) &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args) + "Start a new process and run an init function on it. + Returns a pointer to the new process, or #f (or is it 0?) if something goes wrong." + + (with-gensyms (new-proc) + `(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size)))) + (when ,new-proc + ((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name `(quote ,proc-type)) ,stack) + (run-now-in-process ,new-proc ,(if init init (string->symbol (fmt #f "{}-init-by-other" proc-type))) ,@args) + (the (pointer ,proc-type) (-> ,new-proc ppointer)) + ) + ) + ) + ) + +;; display a listing of active processes. +(defmacro ps (&key (detail #f)) + `(inspect-process-tree *active-pool* 0 0 ,detail) + ) + +;; use a compile-time list to keep track of the type of an anonymous behavior. +(seval (define *defstate-type-stack* '())) +(desfun def-state-check-behavior (beh-form beh-type) + "check if code block is an anonymous behavior. needed for anonymous behaviors on defstate." + + (when (and (pair? beh-form) (eq? (first beh-form) 'behavior)) + (push! *defstate-type-stack* beh-type) + ) + ) +(defmacro clear-def-state-stack () + (set! *defstate-type-stack* '()) + `(none) + ) +;; *no-state* is just used for the compiler to know whether a handler was actually set or not +(defmacro defstate (state-name parents + &key (virtual #f) + &key (event *no-state*) + &key (enter *no-state*) + &key (trans *no-state*) + &key (exit *no-state*) + &key (code *no-state*) + &key (post *no-state*) + ) + "Define a new state!" + + (with-gensyms (new-state) + (let ((defstate-type (first parents))) + (when (not (null? *defstate-type-stack*)) + (fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}" + *defstate-type-stack*) + ) + (set! *defstate-type-stack* '()) + ;; check for default handlers + (let ((default-handlers (assoc defstate-type *default-state-handlers*))) + (when (not (null? default-handlers)) + ;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers) + ;; event + (set! default-handlers (cadr default-handlers)) + (when (and (eq? event '*no-state*) (car default-handlers)) + (set! event (car default-handlers))) + ;; enter + (set! default-handlers (cdr default-handlers)) + (when (and (eq? enter '*no-state*) (car default-handlers)) + (set! enter (car default-handlers))) + ;; trans + (set! default-handlers (cdr default-handlers)) + (when (and (eq? trans '*no-state*) (car default-handlers)) + (set! trans (car default-handlers))) + ;; exit + (set! default-handlers (cdr default-handlers)) + (when (and (eq? exit '*no-state*) (car default-handlers)) + (set! exit (car default-handlers))) + ;; code + (set! default-handlers (cdr default-handlers)) + (when (and (eq? code '*no-state*) (car default-handlers)) + (set! code (car default-handlers))) + ;; post + (set! default-handlers (cdr default-handlers)) + (when (and (eq? post '*no-state*) (car default-handlers)) + (set! post (car default-handlers))) + + (set! default-handlers (cdr default-handlers)) + ) + ) + (def-state-check-behavior event defstate-type) + (def-state-check-behavior enter defstate-type) + (def-state-check-behavior trans defstate-type) + (def-state-check-behavior exit defstate-type) + (def-state-check-behavior code defstate-type) + (def-state-check-behavior post defstate-type) + `(let ((,new-state (new 'static 'state + :name (quote ,state-name) + :next #f + :exit #f + :code #f + :trans #f + :post #f + :enter #f + :event #f + ) + )) + ;; the compiler will set the fields of the given state and define the symbol. + ;; This way it can check the individual function types, make sure they make sense, and create + ;; a state with the appropriate type. + ,(if virtual + `(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post) + `(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post) + ) + + ) + ) + ) + ) + +(defmacro behavior (bindings &rest body) + "Define an anonymous behavior for a process state. This may only be used inside a defstate!" + + (let ((behavior-type (first *defstate-type-stack*))) + (pop! *defstate-type-stack*) + `(lambda :behavior ,behavior-type ,bindings ,@body) + ) + ) + +;; set the default handler functions for a process's state handlers +(seval (define *default-state-handlers* '())) +(defmacro defstatehandler (proc + &key (event #f) + &key (enter #f) + &key (trans #f) + &key (exit #f) + &key (code #f) + &key (post #f)) + (let ((old (assoc proc *default-state-handlers*)) + (new (list proc (list event enter trans exit code post)))) + (if (null? old) + (append!! *default-state-handlers* new) ;; add new set of default handlers + (dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones + (when (eq? (car hnd) old) + (set-car! hnd new) + ) + ) + ) + ) + `(none) + ) + +(defmethod new state + ((allocation symbol) + (type-to-make type) + (name symbol) + (code function) + (trans (function none)) + (enter function) + (exit (function none)) + (event (function process int symbol event-message-block object))) + "Allocate a new state. It seems like this isn't really used much and most states are + statically allocated and as a result don't have the constructor called." + (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> obj name) name) + (set! (-> obj next) #f) + (set! (-> obj exit) exit) + (set! (-> obj code) code) + (set! (-> obj trans) trans) + (set! (-> obj post) #f) + (set! (-> obj enter) enter) + (set! (-> obj event) event) + obj + ) + ) + +(defun inherit-state ((child state) (parent state)) + "Copy handler functions from parent to child" + (cond + ((nonzero? parent) + (set! (-> child exit) (-> parent exit)) + (set! (-> child code) (-> parent code)) + (set! (-> child trans) (-> parent trans)) + (set! (-> child post) (-> parent post)) + (set! (-> child enter) (-> parent enter)) + (set! (-> child event) (-> parent event)) + ) + (else + ;; Note: this is added to let us defstate on a child before the parent. + ;; The child won't be usable like this, but it will prevent a crash. + (format 0 "[STATE ERROR] inherit-state got a null parent state. Child is ~A~%" (-> child name)) + ) + ) + + child + ) + +(defmethod print state ((obj state)) + "Print a state." + (format '#t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj) + obj + ) + +(define-extern enter-state (function object object object object object object object)) +(defun enter-state (arg0 arg1 arg2 arg3 arg4 arg5) + "Make the process stored in pp enter the state in pp next-state" + (with-pp + ;; unsleep us + (process-mask-clear! (-> pp mask) sleep sleep-code) + ;; mark as going + (process-mask-set! (-> pp mask) going) + (cond + ((= (-> pp status) 'initialize) + ;; did a go during initialize. + ;; remove the old trans hook, if there was one + (set! (-> pp trans-hook) #f) + ;; set us up to run enter-state again, the next time we're scheduled. + (set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5) + ;; tell the kernel that we did a go during init + (set! (-> pp status) 'initialize-go) + ;; abandon this thread, go back to what initialized us! + (throw 'initialize #t) + #t + ) + ((!= (-> *kernel-context* current-process) pp) + ;; we aren't actually in process pp right now. + ;; so set us up to go in the next run + (let ((status-backup (-> pp status))) + (set! (-> pp trans-hook) #f) + ;; will set waiting-to-run + (set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5) + ;; restore the old status. + (set! (-> pp status) status-backup) + #t + ) + ) + ((= (-> pp main-thread) (-> pp top-thread)) + ;; we are in the right process, and in the main thread! + ;; we will do a nonlocal control transfer to the new state's code. + ;; the new state can then suspend and get back to the kernel dispatcher lambda + ;; like normal. + + ;; change state! + (set! (-> pp state) (-> pp next-state)) + + ;; do exits + (let ((frame (-> pp stack-frame-top))) + (while frame + (case (-> frame type) + ((protect-frame state) + ((-> (the-as protect-frame frame) exit)) + ) + ) + (set! frame (-> frame next)) + ) + ) + + ;; done with going, clear the mask + (process-mask-clear! (-> pp mask) going) + + ;; now, update the process: + (let ((new-state (-> pp state))) + ;; event hook from the current state + (set! (-> pp event-hook) (-> new-state event)) + ;; if we have an exit, push it onto the stack frame + ;; and also blow away the old stack frame + (if (-> new-state exit) + (set! (-> pp stack-frame-top) new-state) + (set! (-> pp stack-frame-top) #f) + ) + (set! (-> pp post-hook) (-> new-state post)) + (set! (-> pp trans-hook) (-> new-state trans)) + + + ;; start up the new state. First run the enter function + (let ((enter-func (-> new-state enter))) + (if enter-func + ((the (function _varargs_ none) enter-func) arg0 arg1 arg2 arg3 arg4 arg5) + ) + ) + + ;; run the trans function before the code. + (let ((trans-func (-> new-state trans))) + (if trans-func + (trans-func) + ) + ) + ;; now we run the code, but in a tricky way. + ;; we need to: + ;; - make sure that when this code returns, we do a deactivate + ;; - reset the stack to the top, so we can't just call the code. + (rlet ((temp) + (func) + (sp :reg rsp :type uint) + (off :reg r15 :type uint) + (carg0 :reg rdi) + (carg1 :reg rsi) + (carg2 :reg rdx) + (carg3 :reg rcx)) + ;; prepare args + ;; compiler will likely have these on the stack, we need to get them in regs + ;; before messing with the stack. + (.mov carg0 arg0) + (.mov carg1 arg1) + (.mov carg2 arg2) + (.mov carg3 arg3) + + ;; get the main code as an x86-64 pointer + (.mov func (-> new-state code)) + (.add func off) + ;; reset the stack (scary) + (.mov sp (-> pp main-thread stack-top)) + (.add sp off) + ;; push the return trampoline for when code returns. + (.mov temp return-from-thread-dead) ;; will deactivate + (.add temp off) + (.push temp) + ;; and call! + (.jr func) + ;; stupid hack so the compiler doesn't throw away these registers. + (.add carg0 carg1) + (.add carg2 carg3) + #f ;; can't get here + ) + ) + ) + (else + ;; not in the main-thread. + ;; so we set up the main thread to try again. + (set! (-> pp trans-hook) #f) + (set-to-run (-> pp main-thread) + enter-state arg0 arg1 arg2 arg3 arg4 arg5) + (when (!= (-> pp top-thread name) 'post) + ;; abandon this one too. + ;; NOTE - this is different from GOAL. + ;; GOAL installs this as the return address for this function and returns normally. + ;; but we don't because I don't have an easy way to find where to stick this. + ;; I can't see how this makes a difference, as all non-main threads seem + ;; temporary, but if this turns out to be false, we will need to change this. + (rlet ((temp) + (off :reg r15 :type uint :reset-here #t)) + (.mov temp return-from-thread) ;; could probably just call this... + (.add temp off) + (.push temp) + (.ret) + #f ;; can't get here + ) + ) + ) + ) + ) + ) + +(kmemopen global "event-queue") + +(let ((v1-3 (new 'global 'event-message-block-array 64))) + (set! (-> v1-3 length) 0) + (define *event-queue* v1-3) + ) + +(kmemclose) + +(defun send-event-function ((arg0 process-tree) (arg1 event-message-block)) + "Send an event block to a process." + (with-pp + (when (and arg0 (!= (-> arg0 type) process-tree) (-> (the-as process arg0) event-hook) (-> arg1 from)) + (let ((gp-0 pp)) + (set! pp (the-as process arg0)) + (let ((v0-0 ((-> (the-as process arg0) event-hook) (-> arg1 from 0) (-> arg1 num-params) (-> arg1 message) arg1))) + (set! pp gp-0) + v0-0 + ) + ) + ) + ) + ) + +(defmethod send-all! event-message-block-array ((obj event-message-block-array)) + "Send all pending messages. Will only do the send if both the sender and receiver are still alive." + (dotimes (s5-0 (-> obj length)) + (let* ((a1-0 (-> obj data s5-0)) + (a0-2 (handle->process (-> a1-0 to-handle))) + ) + (if (and a0-2 (handle->process (-> a1-0 form-handle))) + (send-event-function a0-2 a1-0) + ) + ) + ) + (set! (-> obj length) 0) + 0 + (none) + ) + +(defun looping-code () + "Function which calls suspend in a loop. Can be used to create a thread that does nothing." + (until #f + (suspend) + ) + #f + ) + + + + diff --git a/goal_src/jak2/kernel/gstring-h.gc b/goal_src/jak2/kernel/gstring-h.gc index 7b3331ed05..be82621eb9 100644 --- a/goal_src/jak2/kernel/gstring-h.gc +++ b/goal_src/jak2/kernel/gstring-h.gc @@ -5,3 +5,10 @@ ;; name in dgo: gstring-h ;; dgos: KERNEL +(define-extern *string-tmp-str* string) +(define-extern *temp-string* string) +(define-extern *stdcon0* string) +(define-extern *stdcon1* string) +(define-extern *stdcon* string) +(define-extern *debug-draw-pauseable* symbol) +(define-extern string= (function string string symbol)) diff --git a/goal_src/jak2/kernel/gstring.gc b/goal_src/jak2/kernel/gstring.gc index 6abdec3321..5e69927e12 100644 --- a/goal_src/jak2/kernel/gstring.gc +++ b/goal_src/jak2/kernel/gstring.gc @@ -5,3 +5,785 @@ ;; name in dgo: gstring ;; dgos: KERNEL +(defmethod length string ((obj string)) + "Get the length of a string. Like strlen" + (let ((v1-0 (-> obj data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (&- v1-0 (the-as uint (-> obj data))) + ) + ) + +(defmethod asize-of string ((obj string)) + "get the size in bytes of a string." + (+ (-> obj allocated-length) 1 (-> string size)) + ) + +(defun copy-string<-string ((arg0 string) (arg1 string)) + "Copy data from one string to another, like strcpy" + (let ((v1-0 (-> arg0 data))) + (let ((a1-1 (-> arg1 data))) + (while (nonzero? (-> a1-1 0)) + (set! (-> v1-0 0) (-> a1-1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! a1-1 (&-> a1-1 1)) + ) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +(defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string)) + "Create a new string of the given size. If other is not #f, copy data from it." + (cond + (arg1 + (let* ((s2-1 (max (length arg1) arg0)) + (a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size)))) + ) + (set! (-> a0-4 allocated-length) s2-1) + (copy-string<-string a0-4 arg1) + ) + ) + (else + (let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size))))) + (set! (-> v0-2 allocated-length) arg0) + v0-2 + ) + ) + ) + ) + +(defun string= ((arg0 string) (arg1 string)) + "Does str-a hold the same data as str-b?. + If either string is null, returns #f." + (let ((a2-0 (-> arg0 data)) + (v1-0 (-> arg1 data)) + ) + (if (or (zero? arg0) (zero? arg1)) + (return #f) + ) + (while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0))) + (if (!= (-> a2-0 0) (-> v1-0 0)) + (return #f) + ) + (set! a2-0 (&-> a2-0 1)) + (set! v1-0 (&-> v1-0 1)) + ) + (and (zero? (-> a2-0 0)) (zero? (-> v1-0 0))) + ) + ) + +(defun string-prefix= ((arg0 string) (arg1 string)) + "Is the first string a prefix of the second? (string-prefix= 'foo' 'foobar') = #t" + (let ((v1-0 (-> arg0 data))) + (let ((a2-0 (-> arg1 data))) + (if (or (zero? arg0) (zero? arg1)) + (return #f) + ) + (while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0))) + (if (!= (-> v1-0 0) (-> a2-0 0)) + (return #f) + ) + (set! v1-0 (&-> v1-0 1)) + (set! a2-0 (&-> a2-0 1)) + ) + ) + (zero? (-> v1-0 0)) + ) + ) + +(defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8))) + "Is the first cstring a prefix of the second?" + (while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0))) + (if (!= (-> arg0 0) (-> arg1 0)) + (return #f) + ) + (set! arg0 (&-> arg0 1)) + (set! arg1 (&-> arg1 1)) + ) + (zero? (-> arg0 0)) + ) + +(defun string-suffix= ((arg0 string) (arg1 string)) + "Is the _second_ string a suffix of the first?" + (let ((s5-0 (-> arg0 data)) + (gp-0 (-> arg1 data)) + ) + (if (or (zero? arg0) (zero? arg1)) + (return #f) + ) + (let ((s4-0 (length arg0)) + (v1-5 (length arg1)) + ) + (if (< s4-0 v1-5) + (return #f) + ) + (let ((v1-7 (&+ s5-0 (- s4-0 v1-5)))) + (while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0))) + (if (!= (-> v1-7 0) (-> gp-0 0)) + (return #f) + ) + (set! v1-7 (&-> v1-7 1)) + (set! gp-0 (&-> gp-0 1)) + ) + (zero? (-> v1-7 0)) + ) + ) + ) + ) + +(defun string-position ((arg0 string) (arg1 string)) + "Find the position of the first string in the second." + (let ((s5-0 0) + (s4-0 (-> arg1 data)) + ) + (while (nonzero? (-> s4-0 0)) + (if (charp-prefix= (-> arg0 data) s4-0) + (return s5-0) + ) + (+! s5-0 1) + (set! s4-0 (&-> s4-0 1)) + ) + ) + -1 + ) + +(defun string-charp= ((arg0 string) (arg1 (pointer uint8))) + "Is the data in str equal to the C string charp?" + (let ((v1-0 (-> arg0 data))) + (while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0))) + (if (!= (-> v1-0 0) (-> arg1 0)) + (return #f) + ) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (and (zero? (-> v1-0 0)) (zero? (-> arg1 0))) + ) + ) + +;; definition for function name= +;; ERROR: function was not converted to expressions. Cannot decompile. +(defun name= ((arg0 object) (arg1 object)) + "Do arg0 and arg1 have the same name? + This can use either strings or symbols" + (cond + ((= arg0 arg1) + ;; Either same symbols, or same string objects, fast check pass! + #t) + ((and (= (rtype-of arg0) string) (= (rtype-of arg1) string)) + (string= (the-as string arg0) (the-as string arg1)) + ) + ((and (= (rtype-of arg0) string) (= (rtype-of arg1) symbol)) + (string= (the-as string arg0) (symbol->string arg1)) + ) + ((and (= (rtype-of arg1) string) (= (rtype-of arg0) symbol)) + (string= (the-as string arg1) (symbol->string arg0)) + ) + ;; no need to check symbol - symbol, that would have passed the first check. + ) + ) + + +(defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int)) + "Copy data from a charp to a GOAL string. Copies len chars, plus a null." + (let ((v1-0 (-> arg0 data))) + (dotimes (a3-0 arg2) + (set! (-> v1-0 0) (-> arg1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +(defun string<-charp ((arg0 string) (arg1 (pointer uint8))) + "Copy all chars from a char* to a GOAL string. + Does NO length checking." + (let ((v1-0 (-> arg0 data))) + (while (nonzero? (-> arg1 0)) + (set! (-> v1-0 0) (-> arg1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +(defun charp<-string ((arg0 (pointer uint8)) (arg1 string)) + "Copy a GOAL string into a character array." + (let ((v1-0 (-> arg1 data))) + (while (nonzero? (-> v1-0 0)) + (set! (-> arg0 0) (-> v1-0 0)) + (set! arg0 (&-> arg0 1)) + (set! v1-0 (&-> v1-0 1)) + ) + ) + (set! (-> arg0 0) (the-as uint 0)) + 0 + ) + +(defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int)) + "Copy n chars from string to character array." + (let ((v1-0 (-> arg1 data))) + (while (and (nonzero? (-> v1-0 0)) (< 1 arg2)) + (set! (-> arg0 0) (-> v1-0 0)) + (set! arg0 (&-> arg0 1)) + (set! v1-0 (&-> v1-0 1)) + (set! arg2 (+ arg2 -1)) + ) + ) + (while (> arg2 0) + (set! (-> arg0 0) (the-as uint 0)) + (set! arg0 (&-> arg0 1)) + (set! arg2 (+ arg2 -1)) + ) + 0 + (none) + ) + +(defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8))) + "C string copy." + (while (nonzero? (-> arg1 0)) + (set! (-> arg0 0) (-> arg1 0)) + (set! arg0 (&-> arg0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> arg0 0) (the-as uint 0)) + arg0 + ) + +(defun cat-string<-string ((arg0 string) (arg1 string)) + "Append b to a. No length checks" + (let ((v1-0 (-> arg0 data))) + (let ((a1-1 (-> arg1 data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (while (nonzero? (-> a1-1 0)) + (set! (-> v1-0 0) (-> a1-1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! a1-1 (&-> a1-1 1)) + ) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +(defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int)) + "Append b to a, exactly len chars" + (let ((v1-0 (-> arg0 data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (dotimes (a3-2 arg2) + (set! (-> v1-0 0) (-> arg1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +(defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (pointer uint8))) + "Append b to a, using chars of b up to (and including) the one pointed to by end-ptr, + or, until the end of b, whichever comes first." + (let ((v1-0 (-> arg1 data)) + (v0-0 (-> arg0 data)) + ) + (while (nonzero? (-> v0-0 0)) + (nop!) + (nop!) + (nop!) + (set! v0-0 (&-> v0-0 1)) + ) + (while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0))) + (set! (-> v0-0 0) (-> v1-0 0)) + (set! v0-0 (&-> v0-0 1)) + (set! v1-0 (&-> v1-0 1)) + ) + (set! (-> v0-0 0) (the-as uint 0)) + v0-0 + ) + ) + +(defun append-character-to-string ((arg0 string) (arg1 uint8)) + "Append char to the end of the given string." + (let ((v1-0 (-> arg0 data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (set! (-> v1-0 0) (the-as uint arg1)) + (set! (-> v1-0 1) (the-as uint 0)) + ) + 0 + 0 + ) + +(defun charp-basename ((arg0 (pointer uint8))) + "Like basename in C" + (let ((v1-0 arg0)) + (while (nonzero? (-> v1-0 0)) + (set! v1-0 (&-> v1-0 1)) + ) + (while (< (the-as int arg0) (the-as int v1-0)) + (set! v1-0 (&-> v1-0 -1)) + (if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92)) + (return (&-> v1-0 1)) + ) + ) + ) + arg0 + ) + +(defun clear ((arg0 string)) + "Make string empty" + (set! (-> arg0 data 0) (the-as uint 0)) + arg0 + ) + +;; NOTE: these string comparisons are a little broken. +;; ex: (string arg0 data v1-4) (-> arg1 data v1-4)) + (return #t) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #f) + ) + ) + ) + ) + #f + ) + +(defun string>? ((arg0 string) (arg1 string)) + "In dictionary order, is a > b?" + (let ((s4-1 (min (length arg0) (length arg1)))) + (dotimes (v1-4 s4-1) + (cond + ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) + (return #f) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #t) + ) + ) + ) + ) + #f + ) + +(defun string<=? ((arg0 string) (arg1 string)) + (let ((s4-1 (min (length arg0) (length arg1)))) + (dotimes (v1-4 s4-1) + (cond + ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) + (return #t) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #f) + ) + ) + ) + ) + #t + ) + +(defun string>=? ((arg0 string) (arg1 string)) + (let ((s4-1 (min (length arg0) (length arg1)))) + (dotimes (v1-4 s4-1) + (cond + ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) + (return #f) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #t) + ) + ) + ) + ) + #t + ) + +;; temporary string for argument functions +(define *string-tmp-str* (new 'global 'string 128 (the-as string #f))) + +(defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint)) + "Return pointer to first instance of char in C string, or to the null terminator if none" + (while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1)) + (set! arg0 (&-> arg0 1)) + ) + arg0 + ) + +(defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint)) + "Append append-str to the end of base-str, up to the last occurance of char in append-str" + (let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3))) + (let ((v1-0 (string-skip-to-char (-> arg1 data) arg2))) + (when (= (-> v1-0 0) arg2) + (until (!= (-> v1-0 0) arg2) + (set! s4-0 v1-0) + (set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2)) + ) + ) + ) + (cat-string<-string_to_charp arg0 arg1 s4-0) + ) + ) + +(defun string-skip-whitespace ((arg0 (pointer uint8))) + "Skip over spaces, tabs, r's and n's" + ;; 32 = space + ;; 9 = \t + ;; 13 = \r + ;; 10 = \n + (while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10))) + (set! arg0 (&-> arg0 1)) + ) + arg0 + ) + +(defun string-suck-up! ((arg0 string) (arg1 (pointer uint8))) + "Remove character between the start of string and location. + The char pointed to by location is now the first." + (when (!= arg1 (-> arg0 data)) + (let ((v1-2 (-> arg0 data))) + (while (nonzero? (-> arg1 0)) + (set! (-> v1-2 0) (-> arg1 0)) + (set! v1-2 (&-> v1-2 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-2 0) (the-as uint 0)) + ) + 0 + ) + #f + ) + +(defun string-strip-leading-whitespace! ((arg0 string)) + "Remove whitespace at the front of a string" + (let ((a1-0 (string-skip-whitespace (-> arg0 data)))) + (string-suck-up! arg0 a1-0) + ) + #f + ) + +(defun string-strip-trailing-whitespace! ((arg0 string)) + "Remove whitespace at the end of a string" + (when (nonzero? (length arg0)) + (let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1)))) + (while (and (>= (the-as int v1-6) (the-as int (-> arg0 data))) + (or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10)) + ) + (set! v1-6 (&-> v1-6 -1)) + ) + (set! (-> v1-6 1) (the-as uint 0)) + ) + 0 + ) + #f + ) + +(defun string-strip-whitespace! ((arg0 string)) + "Remove whitespace at the beginning and end of a string" + (string-strip-trailing-whitespace! arg0) + (string-strip-leading-whitespace! arg0) + #f + ) + +(defun string-upcase ((arg0 string) (arg1 string)) + "Uppercase the given string." + (let* ((a0-1 (-> arg0 data)) + (a3-0 (-> a0-1 0)) + (a2-0 1) + (v1-0 0) + ) + (while (nonzero? a3-0) + (if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0)) + (+! a3-0 -32) + ) + (set! (-> arg1 data v1-0) a3-0) + (set! a3-0 (-> a0-1 a2-0)) + (+! a2-0 1) + (+! v1-0 1) + ) + (set! (-> arg1 data v1-0) (the-as uint 0)) + ) + 0 + (none) + ) + +(defun string-get-arg!! ((arg0 string) (arg1 string)) + "Get the first argument from a whitespace separated list of arguments. + The arguments can be in quotes or not. + Removes argument from arg string, sucks up white space before the next one + Outputs argument to a-str." + + (let ((s4-0 (string-skip-whitespace (-> arg1 data)))) + (cond + ((= (-> s4-0 0) 34) + (let ((s4-1 (&-> s4-0 1))) + (let ((v1-3 s4-1)) + (while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34)) + (set! s4-1 (&-> s4-1 1)) + ) + (copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3))) + ) + (if (= (-> s4-1 0) 34) + (set! s4-1 (&-> s4-1 1)) + ) + (let ((a1-3 (string-skip-whitespace s4-1))) + (string-suck-up! arg1 a1-3) + ) + ) + (return #t) + ) + ((nonzero? (-> s4-0 0)) + (let ((v1-11 s4-0)) + (while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10)) + (set! s4-0 (&-> s4-0 1)) + ) + (copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11))) + ) + (let ((a1-9 (string-skip-whitespace s4-0))) + (string-suck-up! arg1 a1-9) + ) + (return #t) + ) + ) + ) + #f + ) + +(defun string->int ((arg0 string)) + "String to int. Supports binary, hex, and decimal. Negative is implemented for decimal and hex + But I think it's broken?" + (let ((a0-1 (-> arg0 data)) + (v0-0 0) + (v1-0 #f) + ) + (cond + ((= (-> a0-1 0) 35) + (let ((a0-2 (&-> a0-1 1))) + (cond + ((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88)) + (let ((a0-3 (&-> a0-2 1))) + (when (= (-> a0-3 1) 45) + (set! v1-0 #t) + (set! a0-3 (&-> a0-3 1)) + ) + (while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0))) + (and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0))) + (and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0))) + ) + (cond + ((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0))) + (set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16)))) + ) + ((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0))) + (set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16)))) + ) + (else + (set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16)))) + ) + ) + (set! a0-3 (&-> a0-3 1)) + ) + ) + ) + ((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66)) + (let ((a0-4 (&-> a0-2 1))) + (while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0))) + (set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2)))) + (set! a0-4 (&-> a0-4 1)) + ) + ) + ) + ) + ) + ) + (else + (when (= (-> a0-1 1) 45) + (set! v1-0 #t) + (set! a0-1 (&-> a0-1 1)) + ) + (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) + (set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0)))) + (set! a0-1 (&-> a0-1 1)) + ) + ) + ) + (cond + (v1-0 + (- v0-0) + ) + (else + (empty) + v0-0 + ) + ) + ) + ) + +(defun string->float ((arg0 string)) + "They implemented it!" + (let ((a0-1 (-> arg0 data)) + (f0-0 0.0) + (v1-0 #f) + ) + (when (= (-> a0-1 0) 45) + (set! v1-0 #t) + (set! a0-1 (&-> a0-1 1)) + ) + (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) + (set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48)))) + (set! a0-1 (&-> a0-1 1)) + ) + (when (= (-> a0-1 0) 46) + (set! a0-1 (&-> a0-1 1)) + (let ((a2-4 #xf4240) + (a1-12 0) + ) + (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) + (+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4))) + (set! a2-4 (/ a2-4 10)) + (set! a0-1 (&-> a0-1 1)) + ) + (+! f0-0 (* 0.0000001 (the float a1-12))) + ) + ) + (when (= (-> a0-1 0) 101) + (let ((a1-16 (&-> a0-1 1)) + (f1-5 0.0) + (a0-2 #f) + ) + (cond + ((= (-> a1-16 0) 45) + (set! a0-2 #t) + (set! a1-16 (&-> a1-16 1)) + ) + ((= (-> a1-16 0) 43) + (set! a1-16 (&-> a1-16 1)) + ) + ) + (while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0))) + (set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48)))) + (set! a1-16 (&-> a1-16 1)) + ) + (when (!= f1-5 0.0) + (let ((f2-6 1.0)) + (cond + (a0-2 + (dotimes (a0-3 (the int f1-5)) + (set! f2-6 (* 0.1 f2-6)) + (nop!) + (nop!) + ) + ) + (else + (dotimes (a0-6 (the int f1-5)) + (set! f2-6 (* 10.0 f2-6)) + (nop!) + (nop!) + ) + ) + ) + (set! f0-0 (* f0-0 f2-6)) + ) + ) + ) + ) + (if v1-0 + (- f0-0) + f0-0 + ) + ) + ) + +(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string)) + "Get an int32 from a list of arguments" + (cond + ((string-get-arg!! *string-tmp-str* arg1) + (set! (-> arg0 0) (string->int *string-tmp-str*)) + #t + ) + (else + #f + ) + ) + ) + +(defun string-get-float!! ((arg0 (pointer float)) (arg1 string)) + "Get a float from a list of arguments." + (cond + ((string-get-arg!! *string-tmp-str* arg1) + (set! (-> arg0 0) (string->float *string-tmp-str*)) + #t + ) + (else + #f + ) + ) + ) + +(defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string)) + "Get a flag argument (either arg2 or arg3) from a list of arugments." + (cond + ((string-get-arg!! *string-tmp-str* arg1) + (cond + ((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3)) + (set! (-> arg0 0) (string= *string-tmp-str* arg2)) + #t + ) + (else + #f + ) + ) + ) + (else + #f + ) + ) + ) + +(kmemopen global "gstring-globals") + +(define *debug-draw-pauseable* #f) +(define *stdcon0* (new 'global 'string #x4000 (the-as string #f))) +(define *stdcon1* (new 'global 'string #x4000 (the-as string #f))) +(define *stdcon* *stdcon0*) + +;; up from 256 bytes in jak 1 +(define *temp-string* (new 'global 'string 2048 (the-as string #f))) + +(kmemclose) + + + + diff --git a/goalc/compiler/Compiler.h b/goalc/compiler/Compiler.h index 64404e4950..546583cb1d 100644 --- a/goalc/compiler/Compiler.h +++ b/goalc/compiler/Compiler.h @@ -220,6 +220,7 @@ class Compiler { bool is_structure(const TypeSpec& ts); bool is_bitfield(const TypeSpec& ts); bool is_pair(const TypeSpec& ts); + bool is_symbol(const TypeSpec& ts); std::vector get_list_as_vector(const goos::Object& o, goos::Object* rest_out = nullptr, int max_length = -1); diff --git a/goalc/compiler/Util.cpp b/goalc/compiler/Util.cpp index 0e9f9d8ea3..f4b57fd969 100644 --- a/goalc/compiler/Util.cpp +++ b/goalc/compiler/Util.cpp @@ -336,6 +336,10 @@ bool Compiler::is_pair(const TypeSpec& ts) { return m_ts.tc(m_ts.make_typespec("pair"), ts); } +bool Compiler::is_symbol(const TypeSpec& ts) { + return m_ts.tc(m_ts.make_typespec("symbol"), ts); +} + bool Compiler::get_true_or_false(const goos::Object& form, const goos::Object& boolean) { // todo try other things. if (boolean.is_symbol()) { diff --git a/goalc/compiler/compilation/Atoms.cpp b/goalc/compiler/compilation/Atoms.cpp index 3d491a129c..792c9d3d19 100644 --- a/goalc/compiler/compilation/Atoms.cpp +++ b/goalc/compiler/compilation/Atoms.cpp @@ -380,7 +380,7 @@ Val* Compiler::compile_get_symbol_value(const goos::Object& form, } auto ts = existing_symbol->second; - auto sext = m_ts.lookup_type(ts)->get_load_signed(); + auto sext = m_ts.lookup_type_allow_partial_def(ts)->get_load_signed(); auto fe = env->function_env(); auto sym = fe->alloc_val(name, m_ts.make_typespec("symbol")); auto re = fe->alloc_val(sym, ts, sext); diff --git a/goalc/compiler/compilation/Static.cpp b/goalc/compiler/compilation/Static.cpp index b3c9e3297c..a172284acc 100644 --- a/goalc/compiler/compilation/Static.cpp +++ b/goalc/compiler/compilation/Static.cpp @@ -139,7 +139,8 @@ void Compiler::compile_static_structure_inline(const goos::Object& form, deref_info.sign_extend); } - } else if (is_structure(field_info.type) || is_pair(field_info.type)) { + } else if (is_structure(field_info.type) || is_pair(field_info.type) || + is_symbol(field_info.type)) { if (is_pair(field_info.type)) { ASSERT(!field_info.field.is_inline()); } @@ -846,7 +847,12 @@ void Compiler::fill_static_array_inline(const goos::Object& form, if (is_integer(content_type)) { typecheck(form, TypeSpec("integer"), sr.typespec()); } else { - typecheck(form, content_type, sr.typespec()); + if (sr.is_symbol() && sr.symbol_name() == "#f") { + // allow #f for any structure. + typecheck(form, TypeSpec("structure"), content_type); + } else { + typecheck(form, content_type, sr.typespec()); + } } if (sr.is_symbol()) { ASSERT(deref_info.stride == 4); diff --git a/goalc/compiler/compilation/Type.cpp b/goalc/compiler/compilation/Type.cpp index c730125754..30b438a043 100644 --- a/goalc/compiler/compilation/Type.cpp +++ b/goalc/compiler/compilation/Type.cpp @@ -162,7 +162,8 @@ void Compiler::generate_field_description(const goos::Object& form, format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(form, env)); } else if (m_ts.tc(m_ts.make_typespec("basic"), f.type()) || m_ts.tc(m_ts.make_typespec("binteger"), f.type()) || - m_ts.tc(m_ts.make_typespec("pair"), f.type())) { + m_ts.tc(m_ts.make_typespec("pair"), f.type()) || + m_ts.tc(m_ts.make_typespec("symbol"), f.type())) { // basic, binteger, pair str_template += fmt::format("{}{}: ~A~%", tabs, f.name()); format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(form, env)); diff --git a/test/decompiler/reference/jak2/decompiler-macros.gc b/test/decompiler/reference/jak2/decompiler-macros.gc new file mode 100644 index 0000000000..31e1cdc975 --- /dev/null +++ b/test/decompiler/reference/jak2/decompiler-macros.gc @@ -0,0 +1,557 @@ +;; This file should contain an implementation for all macros that the decompiler uses in its output. + +(defun ash ((value int) (shift-amount int)) + "Arithmetic shift value by shift-amount. + A positive shift-amount will shift to the left and a negative will shift to the right. + " + ;; OpenGOAL does not support ash in the compiler, so we implement it here as an inline function. + (declare (inline)) + (if (> shift-amount 0) + (shl value shift-amount) + (sar value (- shift-amount)) + ) + ) + +(defmacro suspend () + '(none) + ) + +(defmacro empty-form () + '(none) + ) + +(defmacro .sync.l () + `(none)) + +(defmacro make-u128 (upper lower) + `(rlet ((result :class i128) + (upper-xmm :class i128) + (lower-xmm :class i128)) + (.mov upper-xmm ,upper) + (.mov lower-xmm ,lower) + (.pcpyld result upper-xmm lower-xmm) + (the uint result) + ) + ) + +(defmacro init-vf0-vector () + "Initializes the VF0 vector which is a constant vector in the VU set to <0,0,0,1>" + `(.lvf vf0 (new 'static 'vector :x 0.0 :y 0.0 :z 0.0 :w 1.0)) + ) + +(defconstant SYM_TO_STRING_OFFSET #xff38) +(defmacro symbol->string (sym) + "Convert a symbol to a goal string." + `(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym)))) + ) + +(defmacro new-stack-matrix0 () + "Get a new matrix on the stack that's set to zero." + `(let ((mat (new 'stack-no-clear 'matrix))) + (set! (-> mat quad 0) (the-as uint128 0)) + (set! (-> mat quad 1) (the-as uint128 0)) + (set! (-> mat quad 2) (the-as uint128 0)) + (set! (-> mat quad 3) (the-as uint128 0)) + mat + ) + ) + +(defmacro new-stack-vector0 () + "Get a stack vector that's set to 0. + This is more efficient than (new 'stack 'vector) because + this doesn't call the constructor." + `(let ((vec (new 'stack-no-clear 'vector))) + (set! (-> vec quad) (the-as uint128 0)) + vec + ) + ) + +(defmacro new-stack-quaternion0 () + "Get a stack quaternion that's set to 0. + This is more efficient than (new 'stack 'quaternion) because + this doesn't call the constructor." + `(let ((q (new 'stack-no-clear 'quaternion))) + (set! (-> q quad) (the-as uint128 0)) + q + ) + ) + + +(defmacro with-pp (&rest body) + `(rlet ((pp :reg r13 :reset-here #t :type process)) + ,@body) + ) + +(defmacro fabs (x) + `(if (< (the float ,x) 0) + (- (the float ,x)) + (the float ,x)) + ) + +(defconstant PI (the-as float #x40490fda)) +(defconstant MINUS_PI (the-as float #xc0490fda)) + +(defmacro handle->process (handle) + ;; the actual implementation is more clever than this. + ;; Checks PID. + `(let ((the-handle (the-as handle ,handle))) + (if (-> the-handle process) + (let ((proc (-> (-> the-handle process)))) + (if (= (-> the-handle pid) (-> proc pid)) + proc + ) + ) + ) + ) + ) + +(defmacro ppointer->process (ppointer) + ;; convert a (pointer process) to a process. + ;; this uses the self field, which seems to always just get set to the object. + ;; perhaps when deleting a process you could have it set self to #f? + ;; I don't see this happen anywhere though, so it's not clear. + `(let ((the-pp ,ppointer)) + (the process-tree (if the-pp (-> the-pp 0 self))) + ) + ) + +(defmacro process->ppointer (proc) + ;"safely get a (pointer process) from a process, returning #f if invalid." + `(let ((the-proc ,proc)) + (if the-proc (-> the-proc ppointer)) + ) + ) + +(defmacro ppointer->handle (pproc) + `(let ((the-process (the-as (pointer process) ,pproc))) + (new 'static 'handle :process the-process :pid (-> the-process 0 pid)) + ) + ) + +(defmacro process->handle (proc) + `(ppointer->handle (process->ppointer ,proc)) + ) + + +(defmacro defbehavior (name process-type bindings &rest body) + (if (and + (> (length body) 1) ;; more than one thing in function + (string? (first body)) ;; first thing is a string + ) + ;; then it's a docstring and we ignore it. + `(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@(cdr body))) + ;; otherwise don't ignore it. + `(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body)) + ) + ) + +(defmacro b! (pred destination &key (delay '()) &key (likely-delay '())) + "Branch!" + ;; evaluate the predicate + `(let ((should-branch ,pred)) + ;; normal delay slot: + ,delay + (when should-branch + ,likely-delay + (goto ,destination) + ) + ) + ) + + +;; meters are stored as (usually) a float, scaled by 4096. +;; this gives you reasonable accuracy as an integer. +(defglobalconstant METER_LENGTH 4096.0) + +(defmacro meters (x) + "Convert number to meters. + If the input is a constant float or integer, the result will be a + compile time constant float. Otherwise, it will not be constant. + Returns float." + + ;; we don't have enough constant propagation for the compiler to figure this out. + (cond + ((float? x) + (* METER_LENGTH x) + ) + ((integer? x) + (* METER_LENGTH x) + ) + (#t + `(* METER_LENGTH ,x) + ) + ) + ) + +;; rotations are stored in 65,536ths of a full rotation. +;; like with meters, you get a reasonable accuracy as an integer. +;; additionally, it is a power-of-two, so wrapping rotations can be done +;; quickly by converting to an int, masking, and back to float +(defglobalconstant DEGREES_PER_ROT 65536.0) + +;; this was deg in GOAL +(defmacro degrees (x) + "Convert number to degrees unit. + Will keep a constant float/int constant." + (cond + ((or (float? x) (integer? x)) + (* DEGREES_PER_ROT (/ (+ 0.0 x) 360.0)) + ) + (#t + `(* (/ (the float ,x) 360.0) + DEGREES_PER_ROT + ) + ) + ) + ) + +;; times are stored in 300ths of a second. +;; this divides evenly into frames at both 50 and 60 fps. +;; typically these are stored as integers as more precision is not useful. +;; an unsigned 32-bit integer can store about 150 days +(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps + +;; this was usec in GOAL +(defmacro seconds (x) + "Convert number to seconds unit. + Returns uint." + (cond + ((integer? x) + (* TICKS_PER_SECOND x) + ) + ((float? x) + (* 1 (* 1.0 x TICKS_PER_SECOND)) + ) + (#t + `(the uint (* TICKS_PER_SECOND ,x)) + ) + ) + ) + +(defmacro fsec (x) + "Convert number to seconds unit. + Returns float." + (cond + ((or (integer? x) (float? x)) + (* 1.0 TICKS_PER_SECOND x) + ) + (#t + `(* 1.0 TICKS_PER_SECOND ,x) + ) + ) + ) + +(fake-asm .sync.l) +(fake-asm .sync.p) +(fake-asm .mfc0 dest src) +(fake-asm .mtc0 dest src) +(fake-asm .mtpc dest src) +(fake-asm .mfpc dest src) +(fake-asm .mtdab src) +(fake-asm .mtdabm src) + +;; maybe rename to "velocity"? +(defmacro vel-tick (vel) + "turn a velocity value into a per-tick value" + `(* (/ 1.0 ,TICKS_PER_SECOND) ,vel) + ) + +(defmacro copy-and-set-field (original field-name field-value) + `(let ((temp-copy ,original)) + (set! (-> temp-copy ,field-name) ,field-value) + temp-copy + ) + ) + +(defmacro set-vector! (v xv yv zv wv) + "Set all fields in a vector" + (with-gensyms (vec) + `(let ((,vec ,v)) + (set! (-> ,vec x) ,xv) + (set! (-> ,vec y) ,yv) + (set! (-> ,vec z) ,zv) + (set! (-> ,vec w) ,wv) + ,vec + )) + ) + +;; cause the current process to change state +(defmacro go (next-state &rest args) + `(with-pp + (go-hook pp ,next-state ,@args) + ) + ) + +(defmacro go-virtual (state-name &key (proc self) &rest args) + "Change the current process to the virtual state of the given process." + `(go (method-of-object ,proc ,state-name) ,@args) + ) + +(defmacro static-sound-name (str) + "Convert a string constant to a static sound-name." + + ;; all this is done at compile-time so we can come up with 2 + ;; 64-bit constants to use + (when (> (string-length str) 16) + (error "static-sound-name got a string that is too long") + ) + (let ((lo-val 0) + (hi-val 0) + ) + (dotimes (i (string-length str)) + (if (>= i 8) + (+! hi-val (ash (string-ref str i) (* 8 (- i 8)))) + (+! lo-val (ash (string-ref str i) (* 8 i))) + ) + ) + `(new 'static 'sound-name :lo ,lo-val :hi ,hi-val) + ) + ) + +(defmacro vftoi4.xyzw (dst src) + "convert to 28.4 integer. This does the multiply while the number is still + a float. This will have issues for very large floats, but it seems like this + is how PCSX2 does it as well, so maybe it's right? + NOTE: this is the only version of the instruction used in Jak 1, so we + don't need to worry about masks." + + `(begin + (rlet ((temp :class vf)) + (set! temp 16.0) + (.mul.x.vf temp ,src temp) + (.ftoi.vf ,dst temp) + ) + ) + ) + +(defmacro vftoi12.xyzw (dst src) + "convert to 20.12 integer. This does the multiply while the number is still + a float. This will have issues for very large floats, but it seems like this + is how PCSX2 does it as well, so maybe it's right? + NOTE: this is the only version of the instruction used in Jak 1, so we + don't need to worry about masks." + + `(begin + (rlet ((temp :class vf)) + (set! temp 4096.0) + (.mul.x.vf temp ,src temp) + (.ftoi.vf ,dst temp) + ) + ) + ) + +(defmacro vftoi15.xyzw (dst src) + "convert to 17.15 integer. This does the multiply while the number is still + a float. This will have issues for very large floats, but it seems like this + is how PCSX2 does it as well, so maybe it's right? + NOTE: this is the only version of the instruction used in Jak 1, so we + don't need to worry about masks." + + `(begin + (rlet ((temp :class vf)) + (set! temp 32768.0) + (.mul.x.vf temp ,src temp) + (.ftoi.vf ,dst temp) + ) + ) + ) + +(defmacro vitof4.xyzw (dst src) + "convert from a 28.4 integer. This does the multiply while the number is still + a float. This will have issues for very large floats, but it seems like this + is how PCSX2 does it as well, so maybe it's right? + NOTE: this is the only version of the instruction used in Jak 1, so we + don't need to worry about masks." + + `(begin + (rlet ((temp :class vf)) + (set! temp 0.0625) + (.mul.x.vf temp ,src temp) + (.ftoi.vf ,dst temp) + ) + ) + ) + +(defmacro vitof12.xyzw (dst src) + "convert from a 20.12 integer. This does the multiply while the number is still + a float. This will have issues for very large floats, but it seems like this + is how PCSX2 does it as well, so maybe it's right? + NOTE: this is the only version of the instruction used in Jak 1, so we + don't need to worry about masks." + + `(begin + (rlet ((temp :class vf)) + (set! temp 0.000244140625) + (.mul.x.vf temp ,src temp) + (.ftoi.vf ,dst temp) + ) + ) + ) + +(defmacro vitof15.xyzw (dst src) + "convert from a 17.15 integer. This does the multiply while the number is still + a float. This will have issues for very large floats, but it seems like this + is how PCSX2 does it as well, so maybe it's right? + NOTE: this is the only version of the instruction used in Jak 1, so we + don't need to worry about masks." + + `(begin + (rlet ((temp :class vf)) + (set! temp 0.000030517578125) + (.mul.x.vf temp ,src temp) + (.ftoi.vf ,dst temp) + ) + ) + ) + +;; use a compile-time list to keep track of the type of an anonymous behavior. +(seval (define *defstate-type-stack* '())) +(desfun def-state-check-behavior (beh-form beh-type) + "check if code block is an anonymous behavior. needed for anonymous behaviors on defstate." + + (when (and (pair? beh-form) (eq? (first beh-form) 'behavior)) + (push! *defstate-type-stack* beh-type) + ) + ) +(defmacro clear-def-state-stack () + (set! *defstate-type-stack* '()) + `(none) + ) +;; *no-state* is just used for the compiler to know whether a handler was actually set or not +(defmacro defstate (state-name parents + &key (virtual #f) + &key (event *no-state*) + &key (enter *no-state*) + &key (trans *no-state*) + &key (exit *no-state*) + &key (code *no-state*) + &key (post *no-state*) + ) + "Define a new state!" + + (with-gensyms (new-state) + (let ((defstate-type (first parents))) + (when (not (null? *defstate-type-stack*)) + (fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}" + *defstate-type-stack*) + ) + (set! *defstate-type-stack* '()) + ;; check for default handlers + (let ((default-handlers (assoc defstate-type *default-state-handlers*))) + (when (not (null? default-handlers)) + ;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers) + ;; event + (set! default-handlers (cadr default-handlers)) + (when (and (eq? event '*no-state*) (car default-handlers)) + (set! event (car default-handlers))) + ;; enter + (set! default-handlers (cdr default-handlers)) + (when (and (eq? enter '*no-state*) (car default-handlers)) + (set! enter (car default-handlers))) + ;; trans + (set! default-handlers (cdr default-handlers)) + (when (and (eq? trans '*no-state*) (car default-handlers)) + (set! trans (car default-handlers))) + ;; exit + (set! default-handlers (cdr default-handlers)) + (when (and (eq? exit '*no-state*) (car default-handlers)) + (set! exit (car default-handlers))) + ;; code + (set! default-handlers (cdr default-handlers)) + (when (and (eq? code '*no-state*) (car default-handlers)) + (set! code (car default-handlers))) + ;; post + (set! default-handlers (cdr default-handlers)) + (when (and (eq? post '*no-state*) (car default-handlers)) + (set! post (car default-handlers))) + + (set! default-handlers (cdr default-handlers)) + ) + ) + (def-state-check-behavior event defstate-type) + (def-state-check-behavior enter defstate-type) + (def-state-check-behavior trans defstate-type) + (def-state-check-behavior exit defstate-type) + (def-state-check-behavior code defstate-type) + (def-state-check-behavior post defstate-type) + `(let ((,new-state (new 'static 'state + :name (quote ,state-name) + :next #f + :exit #f + :code #f + :trans #f + :post #f + :enter #f + :event #f + ) + )) + ;; the compiler will set the fields of the given state and define the symbol. + ;; This way it can check the individual function types, make sure they make sense, and create + ;; a state with the appropriate type. + ,(if virtual + `(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post) + `(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post) + ) + + ) + ) + ) + ) + +(defmacro behavior (bindings &rest body) + "Define an anonymous behavior for a process state. This may only be used inside a defstate!" + + (let ((behavior-type (first *defstate-type-stack*))) + (pop! *defstate-type-stack*) + `(lambda :behavior ,behavior-type ,bindings ,@body) + ) + ) + +;; set the default handler functions for a process's state handlers +(seval (define *default-state-handlers* '())) +(defmacro defstatehandler (proc + &key (event #f) + &key (enter #f) + &key (trans #f) + &key (exit #f) + &key (code #f) + &key (post #f)) + (let ((old (assoc proc *default-state-handlers*)) + (new (list proc (list event enter trans exit code post)))) + (if (null? old) + (append!! *default-state-handlers* new) ;; add new set of default handlers + (dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones + (if (eq? (car hnd) old) + (set-car! hnd new) + ) + ) + ) + ) + `(none) + ) + +(defmacro sext32 (in) + `(sar (shl ,in 32) 32) + ) + +(defmacro .sra (result in sa) + `(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa))) + ) + +(defmacro .movn (result value check original) + `(if (!= ,check 0) + (set! ,result (the-as int ,value)) + (set! ,result (the-as int ,original)) + ) + ) + +(defmacro .movz (result value check original) + `(if (= ,check 0) + (set! ,result (the-as int ,value)) + (set! ,result (the-as int ,original)) + ) + ) + +(defmacro .mfc0 (&rest stuff) + `(empty) + ) \ No newline at end of file diff --git a/test/decompiler/reference/jak2/kernel/dgo-h_REF.gc b/test/decompiler/reference/jak2/kernel/dgo-h_REF.gc new file mode 100644 index 0000000000..c3f871e888 --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/dgo-h_REF.gc @@ -0,0 +1,59 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition of type dgo-entry +(deftype dgo-entry (structure) + ((offset uint32 :offset-assert 0) + (length uint32 :offset-assert 4) + ) + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; definition for method 3 of type dgo-entry +(defmethod inspect dgo-entry ((obj dgo-entry)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj 'dgo-entry) + (format #t "~1Toffset: ~D~%" (-> obj offset)) + (format #t "~1Tlength: ~D~%" (-> obj length)) + (label cfg-4) + obj + ) + +;; definition of type dgo-file +(deftype dgo-file (basic) + ((num-go-files uint32 :offset-assert 4) + (total-length uint32 :offset-assert 8) + (rsvd uint32 :offset-assert 12) + (data uint8 :dynamic :offset-assert 16) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + +;; definition for method 3 of type dgo-file +(defmethod inspect dgo-file ((obj dgo-file)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tnum-go-files: ~D~%" (-> obj num-go-files)) + (format #t "~1Ttotal-length: ~D~%" (-> obj total-length)) + (format #t "~1Trsvd: ~D~%" (-> obj rsvd)) + (format #t "~1Tdata[0] @ #x~X~%" (-> obj data)) + (label cfg-4) + obj + ) + +;; failed to figure out what this is: +0 + + + + diff --git a/test/decompiler/reference/jak2/kernel/gcommon_REF.gc b/test/decompiler/reference/jak2/kernel/gcommon_REF.gc new file mode 100644 index 0000000000..29beb8bf1c --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/gcommon_REF.gc @@ -0,0 +1,1190 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for function identity +(defun identity ((arg0 object)) + arg0 + ) + +;; definition for function 1/ +(defun 1/ ((arg0 float)) + (/ 1.0 arg0) + ) + +;; definition for function + +(defun + ((arg0 int) (arg1 int)) + (+ arg0 arg1) + ) + +;; definition for function - +(defun - ((arg0 int) (arg1 int)) + (- arg0 arg1) + ) + +;; definition for function * +(defun * ((arg0 int) (arg1 int)) + (* arg0 arg1) + ) + +;; definition for function / +(defun / ((arg0 int) (arg1 int)) + (/ arg0 arg1) + ) + +;; definition for function ash +(defun ash ((arg0 int) (arg1 int)) + (ash arg0 arg1) + ) + +;; definition for function mod +(defun mod ((arg0 int) (arg1 int)) + (mod arg0 arg1) + ) + +;; definition for function rem +(defun rem ((arg0 int) (arg1 int)) + (mod arg0 arg1) + ) + +;; definition for function abs +(defun abs ((arg0 int)) + (abs arg0) + ) + +;; definition for function min +(defun min ((arg0 int) (arg1 int)) + (min arg0 arg1) + ) + +;; definition for function max +(defun max ((arg0 int) (arg1 int)) + (max arg0 arg1) + ) + +;; definition for function logior +(defun logior ((arg0 int) (arg1 int)) + (logior arg0 arg1) + ) + +;; definition for function logand +(defun logand ((arg0 int) (arg1 int)) + (logand arg0 arg1) + ) + +;; definition for function lognor +(defun lognor ((arg0 int) (arg1 int)) + (lognor arg0 arg1) + ) + +;; definition for function logxor +(defun logxor ((arg0 int) (arg1 int)) + (logxor arg0 arg1) + ) + +;; definition for function lognot +(defun lognot ((arg0 int)) + (lognot arg0) + ) + +;; definition for function false-func +(defun false-func () + #f + ) + +;; definition for function true-func +(defun true-func () + #t + ) + +;; definition for symbol format, type (function _varargs_ object) +(define format _format) + +;; definition of type vec4s +(deftype vec4s (uint128) + ((x float :offset 0 :size 32) + (y float :offset 32 :size 32) + (z float :offset 64 :size 32) + (w float :offset 96 :size 32) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + +;; definition for method 3 of type vec4s +(defmethod inspect vec4s ((obj vec4s)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj 'vec4s) + (format #t "~1Tx: ~f~%" (-> obj x)) + (format #t "~1Ty: ~f~%" (-> obj y)) + (format #t "~1Tz: ~f~%" (-> obj z)) + (format #t "~1Tw: ~f~%" (-> obj w)) + (label cfg-4) + obj + ) + +;; definition for method 2 of type vec4s +(defmethod print vec4s ((obj vec4s)) + (format #t "#" (-> obj x) (-> obj y) (-> obj z) (-> obj w) obj) + obj + ) + +;; definition of type vector +(deftype vector (structure) + ((data float 4 :offset-assert 0) + (x float :offset 0) + (y float :offset 4) + (z float :offset 8) + (w float :offset 12) + (quad uint128 :offset 0) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + ) + +;; definition for method 3 of type vector +;; Used lq/sq +(defmethod inspect vector ((obj vector)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj 'vector) + (format #t "~1Tdata[4] @ #x~X~%" (&-> obj x)) + (format #t "~1Tx: ~f~%" (-> obj x)) + (format #t "~1Ty: ~f~%" (-> obj y)) + (format #t "~1Tz: ~f~%" (-> obj z)) + (format #t "~1Tw: ~f~%" (-> obj w)) + (format #t "~1Tquad: ~D~%" (-> obj quad)) + (label cfg-4) + obj + ) + +;; definition of type bfloat +(deftype bfloat (basic) + ((data float :offset-assert 4) + ) + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; definition for method 3 of type bfloat +(defmethod inspect bfloat ((obj bfloat)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tdata: ~f~%" (-> obj data)) + (label cfg-4) + obj + ) + +;; definition for method 2 of type bfloat +(defmethod print bfloat ((obj bfloat)) + (format #t "~f" (-> obj data)) + obj + ) + +;; definition for method 5 of type type +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of type ((obj type)) + (the-as int (logand (the-as uint #xfffffff0) (+ (* (-> obj allocated-length) 4) 43))) + ) + +;; definition for function basic-type? +(defun basic-type? ((arg0 basic) (arg1 type)) + (let ((v1-0 (-> arg0 type)) + (a0-1 object) + ) + (until (= v1-0 a0-1) + (if (= v1-0 arg1) + (return #t) + ) + (set! v1-0 (-> v1-0 parent)) + ) + ) + #f + ) + +;; definition for function type-type? +(defun type-type? ((arg0 type) (arg1 type)) + (let ((v1-0 object)) + (if (= arg1 v1-0) + (return #t) + ) + (until (or (= arg0 v1-0) (zero? arg0)) + (if (= arg0 arg1) + (return #t) + ) + (set! arg0 (-> arg0 parent)) + ) + ) + #f + ) + +;; definition for function type? +;; WARN: Using new Jak 2 rtype-of +(defun type? ((arg0 object) (arg1 type)) + (let ((v1-0 object) + (a0-1 (rtype-of arg0)) + ) + (if (= arg1 v1-0) + (return #t) + ) + (until (or (= a0-1 v1-0) (zero? a0-1)) + (if (= a0-1 arg1) + (return #t) + ) + (set! a0-1 (-> a0-1 parent)) + ) + ) + #f + ) + +;; definition for function find-parent-method +(defun find-parent-method ((arg0 type) (arg1 int)) + (local-vars (v0-0 function)) + (let ((v1-2 (-> arg0 method-table arg1))) + (until (!= v0-0 v1-2) + (if (= arg0 object) + (return nothing) + ) + (set! arg0 (-> arg0 parent)) + (set! v0-0 (-> arg0 method-table arg1)) + (if (zero? v0-0) + (return nothing) + ) + ) + ) + v0-0 + ) + +;; definition for function ref +(defun ref ((arg0 object) (arg1 int)) + (dotimes (v1-0 arg1) + (nop!) + (nop!) + (set! arg0 (cdr arg0)) + ) + (car arg0) + ) + +;; definition for method 4 of type pair +(defmethod length pair ((obj pair)) + (local-vars (v0-0 int)) + (cond + ((null? obj) + (set! v0-0 0) + ) + (else + (let ((v1-1 (cdr obj))) + (set! v0-0 1) + (while (and (not (null? v1-1)) (pair? v1-1)) + (+! v0-0 1) + (set! v1-1 (cdr v1-1)) + ) + ) + ) + ) + v0-0 + ) + +;; definition for method 5 of type pair +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of pair ((obj pair)) + (the-as int (-> pair size)) + ) + +;; definition for function last +(defun last ((arg0 object)) + (let ((v0-0 arg0)) + (while (not (null? (cdr v0-0))) + (nop!) + (nop!) + (set! v0-0 (cdr v0-0)) + ) + v0-0 + ) + ) + +;; definition for function member +(defun member ((arg0 object) (arg1 object)) + (let ((v1-0 arg1)) + (while (not (or (null? v1-0) (= (car v1-0) arg0))) + (set! v1-0 (cdr v1-0)) + ) + (if (not (null? v1-0)) + v1-0 + ) + ) + ) + +;; definition for function nmember +(defun nmember ((arg0 basic) (arg1 object)) + (while (not (or (null? arg1) (name= (car arg1) arg0))) + (set! arg1 (cdr arg1)) + ) + (if (not (null? arg1)) + arg1 + ) + ) + +;; definition for function assoc +(defun assoc ((arg0 object) (arg1 object)) + (let ((v1-0 arg1)) + (while (not (or (null? v1-0) (= (car (car v1-0)) arg0))) + (set! v1-0 (cdr v1-0)) + ) + (if (not (null? v1-0)) + (car v1-0) + ) + ) + ) + +;; definition for function assoce +(defun assoce ((arg0 object) (arg1 object)) + (let ((v1-0 arg1)) + (while (not (or (null? v1-0) (= (car (car v1-0)) arg0) (= (car (car v1-0)) 'else))) + (set! v1-0 (cdr v1-0)) + ) + (if (not (null? v1-0)) + (car v1-0) + ) + ) + ) + +;; definition for function nassoc +(defun nassoc ((arg0 string) (arg1 object)) + (while (not (or (null? arg1) (let ((a1-1 (car (car arg1)))) + (if (pair? a1-1) + (nmember arg0 a1-1) + (name= a1-1 arg0) + ) + ) + ) + ) + (set! arg1 (cdr arg1)) + ) + (if (not (null? arg1)) + (car arg1) + ) + ) + +;; definition for function nassoce +(defun nassoce ((arg0 string) (arg1 object)) + (while (not (or (null? arg1) (let ((s4-0 (car (car arg1)))) + (if (pair? s4-0) + (nmember arg0 s4-0) + (or (name= s4-0 arg0) (= s4-0 'else)) + ) + ) + ) + ) + (set! arg1 (cdr arg1)) + ) + (if (not (null? arg1)) + (car arg1) + ) + ) + +;; definition for function append! +(defun append! ((arg0 object) (arg1 object)) + (cond + ((null? arg0) + arg1 + ) + (else + (let ((v1-1 arg0)) + (while (not (null? (cdr v1-1))) + (nop!) + (nop!) + (set! v1-1 (cdr v1-1)) + ) + (if (not (null? v1-1)) + (set! (cdr v1-1) arg1) + ) + ) + arg0 + ) + ) + ) + +;; definition for function delete! +;; INFO: Return type mismatch object vs pair. +(defun delete! ((arg0 object) (arg1 object)) + (the-as pair (cond + ((= arg0 (car arg1)) + (cdr arg1) + ) + (else + (let ((v1-1 arg1) + (a2-0 (cdr arg1)) + ) + (while (not (or (null? a2-0) (= (car a2-0) arg0))) + (set! v1-1 a2-0) + (set! a2-0 (cdr a2-0)) + ) + (if (not (null? a2-0)) + (set! (cdr v1-1) (cdr a2-0)) + ) + ) + arg1 + ) + ) + ) + ) + +;; definition for function delete-car! +(defun delete-car! ((arg0 object) (arg1 object)) + (cond + ((= arg0 (car (car arg1))) + (cdr arg1) + ) + (else + (let ((v1-2 arg1) + (a2-0 (cdr arg1)) + ) + (while (not (or (null? a2-0) (= (car (car a2-0)) arg0))) + (set! v1-2 a2-0) + (set! a2-0 (cdr a2-0)) + ) + (if (not (null? a2-0)) + (set! (cdr v1-2) (cdr a2-0)) + ) + ) + arg1 + ) + ) + ) + +;; definition for function insert-cons! +(defun insert-cons! ((arg0 object) (arg1 object)) + (let ((a3-0 (delete-car! (car arg0) arg1))) + (cons arg0 a3-0) + ) + ) + +;; definition for function sort +(defun sort ((arg0 pair) (arg1 (function object object object))) + (let ((s4-0 -1)) + (while (nonzero? s4-0) + (set! s4-0 0) + (let ((s3-0 arg0)) + (while (not (or (null? (cdr s3-0)) (not (pair? (cdr s3-0))))) + (let* ((s2-0 (car s3-0)) + (s1-0 (car (cdr s3-0))) + (v1-1 (arg1 s2-0 s1-0)) + ) + (when (and (or (not v1-1) (> (the-as int v1-1) 0)) (!= v1-1 #t)) + (+! s4-0 1) + (set! (car s3-0) s1-0) + (set! (car (cdr s3-0)) s2-0) + ) + ) + (set! s3-0 (cdr s3-0)) + ) + ) + ) + ) + arg0 + ) + +;; definition of type inline-array-class +(deftype inline-array-class (basic) + ((length int32 :offset-assert 4) + (allocated-length int32 :offset-assert 8) + (_data uint8 :dynamic :offset 16) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + (:methods + (new (symbol type int) _type_ 0) + ) + ) + +;; definition for method 3 of type inline-array-class +(defmethod inspect inline-array-class ((obj inline-array-class)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tlength: ~D~%" (-> obj length)) + (format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length)) + (label cfg-4) + obj + ) + +;; definition for method 0 of type inline-array-class +(defmethod new inline-array-class ((allocation symbol) (type-to-make type) (arg0 int)) + (let ((v0-0 (object-new + allocation + type-to-make + (the-as int (+ (-> type-to-make size) (* (the-as uint arg0) (-> type-to-make heap-base)))) + ) + ) + ) + (when (nonzero? v0-0) + (set! (-> v0-0 length) arg0) + (set! (-> v0-0 allocated-length) arg0) + ) + v0-0 + ) + ) + +;; definition for method 4 of type inline-array-class +(defmethod length inline-array-class ((obj inline-array-class)) + (-> obj length) + ) + +;; definition for method 5 of type inline-array-class +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of inline-array-class ((obj inline-array-class)) + (the-as int (+ (-> obj type size) (* (-> obj allocated-length) (the-as int (-> obj type heap-base))))) + ) + +;; definition for method 0 of type array +(defmethod new array ((allocation symbol) (type-to-make type) (arg0 type) (arg1 int)) + (let ((v0-1 (object-new + allocation + type-to-make + (the-as int (+ (-> type-to-make size) (* arg1 (if (type-type? arg0 number) + (the-as int (-> arg0 size)) + 4 + ) + ) + ) + ) + ) + ) + ) + (set! (-> v0-1 allocated-length) arg1) + (set! (-> v0-1 length) arg1) + (set! (-> v0-1 content-type) arg0) + v0-1 + ) + ) + +;; definition for method 2 of type array +;; Used lq/sq +(defmethod print array ((obj array)) + (format #t "#(") + (cond + ((type-type? (-> obj content-type) integer) + (case (-> obj content-type symbol) + (('int32) + (dotimes (s5-0 (-> obj length)) + (format + #t + (if (zero? s5-0) + "~D" + " ~D" + ) + (-> (the-as (array int32) obj) s5-0) + ) + ) + ) + (('uint32) + (dotimes (s5-1 (-> obj length)) + (format + #t + (if (zero? s5-1) + "~D" + " ~D" + ) + (-> (the-as (array uint32) obj) s5-1) + ) + ) + ) + (('int64) + (dotimes (s5-2 (-> obj length)) + (format + #t + (if (zero? s5-2) + "~D" + " ~D" + ) + (-> (the-as (array int64) obj) s5-2) + ) + ) + ) + (('uint64) + (dotimes (s5-3 (-> obj length)) + (format + #t + (if (zero? s5-3) + "#x~X" + " #x~X" + ) + (-> (the-as (array uint64) obj) s5-3) + ) + ) + ) + (('int8) + (dotimes (s5-4 (-> obj length)) + (format + #t + (if (zero? s5-4) + "~D" + " ~D" + ) + (-> (the-as (array int8) obj) s5-4) + ) + ) + ) + (('uint8) + (dotimes (s5-5 (-> obj length)) + (format + #t + (if (zero? s5-5) + "~D" + " ~D" + ) + (-> (the-as (array uint8) obj) s5-5) + ) + ) + ) + (('int16) + (dotimes (s5-6 (-> obj length)) + (format + #t + (if (zero? s5-6) + "~D" + " ~D" + ) + (-> (the-as (array int16) obj) s5-6) + ) + ) + ) + (('uint16) + (dotimes (s5-7 (-> obj length)) + (format + #t + (if (zero? s5-7) + "~D" + " ~D" + ) + (-> (the-as (array uint16) obj) s5-7) + ) + ) + ) + (('uint128 'int128) + (dotimes (s5-8 (-> obj length)) + (format + #t + (if (zero? s5-8) + "#x~X" + " #x~X" + ) + (-> (the-as (array uint128) obj) s5-8) + ) + ) + ) + (else + (dotimes (s5-9 (-> obj length)) + (format + #t + (if (zero? s5-9) + "~D" + " ~D" + ) + (-> (the-as (array int32) obj) s5-9) + ) + ) + ) + ) + ) + ((= (-> obj content-type) float) + (dotimes (s5-10 (-> obj length)) + (if (zero? s5-10) + (format #t "~f" (-> (the-as (array float) obj) s5-10)) + (format #t " ~f" (-> (the-as (array float) obj) s5-10)) + ) + ) + ) + (else + (dotimes (s5-11 (-> obj length)) + (if (zero? s5-11) + (format #t "~A" (-> (the-as (array basic) obj) s5-11)) + (format #t " ~A" (-> (the-as (array basic) obj) s5-11)) + ) + ) + ) + ) + (format #t ")") + obj + ) + +;; definition for method 3 of type array +;; Used lq/sq +(defmethod inspect array ((obj array)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Tlength: ~D~%" (-> obj length)) + (format #t "~Tcontent-type: ~A~%" (-> obj content-type)) + (format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data)) + (cond + ((and (= (logand (the-as int (-> obj content-type)) 7) 4) (type-type? (-> obj content-type) integer)) + (case (-> obj content-type symbol) + (('int32) + (dotimes (s5-0 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0)) + ) + ) + (('uint32) + (dotimes (s5-1 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) obj) s5-1)) + ) + ) + (('int64) + (dotimes (s5-2 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) obj) s5-2)) + ) + ) + (('uint64) + (dotimes (s5-3 (-> obj length)) + (format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) obj) s5-3)) + ) + ) + (('int8) + (dotimes (s5-4 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) obj) s5-4)) + ) + ) + (('uint8) + (dotimes (s5-5 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) obj) s5-5)) + ) + ) + (('int16) + (dotimes (s5-6 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) obj) s5-6)) + ) + ) + (('uint16) + (dotimes (s5-7 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) obj) s5-7)) + ) + ) + (('int128 'uint128) + (dotimes (s5-8 (-> obj length)) + (format #t "~T [~D] #x~X~%" s5-8 (-> (the-as (array uint128) obj) s5-8)) + ) + ) + (else + (dotimes (s5-9 (-> obj length)) + (format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) obj) s5-9)) + ) + ) + ) + ) + ((= (-> obj content-type) float) + (dotimes (s5-10 (-> obj length)) + (format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) obj) s5-10)) + ) + ) + (else + (dotimes (s5-11 (-> obj length)) + (format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) obj) s5-11)) + ) + ) + ) + obj + ) + +;; definition for method 4 of type array +(defmethod length array ((obj array)) + (-> obj length) + ) + +;; definition for method 5 of type array +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of array ((obj array)) + (the-as + int + (+ (-> obj type size) (* (-> obj allocated-length) (if (type-type? (-> obj content-type) number) + (the-as int (-> obj content-type size)) + 4 + ) + ) + ) + ) + ) + +;; definition for function mem-copy! +(defun mem-copy! ((arg0 pointer) (arg1 pointer) (arg2 int)) + (let ((v0-0 arg0)) + (dotimes (v1-0 arg2) + (set! (-> (the-as (pointer uint8) arg0)) (-> (the-as (pointer uint8) arg1))) + (&+! arg0 1) + (&+! arg1 1) + ) + v0-0 + ) + ) + +;; definition for function qmem-copy<-! +;; Used lq/sq +(defun qmem-copy<-! ((arg0 pointer) (arg1 pointer) (arg2 int)) + (let ((v0-0 arg0)) + (countdown (v1-1 (/ (+ arg2 15) 16)) + (set! (-> (the-as (pointer uint128) arg0)) (-> (the-as (pointer uint128) arg1))) + (&+! arg0 16) + (&+! arg1 16) + ) + v0-0 + ) + ) + +;; definition for function qmem-copy->! +;; Used lq/sq +(defun qmem-copy->! ((arg0 pointer) (arg1 pointer) (arg2 int)) + (let ((v0-0 arg0)) + (let* ((v1-1 (/ (+ arg2 15) 16)) + (a0-1 (&+ arg0 (* v1-1 16))) + (a1-1 (&+ arg1 (* v1-1 16))) + ) + (while (nonzero? v1-1) + (+! v1-1 -1) + (&+! a0-1 -16) + (&+! a1-1 -16) + (set! (-> (the-as (pointer uint128) a0-1)) (-> (the-as (pointer uint128) a1-1))) + ) + ) + v0-0 + ) + ) + +;; definition for function mem-set32! +(defun mem-set32! ((arg0 pointer) (arg1 int) (arg2 int)) + (let ((v0-0 arg0)) + (dotimes (v1-0 arg1) + (set! (-> (the-as (pointer int32) arg0)) arg2) + (&+! arg0 4) + (nop!) + ) + v0-0 + ) + ) + +;; definition for function mem-or! +(defun mem-or! ((arg0 pointer) (arg1 pointer) (arg2 int)) + (let ((v0-0 arg0)) + (dotimes (v1-0 arg2) + (logior! (-> (the-as (pointer uint8) arg0)) (-> (the-as (pointer uint8) arg1))) + (&+! arg0 1) + (&+! arg1 1) + ) + v0-0 + ) + ) + +;; definition for function quad-copy! +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function fact +(defun fact ((arg0 int)) + (if (= arg0 1) + 1 + (* arg0 (fact (+ arg0 -1))) + ) + ) + +;; definition for symbol *print-column*, type binteger +(define *print-column* (the-as binteger 0)) + +;; definition for function print +;; WARN: Using new Jak 2 rtype-of +(defun print ((arg0 object)) + ((method-of-type (rtype-of arg0) print) arg0) + ) + +;; definition for function printl +;; WARN: Using new Jak 2 rtype-of +(defun printl ((arg0 object)) + (let ((a0-1 arg0)) + ((method-of-type (rtype-of a0-1) print) a0-1) + ) + (format #t "~%") + arg0 + ) + +;; definition for function inspect +;; WARN: Using new Jak 2 rtype-of +(defun inspect ((arg0 object)) + ((method-of-type (rtype-of arg0) inspect) arg0) + ) + +;; definition (debug) for function mem-print +(defun-debug mem-print ((arg0 (pointer uint32)) (arg1 int)) + (dotimes (s4-0 (/ arg1 4)) + (format + 0 + "~X: ~X ~X ~X ~X~%" + (&-> arg0 (* s4-0 4)) + (-> arg0 (* s4-0 4)) + (-> arg0 (+ (* s4-0 4) 1)) + (-> arg0 (+ (* s4-0 4) 2)) + (-> arg0 (+ (* s4-0 4) 3)) + ) + ) + #f + ) + +;; definition for symbol *trace-list*, type pair +(define *trace-list* '()) + +;; definition for function print-tree-bitmask +(defun print-tree-bitmask ((arg0 int) (arg1 int)) + (dotimes (s4-0 arg1) + (if (zero? (logand arg0 1)) + (format #t " ") + (format #t "| ") + ) + (set! arg0 (shr arg0 1)) + ) + #f + ) + +;; definition for function breakpoint-range-set! +;; WARN: Unsupported inline assembly instruction kind - [mtc0 Debug, a0] +;; WARN: Unsupported inline assembly instruction kind - [mtdab a1] +;; WARN: Unsupported inline assembly instruction kind - [mtdabm a2] +(defun breakpoint-range-set! ((arg0 uint) (arg1 uint) (arg2 uint)) + (.mtc0 Debug arg0) + (.mtdab arg1) + (.mtdabm arg2) + 0 + ) + +;; definition for function valid? +;; WARN: Using new Jak 2 rtype-of +;; WARN: Using new Jak 2 rtype-of +;; WARN: Using new Jak 2 rtype-of +;; WARN: Using new Jak 2 rtype-of +;; WARN: Using new Jak 2 rtype-of +;; WARN: Unsupported inline assembly instruction kind - [daddu v1, v1, s7] +;; WARN: Unsupported inline assembly instruction kind - [daddu v1, v1, s7] +;; WARN: Unsupported inline assembly instruction kind - [daddu v1, v1, s7] +;; WARN: Unsupported inline assembly instruction kind - [daddu v1, v1, s7] +(defun valid? ((arg0 object) (arg1 type) (arg2 symbol) (arg3 symbol) (arg4 object)) + (local-vars (v1-11 int) (v1-26 int) (v1-56 int) (v1-60 int) (s7-0 none)) + (let ((v1-1 + (and (>= (the-as uint arg0) (the-as uint __START-OF-TABLE__)) (< (the-as uint arg0) (the-as uint #x8000000))) + ) + ) + (cond + ((not arg1) + (cond + ((logtest? (the-as int arg0) 3) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object (misaligned)~%" arg0 arg2) + ) + #f + ) + ((not v1-1) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object (bad address)~%" arg0 arg2) + ) + #f + ) + (else + #t + ) + ) + ) + ((and arg3 (not arg0)) + #t + ) + ((= arg1 structure) + (cond + ((logtest? (the-as int arg0) 15) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((or (not v1-1) (begin + (let ((v1-10 #x8000)) + (.daddu v1-11 v1-10 s7-0) + ) + (< (the-as uint arg0) (the-as uint v1-11)) + ) + ) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + (else + #t + ) + ) + ) + ((= arg1 pair) + (cond + ((not (pair? arg0)) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((not v1-1) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + (else + #t + ) + ) + ) + ((= arg1 binteger) + (cond + ((zero? (logand (the-as int arg0) 7)) + #t + ) + (else + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ) + ) + ((or (= arg1 symbol) (= arg1 boolean)) + (cond + ((zero? (logand (the-as int arg0) 1)) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((or (not v1-1) (< (the-as int arg0) (the-as int __START-OF-TABLE__)) (begin + (let ((v1-25 #x8000)) + (.daddu v1-26 v1-25 s7-0) + ) + (>= (the-as int arg0) v1-26) + ) + ) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + (else + #t + ) + ) + ) + ((!= (logand (the-as int arg0) 7) 4) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1) + ) + #f + ) + ((not v1-1) + (if arg2 + (format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1) + ) + #f + ) + ((and (= arg1 type) (!= (rtype-of arg0) type)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%" + arg0 + arg2 + arg1 + (rtype-of arg0) + ) + ) + #f + ) + ((and (!= arg1 type) (not (valid? (rtype-of arg0) type #f #t 0))) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%" + arg0 + arg2 + arg1 + (rtype-of arg0) + ) + ) + #f + ) + ((not (type? arg0 arg1)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (is type '~A' instead)~%" + arg0 + arg2 + arg1 + (rtype-of arg0) + ) + ) + #f + ) + ((= arg1 symbol) + (let ((v1-55 #x8000)) + (.daddu v1-56 v1-55 s7-0) + ) + (cond + ((>= (the-as uint arg0) (the-as uint v1-56)) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (not in symbol table)~%" + arg0 + arg2 + arg1 + ) + ) + #f + ) + (else + #t + ) + ) + ) + ((begin + (let ((v1-59 #x8000)) + (.daddu v1-60 v1-59 s7-0) + ) + (< (the-as uint arg0) (the-as uint v1-60)) + ) + (if arg2 + (format + arg4 + "ERROR: object #x~X ~S is not a valid object of type '~A' (inside symbol table)~%" + arg0 + arg2 + arg1 + ) + ) + #f + ) + (else + #t + ) + ) + ) + ) + +;; failed to figure out what this is: +0 + + + + diff --git a/test/decompiler/reference/jak2/kernel/gkernel-h_REF.gc b/test/decompiler/reference/jak2/kernel/gkernel-h_REF.gc new file mode 100644 index 0000000000..3db71075e9 --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/gkernel-h_REF.gc @@ -0,0 +1,756 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition of type kernel-context +(deftype kernel-context (basic) + ((prevent-from-run process-mask :offset-assert 4) + (require-for-run process-mask :offset-assert 8) + (allow-to-run process-mask :offset-assert 12) + (next-pid int32 :offset-assert 16) + (fast-stack-top pointer :offset-assert 20) + (current-process process :offset-assert 24) + (relocating-process basic :offset-assert 28) + (relocating-min int32 :offset-assert 32) + (relocating-max int32 :offset-assert 36) + (relocating-offset int32 :offset-assert 40) + (relocating-level level :offset-assert 44) + (low-memory-message symbol :offset-assert 48) + (login-object basic :offset-assert 52) + ) + :method-count-assert 9 + :size-assert #x38 + :flag-assert #x900000038 + ) + +;; definition for method 3 of type kernel-context +(defmethod inspect kernel-context ((obj kernel-context)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tprevent-from-run: ~D~%" (-> obj prevent-from-run)) + (format #t "~1Trequire-for-run: ~D~%" (-> obj require-for-run)) + (format #t "~1Tallow-to-run: ~D~%" (-> obj allow-to-run)) + (format #t "~1Tnext-pid: ~D~%" (-> obj next-pid)) + (format #t "~1Tfast-stack-top: #x~X~%" (-> obj fast-stack-top)) + (format #t "~1Tcurrent-process: ~A~%" (-> obj current-process)) + (format #t "~1Trelocating-process: ~A~%" (-> obj relocating-process)) + (format #t "~1Trelocating-min: #x~X~%" (-> obj relocating-min)) + (format #t "~1Trelocating-max: #x~X~%" (-> obj relocating-max)) + (format #t "~1Trelocating-offset: ~D~%" (-> obj relocating-offset)) + (format #t "~1Trelocating-level: ~A~%" (-> obj relocating-level)) + (format #t "~1Tlow-memory-message: ~A~%" (-> obj low-memory-message)) + (format #t "~1Tlogin-object: ~A~%" (-> obj login-object)) + (label cfg-4) + obj + ) + +;; definition of type time-frame +(deftype time-frame (int64) + () + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; definition of type clock +(deftype clock (basic) + ((index int32 :offset-assert 4) + (mask process-mask :offset-assert 8) + (clock-ratio float :offset-assert 12) + (accum float :offset-assert 16) + (integral-accum float :offset-assert 20) + (frame-counter time-frame :offset-assert 24) + (old-frame-counter time-frame :offset-assert 32) + (integral-frame-counter uint64 :offset-assert 40) + (old-integral-frame-counter uint64 :offset-assert 48) + (sparticle-data vector :inline :offset-assert 64) + (seconds-per-frame float :offset-assert 80) + (frames-per-second float :offset-assert 84) + (time-adjust-ratio float :offset-assert 88) + ) + :method-count-assert 15 + :size-assert #x5c + :flag-assert #xf0000005c + (:methods + (new (symbol type int) _type_ 0) + (update-rates! (_type_ float) float 9) + (advance-by! (_type_ float) clock 10) + (tick! (_type_) clock 11) + (save! (_type_ (pointer uint64)) int 12) + (load! (_type_ (pointer uint64)) int 13) + (reset! (_type_) none 14) + ) + ) + +;; definition for method 3 of type clock +(defmethod inspect clock ((obj clock)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tindex: ~D~%" (-> obj index)) + (format #t "~1Tmask: ~D~%" (-> obj mask)) + (format #t "~1Tclock-ratio: ~f~%" (-> obj clock-ratio)) + (format #t "~1Taccum: ~f~%" (-> obj accum)) + (format #t "~1Tintegral-accum: ~f~%" (-> obj integral-accum)) + (format #t "~1Tframe-counter: ~D~%" (-> obj frame-counter)) + (format #t "~1Told-frame-counter: ~D~%" (-> obj old-frame-counter)) + (format #t "~1Tintegral-frame-counter: ~D~%" (-> obj integral-frame-counter)) + (format #t "~1Told-integral-frame-counter: ~D~%" (-> obj old-integral-frame-counter)) + (format #t "~1Tsparticle-data: ~`vector`P~%" (-> obj sparticle-data)) + (format #t "~1Tseconds-per-frame: ~f~%" (-> obj seconds-per-frame)) + (format #t "~1Tframes-per-second: ~f~%" (-> obj frames-per-second)) + (format #t "~1Ttime-adjust-ratio: ~f~%" (-> obj time-adjust-ratio)) + (label cfg-4) + obj + ) + +;; definition for method 0 of type clock +(defmethod new clock ((allocation symbol) (type-to-make type) (arg0 int)) + (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> gp-0 index) arg0) + (set! (-> gp-0 frame-counter) (seconds 1000)) + (set! (-> gp-0 integral-frame-counter) (the-as uint #x493e0)) + (set! (-> gp-0 old-frame-counter) (+ (-> gp-0 frame-counter) -1)) + (set! (-> gp-0 old-integral-frame-counter) (+ (-> gp-0 integral-frame-counter) -1)) + (update-rates! gp-0 1.0) + gp-0 + ) + ) + +;; definition of type thread +(deftype thread (basic) + ((name symbol :offset-assert 4) + (process process :offset-assert 8) + (previous thread :offset-assert 12) + (suspend-hook (function cpu-thread none) :offset-assert 16) + (resume-hook (function cpu-thread none) :offset-assert 20) + (pc pointer :offset-assert 24) + (sp pointer :offset-assert 28) + (stack-top pointer :offset-assert 32) + (stack-size int32 :offset-assert 36) + ) + :method-count-assert 12 + :size-assert #x28 + :flag-assert #xc00000028 + (:methods + (stack-size-set! (_type_ int) none 9) + (thread-suspend (_type_) none 10) + (thread-resume (_type_) none 11) + ) + ) + +;; definition for method 3 of type thread +(defmethod inspect thread ((obj thread)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tprocess: ~A~%" (-> obj process)) + (format #t "~1Tprevious: ~A~%" (-> obj previous)) + (format #t "~1Tsuspend-hook: ~A~%" (-> obj suspend-hook)) + (format #t "~1Tresume-hook: ~A~%" (-> obj resume-hook)) + (format #t "~1Tpc: #x~X~%" (-> obj pc)) + (format #t "~1Tsp: #x~X~%" (-> obj sp)) + (format #t "~1Tstack-top: #x~X~%" (-> obj stack-top)) + (format #t "~1Tstack-size: ~D~%" (-> obj stack-size)) + (label cfg-4) + obj + ) + +;; definition of type cpu-thread +(deftype cpu-thread (thread) + ((rreg uint64 7 :offset-assert 40) + (freg float 8 :offset-assert 96) + (stack uint8 :dynamic :offset-assert 128) + ) + :method-count-assert 12 + :size-assert #x80 + :flag-assert #xc00000080 + (:methods + (new (symbol type process symbol int pointer) _type_ 0) + ) + ) + +;; definition for method 3 of type cpu-thread +(defmethod inspect cpu-thread ((obj cpu-thread)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tprocess: ~A~%" (-> obj process)) + (format #t "~1Tprevious: ~A~%" (-> obj previous)) + (format #t "~1Tsuspend-hook: ~A~%" (-> obj suspend-hook)) + (format #t "~1Tresume-hook: ~A~%" (-> obj resume-hook)) + (format #t "~1Tpc: #x~X~%" (-> obj pc)) + (format #t "~1Tsp: #x~X~%" (-> obj sp)) + (format #t "~1Tstack-top: #x~X~%" (-> obj stack-top)) + (format #t "~1Tstack-size: ~D~%" (-> obj stack-size)) + (format #t "~1Trreg[8] @ #x~X~%" (-> obj rreg)) + (format #t "~1Tfreg[6] @ #x~X~%" (&-> obj freg 2)) + (format #t "~1Tstack[0] @ #x~X~%" (-> obj stack)) + (label cfg-4) + obj + ) + +;; definition of type dead-pool +(deftype dead-pool (process-tree) + () + :method-count-assert 16 + :size-assert #x24 + :flag-assert #x1000000024 + (:methods + (new (symbol type int int string) _type_ 0) + (get-process (_type_ type int) process 14) + (return-process (_type_ process) none 15) + ) + ) + +;; definition for method 3 of type dead-pool +(defmethod inspect dead-pool ((obj dead-pool)) + (when (not obj) + (set! obj obj) + (goto cfg-68) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (let ((s5-0 (-> obj mask))) + (if (= (logand s5-0 (process-mask process-tree)) (process-mask process-tree)) + (format #t "process-tree ") + ) + (if (= (logand s5-0 (process-mask target)) (process-mask target)) + (format #t "target ") + ) + (if (= (logand (process-mask collectable) s5-0) (process-mask collectable)) + (format #t "attackable ") + ) + (if (= (logand (process-mask bit18) s5-0) (process-mask bit18)) + (format #t "collectable ") + ) + (if (= (logand (process-mask projectile) s5-0) (process-mask projectile)) + (format #t "projectile ") + ) + (if (= (logand (process-mask no-track) s5-0) (process-mask no-track)) + (format #t "no-track ") + ) + (if (= (logand s5-0 (process-mask sleep-code)) (process-mask sleep-code)) + (format #t "sleep-code ") + ) + (if (= (logand s5-0 (process-mask actor-pause)) (process-mask actor-pause)) + (format #t "actor-pause ") + ) + (if (= (logand (process-mask bot) s5-0) (process-mask bot)) + (format #t "bot ") + ) + (if (= (logand (process-mask vehicle) s5-0) (process-mask vehicle)) + (format #t "vehicle ") + ) + (if (= (logand (process-mask enemy) s5-0) (process-mask enemy)) + (format #t "enemy ") + ) + (if (= (logand (process-mask entity) s5-0) (process-mask entity)) + (format #t "entity ") + ) + (if (= (logand s5-0 (process-mask heap-shrunk)) (process-mask heap-shrunk)) + (format #t "heap-shrunk ") + ) + (if (= (logand (process-mask sidekick) s5-0) (process-mask sidekick)) + (format #t "sidekick ") + ) + (if (= (logand s5-0 (process-mask going)) (process-mask going)) + (format #t "going ") + ) + (if (= (logand s5-0 (process-mask execute)) (process-mask execute)) + (format #t "execute ") + ) + (if (= (logand (process-mask civilian) s5-0) (shl #x8000 16)) + (format #t "civilian ") + ) + (if (= (logand (process-mask death) s5-0) (process-mask death)) + (format #t "death ") + ) + (if (= (logand (process-mask guard) s5-0) (process-mask guard)) + (format #t "guard ") + ) + (if (= (logand s5-0 (process-mask no-kill)) (process-mask no-kill)) + (format #t "no-kill ") + ) + (if (= (logand (process-mask platform) s5-0) (process-mask platform)) + (format #t "platform ") + ) + (if (= (logand s5-0 (process-mask freeze)) (process-mask freeze)) + (format #t "freeze ") + ) + (if (= (logand s5-0 (process-mask sleep)) (process-mask sleep)) + (format #t "sleep ") + ) + (if (= (logand s5-0 (process-mask progress)) (process-mask progress)) + (format #t "progress ") + ) + (if (= (logand s5-0 (process-mask menu)) (process-mask menu)) + (format #t "menu ") + ) + (if (= (logand (process-mask camera) s5-0) (process-mask camera)) + (format #t "camera ") + ) + (if (= (logand (process-mask ambient) s5-0) (process-mask ambient)) + (format #t "ambient ") + ) + (if (= (logand s5-0 (process-mask dark-effect)) (process-mask dark-effect)) + (format #t "dark-effect ") + ) + (if (= (logand (process-mask crate) s5-0) (process-mask crate)) + (format #t "crate ") + ) + (if (= (logand s5-0 (process-mask kernel-run)) (process-mask kernel-run)) + (format #t "kernel-run ") + ) + (if (= (logand s5-0 (process-mask movie)) (process-mask movie)) + (format #t "movie ") + ) + (if (= (logand s5-0 (process-mask pause)) (process-mask pause)) + (format #t "pause ") + ) + ) + (format #t ")~%") + (format #t "~1Tclock: ~A~%" (-> obj clock)) + (format #t "~1Tparent: #x~X~%" (-> obj parent)) + (format #t "~1Tbrother: #x~X~%" (-> obj brother)) + (format #t "~1Tchild: #x~X~%" (-> obj child)) + (format #t "~1Tppointer: #x~X~%" (-> obj ppointer)) + (format #t "~1Tself: ~A~%" (-> obj self)) + (label cfg-68) + obj + ) + +;; definition of type dead-pool-heap-rec +(deftype dead-pool-heap-rec (structure) + ((process process :offset-assert 0) + (prev dead-pool-heap-rec :offset-assert 4) + (next dead-pool-heap-rec :offset-assert 8) + ) + :pack-me + :method-count-assert 9 + :size-assert #xc + :flag-assert #x90000000c + ) + +;; definition for method 3 of type dead-pool-heap-rec +(defmethod inspect dead-pool-heap-rec ((obj dead-pool-heap-rec)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj 'dead-pool-heap-rec) + (format #t "~1Tprocess: ~A~%" (-> obj process)) + (format #t "~1Tprev: #~%" (-> obj prev)) + (format #t "~1Tnext: #~%" (-> obj next)) + (label cfg-4) + obj + ) + +;; definition of type dead-pool-heap +(deftype dead-pool-heap (dead-pool) + ((allocated-length int32 :offset-assert 36) + (compact-time uint32 :offset-assert 40) + (compact-count-targ uint32 :offset-assert 44) + (compact-count uint32 :offset-assert 48) + (fill-percent float :offset-assert 52) + (first-gap dead-pool-heap-rec :offset-assert 56) + (first-shrink dead-pool-heap-rec :offset-assert 60) + (heap kheap :inline :offset-assert 64) + (alive-list dead-pool-heap-rec :inline :offset-assert 80) + (last dead-pool-heap-rec :offset 84) + (dead-list dead-pool-heap-rec :inline :offset-assert 92) + (process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104) + ) + :method-count-assert 28 + :size-assert #x68 + :flag-assert #x1c00000068 + (:methods + (new (symbol type string int int) _type_ 0) + (init (_type_ symbol int) none 16) + (compact (dead-pool-heap int) none 17) + (shrink-heap (dead-pool-heap process) dead-pool-heap 18) + (churn (dead-pool-heap int) none 19) + (memory-used (_type_) int 20) + (memory-total (_type_) int 21) + (memory-free (dead-pool-heap) int 22) + (compact-time (dead-pool-heap) uint 23) + (gap-size (dead-pool-heap dead-pool-heap-rec) int 24) + (gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25) + (find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26) + (find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27) + ) + ) + +;; definition for method 3 of type dead-pool-heap +;; INFO: this function exists in multiple non-identical object files +(defmethod inspect dead-pool-heap ((obj dead-pool-heap)) + (when (not obj) + (set! obj obj) + (goto cfg-68) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (let ((s5-0 (-> obj mask))) + (if (= (logand s5-0 (process-mask process-tree)) (process-mask process-tree)) + (format #t "process-tree ") + ) + (if (= (logand s5-0 (process-mask target)) (process-mask target)) + (format #t "target ") + ) + (if (= (logand (process-mask collectable) s5-0) (process-mask collectable)) + (format #t "attackable ") + ) + (if (= (logand (process-mask bit18) s5-0) (process-mask bit18)) + (format #t "collectable ") + ) + (if (= (logand (process-mask projectile) s5-0) (process-mask projectile)) + (format #t "projectile ") + ) + (if (= (logand (process-mask no-track) s5-0) (process-mask no-track)) + (format #t "no-track ") + ) + (if (= (logand s5-0 (process-mask sleep-code)) (process-mask sleep-code)) + (format #t "sleep-code ") + ) + (if (= (logand s5-0 (process-mask actor-pause)) (process-mask actor-pause)) + (format #t "actor-pause ") + ) + (if (= (logand (process-mask bot) s5-0) (process-mask bot)) + (format #t "bot ") + ) + (if (= (logand (process-mask vehicle) s5-0) (process-mask vehicle)) + (format #t "vehicle ") + ) + (if (= (logand (process-mask enemy) s5-0) (process-mask enemy)) + (format #t "enemy ") + ) + (if (= (logand (process-mask entity) s5-0) (process-mask entity)) + (format #t "entity ") + ) + (if (= (logand s5-0 (process-mask heap-shrunk)) (process-mask heap-shrunk)) + (format #t "heap-shrunk ") + ) + (if (= (logand (process-mask sidekick) s5-0) (process-mask sidekick)) + (format #t "sidekick ") + ) + (if (= (logand s5-0 (process-mask going)) (process-mask going)) + (format #t "going ") + ) + (if (= (logand s5-0 (process-mask execute)) (process-mask execute)) + (format #t "execute ") + ) + (if (= (logand (process-mask civilian) s5-0) (shl #x8000 16)) + (format #t "civilian ") + ) + (if (= (logand (process-mask death) s5-0) (process-mask death)) + (format #t "death ") + ) + (if (= (logand (process-mask guard) s5-0) (process-mask guard)) + (format #t "guard ") + ) + (if (= (logand s5-0 (process-mask no-kill)) (process-mask no-kill)) + (format #t "no-kill ") + ) + (if (= (logand (process-mask platform) s5-0) (process-mask platform)) + (format #t "platform ") + ) + (if (= (logand s5-0 (process-mask freeze)) (process-mask freeze)) + (format #t "freeze ") + ) + (if (= (logand s5-0 (process-mask sleep)) (process-mask sleep)) + (format #t "sleep ") + ) + (if (= (logand s5-0 (process-mask progress)) (process-mask progress)) + (format #t "progress ") + ) + (if (= (logand s5-0 (process-mask menu)) (process-mask menu)) + (format #t "menu ") + ) + (if (= (logand (process-mask camera) s5-0) (process-mask camera)) + (format #t "camera ") + ) + (if (= (logand (process-mask ambient) s5-0) (process-mask ambient)) + (format #t "ambient ") + ) + (if (= (logand s5-0 (process-mask dark-effect)) (process-mask dark-effect)) + (format #t "dark-effect ") + ) + (if (= (logand (process-mask crate) s5-0) (process-mask crate)) + (format #t "crate ") + ) + (if (= (logand s5-0 (process-mask kernel-run)) (process-mask kernel-run)) + (format #t "kernel-run ") + ) + (if (= (logand s5-0 (process-mask movie)) (process-mask movie)) + (format #t "movie ") + ) + (if (= (logand s5-0 (process-mask pause)) (process-mask pause)) + (format #t "pause ") + ) + ) + (format #t ")~%") + (format #t "~1Tclock: ~A~%" (-> obj clock)) + (format #t "~1Tparent: #x~X~%" (-> obj parent)) + (format #t "~1Tbrother: #x~X~%" (-> obj brother)) + (format #t "~1Tchild: #x~X~%" (-> obj child)) + (format #t "~1Tppointer: #x~X~%" (-> obj ppointer)) + (format #t "~1Tself: ~A~%" (-> obj self)) + (format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~1Tcompact-time: ~D~%" (-> obj compact-time)) + (format #t "~1Tcompact-count-targ: ~D~%" (-> obj compact-count-targ)) + (format #t "~1Tcompact-count: ~D~%" (-> obj compact-count)) + (format #t "~1Tfill-percent: ~f~%" (-> obj fill-percent)) + (format #t "~1Tfirst-gap: #~%" (-> obj first-gap)) + (format #t "~1Tfirst-shrink: #~%" (-> obj first-shrink)) + (format #t "~1Theap: #~%" (-> obj heap)) + (format #t "~1Talive-list: #~%" (-> obj alive-list)) + (format #t "~1Tlast: #~%" (-> obj alive-list prev)) + (format #t "~1Tdead-list: #~%" (-> obj dead-list)) + (format #t "~1Tprocess-list[0] @ #x~X~%" (-> obj process-list)) + (label cfg-68) + obj + ) + +;; definition of type catch-frame +(deftype catch-frame (stack-frame) + ((sp int32 :offset-assert 12) + (ra int32 :offset-assert 16) + (freg float 6 :offset-assert 20) + (rreg uint128 8 :offset-assert 48) + ) + :method-count-assert 9 + :size-assert #xb0 + :flag-assert #x9000000b0 + (:methods + (new (symbol type symbol function (pointer uint64)) object 0) + ) + ) + +;; definition for method 3 of type catch-frame +(defmethod inspect catch-frame ((obj catch-frame)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tnext: ~A~%" (-> obj next)) + (format #t "~1Tsp: #x~X~%" (-> obj sp)) + (format #t "~1Tra: #x~X~%" (-> obj ra)) + (format #t "~1Tfreg[6] @ #x~X~%" (-> obj freg)) + (format #t "~1Trreg[8] @ #x~X~%" (-> obj rreg)) + (label cfg-4) + obj + ) + +;; definition of type protect-frame +(deftype protect-frame (stack-frame) + ((exit (function none) :offset-assert 12) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + (:methods + (new (symbol type (function none)) protect-frame 0) + ) + ) + +;; definition for method 3 of type protect-frame +(defmethod inspect protect-frame ((obj protect-frame)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tnext: ~A~%" (-> obj next)) + (format #t "~1Texit: ~A~%" (-> obj exit)) + (label cfg-4) + obj + ) + +;; definition of type handle +(deftype handle (uint64) + ((process (pointer process) :offset 0 :size 32) + (pid int32 :offset 32 :size 32) + (u64 uint64 :offset 0 :size 64) + ) + :method-count-assert 9 + :size-assert #x8 + :flag-assert #x900000008 + ) + +;; definition for method 3 of type handle +(defmethod inspect handle ((obj handle)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj 'handle) + (format #t "~1Tprocess: #x~X~%" (-> obj process)) + (format #t "~1Tpid: ~D~%" (-> obj pid)) + (label cfg-4) + obj + ) + +;; definition for method 2 of type handle +(defmethod print handle ((obj handle)) + (if (nonzero? obj) + (format #t "#" (handle->process obj) (-> obj pid)) + (format #t "#") + ) + obj + ) + +;; definition of type state +(deftype state (protect-frame) + ((code function :offset-assert 16) + (trans (function none) :offset-assert 20) + (post function :offset-assert 24) + (enter function :offset-assert 28) + (event (function process int symbol event-message-block object) :offset-assert 32) + ) + :method-count-assert 9 + :size-assert #x24 + :flag-assert #x900000024 + (:methods + (new (symbol type symbol function (function none) function (function none) (function process int symbol event-message-block object)) _type_ 0) + ) + ) + +;; definition for method 3 of type state +(defmethod inspect state ((obj state)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tname: ~A~%" (-> obj name)) + (format #t "~1Tnext: ~A~%" (-> obj next)) + (format #t "~1Texit: ~A~%" (-> obj exit)) + (format #t "~1Tcode: ~A~%" (-> obj code)) + (format #t "~1Ttrans: ~A~%" (-> obj trans)) + (format #t "~1Tpost: ~A~%" (-> obj post)) + (format #t "~1Tenter: ~A~%" (-> obj enter)) + (format #t "~1Tevent: ~A~%" (-> obj event)) + (label cfg-4) + obj + ) + +;; definition of type event-message-block +(deftype event-message-block (structure) + ((to-handle handle :offset-assert 0) + (to (pointer process) :offset 0) + (form-handle handle :offset-assert 8) + (from (pointer process) :offset 8) + (param uint64 6 :offset-assert 16) + (message symbol :offset-assert 64) + (num-params int32 :offset-assert 68) + ) + :method-count-assert 9 + :size-assert #x48 + :flag-assert #x900000048 + ) + +;; definition for method 3 of type event-message-block +(defmethod inspect event-message-block ((obj event-message-block)) + (when (not obj) + (set! obj obj) + (goto cfg-8) + ) + (format #t "[~8x] ~A~%" obj 'event-message-block) + (format #t "~1Tto-handle: ~D~%" (-> obj to-handle)) + (format #t "~1Tto: ~A~%" (ppointer->process (-> obj to))) + (format #t "~1Tfrom-handle: ~D~%" (-> obj form-handle)) + (format #t "~1Tfrom: ~A~%" (ppointer->process (-> obj from))) + (format #t "~1Tparam[6] @ #x~X~%" (-> obj param)) + (format #t "~1Tmessage: ~A~%" (-> obj message)) + (format #t "~1Tnum-params: ~D~%" (-> obj num-params)) + (label cfg-8) + obj + ) + +;; definition of type event-message-block-array +(deftype event-message-block-array (inline-array-class) + ((data event-message-block :inline :dynamic :offset-assert 16) + ) + :method-count-assert 10 + :size-assert #x10 + :flag-assert #xa00000010 + (:methods + (send-all! (_type_) none 9) + ) + ) + +;; definition for method 3 of type event-message-block-array +(defmethod inspect event-message-block-array ((obj event-message-block-array)) + (when (not obj) + (set! obj obj) + (goto cfg-4) + ) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~1Tlength: ~D~%" (-> obj length)) + (format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~1Tdata[0] @ #x~X~%" (-> obj data)) + (label cfg-4) + obj + ) + +;; failed to figure out what this is: +(set! (-> event-message-block-array heap-base) (the-as uint 80)) + +;; definition of type sql-result +(deftype sql-result (basic) + ((len int32 :offset-assert 4) + (allocated-length uint32 :offset-assert 8) + (error symbol :offset-assert 12) + (data symbol :dynamic :offset-assert 16) + ) + :method-count-assert 9 + :size-assert #x10 + :flag-assert #x900000010 + (:methods + (new (symbol type uint) _type_ 0) + ) + ) + +;; definition for method 0 of type sql-result +(defmethod new sql-result ((allocation symbol) (type-to-make type) (arg0 uint)) + (let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* arg0 4)))))) + (set! (-> v0-0 allocated-length) arg0) + (set! (-> v0-0 error) 'error) + v0-0 + ) + ) + +;; definition for method 2 of type sql-result +(defmethod print sql-result ((obj sql-result)) + (format #t "#(~A" (-> obj error)) + (dotimes (s5-0 (-> obj len)) + (format #t " ~A" (-> obj data s5-0)) + ) + (format #t ")") + obj + ) + +;; definition for symbol *sql-result*, type sql-result +(define *sql-result* (the-as sql-result #f)) + +;; failed to figure out what this is: +0 + + + + diff --git a/test/decompiler/reference/jak2/kernel/gkernel_REF.gc b/test/decompiler/reference/jak2/kernel/gkernel_REF.gc new file mode 100644 index 0000000000..bed8514459 --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/gkernel_REF.gc @@ -0,0 +1,1692 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for symbol *kernel-version*, type binteger +(define *kernel-version* (the-as binteger #xb00000)) + +;; definition for symbol *irx-version*, type binteger +(define *irx-version* (the-as binteger #x200000)) + +;; definition for symbol *kernel-boot-mode*, type symbol +(define *kernel-boot-mode* 'listener) + +;; definition for symbol *kernel-boot-level*, type symbol +(define *kernel-boot-level* #f) + +;; definition for symbol *deci-count*, type int +(define *deci-count* 0) + +;; definition for symbol *last-loado-length*, type int +(define *last-loado-length* 0) + +;; definition for symbol *last-loado-global-usage*, type int +(define *last-loado-global-usage* 0) + +;; definition for symbol *last-loado-debug-usage*, type int +(define *last-loado-debug-usage* 0) + +;; definition for method 7 of type object +(defmethod relocate object ((obj object) (arg0 int)) + obj + ) + +;; definition for symbol *kernel-packages*, type pair +(define *kernel-packages* '()) + +;; definition for function load-package +(defun load-package ((arg0 string) (arg1 kheap)) + (when (not (nmember arg0 *kernel-packages*)) + (kmemopen global arg0) + (dgo-load arg0 arg1 (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000) + (set! *kernel-packages* (cons arg0 *kernel-packages*)) + (kmemclose) + *kernel-packages* + ) + ) + +;; definition for function unload-package +(defun unload-package ((arg0 string)) + (let ((v1-0 (nmember arg0 *kernel-packages*))) + (if v1-0 + (set! *kernel-packages* (delete! (car v1-0) *kernel-packages*)) + ) + ) + *kernel-packages* + ) + +;; definition for symbol *kernel-context*, type kernel-context +(define *kernel-context* (new 'static 'kernel-context + :prevent-from-run (process-mask execute sleep) + :next-pid 3 + :current-process #f + :relocating-process #f + :low-memory-message #t + ) + ) + +;; definition for symbol *dram-stack*, type (pointer uint8) +(define *dram-stack* (the-as (pointer uint8) (malloc 'global #x3800))) + +;; failed to figure out what this is: +(set! (-> *kernel-context* fast-stack-top) (the-as pointer #x70004000)) + +;; definition for symbol *null-kernel-context*, type kernel-context +(define *null-kernel-context* (new 'static 'kernel-context)) + +;; definition for method 1 of type thread +;; INFO: Return type mismatch int vs none. +(defmethod delete thread ((obj thread)) + (when (= obj (-> obj process main-thread)) + (break!) + 0 + ) + (set! (-> obj process top-thread) (the-as cpu-thread (-> obj previous))) + 0 + (none) + ) + +;; definition for method 2 of type thread +(defmethod print thread ((obj thread)) + (format #t "#<~A ~S of ~S pc: #x~X @ #x~X>" (-> obj type) (-> obj name) (-> obj process name) (-> obj pc) obj) + obj + ) + +;; definition for method 9 of type thread +;; INFO: Return type mismatch int vs none. +(defmethod stack-size-set! thread ((obj thread) (arg0 int)) + (let ((a2-0 (-> obj process))) + (cond + ((!= obj (-> a2-0 main-thread)) + (format 0 "ERROR: illegal attempt change stack size of ~A when the main-thread is not the top-thread.~%" a2-0) + ) + ((= (-> obj stack-size) arg0) + ) + ((= (-> a2-0 heap-cur) (+ (+ (-> obj stack-size) -4 (-> obj type size)) (the-as int obj))) + (set! (-> a2-0 heap-cur) (the-as pointer (+ (+ arg0 -4 (-> obj type size)) (the-as int obj)))) + (set! (-> obj stack-size) arg0) + ) + (else + (format 0 "ERROR: illegal attempt change stack size of ~A after more heap allocation has occured.~%" a2-0) + ) + ) + ) + 0 + (none) + ) + +;; definition for method 0 of type cpu-thread +;; INFO: Return type mismatch pointer vs cpu-thread. +(defmethod new cpu-thread ((allocation symbol) (type-to-make type) (arg0 process) (arg1 symbol) (arg2 int) (arg3 pointer)) + (let ((v0-0 (cond + ((-> arg0 top-thread) + (&+ arg3 -7164) + ) + (else + (let ((v1-2 (logand -16 (&+ (-> arg0 heap-cur) 15)))) + (set! (-> arg0 heap-cur) (&+ (&+ v1-2 (-> type-to-make size)) arg2)) + (&+ v1-2 4) + ) + ) + ) + ) + ) + (set! (-> (the-as cpu-thread v0-0) type) type-to-make) + (set! (-> (the-as cpu-thread v0-0) name) arg1) + (set! (-> (the-as cpu-thread v0-0) process) arg0) + (set! (-> (the-as cpu-thread v0-0) sp) arg3) + (set! (-> (the-as cpu-thread v0-0) stack-top) arg3) + (set! (-> (the-as cpu-thread v0-0) previous) (-> arg0 top-thread)) + (set! (-> arg0 top-thread) (the-as cpu-thread v0-0)) + (set! (-> (the-as cpu-thread v0-0) suspend-hook) (method-of-object (the-as cpu-thread v0-0) thread-suspend)) + (set! (-> (the-as cpu-thread v0-0) resume-hook) (method-of-object (the-as cpu-thread v0-0) thread-resume)) + (set! (-> (the-as cpu-thread v0-0) stack-size) arg2) + (the-as cpu-thread v0-0) + ) + ) + +;; definition for method 5 of type cpu-thread +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of cpu-thread ((obj cpu-thread)) + (the-as int (+ (-> obj type size) (-> obj stack-size))) + ) + +;; definition for function remove-exit +;; INFO: Return type mismatch int vs none. +(defbehavior remove-exit process () + (if (-> self stack-frame-top) + (set! (-> self stack-frame-top) (-> self stack-frame-top next)) + ) + 0 + (none) + ) + +;; definition (debug) for function stream<-process-mask +(defun-debug stream<-process-mask ((arg0 object) (arg1 process-mask)) + (let ((s4-0 arg1)) + (if (= (logand s4-0 (process-mask process-tree)) (process-mask process-tree)) + (format arg0 "process-tree ") + ) + (if (= (logand s4-0 (process-mask target)) (process-mask target)) + (format arg0 "target ") + ) + (if (= (logand (process-mask collectable) s4-0) (process-mask collectable)) + (format arg0 "attackable ") + ) + (if (= (logand (process-mask bit18) s4-0) (process-mask bit18)) + (format arg0 "collectable ") + ) + (if (= (logand (process-mask projectile) s4-0) (process-mask projectile)) + (format arg0 "projectile ") + ) + (if (= (logand (process-mask no-track) s4-0) (process-mask no-track)) + (format arg0 "no-track ") + ) + (if (= (logand s4-0 (process-mask sleep-code)) (process-mask sleep-code)) + (format arg0 "sleep-code ") + ) + (if (= (logand s4-0 (process-mask actor-pause)) (process-mask actor-pause)) + (format arg0 "actor-pause ") + ) + (if (= (logand (process-mask bot) s4-0) (process-mask bot)) + (format arg0 "bot ") + ) + (if (= (logand (process-mask vehicle) s4-0) (process-mask vehicle)) + (format arg0 "vehicle ") + ) + (if (= (logand (process-mask enemy) s4-0) (process-mask enemy)) + (format arg0 "enemy ") + ) + (if (= (logand (process-mask entity) s4-0) (process-mask entity)) + (format arg0 "entity ") + ) + (if (= (logand s4-0 (process-mask heap-shrunk)) (process-mask heap-shrunk)) + (format arg0 "heap-shrunk ") + ) + (if (= (logand (process-mask sidekick) s4-0) (process-mask sidekick)) + (format arg0 "sidekick ") + ) + (if (= (logand s4-0 (process-mask going)) (process-mask going)) + (format arg0 "going ") + ) + (if (= (logand s4-0 (process-mask execute)) (process-mask execute)) + (format arg0 "execute ") + ) + (if (= (logand (process-mask civilian) s4-0) (shl #x8000 16)) + (format arg0 "civilian ") + ) + (if (= (logand (process-mask death) s4-0) (process-mask death)) + (format arg0 "death ") + ) + (if (= (logand (process-mask guard) s4-0) (process-mask guard)) + (format arg0 "guard ") + ) + (if (= (logand s4-0 (process-mask no-kill)) (process-mask no-kill)) + (format arg0 "no-kill ") + ) + (if (= (logand (process-mask platform) s4-0) (process-mask platform)) + (format arg0 "platform ") + ) + (if (= (logand s4-0 (process-mask freeze)) (process-mask freeze)) + (format arg0 "freeze ") + ) + (if (= (logand s4-0 (process-mask sleep)) (process-mask sleep)) + (format arg0 "sleep ") + ) + (if (= (logand s4-0 (process-mask progress)) (process-mask progress)) + (format arg0 "progress ") + ) + (if (= (logand s4-0 (process-mask menu)) (process-mask menu)) + (format arg0 "menu ") + ) + (if (= (logand (process-mask camera) s4-0) (process-mask camera)) + (format arg0 "camera ") + ) + (if (= (logand (process-mask ambient) s4-0) (process-mask ambient)) + (format arg0 "ambient ") + ) + (if (= (logand s4-0 (process-mask dark-effect)) (process-mask dark-effect)) + (format arg0 "dark-effect ") + ) + (if (= (logand (process-mask crate) s4-0) (process-mask crate)) + (format arg0 "crate ") + ) + (if (= (logand s4-0 (process-mask kernel-run)) (process-mask kernel-run)) + (format arg0 "kernel-run ") + ) + (if (= (logand s4-0 (process-mask movie)) (process-mask movie)) + (format arg0 "movie ") + ) + (if (= (logand s4-0 (process-mask pause)) (process-mask pause)) + (format arg0 "pause ") + ) + ) + arg1 + ) + +;; definition for symbol *master-mode*, type symbol +(define *master-mode* 'game) + +;; definition for symbol *pause-lock*, type symbol +(define *pause-lock* #f) + +;; definition for method 2 of type process-tree +(defmethod print process-tree ((obj process-tree)) + (format #t "#<~A ~S @ #x~X>" (-> obj type) (-> obj name) obj) + obj + ) + +;; definition for method 0 of type process-tree +(defmethod new process-tree ((allocation symbol) (type-to-make type) (arg0 string)) + (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> v0-0 name) arg0) + (set! (-> v0-0 mask) (process-mask process-tree)) + (set! (-> v0-0 clock) *kernel-clock*) + (set! (-> v0-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 child) (the-as (pointer process-tree) #f)) + (set! (-> v0-0 self) v0-0) + (set! (-> v0-0 ppointer) (the-as (pointer process) (&-> v0-0 self))) + v0-0 + ) + ) + +;; definition for method 3 of type process-tree +(defmethod inspect process-tree ((obj process-tree)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~S~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (stream<-process-mask #t (-> obj mask)) + (format #t ")~%") + (format #t "~Tclock: ~A~%" (-> obj clock)) + (format #t "~Tparent: ~A~%" (ppointer->process (-> obj parent))) + (format #t "~Tbrother: ~A~%" (ppointer->process (-> obj brother))) + (format #t "~Tchild: ~A~%" (ppointer->process (-> obj child))) + obj + ) + +;; definition for method 0 of type process +;; INFO: Return type mismatch object vs process. +(defmethod new process ((allocation symbol) (type-to-make type) (arg0 string) (arg1 int)) + (let ((v0-0 (if (logtest? (the-as int allocation) 1) + (object-new allocation type-to-make (the-as int (+ (-> process size) arg1))) + (+ (the-as int allocation) 4) + ) + ) + ) + (set! (-> (the-as process v0-0) name) arg0) + (set! (-> (the-as process v0-0) clock) *kernel-clock*) + (set! (-> (the-as process v0-0) status) 'dead) + (set! (-> (the-as process v0-0) pid) 0) + (set! (-> (the-as process v0-0) pool) #f) + (set! (-> (the-as process v0-0) allocated-length) arg1) + (set! (-> (the-as process v0-0) top-thread) #f) + (set! (-> (the-as process v0-0) main-thread) #f) + (let ((v1-6 (-> (the-as process v0-0) stack))) + (set! (-> (the-as process v0-0) heap-cur) v1-6) + (set! (-> (the-as process v0-0) heap-base) v1-6) + ) + (set! (-> (the-as process v0-0) heap-top) + (&-> (the-as process v0-0) stack (-> (the-as process v0-0) allocated-length)) + ) + (set! (-> (the-as process v0-0) stack-frame-top) (the-as stack-frame (-> (the-as process v0-0) heap-top))) + (set! (-> (the-as process v0-0) stack-frame-top) #f) + (set! (-> (the-as process v0-0) state) #f) + (set! (-> (the-as process v0-0) next-state) #f) + (set! (-> (the-as process v0-0) entity) #f) + (set! (-> (the-as process v0-0) level) #f) + (set! (-> (the-as process v0-0) trans-hook) #f) + (set! (-> (the-as process v0-0) post-hook) #f) + (set! (-> (the-as process v0-0) event-hook) #f) + (set! (-> (the-as process v0-0) parent) (the-as (pointer process-tree) #f)) + (set! (-> (the-as process v0-0) brother) (the-as (pointer process-tree) #f)) + (set! (-> (the-as process v0-0) child) (the-as (pointer process-tree) #f)) + (set! (-> (the-as process v0-0) self) (the-as process v0-0)) + (set! (-> (the-as process v0-0) ppointer) (the-as (pointer process) (&-> (the-as process v0-0) self))) + (the-as process v0-0) + ) + ) + +;; definition for function inspect-process-heap +(defun inspect-process-heap ((arg0 process)) + (let ((s5-0 (the-as object (&+ (-> arg0 heap-base) 4)))) + (while (< (the-as int s5-0) (the-as int (-> arg0 heap-cur))) + (inspect (the-as basic s5-0)) + (set! s5-0 (&+ (the-as pointer s5-0) (logand -16 (+ (asize-of (the-as basic s5-0)) 15)))) + ) + ) + #f + ) + +;; definition for method 3 of type process +(defmethod inspect process ((obj process)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~S~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (stream<-process-mask #t (-> obj mask)) + (format #t ")~%") + (format #t "~Tclock: ~A~%" (-> obj clock)) + (format #t "~Tstatus: ~A~%" (-> obj status)) + (format #t "~Tmain-thread: ~A~%" (-> obj main-thread)) + (format #t "~Ttop-thread: ~A~%" (-> obj top-thread)) + (format #t "~Tentity: ~A~%" (-> obj entity)) + (format #t "~Tlevel: ~A~%" (-> obj level)) + (format #t "~Tstate: ~A~%" (-> obj state)) + (format #t "~Tnext-state: ~A~%" (-> obj next-state)) + (format #t "~Ttrans-hook: ~A~%" (-> obj trans-hook)) + (format #t "~Tpost-hook: ~A~%" (-> obj post-hook)) + (format #t "~Tevent-hook: ~A~%" (-> obj event-hook)) + (format #t "~Tparent: ~A~%" (ppointer->process (-> obj parent))) + (format #t "~Tbrother: ~A~%" (ppointer->process (-> obj brother))) + (format #t "~Tchild: ~A~%" (ppointer->process (-> obj child))) + (format #t "~Tconnection-list: ~`connectable`P~%" (-> obj connection-list)) + (format #t "~Tstack-frame-top: ~A~%" (-> obj stack-frame-top)) + (format #t "~Theap-base: #x~X~%" (-> obj heap-base)) + (format #t "~Theap-top: #x~X~%" (-> obj heap-top)) + (format #t "~Theap-cur: #x~X~%" (-> obj heap-cur)) + (let ((s5-0 *print-column*)) + (set! *print-column* (+ *print-column* 64)) + (format #t "----~%") + (inspect-process-heap obj) + (format #t "----~%") + (set! *print-column* s5-0) + ) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Tstack[~D] @ #x~X~%" (-> obj allocated-length) (-> obj stack)) + obj + ) + +;; definition for method 5 of type process +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of process ((obj process)) + (the-as int (+ (-> process size) (-> obj allocated-length))) + ) + +;; definition for method 2 of type process +(defmethod print process ((obj process)) + (cond + ((and (-> obj top-thread) (!= (-> obj status) 'dead)) + (format #t "#<~A ~S ~A :state ~S " (-> obj type) (-> obj name) (-> obj status) (if (-> obj state) + (-> obj state name) + ) + ) + (format + #t + ":stack ~D/~D :heap ~D/~D @ #x~X>" + (&- (-> obj top-thread stack-top) (the-as uint (-> obj top-thread sp))) + (-> obj main-thread stack-size) + (- (-> obj allocated-length) (&- (-> obj heap-top) (the-as uint (-> obj heap-cur)))) + (-> obj allocated-length) + obj + ) + ) + (else + (format + #t + "#<~A ~S ~A :state ~S @ #x~X" + (-> obj type) + (-> obj name) + (-> obj status) + (if (-> obj state) + (-> obj state name) + ) + obj + ) + ) + ) + obj + ) + +;; definition for function return-from-thread +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function return-from-thread-dead +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function reset-and-call +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 10 of type cpu-thread +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 11 of type cpu-thread +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 0 of type dead-pool +(defmethod new dead-pool ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int) (arg2 string)) + (let ((s3-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> s3-0 name) arg2) + (set! (-> s3-0 mask) (process-mask process-tree)) + (set! (-> s3-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 child) (the-as (pointer process-tree) #f)) + (set! (-> s3-0 self) s3-0) + (set! (-> s3-0 ppointer) (the-as (pointer process) (&-> s3-0 self))) + (dotimes (s2-1 arg0) + (let ((s1-0 (-> s3-0 child)) + (v1-5 ((method-of-type process new) allocation process "dead" arg1)) + ) + (set! (-> s3-0 child) (process->ppointer v1-5)) + (set! (-> v1-5 parent) (process->ppointer (the-as process s3-0))) + (set! (-> v1-5 pool) s3-0) + (set! (-> v1-5 brother) s1-0) + ) + ) + s3-0 + ) + ) + +;; definition for method 14 of type dead-pool +(defmethod get-process dead-pool ((obj dead-pool) (arg0 type) (arg1 int)) + (let ((s4-0 (the-as object (-> obj child)))) + (when (and (not (the-as (pointer process-tree) s4-0)) *debug-segment* (!= obj *debug-dead-pool*)) + (set! s4-0 (get-process *debug-dead-pool* arg0 arg1)) + (if (the-as process s4-0) + (format + 0 + "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" + arg0 + (ppointer->process (the-as process s4-0)) + (-> obj name) + ) + ) + ) + (cond + (s4-0 + (set! (-> (the-as (pointer process) s4-0) 0 type) arg0) + (-> (the-as (pointer process) s4-0) 0) + ) + (else + (format + 0 + "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" + arg0 + (ppointer->process (the-as (pointer process) s4-0)) + (-> obj name) + ) + (the-as process #f) + ) + ) + ) + ) + +;; definition for method 15 of type dead-pool +;; INFO: Return type mismatch int vs none. +(defmethod return-process dead-pool ((obj dead-pool) (arg0 process)) + (change-parent arg0 obj) + 0 + (none) + ) + +;; definition for method 0 of type dead-pool-heap +(defmethod new dead-pool-heap ((allocation symbol) (type-to-make type) (arg0 string) (arg1 int) (arg2 int)) + (let ((s2-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* 12 arg1)))))) + (set! (-> s2-0 name) arg0) + (set! (-> s2-0 mask) (process-mask process-tree)) + (set! (-> s2-0 allocated-length) arg1) + (set! (-> s2-0 parent) (the-as (pointer process-tree) #f)) + (set! (-> s2-0 brother) (the-as (pointer process-tree) #f)) + (set! (-> s2-0 child) (the-as (pointer process-tree) #f)) + (set! (-> s2-0 self) s2-0) + (set! (-> s2-0 ppointer) (the-as (pointer process) (&-> s2-0 self))) + (init s2-0 allocation arg2) + s2-0 + ) + ) + +;; definition for method 16 of type dead-pool-heap +;; INFO: Return type mismatch dead-pool-heap vs none. +(defmethod init dead-pool-heap ((obj dead-pool-heap) (arg0 symbol) (arg1 int)) + (countdown (v1-0 (-> obj allocated-length)) + (let ((a0-4 (-> obj process-list v1-0))) + (set! (-> a0-4 process) *null-process*) + (set! (-> a0-4 next) (-> obj process-list (+ v1-0 1))) + ) + ) + (set! (-> obj dead-list next) (the-as dead-pool-heap-rec (-> obj process-list))) + (set! (-> obj alive-list process) #f) + (set! (-> obj process-list (+ (-> obj allocated-length) -1) next) #f) + (set! (-> obj alive-list prev) (-> obj alive-list)) + (set! (-> obj alive-list next) #f) + (set! (-> obj alive-list process) #f) + (set! (-> obj first-gap) (-> obj alive-list)) + (set! (-> obj first-shrink) #f) + (cond + ((zero? arg1) + (set! (-> obj heap base) (the-as pointer 0)) + (set! (-> obj heap current) (the-as pointer 0)) + (set! (-> obj heap top) (the-as pointer 0)) + (set! (-> obj heap top-base) (the-as pointer 0)) + 0 + ) + (else + (set! (-> obj heap base) (malloc arg0 arg1)) + (set! (-> obj heap current) (-> obj heap base)) + (set! (-> obj heap top) (&+ (-> obj heap base) arg1)) + (set! (-> obj heap top-base) (-> obj heap top)) + ) + ) + (none) + ) + +;; definition for method 25 of type dead-pool-heap +;; INFO: Return type mismatch object vs pointer. +(defmethod gap-location dead-pool-heap ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + (the-as + pointer + (if (-> arg0 process) + (+ (+ (-> arg0 process allocated-length) -4 (-> process size)) (the-as int (-> arg0 process))) + (-> obj heap base) + ) + ) + ) + +;; definition for method 24 of type dead-pool-heap +(defmethod gap-size dead-pool-heap ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + (cond + ((-> arg0 process) + (let ((v1-3 (&+ (&+ (the-as pointer (-> arg0 process)) (-> process size)) (-> arg0 process allocated-length)))) + (if (-> arg0 next) + (&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3)) + (&- (-> obj heap top) (the-as uint (&+ v1-3 4))) + ) + ) + ) + ((-> arg0 next) + (&- (the-as pointer (-> arg0 next process)) (the-as uint (&+ (-> obj heap base) 4))) + ) + (else + (&- (-> obj heap top) (the-as uint (-> obj heap base))) + ) + ) + ) + +;; definition for method 26 of type dead-pool-heap +(defmethod find-gap dead-pool-heap ((obj dead-pool-heap) (arg0 dead-pool-heap-rec)) + (while (and (-> arg0 next) (zero? (gap-size obj arg0))) + (set! arg0 (-> arg0 next)) + ) + arg0 + ) + +;; definition for method 3 of type dead-pool-heap +;; INFO: this function exists in multiple non-identical object files +(defmethod inspect dead-pool-heap ((obj dead-pool-heap)) + (format #t "[~8x] ~A~%" obj (-> obj type)) + (format #t "~Tname: ~A~%" (-> obj name)) + (format #t "~1Tmask: #x~X : (process-mask " (-> obj mask)) + (stream<-process-mask #t (-> obj mask)) + (format #t ")~%") + (format #t "~Tparent: #x~X~%" (-> obj parent)) + (format #t "~Tbrother: #x~X~%" (-> obj brother)) + (format #t "~Tchild: #x~X~%" (-> obj child)) + (format #t "~Tppointer: #x~X~%" (-> obj ppointer)) + (format #t "~Tself: ~A~%" (-> obj self)) + (format #t "~Tallocated-length: ~D~%" (-> obj allocated-length)) + (format #t "~Theap: #~%" (-> obj heap)) + (format #t "~Tfirst-gap: #~%" (-> obj first-gap)) + (format #t "~Tfirst-shrink: #~%" (-> obj first-shrink)) + (format #t "~Talive-list: #~%" (-> obj alive-list)) + (format #t "~Tlast: #~%" (-> obj alive-list prev)) + (format #t "~Tdead-list: #~%" (-> obj dead-list)) + (let* ((s5-0 (&- (-> obj heap top) (the-as uint (-> obj heap base)))) + (v1-3 (if (-> obj alive-list prev) + (gap-size obj (-> obj alive-list prev)) + s5-0 + ) + ) + ) + (format #t "~Tprocess-list[0] @ #x~X ~D/~D bytes used~%" (-> obj process-list) (- s5-0 v1-3) s5-0) + ) + (let ((s5-1 (-> obj alive-list)) + (s4-0 0) + ) + (while s5-1 + (if (-> s5-1 process) + (format #t "~T [~3D] # ~A~%" s4-0 s5-1 (-> s5-1 process)) + ) + (let ((s3-0 (gap-size obj s5-1))) + (if (nonzero? s3-0) + (format #t "~T gap: ~D bytes @ #x~X~%" s3-0 (gap-location obj s5-1)) + ) + ) + (set! s5-1 (-> s5-1 next)) + (+! s4-0 1) + ) + ) + obj + ) + +;; definition for method 5 of type dead-pool-heap +;; INFO: Return type mismatch uint vs int. +(defmethod asize-of dead-pool-heap ((obj dead-pool-heap)) + (the-as int (+ (-> obj type size) (* 12 (-> obj allocated-length)))) + ) + +;; definition for method 20 of type dead-pool-heap +(defmethod memory-used dead-pool-heap ((obj dead-pool-heap)) + (if (-> obj alive-list prev) + (- (memory-total obj) (gap-size obj (-> obj alive-list prev))) + 0 + ) + ) + +;; definition for method 21 of type dead-pool-heap +(defmethod memory-total dead-pool-heap ((obj dead-pool-heap)) + (&- (-> obj heap top) (the-as uint (-> obj heap base))) + ) + +;; definition for method 22 of type dead-pool-heap +(defmethod memory-free dead-pool-heap ((obj dead-pool-heap)) + (let ((v1-0 (-> obj heap top))) + (if (-> obj alive-list prev) + (gap-size obj (-> obj alive-list prev)) + (&- v1-0 (the-as uint (-> obj heap base))) + ) + ) + ) + +;; definition for method 23 of type dead-pool-heap +(defmethod compact-time dead-pool-heap ((obj dead-pool-heap)) + (-> obj compact-time) + ) + +;; definition for method 27 of type dead-pool-heap +(defmethod find-gap-by-size dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + (let ((gp-0 (-> obj first-gap))) + (while (and gp-0 (< (gap-size obj gp-0) arg0)) + (set! gp-0 (-> gp-0 next)) + ) + gp-0 + ) + ) + +;; definition for method 14 of type dead-pool-heap +(defmethod get-process dead-pool-heap ((obj dead-pool-heap) (arg0 type) (arg1 int)) + (let ((s4-0 (-> obj dead-list next)) + (s3-0 (the-as process #f)) + ) + (let ((s1-0 (find-gap-by-size obj (the-as int (+ (-> process size) arg1))))) + (cond + ((and s4-0 s1-0 (nonzero? (-> obj heap base))) + (set! (-> obj dead-list next) (-> s4-0 next)) + (let ((v1-6 (-> s1-0 next))) + (set! (-> s1-0 next) s4-0) + (set! (-> s4-0 next) v1-6) + (if v1-6 + (set! (-> v1-6 prev) s4-0) + ) + ) + (set! (-> s4-0 prev) s1-0) + (if (= s1-0 (-> obj alive-list prev)) + (set! (-> obj alive-list prev) s4-0) + ) + (let ((a0-5 (gap-location obj s1-0))) + (set! s3-0 ((method-of-type process new) (the-as symbol a0-5) process "process" arg1)) + ) + (set! (-> s4-0 process) s3-0) + (set! (-> s3-0 ppointer) (&-> s4-0 process)) + (if (= (-> obj first-gap) s1-0) + (set! (-> obj first-gap) (find-gap obj s4-0)) + ) + (if (or (not (-> obj first-shrink)) (< (the-as int s3-0) (the-as int (-> obj first-shrink process)))) + (set! (-> obj first-shrink) s4-0) + ) + (set! (-> s3-0 parent) (-> obj ppointer)) + (set! (-> s3-0 pool) obj) + (set! (-> obj child) (&-> s4-0 process)) + ) + (else + (when (and *debug-segment* (!= obj *debug-dead-pool*)) + (set! s3-0 (get-process *debug-dead-pool* arg0 arg1)) + (if (and s3-0 *vis-boot*) + (format + 0 + "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" + arg0 + s3-0 + (-> obj name) + ) + ) + ) + ) + ) + ) + (if s3-0 + (set! (-> s3-0 type) arg0) + (format 0 "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" arg0 s3-0 (-> obj name)) + ) + s3-0 + ) + ) + +;; definition for method 15 of type dead-pool-heap +;; INFO: Return type mismatch int vs none. +(defmethod return-process dead-pool-heap ((obj dead-pool-heap) (arg0 process)) + (if (!= obj (-> arg0 pool)) + (format 0 "ERROR: process ~A does not belong to dead-pool-heap ~A.~%" arg0 obj) + ) + (change-parent arg0 obj) + (set! (-> obj child) (the-as (pointer process-tree) #f)) + (let ((s5-1 (-> arg0 ppointer))) + (if (or (= (-> obj first-gap) s5-1) (< (the-as int (gap-location obj (the-as dead-pool-heap-rec s5-1))) + (the-as int (gap-location obj (-> obj first-gap))) + ) + ) + (set! (-> obj first-gap) (the-as dead-pool-heap-rec (-> s5-1 1))) + ) + (when (= (-> obj first-shrink) s5-1) + (set! (-> obj first-shrink) (the-as dead-pool-heap-rec (-> s5-1 1))) + (if (not (-> obj first-shrink process)) + (set! (-> obj first-shrink) #f) + ) + ) + (set! (-> s5-1 1 clock) (the-as clock (-> s5-1 2))) + (if (-> s5-1 2) + (set! (-> s5-1 2 mask) (the-as process-mask (-> s5-1 1))) + (set! (-> obj alive-list prev) (the-as dead-pool-heap-rec (-> s5-1 1))) + ) + (set! (-> s5-1 2) (the-as process (-> obj dead-list next))) + (set! (-> obj dead-list next) (the-as dead-pool-heap-rec s5-1)) + (set! (-> s5-1 0) *null-process*) + ) + 0 + (none) + ) + +;; definition for method 18 of type dead-pool-heap +(defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (arg0 process)) + (when arg0 + (let ((s5-0 (-> arg0 ppointer))) + (when (not (or (logtest? (-> arg0 mask) (process-mask heap-shrunk)) + (and (not (-> arg0 next-state)) (not (-> arg0 state))) + ) + ) + (set! (-> arg0 allocated-length) (&- (-> arg0 heap-cur) (the-as uint (-> arg0 stack)))) + (set! (-> arg0 heap-top) (&-> arg0 stack (-> arg0 allocated-length))) + (if (< (the-as int arg0) (the-as int (gap-location obj (-> obj first-gap)))) + (set! (-> obj first-gap) (find-gap obj (the-as dead-pool-heap-rec s5-0))) + ) + (logior! (-> arg0 mask) (process-mask heap-shrunk)) + ) + (if (= (-> obj first-shrink) s5-0) + (set! (-> obj first-shrink) (the-as dead-pool-heap-rec (-> s5-0 2))) + ) + ) + ) + obj + ) + +;; definition for method 17 of type dead-pool-heap +;; INFO: Return type mismatch int vs none. +;; WARN: Expression building failed: Function (method 17 dead-pool-heap) has a return type of none, but the expression builder found a return statement. +(defmethod compact dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + (if (zero? (-> obj heap base)) + (return 0) + ) + (let* ((s4-0 (memory-free obj)) + (v1-5 (memory-total obj)) + (f0-2 (/ (the float s4-0) (the float v1-5))) + ) + (cond + ((< f0-2 0.1) + (set! arg0 1000) + (if (and *debug-segment* (-> *kernel-context* low-memory-message)) + (format *stdcon* "~3LLow Actor Memory~%~0L") + ) + ) + ((< f0-2 0.2) + (set! arg0 (* arg0 4)) + ) + ((< f0-2 0.3) + (set! arg0 (* arg0 2)) + ) + ) + ) + (set! (-> obj compact-count-targ) (the-as uint arg0)) + (set! (-> obj compact-count) (the-as uint 0)) + (while (nonzero? arg0) + (+! arg0 -1) + (let ((v1-19 (-> obj first-shrink))) + (when (not v1-19) + (set! v1-19 (-> obj alive-list next)) + (set! (-> obj first-shrink) v1-19) + ) + (if v1-19 + (shrink-heap obj (-> v1-19 process)) + ) + ) + (let ((s4-1 (-> obj first-gap))) + (when (-> s4-1 next) + (let ((s3-0 (-> s4-1 next process)) + (s2-0 (gap-size obj s4-1)) + ) + (when (nonzero? s2-0) + (when (< s2-0 0) + (break!) + 0 + ) + (shrink-heap obj s3-0) + (relocate s3-0 (- s2-0)) + (set! (-> obj first-gap) (find-gap obj s4-1)) + (+! (-> obj compact-count) 1) + ) + ) + ) + ) + ) + 0 + (none) + ) + +;; definition for method 19 of type dead-pool-heap +;; INFO: Return type mismatch int vs none. +(defmethod churn dead-pool-heap ((obj dead-pool-heap) (arg0 int)) + (while (nonzero? arg0) + (+! arg0 -1) + (let ((s4-0 (-> obj alive-list next))) + (when s4-0 + (if (or (= (-> obj first-gap) s4-0) + (< (the-as int (gap-location obj s4-0)) (the-as int (gap-location obj (-> obj first-gap)))) + ) + (set! (-> obj first-gap) (-> s4-0 prev)) + ) + (when (= (-> obj first-shrink) s4-0) + (set! (-> obj first-shrink) (-> s4-0 prev)) + (if (not (-> obj first-shrink process)) + (set! (-> obj first-shrink) #f) + ) + ) + (set! (-> s4-0 prev next) (-> s4-0 next)) + (if (-> s4-0 next) + (set! (-> s4-0 next prev) (-> s4-0 prev)) + (set! (-> obj alive-list prev) (-> s4-0 prev)) + ) + (let ((a1-3 (-> obj alive-list prev))) + (let ((v1-19 (-> a1-3 next))) + (set! (-> a1-3 next) s4-0) + (set! (-> s4-0 next) v1-19) + (if v1-19 + (set! (-> v1-19 prev) s4-0) + ) + ) + (set! (-> s4-0 prev) a1-3) + (set! (-> obj alive-list prev) s4-0) + (set! (-> s4-0 process) + (relocate (-> s4-0 process) (&- (gap-location obj a1-3) (the-as uint (&-> (-> s4-0 process) type)))) + ) + ) + ) + ) + ) + 0 + (none) + ) + +;; definition for function method-state +;; INFO: Return type mismatch function vs state. +(defun method-state ((arg0 type) (arg1 basic)) + (dotimes (v1-0 (the-as int (-> arg0 allocated-length))) + (let ((a2-2 (the-as basic (-> arg0 method-table v1-0)))) + (if (and (nonzero? (the-as function a2-2)) + (= (-> (the-as function a2-2) type) state) + (= (-> (the-as state a2-2) name) arg1) + ) + (return (the-as state a2-2)) + ) + ) + ) + (the-as state #f) + ) + +;; definition for symbol *global-search-name*, type basic +(define *global-search-name* (the-as basic #f)) + +;; definition for symbol *global-search-count*, type int +(define *global-search-count* 0) + +;; definition for function process-by-name +;; INFO: Return type mismatch process-tree vs process. +(defun process-by-name ((arg0 string) (arg1 process-tree)) + (set! *global-search-name* arg0) + (the-as process (search-process-tree + arg1 + (lambda ((arg0 process)) (string= (-> arg0 name) (the-as string *global-search-name*))) + ) + ) + ) + +;; definition for function process-not-name +;; INFO: Return type mismatch process-tree vs process. +(defun process-not-name ((arg0 string) (arg1 process-tree)) + (set! *global-search-name* arg0) + (the-as + process + (search-process-tree + arg1 + (lambda ((arg0 process)) (not (string= (-> arg0 name) (the-as string *global-search-name*)))) + ) + ) + ) + +;; definition for function process-count +(defun process-count ((arg0 process-tree)) + (set! *global-search-count* 0) + (iterate-process-tree + arg0 + (lambda ((arg0 process)) (set! *global-search-count* (+ *global-search-count* 1)) #t) + *null-kernel-context* + ) + *global-search-count* + ) + +;; definition for function kill-by-name +(defun kill-by-name ((arg0 string) (arg1 process-tree)) + (local-vars (a0-1 process)) + (while (begin (set! a0-1 (process-by-name arg0 arg1)) a0-1) + (deactivate a0-1) + ) + #f + ) + +;; definition for function kill-by-type +(defun kill-by-type ((arg0 type) (arg1 process-tree)) + (local-vars (a0-1 process-tree)) + (set! *global-search-name* arg0) + (while (begin + (set! a0-1 (search-process-tree arg1 (lambda ((arg0 process)) (= (-> arg0 type) *global-search-name*)))) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +;; definition for function kill-not-name +(defun kill-not-name ((arg0 string) (arg1 process-tree)) + (local-vars (a0-1 process)) + (while (begin (set! a0-1 (process-not-name arg0 arg1)) a0-1) + (deactivate a0-1) + ) + #f + ) + +;; definition for function kill-not-type +(defun kill-not-type ((arg0 type) (arg1 process-tree)) + (local-vars (a0-1 process-tree)) + (set! *global-search-name* arg0) + (while (begin + (set! a0-1 (search-process-tree arg1 (lambda ((arg0 process)) (!= (-> arg0 type) *global-search-name*)))) + a0-1 + ) + (deactivate a0-1) + ) + #f + ) + +;; definition for method 12 of type process +(defmethod run-logic? process ((obj process)) + #t + ) + +;; definition for function iterate-process-tree +(defun iterate-process-tree ((arg0 process-tree) (arg1 (function object object)) (arg2 kernel-context)) + (let ((s4-0 (or (logtest? (-> arg0 mask) (process-mask process-tree)) (arg1 arg0)))) + (cond + ((= s4-0 'dead) + ) + (else + (let ((v1-4 (-> arg0 child))) + (while v1-4 + (let ((s3-1 (-> v1-4 0 brother))) + (iterate-process-tree (-> v1-4 0) arg1 arg2) + (set! v1-4 s3-1) + ) + ) + ) + ) + ) + s4-0 + ) + ) + +;; definition for function execute-process-tree +(defun execute-process-tree ((arg0 process-tree) (arg1 (function object object)) (arg2 kernel-context)) + (logclear! (-> arg0 mask) (process-mask kernel-run)) + (let ((s3-0 (or (logtest? (-> arg0 mask) (process-mask process-tree)) + (not (and (zero? (logand (-> arg2 prevent-from-run) (-> arg0 mask))) (run-logic? arg0))) + (begin (logior! (-> arg0 mask) (process-mask kernel-run)) (arg1 arg0)) + ) + ) + ) + (cond + ((= s3-0 'dead) + ) + (else + (let ((v1-12 (-> arg0 child))) + (while v1-12 + (let ((s4-1 (-> v1-12 0 brother))) + (execute-process-tree (-> v1-12 0) arg1 arg2) + (set! v1-12 s4-1) + ) + ) + ) + ) + ) + s3-0 + ) + ) + +;; definition for function search-process-tree +(defun search-process-tree ((arg0 process-tree) (arg1 (function process-tree object))) + (when (zero? (logand (-> arg0 mask) (process-mask process-tree))) + (if (arg1 arg0) + (return arg0) + ) + ) + (let ((v1-5 (-> arg0 child))) + (while v1-5 + (let ((s5-1 (-> v1-5 0 brother))) + (let ((v1-6 (search-process-tree (-> v1-5 0) arg1))) + (if v1-6 + (return v1-6) + ) + ) + (set! v1-5 s5-1) + ) + ) + ) + (the-as process-tree #f) + ) + +;; definition for function kernel-dispatcher +(defun kernel-dispatcher () + (when *listener-function* + (set! *enable-method-set* (+ *enable-method-set* 1)) + (let ((t1-0 (reset-and-call (-> *listener-process* main-thread) *listener-function*))) + (format #t "~D #x~X ~F ~A~%" t1-0 t1-0 t1-0 t1-0) + ) + (set! *listener-function* #f) + (set! *enable-method-set* (+ *enable-method-set* -1)) + 0 + ) + (execute-process-tree + *active-pool* + (lambda ((arg0 process)) + (let ((s5-0 *kernel-context*)) + (case (-> arg0 status) + (('waiting-to-run 'suspended) + (set! (-> s5-0 current-process) arg0) + (cond + ((logtest? (-> arg0 mask) (process-mask pause)) + (set! *stdcon* *stdcon1*) + (set! *debug-draw-pauseable* #t) + ) + (else + (set! *stdcon* *stdcon0*) + (set! *debug-draw-pauseable* #f) + ) + ) + (when (-> arg0 trans-hook) + (let ((s4-0 (new 'process 'cpu-thread arg0 'trans 256 (-> arg0 main-thread stack-top)))) + (reset-and-call s4-0 (-> arg0 trans-hook)) + (delete s4-0) + ) + (when (= (-> arg0 status) 'dead) + (set! (-> s5-0 current-process) #f) + (return 'dead) + ) + ) + (if (logtest? (-> arg0 mask) (process-mask sleep-code)) + (set! (-> arg0 status) 'suspended) + ((-> arg0 main-thread resume-hook) (-> arg0 main-thread)) + ) + (cond + ((= (-> arg0 status) 'dead) + (set! (-> s5-0 current-process) #f) + 'dead + ) + (else + (when (-> arg0 post-hook) + (let ((s4-1 (new 'process 'cpu-thread arg0 'post 256 (&-> *dram-stack* 14336)))) + (reset-and-call s4-1 (-> arg0 post-hook)) + (delete s4-1) + ) + (when (= (-> arg0 status) 'dead) + (set! (-> s5-0 current-process) #f) + (return 'dead) + ) + (set! (-> arg0 status) 'suspended) + ) + (set! (-> s5-0 current-process) #f) + #f + ) + ) + ) + (('dead) + 'dead + ) + ) + ) + ) + *kernel-context* + ) + ) + +;; definition for function sync-dispatcher +;; INFO: Return type mismatch symbol vs object. +(defun sync-dispatcher () + (let ((t9-0 *listener-function*)) + (the-as object (when t9-0 + (set! *listener-function* #f) + (t9-0) + #f + ) + ) + ) + ) + +;; definition for function inspect-process-tree +(defun inspect-process-tree ((arg0 process-tree) (arg1 int) (arg2 int) (arg3 symbol)) + (print-tree-bitmask arg2 arg1) + (cond + (arg3 + (format #t "__________________~%") + (format + #t + "~S~A~%" + (if (zero? arg1) + "" + "+---" + ) + arg0 + ) + (let ((s2-0 *print-column*)) + (set! *print-column* (the-as binteger (* (* arg1 4) 8))) + (inspect arg0) + (set! *print-column* s2-0) + ) + ) + (else + (format + #t + "~S~A~%" + (if (zero? arg1) + "" + "+---" + ) + arg0 + ) + ) + ) + (let ((s2-1 (-> arg0 child))) + (while s2-1 + (inspect-process-tree + (-> s2-1 0) + (+ arg1 1) + (if (not (-> s2-1 0 brother)) + arg2 + (logior arg2 (ash 1 (+ arg1 1))) + ) + arg3 + ) + (set! s2-1 (-> s2-1 0 brother)) + ) + ) + arg0 + ) + +;; definition for method 0 of type catch-frame +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function throw-dispatch +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function throw +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for method 0 of type protect-frame +;; INFO: Return type mismatch int vs protect-frame. +(defmethod new protect-frame ((allocation symbol) (type-to-make type) (arg0 (function none))) + (with-pp + (let ((v0-0 (the-as object (+ (the-as int allocation) 4)))) + (set! (-> (the-as protect-frame v0-0) type) type-to-make) + (set! (-> (the-as protect-frame v0-0) name) 'protect-frame) + (set! (-> (the-as protect-frame v0-0) exit) arg0) + (set! (-> (the-as protect-frame v0-0) next) (-> pp stack-frame-top)) + (set! (-> pp stack-frame-top) (the-as protect-frame v0-0)) + (the-as protect-frame v0-0) + ) + ) + ) + +;; definition for function previous-brother +;; INFO: Return type mismatch (pointer process-tree) vs object. +(defun previous-brother ((arg0 process-tree)) + (let ((v1-0 (-> arg0 parent))) + (when v1-0 + (let ((v1-2 (-> v1-0 0 child))) + (if (= v1-2 arg0) + (return (the-as object #f)) + ) + (while v1-2 + (if (= (-> v1-2 0 brother) arg0) + (return (the-as object v1-2)) + ) + (set! v1-2 (-> v1-2 0 brother)) + ) + ) + (the-as (pointer process-tree) #f) + ) + ) + ) + +;; definition for function change-parent +(defun change-parent ((arg0 process-tree) (arg1 process-tree)) + (let ((a2-0 (-> arg0 parent))) + (when a2-0 + (let ((v1-2 (-> a2-0 0 child))) + (cond + ((= (ppointer->process v1-2) arg0) + (set! (-> a2-0 0 child) (-> arg0 brother)) + ) + (else + (while (!= (ppointer->process (-> v1-2 0 brother)) arg0) + (nop!) + (nop!) + (nop!) + (set! v1-2 (-> v1-2 0 brother)) + ) + (set! (-> v1-2 0 brother) (-> arg0 brother)) + ) + ) + ) + ) + ) + (set! (-> arg0 parent) (-> arg1 ppointer)) + (set! (-> arg0 brother) (-> arg1 child)) + (set! (-> arg1 child) (-> arg0 ppointer)) + arg0 + ) + +;; definition for function change-brother +(defun change-brother ((arg0 process-tree) (arg1 process-tree)) + (when (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1)) + (let ((a2-1 (-> arg0 parent))) + (when a2-1 + (let ((t0-0 (-> a2-1 0 child)) + (a3-1 (the-as (pointer process-tree) #f)) + (v1-4 (the-as (pointer process-tree) #f)) + ) + (if (= (ppointer->process t0-0) arg0) + (set! a3-1 a2-1) + ) + (if (= (ppointer->process t0-0) arg1) + (set! v1-4 a2-1) + ) + (while (and (-> t0-0 0 brother) (or (not a3-1) (not v1-4))) + (if (= (-> (ppointer->process t0-0) brother) arg1) + (set! v1-4 t0-0) + ) + (if (= (-> (ppointer->process t0-0) brother) arg0) + (set! a3-1 t0-0) + ) + (set! t0-0 (-> t0-0 0 brother)) + ) + (cond + ((or (not a3-1) (not v1-4)) + (return 0) + ) + ((= a3-1 a2-1) + (set! (-> a3-1 5) (the-as process-tree (-> arg0 brother))) + ) + (else + (set! (-> a3-1 4) (the-as process-tree (-> arg0 brother))) + ) + ) + (cond + ((= v1-4 a2-1) + (set! (-> arg0 brother) (the-as (pointer process-tree) (-> v1-4 5))) + (set! (-> v1-4 5) (the-as process-tree (-> arg0 ppointer))) + ) + (else + (set! (-> arg0 brother) (the-as (pointer process-tree) (-> v1-4 4))) + (set! (-> v1-4 4) (the-as process-tree (-> arg0 ppointer))) + ) + ) + ) + ) + ) + ) + arg0 + ) + +;; definition for function change-to-last-brother +(defun change-to-last-brother ((arg0 process-tree)) + (when (and (-> arg0 brother) (-> arg0 parent)) + (let* ((a1-0 (-> arg0 parent)) + (v1-4 (-> a1-0 0 child)) + ) + (cond + ((= (-> v1-4 0) arg0) + (set! (-> a1-0 0 child) (-> arg0 brother)) + ) + (else + (while (!= (-> v1-4 0 brother 0) arg0) + (nop!) + (nop!) + (nop!) + (nop!) + (set! v1-4 (-> v1-4 0 brother)) + ) + (set! (-> v1-4 0 brother) (-> arg0 brother)) + ) + ) + (while (-> v1-4 0 brother) + (nop!) + (nop!) + (nop!) + (nop!) + (set! v1-4 (-> v1-4 0 brother)) + ) + (set! (-> v1-4 0 brother) (-> arg0 ppointer)) + ) + (set! (-> arg0 brother) (the-as (pointer process-tree) #f)) + ) + arg0 + ) + +;; definition for method 9 of type process +(defmethod activate process ((obj process) (arg0 process-tree) (arg1 basic) (arg2 pointer)) + (set! (-> obj mask) (logclear (-> arg0 mask) (process-mask sleep sleep-code process-tree heap-shrunk))) + (set! (-> obj clock) (-> arg0 clock)) + (set! (-> obj status) 'ready) + (let ((v1-5 (-> *kernel-context* next-pid))) + (set! (-> obj pid) v1-5) + (set! (-> *kernel-context* next-pid) (+ v1-5 1)) + ) + (set! (-> obj top-thread) #f) + (set! (-> obj main-thread) #f) + (set! (-> obj name) (the-as string arg1)) + (let ((v1-10 (&-> obj stack (-> obj type heap-base)))) + (set! (-> obj heap-cur) v1-10) + (set! (-> obj heap-base) v1-10) + ) + (set! (-> obj stack-frame-top) #f) + (mem-set32! (-> obj stack) (the-as int (shr (-> obj type heap-base) 2)) 0) + (set! (-> obj trans-hook) #f) + (set! (-> obj post-hook) #f) + (set! (-> obj event-hook) #f) + (set! (-> obj state) #f) + (set! (-> obj next-state) #f) + (cond + ((logtest? (-> arg0 mask) (process-mask process-tree)) + (set! (-> obj entity) #f) + (set! (-> obj level) *default-level*) + ) + (else + (set! (-> obj entity) (-> (the-as process arg0) entity)) + (set! (-> obj level) (-> (the-as process arg0) level)) + ) + ) + (set! (-> obj connection-list next1) #f) + (set! (-> obj connection-list prev1) #f) + (set! (-> obj main-thread) (new 'process 'cpu-thread obj 'code 256 arg2)) + (change-parent obj arg0) + ) + +;; definition for function run-function-in-process +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function set-to-run-bootstrap +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function set-to-run +(defun set-to-run ((arg0 cpu-thread) + (arg1 function) + (arg2 object) + (arg3 object) + (arg4 object) + (arg5 object) + (arg6 object) + (arg7 object) + ) + (let ((v1-0 (-> arg0 process))) + (set! (-> v1-0 status) 'waiting-to-run) + ) + (set! (-> arg0 rreg 0) (the-as uint arg2)) + (set! (-> arg0 rreg 1) (the-as uint arg3)) + (set! (-> arg0 rreg 2) (the-as uint arg4)) + (set! (-> arg0 rreg 3) (the-as uint arg5)) + (set! (-> arg0 rreg 4) (the-as uint arg6)) + (set! (-> arg0 rreg 5) (the-as uint arg7)) + (set! (-> arg0 rreg 6) (the-as uint arg1)) + (set! (-> arg0 pc) (the-as pointer set-to-run-bootstrap)) + (let ((v0-0 (-> arg0 stack-top))) + (set! (-> arg0 sp) v0-0) + v0-0 + ) + ) + +;; definition for method 10 of type process-tree +;; INFO: Return type mismatch int vs none. +(defmethod deactivate process-tree ((obj process-tree)) + 0 + (none) + ) + +;; failed to figure out what this is: +(defstate dead-state (process) + :code (the-as (function none :behavior process) nothing) + ) + +;; definition for symbol entity-deactivate-handler, type (function process entity-actor none) +(define entity-deactivate-handler (the-as (function process entity-actor none) nothing)) + +;; definition for method 10 of type process +;; INFO: Return type mismatch int vs none. +;; WARN: Unsupported inline assembly instruction kind - [lw ra, return-from-thread(s7)] +;; WARN: Unsupported inline assembly instruction kind - [jr ra] +(defmethod deactivate process ((obj process)) + (local-vars (s7-0 none) (ra-0 int)) + (with-pp + (when (!= (-> obj status) 'dead) + (set! (-> obj next-state) dead-state) + (if (-> obj entity) + (entity-deactivate-handler obj (the-as entity-actor (-> obj entity))) + ) + (let ((s5-0 pp)) + (set! pp obj) + (let ((s4-0 (-> pp stack-frame-top))) + (while (the-as protect-frame s4-0) + (case (-> s4-0 type) + ((protect-frame state) + ((-> (the-as protect-frame s4-0) exit)) + ) + ) + (set! s4-0 (-> (the-as protect-frame s4-0) next)) + ) + ) + (set! pp s5-0) + ) + (process-disconnect obj) + (let ((v1-12 (-> obj child))) + (while v1-12 + (let ((s5-1 (-> v1-12 0 brother))) + (deactivate (-> v1-12 0)) + (set! v1-12 s5-1) + ) + ) + ) + (return-process (-> obj pool) obj) + (set! (-> obj state) #f) + (set! (-> obj next-state) #f) + (set! (-> obj entity) #f) + (set! (-> obj pid) 0) + (cond + ((= (-> *kernel-context* current-process) obj) + (set! (-> obj status) 'dead) + (.lw ra-0 return-from-thread s7-0) + (.jr ra-0) + (nop!) + 0 + ) + ((= (-> obj status) 'initialize) + (set! (-> obj status) 'dead) + (throw 'initialize #f) + ) + ) + (set! (-> obj status) 'dead) + ) + 0 + (none) + ) + ) + +;; failed to figure out what this is: +(kmemopen global "process-buffers") + +;; failed to figure out what this is: +(let ((v0-43 (new 'global 'process "listener" 2048))) + (set! *listener-process* v0-43) + (let ((gp-0 v0-43)) + (set! (-> gp-0 status) 'ready) + (set! (-> gp-0 pid) 1) + (set! (-> gp-0 main-thread) (new 'process 'cpu-thread gp-0 'main 256 (&-> *dram-stack* 14336))) + ) + ) + +;; definition for symbol *null-process*, type process +(define *null-process* (new 'global 'process "null" 16)) + +;; definition for symbol *vis-boot*, type symbol +(define *vis-boot* #f) + +;; definition for symbol *kernel-clock*, type clock +(define *kernel-clock* (new 'static 'clock)) + +;; definition for symbol *16k-dead-pool*, type dead-pool +(define *16k-dead-pool* (new 'global 'dead-pool 2 #x4000 "*16k-dead-pool*")) + +;; definition for symbol *8k-dead-pool*, type dead-pool +(define *8k-dead-pool* (new 'global 'dead-pool 2 8192 "*8k-dead-pool*")) + +;; definition for symbol *4k-dead-pool*, type dead-pool +(define *4k-dead-pool* (new 'global 'dead-pool 4 4096 "*4k-dead-pool*")) + +;; definition for symbol *target-dead-pool*, type dead-pool +(define *target-dead-pool* (new 'global 'dead-pool 2 #xc000 "*target-dead-pool*")) + +;; definition for symbol *camera-dead-pool*, type dead-pool +(define *camera-dead-pool* (new 'global 'dead-pool 7 4096 "*camera-dead-pool*")) + +;; definition for symbol *camera-master-dead-pool*, type dead-pool +(define *camera-master-dead-pool* (new 'global 'dead-pool 1 8192 "*camera-master-dead-pool*")) + +;; this part is debug only +(when *debug-segment* +;; definition for symbol *debug-dead-pool*, type dead-pool-heap +(define *debug-dead-pool* (new 'debug 'dead-pool-heap "*debug-dead-pool*" 768 #x100000)) + +) +;; definition for symbol *nk-dead-pool*, type dead-pool-heap +(define *nk-dead-pool* (new 'global 'dead-pool-heap "*nk-dead-pool*" 768 #x181000)) + +;; definition for symbol *default-dead-pool*, type dead-pool +(define *default-dead-pool* (the-as dead-pool *nk-dead-pool*)) + +;; definition for symbol *pickup-dead-pool*, type dead-pool +(define *pickup-dead-pool* (the-as dead-pool *nk-dead-pool*)) + +;; definition for symbol *city-dead-pool*, type dead-pool-heap +(define *city-dead-pool* (new 'loading-level 'dead-pool-heap "*city-dead-pool*" 256 0)) + +;; definition for symbol *dead-pool-list*, type pair +(define *dead-pool-list* '(*4k-dead-pool* + *8k-dead-pool* + *16k-dead-pool* + *nk-dead-pool* + *target-dead-pool* + *camera-dead-pool* + *camera-master-dead-pool* + ) + ) + +;; definition for symbol *active-pool*, type process-tree +(define *active-pool* (new 'global 'process-tree "active-pool")) + +;; failed to figure out what this is: +(let ((gp-1 change-parent) + (v0-56 (new 'global 'process-tree "display-pool")) + ) + (set! *display-pool* v0-56) + (gp-1 v0-56 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-2 change-parent) + (a0-61 (new 'global 'process-tree "camera-pool")) + ) + (set! (-> a0-61 mask) (process-mask freeze pause menu progress process-tree camera)) + (set! *camera-pool* a0-61) + (gp-2 a0-61 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-3 change-parent) + (a0-63 (new 'global 'process-tree "target-pool")) + ) + (set! (-> a0-63 mask) (process-mask freeze pause menu progress process-tree)) + (set! *target-pool* a0-63) + (gp-3 a0-63 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-4 change-parent) + (a0-65 (new 'global 'process-tree "entity-pool")) + ) + (set! (-> a0-65 mask) (process-mask freeze pause menu progress process-tree entity)) + (set! *entity-pool* a0-65) + (gp-4 a0-65 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-5 change-parent) + (v0-64 (new 'global 'process-tree "mid-pool")) + ) + (set! *mid-pool* v0-64) + (gp-5 v0-64 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-6 change-parent) + (a0-69 (new 'global 'process-tree "pusher-pool")) + ) + (set! (-> a0-69 mask) (process-mask freeze pause menu progress process-tree entity)) + (set! *pusher-pool* a0-69) + (gp-6 a0-69 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-7 change-parent) + (a0-71 (new 'global 'process-tree "bg-pool")) + ) + (set! (-> a0-71 mask) (process-mask freeze pause menu progress process-tree)) + (set! *bg-pool* a0-71) + (gp-7 a0-71 *active-pool*) + ) + +;; failed to figure out what this is: +(let ((gp-8 change-parent) + (a0-73 (new 'global 'process-tree "default-pool")) + ) + (set! (-> a0-73 mask) (process-mask freeze pause menu progress process-tree)) + (set! *default-pool* a0-73) + (gp-8 a0-73 *active-pool*) + ) + +;; failed to figure out what this is: +(kmemclose) + + + + diff --git a/test/decompiler/reference/jak2/kernel/gstate_REF.gc b/test/decompiler/reference/jak2/kernel/gstate_REF.gc new file mode 100644 index 0000000000..5d00eb305d --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/gstate_REF.gc @@ -0,0 +1,180 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for method 0 of type state +(defmethod new state ((allocation symbol) + (type-to-make type) + (arg0 symbol) + (arg1 function) + (arg2 (function none)) + (arg3 function) + (arg4 (function none)) + (arg5 (function process int symbol event-message-block object)) + ) + (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) + (set! (-> v0-0 name) arg0) + (set! (-> v0-0 next) #f) + (set! (-> v0-0 exit) arg4) + (set! (-> v0-0 code) arg1) + (set! (-> v0-0 trans) arg2) + (set! (-> v0-0 post) #f) + (set! (-> v0-0 enter) arg3) + (set! (-> v0-0 event) arg5) + v0-0 + ) + ) + +;; definition for function inherit-state +(defun inherit-state ((arg0 state) (arg1 state)) + (set! (-> arg0 exit) (-> arg1 exit)) + (set! (-> arg0 code) (-> arg1 code)) + (set! (-> arg0 trans) (-> arg1 trans)) + (set! (-> arg0 post) (-> arg1 post)) + (set! (-> arg0 enter) (-> arg1 enter)) + (set! (-> arg0 event) (-> arg1 event)) + arg0 + ) + +;; definition for method 2 of type state +(defmethod print state ((obj state)) + (format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj) + obj + ) + +;; definition for function enter-state +;; WARN: Unsupported inline assembly instruction kind - [lwu sp, 28(v1)] +;; WARN: Unsupported inline assembly instruction kind - [lw ra, return-from-thread-dead(s7)] +;; WARN: Unsupported inline assembly instruction kind - [jr t9] +;; WARN: Unsupported inline assembly instruction kind - [sw v1, 0(sp)] +(defun enter-state ((arg0 object) (arg1 object) (arg2 object) (arg3 object) (arg4 object) (arg5 object)) + (local-vars (s7-0 none) (sp-0 int) (ra-0 int) (sv-0 none)) + (with-pp + (logclear! (-> pp mask) (process-mask sleep sleep-code)) + (logior! (-> pp mask) (process-mask going)) + (cond + ((= (-> pp status) 'initialize) + (set! (-> pp trans-hook) #f) + (set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5) + (set! (-> pp status) 'initialize-go) + (throw 'initialize #t) + #t + ) + ((!= (-> *kernel-context* current-process) pp) + (let ((s0-0 (-> pp status))) + (set! (-> pp trans-hook) #f) + (set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5) + (set! (-> pp status) s0-0) + ) + #t + ) + ((= (-> pp main-thread) (-> pp top-thread)) + (set! (-> pp state) (-> pp next-state)) + (let ((s0-1 (-> pp stack-frame-top))) + (while s0-1 + (case (-> s0-1 type) + ((protect-frame state) + ((-> (the-as protect-frame s0-1) exit)) + ) + ) + (set! s0-1 (-> s0-1 next)) + ) + ) + (logclear! (-> pp mask) (process-mask going)) + (let ((s0-2 (-> pp state))) + (set! (-> pp event-hook) (-> s0-2 event)) + (if (-> s0-2 exit) + (set! (-> pp stack-frame-top) s0-2) + (set! (-> pp stack-frame-top) #f) + ) + (set! (-> pp post-hook) (-> s0-2 post)) + (set! (-> pp trans-hook) (-> s0-2 trans)) + (let ((t9-4 (-> s0-2 enter))) + (if t9-4 + ((the-as (function object object object object object object none) t9-4) arg0 arg1 arg2 arg3 arg4 arg5) + ) + ) + (let ((t9-5 (-> s0-2 trans))) + (if t9-5 + (t9-5) + ) + ) + (let ((v1-28 (-> pp main-thread))) + (.lwu sp-0 28 v1-28) + ) + (let ((t9-6 (-> s0-2 code))) + (.lw ra-0 return-from-thread-dead s7-0) + (.jr t9-6) + ) + ) + arg4 + ) + (else + (set! (-> pp trans-hook) #f) + (set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5) + (when (!= (-> pp top-thread name) 'post) + (let ((v1-31 return-from-thread)) + (.sw v1-31 0 (the-as none sp-0)) + ) + ) + #t + ) + ) + ) + ) + +;; failed to figure out what this is: +(kmemopen global "event-queue") + +;; failed to figure out what this is: +(let ((v1-3 (new 'global 'event-message-block-array 64))) + (set! (-> v1-3 length) 0) + (set! *event-queue* v1-3) + ) + +;; failed to figure out what this is: +(kmemclose) + +;; definition for function send-event-function +(defun send-event-function ((arg0 process-tree) (arg1 event-message-block)) + (with-pp + (when (and arg0 (!= (-> arg0 type) process-tree) (-> (the-as process arg0) event-hook) (-> arg1 from)) + (let ((gp-0 pp)) + (set! pp (the-as process arg0)) + (let ((v0-0 ((-> (the-as process arg0) event-hook) (-> arg1 from 0) (-> arg1 num-params) (-> arg1 message) arg1))) + (set! pp gp-0) + v0-0 + ) + ) + ) + ) + ) + +;; definition for method 9 of type event-message-block-array +;; INFO: Return type mismatch int vs none. +(defmethod send-all! event-message-block-array ((obj event-message-block-array)) + (dotimes (s5-0 (-> obj length)) + (let* ((a1-0 (-> obj data s5-0)) + (a0-2 (handle->process (-> a1-0 to-handle))) + ) + (if (and a0-2 (handle->process (-> a1-0 form-handle))) + (send-event-function a0-2 a1-0) + ) + ) + ) + (set! (-> obj length) 0) + 0 + (none) + ) + +;; definition for function looping-code +;; WARN: new jak 2 until loop case, check carefully +(defun looping-code () + (until #f + (suspend) + ) + #f + ) + + + + diff --git a/test/decompiler/reference/jak2/kernel/gstring-h_REF.gc b/test/decompiler/reference/jak2/kernel/gstring-h_REF.gc new file mode 100644 index 0000000000..8e4b1f21d4 --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/gstring-h_REF.gc @@ -0,0 +1,9 @@ +;;-*-Lisp-*- +(in-package goal) + +;; failed to figure out what this is: +0 + + + + diff --git a/test/decompiler/reference/jak2/kernel/gstring_REF.gc b/test/decompiler/reference/jak2/kernel/gstring_REF.gc new file mode 100644 index 0000000000..cf6400a461 --- /dev/null +++ b/test/decompiler/reference/jak2/kernel/gstring_REF.gc @@ -0,0 +1,760 @@ +;;-*-Lisp-*- +(in-package goal) + +;; definition for method 4 of type string +(defmethod length string ((obj string)) + (let ((v1-0 (-> obj data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (&- v1-0 (the-as uint (-> obj data))) + ) + ) + +;; definition for method 5 of type string +(defmethod asize-of string ((obj string)) + (+ (-> obj allocated-length) 1 (-> string size)) + ) + +;; definition for function copy-string<-string +(defun copy-string<-string ((arg0 string) (arg1 string)) + (let ((v1-0 (-> arg0 data))) + (let ((a1-1 (-> arg1 data))) + (while (nonzero? (-> a1-1 0)) + (set! (-> v1-0 0) (-> a1-1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! a1-1 (&-> a1-1 1)) + ) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +;; definition for method 0 of type string +(defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string)) + (cond + (arg1 + (let* ((s2-1 (max (length arg1) arg0)) + (a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size)))) + ) + (set! (-> a0-4 allocated-length) s2-1) + (copy-string<-string a0-4 arg1) + ) + ) + (else + (let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size))))) + (set! (-> v0-2 allocated-length) arg0) + v0-2 + ) + ) + ) + ) + +;; definition for function string= +(defun string= ((arg0 string) (arg1 string)) + (let ((a2-0 (-> arg0 data)) + (v1-0 (-> arg1 data)) + ) + (if (or (zero? arg0) (zero? arg1)) + (return #f) + ) + (while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0))) + (if (!= (-> a2-0 0) (-> v1-0 0)) + (return #f) + ) + (set! a2-0 (&-> a2-0 1)) + (set! v1-0 (&-> v1-0 1)) + ) + (and (zero? (-> a2-0 0)) (zero? (-> v1-0 0))) + ) + ) + +;; definition for function string-prefix= +(defun string-prefix= ((arg0 string) (arg1 string)) + (let ((v1-0 (-> arg0 data))) + (let ((a2-0 (-> arg1 data))) + (if (or (zero? arg0) (zero? arg1)) + (return #f) + ) + (while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0))) + (if (!= (-> v1-0 0) (-> a2-0 0)) + (return #f) + ) + (set! v1-0 (&-> v1-0 1)) + (set! a2-0 (&-> a2-0 1)) + ) + ) + (zero? (-> v1-0 0)) + ) + ) + +;; definition for function charp-prefix= +(defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8))) + (while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0))) + (if (!= (-> arg0 0) (-> arg1 0)) + (return #f) + ) + (set! arg0 (&-> arg0 1)) + (set! arg1 (&-> arg1 1)) + ) + (zero? (-> arg0 0)) + ) + +;; definition for function string-suffix= +(defun string-suffix= ((arg0 string) (arg1 string)) + (let ((s5-0 (-> arg0 data)) + (gp-0 (-> arg1 data)) + ) + (if (or (zero? arg0) (zero? arg1)) + (return #f) + ) + (let ((s4-0 (length arg0)) + (v1-5 (length arg1)) + ) + (if (< s4-0 v1-5) + (return #f) + ) + (let ((v1-7 (&+ s5-0 (- s4-0 v1-5)))) + (while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0))) + (if (!= (-> v1-7 0) (-> gp-0 0)) + (return #f) + ) + (set! v1-7 (&-> v1-7 1)) + (set! gp-0 (&-> gp-0 1)) + ) + (zero? (-> v1-7 0)) + ) + ) + ) + ) + +;; definition for function string-position +(defun string-position ((arg0 string) (arg1 string)) + (let ((s5-0 0) + (s4-0 (-> arg1 data)) + ) + (while (nonzero? (-> s4-0 0)) + (if (charp-prefix= (-> arg0 data) s4-0) + (return s5-0) + ) + (+! s5-0 1) + (set! s4-0 (&-> s4-0 1)) + ) + ) + -1 + ) + +;; definition for function string-charp= +(defun string-charp= ((arg0 string) (arg1 (pointer uint8))) + (let ((v1-0 (-> arg0 data))) + (while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0))) + (if (!= (-> v1-0 0) (-> arg1 0)) + (return #f) + ) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (and (zero? (-> v1-0 0)) (zero? (-> arg1 0))) + ) + ) + +;; definition for function name= +;; ERROR: function was not converted to expressions. Cannot decompile. + +;; definition for function copyn-string<-charp +(defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int)) + (let ((v1-0 (-> arg0 data))) + (dotimes (a3-0 arg2) + (set! (-> v1-0 0) (-> arg1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +;; definition for function string<-charp +(defun string<-charp ((arg0 string) (arg1 (pointer uint8))) + (let ((v1-0 (-> arg0 data))) + (while (nonzero? (-> arg1 0)) + (set! (-> v1-0 0) (-> arg1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +;; definition for function charp<-string +(defun charp<-string ((arg0 (pointer uint8)) (arg1 string)) + (let ((v1-0 (-> arg1 data))) + (while (nonzero? (-> v1-0 0)) + (set! (-> arg0 0) (-> v1-0 0)) + (set! arg0 (&-> arg0 1)) + (set! v1-0 (&-> v1-0 1)) + ) + ) + (set! (-> arg0 0) (the-as uint 0)) + 0 + ) + +;; definition for function copyn-charp<-string +;; INFO: Return type mismatch int vs none. +(defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int)) + (let ((v1-0 (-> arg1 data))) + (while (and (nonzero? (-> v1-0 0)) (< 1 arg2)) + (set! (-> arg0 0) (-> v1-0 0)) + (set! arg0 (&-> arg0 1)) + (set! v1-0 (&-> v1-0 1)) + (set! arg2 (+ arg2 -1)) + ) + ) + (while (> arg2 0) + (set! (-> arg0 0) (the-as uint 0)) + (set! arg0 (&-> arg0 1)) + (set! arg2 (+ arg2 -1)) + ) + 0 + (none) + ) + +;; definition for function copy-charp<-charp +(defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8))) + (while (nonzero? (-> arg1 0)) + (set! (-> arg0 0) (-> arg1 0)) + (set! arg0 (&-> arg0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> arg0 0) (the-as uint 0)) + arg0 + ) + +;; definition for function cat-string<-string +(defun cat-string<-string ((arg0 string) (arg1 string)) + (let ((v1-0 (-> arg0 data))) + (let ((a1-1 (-> arg1 data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (while (nonzero? (-> a1-1 0)) + (set! (-> v1-0 0) (-> a1-1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! a1-1 (&-> a1-1 1)) + ) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +;; definition for function catn-string<-charp +(defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int)) + (let ((v1-0 (-> arg0 data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (dotimes (a3-2 arg2) + (set! (-> v1-0 0) (-> arg1 0)) + (set! v1-0 (&-> v1-0 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-0 0) (the-as uint 0)) + ) + arg0 + ) + +;; definition for function cat-string<-string_to_charp +(defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (pointer uint8))) + (let ((v1-0 (-> arg1 data)) + (v0-0 (-> arg0 data)) + ) + (while (nonzero? (-> v0-0 0)) + (nop!) + (nop!) + (nop!) + (set! v0-0 (&-> v0-0 1)) + ) + (while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0))) + (set! (-> v0-0 0) (-> v1-0 0)) + (set! v0-0 (&-> v0-0 1)) + (set! v1-0 (&-> v1-0 1)) + ) + (set! (-> v0-0 0) (the-as uint 0)) + v0-0 + ) + ) + +;; definition for function append-character-to-string +(defun append-character-to-string ((arg0 string) (arg1 uint8)) + (let ((v1-0 (-> arg0 data))) + (while (nonzero? (-> v1-0 0)) + (nop!) + (nop!) + (nop!) + (set! v1-0 (&-> v1-0 1)) + ) + (set! (-> v1-0 0) (the-as uint arg1)) + (set! (-> v1-0 1) (the-as uint 0)) + ) + 0 + 0 + ) + +;; definition for function charp-basename +(defun charp-basename ((arg0 (pointer uint8))) + (let ((v1-0 arg0)) + (while (nonzero? (-> v1-0 0)) + (set! v1-0 (&-> v1-0 1)) + ) + (while (< (the-as int arg0) (the-as int v1-0)) + (set! v1-0 (&-> v1-0 -1)) + (if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92)) + (return (&-> v1-0 1)) + ) + ) + ) + arg0 + ) + +;; definition for function clear +(defun clear ((arg0 string)) + (set! (-> arg0 data 0) (the-as uint 0)) + arg0 + ) + +;; definition for function string arg0 data v1-4) (-> arg1 data v1-4)) + (return #t) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #f) + ) + ) + ) + ) + #f + ) + +;; definition for function string>? +(defun string>? ((arg0 string) (arg1 string)) + (let ((s4-1 (min (length arg0) (length arg1)))) + (dotimes (v1-4 s4-1) + (cond + ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) + (return #f) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #t) + ) + ) + ) + ) + #f + ) + +;; definition for function string<=? +(defun string<=? ((arg0 string) (arg1 string)) + (let ((s4-1 (min (length arg0) (length arg1)))) + (dotimes (v1-4 s4-1) + (cond + ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) + (return #t) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #f) + ) + ) + ) + ) + #t + ) + +;; definition for function string>=? +(defun string>=? ((arg0 string) (arg1 string)) + (let ((s4-1 (min (length arg0) (length arg1)))) + (dotimes (v1-4 s4-1) + (cond + ((< (-> arg0 data v1-4) (-> arg1 data v1-4)) + (return #f) + ) + ((< (-> arg1 data v1-4) (-> arg0 data v1-4)) + (return #t) + ) + ) + ) + ) + #t + ) + +;; definition for symbol *string-tmp-str*, type string +(define *string-tmp-str* (new 'global 'string 128 (the-as string #f))) + +;; definition for function string-skip-to-char +(defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint)) + (while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1)) + (set! arg0 (&-> arg0 1)) + ) + arg0 + ) + +;; definition for function string-cat-to-last-char +(defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint)) + (let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3))) + (let ((v1-0 (string-skip-to-char (-> arg1 data) arg2))) + (when (= (-> v1-0 0) arg2) + (until (!= (-> v1-0 0) arg2) + (set! s4-0 v1-0) + (set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2)) + ) + ) + ) + (cat-string<-string_to_charp arg0 arg1 s4-0) + ) + ) + +;; definition for function string-skip-whitespace +(defun string-skip-whitespace ((arg0 (pointer uint8))) + (while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10))) + (set! arg0 (&-> arg0 1)) + ) + arg0 + ) + +;; definition for function string-suck-up! +(defun string-suck-up! ((arg0 string) (arg1 (pointer uint8))) + (when (!= arg1 (-> arg0 data)) + (let ((v1-2 (-> arg0 data))) + (while (nonzero? (-> arg1 0)) + (set! (-> v1-2 0) (-> arg1 0)) + (set! v1-2 (&-> v1-2 1)) + (set! arg1 (&-> arg1 1)) + ) + (set! (-> v1-2 0) (the-as uint 0)) + ) + 0 + ) + #f + ) + +;; definition for function string-strip-leading-whitespace! +(defun string-strip-leading-whitespace! ((arg0 string)) + (let ((a1-0 (string-skip-whitespace (-> arg0 data)))) + (string-suck-up! arg0 a1-0) + ) + #f + ) + +;; definition for function string-strip-trailing-whitespace! +(defun string-strip-trailing-whitespace! ((arg0 string)) + (when (nonzero? (length arg0)) + (let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1)))) + (while (and (>= (the-as int v1-6) (the-as int (-> arg0 data))) + (or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10)) + ) + (set! v1-6 (&-> v1-6 -1)) + ) + (set! (-> v1-6 1) (the-as uint 0)) + ) + 0 + ) + #f + ) + +;; definition for function string-strip-whitespace! +(defun string-strip-whitespace! ((arg0 string)) + (string-strip-trailing-whitespace! arg0) + (string-strip-leading-whitespace! arg0) + #f + ) + +;; definition for function string-upcase +;; INFO: Return type mismatch int vs none. +(defun string-upcase ((arg0 string) (arg1 string)) + (let* ((a0-1 (-> arg0 data)) + (a3-0 (-> a0-1 0)) + (a2-0 1) + (v1-0 0) + ) + (while (nonzero? a3-0) + (if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0)) + (+! a3-0 -32) + ) + (set! (-> arg1 data v1-0) a3-0) + (set! a3-0 (-> a0-1 a2-0)) + (+! a2-0 1) + (+! v1-0 1) + ) + (set! (-> arg1 data v1-0) (the-as uint 0)) + ) + 0 + (none) + ) + +;; definition for function string-get-arg!! +(defun string-get-arg!! ((arg0 string) (arg1 string)) + (let ((s4-0 (string-skip-whitespace (-> arg1 data)))) + (cond + ((= (-> s4-0 0) 34) + (let ((s4-1 (&-> s4-0 1))) + (let ((v1-3 s4-1)) + (while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34)) + (set! s4-1 (&-> s4-1 1)) + ) + (copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3))) + ) + (if (= (-> s4-1 0) 34) + (set! s4-1 (&-> s4-1 1)) + ) + (let ((a1-3 (string-skip-whitespace s4-1))) + (string-suck-up! arg1 a1-3) + ) + ) + (return #t) + ) + ((nonzero? (-> s4-0 0)) + (let ((v1-11 s4-0)) + (while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10)) + (set! s4-0 (&-> s4-0 1)) + ) + (copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11))) + ) + (let ((a1-9 (string-skip-whitespace s4-0))) + (string-suck-up! arg1 a1-9) + ) + (return #t) + ) + ) + ) + #f + ) + +;; definition for function string->int +(defun string->int ((arg0 string)) + (let ((a0-1 (-> arg0 data)) + (v0-0 0) + (v1-0 #f) + ) + (cond + ((= (-> a0-1 0) 35) + (let ((a0-2 (&-> a0-1 1))) + (cond + ((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88)) + (let ((a0-3 (&-> a0-2 1))) + (when (= (-> a0-3 1) 45) + (set! v1-0 #t) + (set! a0-3 (&-> a0-3 1)) + ) + (while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0))) + (and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0))) + (and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0))) + ) + (cond + ((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0))) + (set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16)))) + ) + ((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0))) + (set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16)))) + ) + (else + (set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16)))) + ) + ) + (set! a0-3 (&-> a0-3 1)) + ) + ) + ) + ((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66)) + (let ((a0-4 (&-> a0-2 1))) + (while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0))) + (set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2)))) + (set! a0-4 (&-> a0-4 1)) + ) + ) + ) + ) + ) + ) + (else + (when (= (-> a0-1 1) 45) + (set! v1-0 #t) + (set! a0-1 (&-> a0-1 1)) + ) + (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) + (set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0)))) + (set! a0-1 (&-> a0-1 1)) + ) + ) + ) + (cond + (v1-0 + (- v0-0) + ) + (else + (empty) + v0-0 + ) + ) + ) + ) + +;; definition for function string->float +(defun string->float ((arg0 string)) + (let ((a0-1 (-> arg0 data)) + (f0-0 0.0) + (v1-0 #f) + ) + (when (= (-> a0-1 0) 45) + (set! v1-0 #t) + (set! a0-1 (&-> a0-1 1)) + ) + (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) + (set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48)))) + (set! a0-1 (&-> a0-1 1)) + ) + (when (= (-> a0-1 0) 46) + (set! a0-1 (&-> a0-1 1)) + (let ((a2-4 #xf4240) + (a1-12 0) + ) + (while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0))) + (+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4))) + (set! a2-4 (/ a2-4 10)) + (set! a0-1 (&-> a0-1 1)) + ) + (+! f0-0 (* 0.0000001 (the float a1-12))) + ) + ) + (when (= (-> a0-1 0) 101) + (let ((a1-16 (&-> a0-1 1)) + (f1-5 0.0) + (a0-2 #f) + ) + (cond + ((= (-> a1-16 0) 45) + (set! a0-2 #t) + (set! a1-16 (&-> a1-16 1)) + ) + ((= (-> a1-16 0) 43) + (set! a1-16 (&-> a1-16 1)) + ) + ) + (while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0))) + (set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48)))) + (set! a1-16 (&-> a1-16 1)) + ) + (when (!= f1-5 0.0) + (let ((f2-6 1.0)) + (cond + (a0-2 + (dotimes (a0-3 (the int f1-5)) + (set! f2-6 (* 0.1 f2-6)) + (nop!) + (nop!) + ) + ) + (else + (dotimes (a0-6 (the int f1-5)) + (set! f2-6 (* 10.0 f2-6)) + (nop!) + (nop!) + ) + ) + ) + (set! f0-0 (* f0-0 f2-6)) + ) + ) + ) + ) + (if v1-0 + (- f0-0) + f0-0 + ) + ) + ) + +;; definition for function string-get-int32!! +(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string)) + (cond + ((string-get-arg!! *string-tmp-str* arg1) + (set! (-> arg0 0) (string->int *string-tmp-str*)) + #t + ) + (else + #f + ) + ) + ) + +;; definition for function string-get-float!! +(defun string-get-float!! ((arg0 (pointer float)) (arg1 string)) + (cond + ((string-get-arg!! *string-tmp-str* arg1) + (set! (-> arg0 0) (string->float *string-tmp-str*)) + #t + ) + (else + #f + ) + ) + ) + +;; definition for function string-get-flag!! +(defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string)) + (cond + ((string-get-arg!! *string-tmp-str* arg1) + (cond + ((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3)) + (set! (-> arg0 0) (string= *string-tmp-str* arg2)) + #t + ) + (else + #f + ) + ) + ) + (else + #f + ) + ) + ) + +;; failed to figure out what this is: +(kmemopen global "gstring-globals") + +;; definition for symbol *debug-draw-pauseable*, type symbol +(define *debug-draw-pauseable* #f) + +;; definition for symbol *stdcon0*, type string +(define *stdcon0* (new 'global 'string #x4000 (the-as string #f))) + +;; definition for symbol *stdcon1*, type string +(define *stdcon1* (new 'global 'string #x4000 (the-as string #f))) + +;; definition for symbol *stdcon*, type string +(define *stdcon* *stdcon0*) + +;; definition for symbol *temp-string*, type string +(define *temp-string* (new 'global 'string 2048 (the-as string #f))) + +;; failed to figure out what this is: +(kmemclose) + + + + diff --git a/test/goalc/test_with_game.cpp b/test/goalc/test_with_game.cpp index ac15620139..1f47f885d8 100644 --- a/test/goalc/test_with_game.cpp +++ b/test/goalc/test_with_game.cpp @@ -961,6 +961,14 @@ TEST(Jak1TypeConsistency, TypeConsistency) { compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc"); } +TEST(Jak2TypeConsistency, TypeConsistency) { + Compiler compiler(GameVersion::Jak2); + compiler.enable_throw_on_redefines(); + add_expected_type_mismatches(compiler); + compiler.run_test_no_load("decompiler/config/jak2/all-types.gc"); + compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc"); +} + struct VectorFloatRegister { float x = 0; float y = 0; diff --git a/test/offline/config/jak2/config.jsonc b/test/offline/config/jak2/config.jsonc index b21284ce17..64a5c8dd02 100644 --- a/test/offline/config/jak2/config.jsonc +++ b/test/offline/config/jak2/config.jsonc @@ -1,9 +1,22 @@ { - "dgos": [], + "dgos": [ + "CGO/KERNEL.CGO", + "CGO/ENGINE.CGO" + ], "skip_compile_files": [], - "skip_compile_functions": [], + "skip_compile_functions": [ + // GCOMMON + // inline assembly + "valid?", + /// GKERNEL + // asm + "(method 10 process)", + "(method 14 dead-pool)", + /// GSTATE + "enter-state" // stack pointer asm + ], "skip_compile_states": {} } diff --git a/test/offline/offline_test_main.cpp b/test/offline/offline_test_main.cpp index 86f3f15a93..e557299901 100644 --- a/test/offline/offline_test_main.cpp +++ b/test/offline/offline_test_main.cpp @@ -96,7 +96,7 @@ Decompiler setup_decompiler(const std::vector& files, } if (db_files.size() != files.size() + art_files.size()) { - lg::error("DB file error."); + lg::error("DB file error: {} {} {}", db_files.size(), files.size(), art_files.size()); for (auto& f : files) { if (!db_files.count(f.unique_name)) { lg::error("didn't find {}\n", f.unique_name); @@ -431,7 +431,11 @@ int main(int argc, char* argv[]) { if (max_files > 0 && max_files < files.size()) { files.erase(files.begin() + max_files, files.end()); } - auto art_files = find_art_files(game_name, config->dgos); + + std::vector art_files; + if (game_name == "jak1") { + art_files = find_art_files(game_name, config->dgos); + } lg::info("Setting up decompiler and loading files..."); auto decompiler =