[Decompile] file-io, loader-h, texture-h, level-h, math-camera-h (#397)

* file-io and loader-h

* add test for level-h

* math camera-h
This commit is contained in:
water111 2021-04-28 20:51:17 -04:00 committed by GitHub
parent 14028b90bc
commit 70d93354eb
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
23 changed files with 1519 additions and 205 deletions

View file

@ -362,7 +362,9 @@ FormElement* StoreOp::get_as_form(FormPool& pool, const Env& env) const {
// nullptr, m_value.as_expr(), m_my_idx);
assert(!rd.addr_of);
return pool.alloc_element<StoreArrayAccess>(source, m_value.as_expr(), m_my_idx, ro.var);
return pool.alloc_element<StoreArrayAccess>(
source, m_value.as_expr(), m_my_idx, ro.var,
get_typecast_for_atom(m_value, env, coerce_to_reg_type(rd.result_type), m_my_idx));
}
}

View file

@ -483,6 +483,12 @@ const UseDefInfo& Env::get_use_def_info(const RegisterAccess& ra) const {
return m_var_names.use_def_info.at(var_id);
}
void Env::disable_def(const RegisterAccess& access) {
if (has_local_vars()) {
m_var_names.disable_def(access);
}
}
/*!
* Set the stack hints. This must be done before type analysis.
* This actually parses the types, so it should be done after the dts is set up.

View file

@ -168,11 +168,7 @@ class Env {
}
}
void disable_def(const RegisterAccess& access) {
if (has_local_vars()) {
m_var_names.disable_def(access);
}
}
void disable_def(const RegisterAccess& access);
void set_defined_in_let(const std::string& var) { m_vars_defined_in_let.insert(var); }

View file

@ -2029,8 +2029,13 @@ void StorePlainDeref::get_modified_regs(RegSet& regs) const {
StoreArrayAccess::StoreArrayAccess(ArrayFieldAccess* dst,
SimpleExpression expr,
int my_idx,
RegisterAccess array_src)
: m_dst(dst), m_expr(expr), m_my_idx(my_idx), m_base_var(array_src) {}
RegisterAccess array_src,
std::optional<TypeSpec> src_cast_type)
: m_dst(dst),
m_expr(expr),
m_my_idx(my_idx),
m_base_var(array_src),
m_src_cast_type(src_cast_type) {}
goos::Object StoreArrayAccess::to_form_internal(const Env& env) const {
return pretty_print::build_list("set!", m_dst->to_form(env),

View file

@ -1198,7 +1198,8 @@ class StoreArrayAccess : public FormElement {
StoreArrayAccess(ArrayFieldAccess* dst,
SimpleExpression expr,
int my_idx,
RegisterAccess array_src);
RegisterAccess array_src,
std::optional<TypeSpec> src_cast_type);
goos::Object to_form_internal(const Env& env) const override;
void apply(const std::function<void(FormElement*)>& f) override;
void apply_form(const std::function<void(Form*)>& f) override;
@ -1211,6 +1212,7 @@ class StoreArrayAccess : public FormElement {
SimpleExpression m_expr;
int m_my_idx = -1;
RegisterAccess m_base_var;
std::optional<TypeSpec> m_src_cast_type;
};
class DecompiledDataElement : public FormElement {

View file

@ -1585,7 +1585,8 @@ void StoreArrayAccess::push_to_stack(const Env& env, FormPool& pool, FormStack&
m_dst->update_with_val(array_form, env, pool, &forms_out, true);
auto form_out = pool.alloc_sequence_form(nullptr, forms_out);
auto fr = pool.alloc_element<SetFormFormElement>(form_out, expr_form);
auto fr = pool.alloc_element<SetFormFormElement>(
form_out, make_optional_cast(m_src_cast_type, expr_form, pool, env));
fr->mark_popped();
stack.push_form_element(fr, true);
}

View file

@ -175,7 +175,10 @@ struct UseDefInfo {
for (auto& x : defs) {
if (x.op_id == op_id) {
if (x.disabled) {
throw std::runtime_error("Invalid disable def twice");
lg::warn(
"disable def twice: {}. This may happen when a cond (no else) is nested inside of "
"another conditional, but it should be rare.\n",
x.op_id);
}
x.disabled = true;
return;

View file

@ -3752,9 +3752,20 @@
(define-extern *file-temp-string* string)
(define-extern make-file-name (function int string int string))
(define-extern make-vfile-name (function int string string))
(define-extern file-info-correct-version? (function file-info int int symbol))
(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)
)
(define-extern make-file-name (function file-kind string int 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

View file

@ -882,6 +882,38 @@
"args": ["out", "min-val", "max-val", "in"]
},
"make-file-name": {
"args": ["kind", "name", "art-group-version"]
},
"make-vfile-name": {
"args": ["kind", "name"]
},
"file-info-correct-version?": {
"args": ["info", "kind", "version-override"],
"vars": {"s5-0":"expected-version", "s4-0":"kind-name"}
},
"(method 0 load-dir)": {
"args": ["allocation", "type-to-make", "length", "unk"],
"vars": {"s4-0": "obj"}
},
"(method 0 load-dir-art-group)": {
"args": ["allocation", "type-to-make", "length", "unk"],
"vars": {"v0-0": "obj"}
},
"(method 0 external-art-buffer)": {
"args": ["allocation", "type-to-make", "idx"],
"vars": {"v0-0":"obj"}
},
"(method 0 external-art-control)": {
"vars": {"gp-0":"obj", "s4-0":"buff-idx", "v1-9":"rec-idx"}
},
"(method 9 display)": {
"args": ["obj", "delta-seconds"],
"vars": { "gp-0": "obj", "s5-0": "delta" }

View file

@ -59,7 +59,7 @@ goos::Object decompile_at_label_with_hint(const LabelType& hint,
}
std::vector<goos::Object> array_def = {pretty_print::to_symbol(fmt::format(
"new 'static 'inline-array '{} {}", type.get_single_arg().print(), *hint.array_size))};
"new 'static 'inline-array {} {}", type.get_single_arg().print(), *hint.array_size))};
for (int elt = 0; elt < len; elt++) {
DecompilerLabel fake_label;
fake_label.target_segment = label.target_segment;
@ -218,7 +218,7 @@ goos::Object decompile_value_array(const TypeSpec& elt_type,
const std::vector<LinkedWord>& obj_words,
const TypeSystem& ts) {
std::vector<goos::Object> array_def = {
pretty_print::to_symbol(fmt::format("new 'static 'array '{} {}", elt_type.print(), length))};
pretty_print::to_symbol(fmt::format("new 'static 'array {} {}", elt_type.print(), length))};
for (int i = 0; i < length; i++) {
auto start = offset + stride * i;
@ -421,7 +421,7 @@ goos::Object decompile_structure(const TypeSpec& type,
field_type_info->get_inline_array_stride_alignment()));
std::vector<goos::Object> array_def = {pretty_print::to_symbol(fmt::format(
"new 'static 'inline-array '{} {}", field.type().print(), field.array_size()))};
"new 'static 'inline-array {} {}", field.type().print(), field.array_size()))};
for (int elt = 0; elt < len; elt++) {
DecompilerLabel fake_label;
fake_label.target_segment = label.target_segment;
@ -441,8 +441,19 @@ goos::Object decompile_structure(const TypeSpec& type,
assert(stride == 4);
std::vector<goos::Object> array_def = {pretty_print::to_symbol(
fmt::format("new 'static 'array '{} {}", field.type().print(), field.array_size()))};
for (int elt = 0; elt < len; elt++) {
fmt::format("new 'static 'array {} {}", field.type().print(), field.array_size()))};
int end_elt = 0;
for (int elt = len; elt-- > 0;) {
auto& word = obj_words.at((field_start / 4) + elt);
if (word.kind == LinkedWord::PLAIN_DATA && word.data == 0) {
continue;
}
end_elt = elt + 1;
break;
}
for (int elt = 0; elt < end_elt; elt++) {
auto& word = obj_words.at((field_start / 4) + elt);
if (word.kind == LinkedWord::PTR) {

View file

@ -142,3 +142,4 @@
- Adding a duplicate entry to an enum now generates a compiler error.
- Added `.psubw` assembly form
- Changed `.ftoi` to `VCVTTPS2DQ` to make the rounding behavior match the PS2 (truncate).
- Forward declaring a type with `declare-type` also forward declares the global holding the runtime type object.

View file

@ -75,44 +75,59 @@
;; allocate a temporary string
(define *file-temp-string* (new 'global 'string 128 (the string #f)))
(defconstant LEVEL_BT_FILE 0) ;; aka bsp-header
(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)
)
(defconstant LEVEL_BT_FILE_VERSION 30)
(defconstant ART_GROUP_FILE 1)
(defconstant ART_GROUP_FILE_VERSION 6)
(defconstant TPAGE_FILE 2)
(defconstant TPAGE_FILE_VERSION 7) ;; also used for dir
(defconstant DIR_TPAGE_FILE 3)
(defconstant LEVEL_VS_FILE 4)
(defconstant LEVEL_VS_FILE_VERSION 30)
(defconstant TX_FILE 5)
(defconstant TX_FILE_VERSION 1)
(defconstant VIS_FILE 6)
(defun make-file-name ((kind int) (name string) (art-group-version int))
"Make a file name. Similar to MakeFileName in C.
(defun make-file-name ((kind file-kind) (name string) (art-group-version int))
"Get a file name to open a file with the given kind and name.
The art-group-version argument can be used to override the version
of the art-group. Set it to 0 or less to use the default version
Similar to MakeFileName in C.
Note: file type enum is different between C and GOAL.
File versions should match those in versions.h.
Uses a single *file-temp-string* buffer, shared with make-vfile-name."
Uses a single *file-temp-string* buffer, shared with make-vfile-name"
(clear *file-temp-string*)
(cond
((= kind DIR_TPAGE_FILE)
(format *file-temp-string* "texture-page~D/dir-tpages" TPAGE_FILE_VERSION))
((= kind TPAGE_FILE)
(format *file-temp-string* "texture-page~D/tpage-~S" TPAGE_FILE_VERSION name))
((= kind LEVEL_BT_FILE)
(format *file-temp-string* "level~D/~S-bt" LEVEL_BT_FILE_VERSION name))
((= kind TX_FILE)
(format *file-temp-string* "res~D/~S-tx" TX_FILE_VERSION name))
((= kind LEVEL_VS_FILE)
(format *file-temp-string* "level~D/~S-vs" LEVEL_VS_FILE_VERSION name))
((= kind VIS_FILE)
(format *file-temp-string* "~S.VIS" name))
((= kind ART_GROUP_FILE)
((= kind (file-kind dir-tpage))
(format *file-temp-string* "texture-page~D/dir-tpages" TPAGE_FILE_VERSION)
)
((= kind (file-kind tpage))
(format *file-temp-string* "texture-page~D/tpage-~S" TPAGE_FILE_VERSION name)
)
((= kind (file-kind level-bt))
(format *file-temp-string* "level~D/~S-bt" LEVEL_VS_FILE_VERSION name)
)
((= kind (file-kind tx))
(format *file-temp-string* "res~D/~S-tx" TX_FILE_VERSION name)
)
((= kind (file-kind level-vs))
(format *file-temp-string* "level~D/~S-vs" LEVEL_BT_FILE_VERSION name)
)
((= kind (file-kind vis))
(format *file-temp-string* "~S.VIS" name)
)
((= kind (file-kind art-group))
(format *file-temp-string* "art-group~D/~S-ag"
(if (> art-group-version 0) art-group-version ART_GROUP_FILE_VERSION)
(if (> art-group-version 0)
art-group-version
ART_GROUP_FILE_VERSION
)
name
)
)
@ -120,72 +135,66 @@
*file-temp-string*
)
(defun make-vfile-name ((a0-0 int) (a1-0 string))
"Make another type of file name."
(local-vars
(s5-0 int)
(gp-0 string)
)
(set! s5-0 a0-0)
(set! gp-0 a1-0)
(defun make-vfile-name ((kind file-kind) (name string))
"Make virtual? file name. This makes a name that the kernel knows how to
handle in a specific way. This function is not used."
(clear *file-temp-string*)
(cond
((zero? s5-0) (format *file-temp-string* "$LEVEL/~S" gp-0))
((= s5-0 1) (format *file-temp-string* "$ART_GROUP/~S" gp-0))
((= kind (file-kind level-bt))
(format *file-temp-string* "$LEVEL/~S" name)
)
((= kind (file-kind art-group))
(format *file-temp-string* "$ART_GROUP/~S" name)
)
)
*file-temp-string*
)
(defun file-info-correct-version? ((info file-info) (kind int) (version int))
"Check if the file info is valid. If you call this with version = 0,
it will pick the right version for the kind automatically."
(local-vars
(v1-0 int)
(v1-1 int)
(expected-kind string)
(expected-version int)
)
;; figure out the expected major version
(set! expected-version
(defun file-info-correct-version? ((info file-info) (kind file-kind) (version-override int))
"Check if the version and kind in the info is valid. The version-override can specify a
non-default version, or set to 0 for the default version"
(let* ((expected-version
(if (zero? version-override)
(let ((v1-0 kind))
(cond
((zero? version) ;; version not specified.
(set! v1-0 kind)
((or (= v1-0 (file-kind tpage)) (= v1-0 (file-kind dir-tpage)))
TPAGE_FILE_VERSION
)
((= kind (file-kind level-vs))
LEVEL_BT_FILE_VERSION
)
((= v1-0 (file-kind art-group))
ART_GROUP_FILE_VERSION
)
)
)
version-override
)
)
(v1-1 kind)
(kind-name
(cond
((or (= v1-0 TPAGE_FILE) (= v1-0 DIR_TPAGE_FILE)) TPAGE_FILE_VERSION) ;; textures.
((= v1-0 LEVEL_BT_FILE) LEVEL_BT_FILE_VERSION) ;; level
((= v1-0 ART_GROUP_FILE) ART_GROUP_FILE_VERSION) ;; art-group
((= v1-1 (file-kind tpage))
"texture-page"
)
((= kind (file-kind level-vs))
"bsp-header"
)
((= v1-1 (file-kind art-group))
"art-group"
)
)
(else version) ;; version was specified
)
)
;; figure out the expected kind
(set! expected-kind
(begin
(set! v1-1 kind)
(cond ((= v1-1 TPAGE_FILE) "texture-page")
((= v1-1 LEVEL_BT_FILE) "bsp-header")
((= v1-1 ART_GROUP_FILE) "art-group"))
)
)
;; check:
(cond
;; first, check the name is right:
;; not clear why we dereference the symbol like this.
((not (name= (the-as basic (-> info file-type value)) expected-kind))
((not (name= (the-as basic (-> info file-type value)) kind-name))
(format 0 "ERROR: file ~A is of type ~S but needs to be ~S.~%"
(-> info file-name) (-> info file-type) expected-kind)
;; FAIL
'#f
(-> info file-name)
(-> info file-type)
kind-name
)
#f
)
;; check versions (only major)
((!= expected-version (-> info major-version))
(format 0 "ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%"
(-> info file-name)
@ -193,10 +202,13 @@
(-> info minor-version)
expected-version
)
'#f
#f
)
(else
;; all checks passed!
#t
)
)
)
)
;; both tests pass!
(else '#t)
)
)

View file

@ -10,8 +10,8 @@
;; This type didn't have an inspect method, so these field names are made up.
(deftype load-dir (basic)
((unknown basic)
(string-array (array string))
(data-array (array basic))
(string-array (array string)) ;; these are the names
(data-array (array basic)) ;; this is the file data.
)
:flag-assert #xb00000010
(:methods
@ -21,6 +21,7 @@
)
)
;; specialization of load-dir where the data-array holds art-groups.
(deftype load-dir-art-group (load-dir)
()
(:methods
@ -30,29 +31,36 @@
)
(defmethod new load-dir ((allocation symbol) (type-to-make type) (length int) (arg1 basic))
(local-vars (obj load-dir))
(set! obj (object-new allocation type-to-make (the-as int (-> type-to-make size))) )
(set! (-> obj unknown) arg1)
(defmethod new load-dir ((allocation symbol) (type-to-make type) (length int) (unk basic))
"Allocate a new load-dir with room for length entries"
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> obj unknown) unk)
;; create the name array
(set! (-> obj string-array)
(the (array string) ((method-of-type array new) allocation array string length))
(the-as (array string)
((method-of-type array new) allocation array string length)
)
)
(set! (-> obj string-array length) 0)
;; create the data array
(set! (-> obj data-array)
(the (array basic) ((method-of-type array new) allocation array basic length))
)
(the-as (array basic)
((method-of-type array new) allocation array basic length)
))
(set! (-> obj data-array length) 0)
obj
)
)
(defmethod new load-dir-art-group ((allocation symbol) (type-to-make type) (arg0 int) (arg1 basic))
(local-vars (v0-0 load-dir))
;; call parent constructor...
(set! v0-0 ((method-of-type load-dir new) allocation type-to-make arg0 arg1))
;; change our content type to art-group
(set! (-> v0-0 data-array content-type) art-group)
;; cast us to a load-dir-art-group.
(the-as load-dir-art-group v0-0)
(defmethod new load-dir-art-group ((allocation symbol) (type-to-make type) (length int) (unk basic))
"Allocate a new load-dir with room for length art-groups"
;; call parent ctor.
(let ((obj ((method-of-type load-dir new) allocation type-to-make length unk)))
;; override the content type
(set! (-> obj data-array content-type) art-group)
;; and cast to child.
(the-as load-dir-art-group obj)
)
)
(deftype external-art-buffer (basic)
@ -89,23 +97,24 @@
)
)
(defmethod new external-art-buffer ((allocation symbol) (type-to-make type) (arg0 int))
(local-vars (v0-0 external-art-buffer))
(set! v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(set! (-> v0-0 index) arg0)
(set! (-> v0-0 load-file) #f)
(set! (-> v0-0 load-file-part) -1)
(set! (-> v0-0 load-file-owner) (the uint64 #f))
(set! (-> v0-0 load-file-priority) 100000000.0)
(set! (-> v0-0 pending-load-file) #f)
(set! (-> v0-0 pending-load-file-part) -1)
(set! (-> v0-0 pending-load-file-owner) (the uint64 #f))
(set! (-> v0-0 pending-load-file-priority) 100000000.0)
(set! (-> v0-0 art-group) #f)
(set! (-> v0-0 status) 'initialize)
(set! (-> v0-0 locked?) #f)
(set! (-> v0-0 other) #f)
v0-0
(defmethod new external-art-buffer ((allocation symbol) (type-to-make type) (idx int))
"Allocate a new external-art-buffer"
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> obj index) idx)
(set! (-> obj load-file) #f)
(set! (-> obj load-file-part) -1)
(set! (-> obj load-file-owner) (the-as uint #f))
(set! (-> obj load-file-priority) 100000000.0)
(set! (-> obj pending-load-file) #f)
(set! (-> obj pending-load-file-part) -1)
(set! (-> obj pending-load-file-owner) (the-as uint #f))
(set! (-> obj pending-load-file-priority) 100000000.0)
(set! (-> obj art-group) #f)
(set! (-> obj status) 'initialize)
(set! (-> obj locked?) #f)
(set! (-> obj other) #f)
obj
)
)
(deftype spool-anim (basic)
@ -150,39 +159,32 @@
)
(defmethod new external-art-control ((allocation symbol) (type-to-make type))
(local-vars (v1-9 int) (s4-0 int) (obj external-art-control))
(set! obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
;; allocate buffers.
(dotimes (buff-idx 2)
(set! (-> obj buffer buff-idx)
((method-of-type external-art-buffer new) allocation external-art-buffer buff-idx)
)
(set! s4-0 0)
(while (< s4-0 2)
;; construct buffers.
(set! (-> obj buffer s4-0)
((method-of-type external-art-buffer new) allocation external-art-buffer s4-0 )
)
(+! s4-0 1)
)
;; point buffers to each other
(set! (-> obj buffer 0 other) (-> obj buffer 1))
(set! (-> obj buffer 1 other) (-> obj buffer 0))
(set! v1-9 0)
;; set up recs
(while (< v1-9 3)
(set! (-> obj rec v1-9 name) #f)
(set! (-> obj rec v1-9 priority) 100000000.000000)
(set! (-> obj rec v1-9 owner) (the uint64 #f))
(+! v1-9 1)
(dotimes (rec-idx 3)
(set! (-> obj rec rec-idx name) #f)
(set! (-> obj rec rec-idx priority) 100000000.0)
(set! (-> obj rec rec-idx owner) (the-as uint #f))
)
;; setup
(set! (-> obj spool-lock) (the uint64 #f))
;; set up defaults.
(set! (-> obj spool-lock) (the-as uint #f))
(set! (-> obj reserve-buffer) #f)
(set! (-> obj active-stream) #f)
;; setup streams
(set! (-> obj preload-stream name) #f)
(set! (-> obj preload-stream priority) 100000000.000000)
(set! (-> obj preload-stream owner) (the uint64 #f))
(set! (-> obj preload-stream priority) 100000000.0)
(set! (-> obj preload-stream owner) (the-as uint #f))
(set! (-> obj last-preload-stream name) #f)
(set! (-> obj last-preload-stream priority) 100000000.000000)
(set! (-> obj last-preload-stream owner) (the uint64 #f))
(set! (-> obj last-preload-stream priority) 100000000.0)
(set! (-> obj last-preload-stream owner) (the-as uint #f))
obj
)
)

View file

@ -994,6 +994,13 @@ Val* Compiler::compile_declare_type(const goos::Object& form, const goos::Object
throw_compiler_error(form, "Invalid declare-type form: unrecognized option {}.", kind);
}
auto existing_type = m_symbol_types.find(type_name);
if (existing_type != m_symbol_types.end() && existing_type->second != TypeSpec("type")) {
throw_compiler_error(form, "Cannot forward declare {} as a type: it is already a {}", type_name,
existing_type->second.print());
}
m_symbol_types[type_name] = TypeSpec("type");
return get_none();
}

View file

@ -292,3 +292,23 @@
;; vector
;; only because trig isn't in the reference yet.
(define-extern deg-lerp-clamp (function float float float 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)
)
;; loader-h
(declare-type art-group basic)
;; level-h
(declare-type entity-links structure)
(declare-type level-group basic)
(define-extern *level* level-group)

View file

@ -0,0 +1,217 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type file-stream
(deftype file-stream (basic)
((flags uint32 :offset-assert 4)
(mode basic :offset-assert 8)
(name string :offset-assert 12)
(file uint32 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
(:methods
(new (symbol type string basic) _type_ 0)
)
)
;; definition for method 3 of type file-stream
(defmethod inspect file-stream ((obj file-stream))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tflags: #x~X~%" (-> obj flags))
(format #t "~Tmode: ~A~%" (-> obj mode))
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Tfile: ~D~%" (-> obj file))
obj
)
;; definition for method 0 of type file-stream
(defmethod
new
file-stream
((allocation symbol) (type-to-make type) (arg0 string) (arg1 basic))
(let
((a0-1
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(file-stream-open a0-1 arg0 arg1)
)
)
;; failed to figure out what this is:
(set! (-> file-stream method-table 4) file-stream-length)
;; definition for function file-stream-read-string
(defun file-stream-read-string ((arg0 file-stream) (arg1 string))
(clear arg1)
(file-stream-read arg0 (-> arg1 data) (length arg0))
arg1
)
;; definition of type file-info
(deftype file-info (basic)
((file-type symbol :offset-assert 4)
(file-name basic :offset-assert 8)
(major-version uint32 :offset-assert 12)
(minor-version uint32 :offset-assert 16)
(maya-file-name basic :offset-assert 20)
(tool-debug basic :offset-assert 24)
(mdb-file-name basic :offset-assert 28)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
;; definition for method 3 of type file-info
(defmethod inspect file-info ((obj file-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tfile-type: ~A~%" (-> obj file-type))
(format #t "~Tfile-name: ~A~%" (-> obj file-name))
(format #t "~Tmajor-version: ~D~%" (-> obj major-version))
(format #t "~Tminor-version: ~D~%" (-> obj minor-version))
(format #t "~Tmaya-file-name: ~A~%" (-> obj maya-file-name))
(format #t "~Ttool-debug: ~A~%" (-> obj tool-debug))
(format #t "~Tmdb-file-name: ~A~%" (-> obj mdb-file-name))
obj
)
;; definition for method 2 of type file-info
(defmethod print file-info ((obj file-info))
(format
#t
"#<~A ~A :version ~D.~D @ #x~X>"
(-> obj type)
(-> obj file-name)
(-> obj major-version)
(-> obj minor-version)
obj
)
obj
)
;; definition for symbol *file-temp-string*, type string
(define *file-temp-string* (new 'global 'string 128 (the-as string #f)))
;; definition for function make-file-name
(defun make-file-name ((kind file-kind) (name string) (art-group-version int))
(clear *file-temp-string*)
(cond
((= kind (file-kind dir-tpage))
(format *file-temp-string* "texture-page~D/dir-tpages" 7)
)
((= kind (file-kind tpage))
(format *file-temp-string* "texture-page~D/tpage-~S" 7 name)
)
((zero? kind)
(format *file-temp-string* "level~D/~S-bt" 30 name)
)
((= kind (file-kind tx))
(format *file-temp-string* "res~D/~S-tx" 1 name)
)
((= kind (file-kind level-vs))
(format *file-temp-string* "level~D/~S-vs" 30 name)
)
((= kind (file-kind vis))
(format *file-temp-string* "~S.VIS" name)
)
((= kind (file-kind art-group))
(format *file-temp-string* "art-group~D/~S-ag" (cond
((> art-group-version 0)
(empty)
art-group-version
)
(else
6
)
)
name
)
)
)
*file-temp-string*
)
;; definition for function make-vfile-name
(defun make-vfile-name ((kind file-kind) (name string))
(clear *file-temp-string*)
(cond
((zero? kind)
(format *file-temp-string* "$LEVEL/~S" name)
)
((= kind (file-kind art-group))
(format *file-temp-string* "$ART_GROUP/~S" name)
)
)
*file-temp-string*
)
;; definition for function file-info-correct-version?
(defun
file-info-correct-version?
((info file-info) (kind file-kind) (version-override int))
(let* ((expected-version (if (zero? version-override)
(let ((v1-0 kind))
(cond
((or
(= v1-0 (file-kind tpage))
(= v1-0 (file-kind dir-tpage))
)
7
)
((zero? v1-0)
30
)
((= v1-0 (file-kind art-group))
6
)
)
)
version-override
)
)
(v1-1 kind)
(kind-name (cond
((= v1-1 (file-kind tpage))
"texture-page"
)
((zero? v1-1)
"bsp-header"
)
((= v1-1 (file-kind art-group))
"art-group"
)
)
)
)
(cond
((not (name= (the-as basic (-> info file-type value)) kind-name))
(format
0
"ERROR: file ~A is of type ~S but needs to be ~S.~%"
(-> info file-name)
(-> info file-type)
kind-name
)
#f
)
((!= expected-version (-> info major-version))
(format
0
"ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%"
(-> info file-name)
(-> info major-version)
(-> info minor-version)
expected-version
)
#f
)
(else
#t
)
)
)
)

View file

@ -0,0 +1,508 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type level-vis-info
(deftype level-vis-info (basic)
((level basic :offset-assert 4)
(from-level basic :offset-assert 8)
(from-bsp basic :offset-assert 12)
(flags uint32 :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 uint8 :dynamic :offset-assert 52)
)
:method-count-assert 9
:size-assert #x34
:flag-assert #x900000034
)
;; definition for method 3 of type level-vis-info
(defmethod inspect level-vis-info ((obj level-vis-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tlevel: ~A~%" (-> obj level))
(format #t "~Tfrom-level: ~A~%" (-> obj from-level))
(format #t "~Tfrom-bsp: ~A~%" (-> obj from-bsp))
(format #t "~Tflags: #x~X~%" (-> obj flags))
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tallocated-length: ~D~%" (-> obj allocated-length))
(format #t "~Tdictionary-length: ~D~%" (-> obj dictionary-length))
(format #t "~Tdictionary: #x~X~%" (-> obj dictionary))
(format #t "~Tstring-block: #x~X~%" (-> obj string-block))
(format #t "~Tramdisk: ~D~%" (-> obj ramdisk))
(format #t "~Tvis-bits: #x~X~%" (-> obj vis-bits))
(format #t "~Tcurrent-vis-string: ~D~%" (-> obj current-vis-string))
(format #t "~Tvis-string[0] @ #x~X~%" (-> obj vis-string))
obj
)
;; definition for method 5 of type level-vis-info
;; INFO: Return type mismatch uint vs int.
(defmethod asize-of level-vis-info ((obj level-vis-info))
(the-as int (+ (-> level-vis-info size) (-> obj dictionary-length)))
)
;; definition of type level-load-info
(deftype level-load-info (basic)
((name-list basic 3 :offset-assert 4)
(index int32 :offset-assert 16)
(name basic :offset 4)
(visname basic :offset 8)
(nickname basic :offset 12)
(packages pair :offset-assert 20)
(sound-banks pair :offset-assert 24)
(music-bank basic :offset-assert 28)
(ambient-sounds pair :offset-assert 32)
(mood basic :offset-assert 36)
(mood-func basic :offset-assert 40)
(ocean basic :offset-assert 44)
(sky basic :offset-assert 48)
(sun-fade float :offset-assert 52)
(continues pair :offset-assert 56)
(tasks pair :offset-assert 60)
(priority int32 :offset-assert 64)
(load-commands pair :offset-assert 68)
(alt-load-commands pair :offset-assert 72)
(bsp-mask uint64 :offset-assert 80)
(bsphere sphere :offset-assert 88)
(buzzer int32 :offset-assert 92)
(bottom-height float :offset-assert 96)
(run-packages pair :offset-assert 100)
(prev-level basic :offset-assert 104)
(next-level basic :offset-assert 108)
(wait-for-load basic :offset-assert 112)
)
:method-count-assert 9
:size-assert #x74
:flag-assert #x900000074
)
;; definition for method 3 of type level-load-info
(defmethod inspect level-load-info ((obj level-load-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tname-list[3] @ #x~X~%" (-> obj name-list))
(format #t "~Tindex: ~D~%" (-> obj index))
(format #t "~Tname: ~A~%" (-> obj name-list 0))
(format #t "~Tvisname: ~A~%" (-> obj name-list 1))
(format #t "~Tnickname: ~A~%" (-> obj name-list 2))
(format #t "~Tpackages: ~A~%" (-> obj packages))
(format #t "~Tsound-banks: ~A~%" (-> obj sound-banks))
(format #t "~Tmusic-bank: ~A~%" (-> obj music-bank))
(format #t "~Tambient-sounds: ~A~%" (-> obj ambient-sounds))
(format #t "~Tmood: ~A~%" (-> obj mood))
(format #t "~Tmood-func: ~A~%" (-> obj mood-func))
(format #t "~Tocean: ~A~%" (-> obj ocean))
(format #t "~Tsky: ~A~%" (-> obj sky))
(format #t "~Tsun-fade: ~f~%" (-> obj sun-fade))
(format #t "~Tcontinues: ~A~%" (-> obj continues))
(format #t "~Ttasks: ~A~%" (-> obj tasks))
(format #t "~Tpriority: ~D~%" (-> obj priority))
(format #t "~Tload-commands: ~A~%" (-> obj load-commands))
(format #t "~Talt-load-commands: ~A~%" (-> obj alt-load-commands))
(format #t "~Tbsp-mask: ~D~%" (-> obj bsp-mask))
(format #t "~Tbsphere: #<sphere @ #x~X>~%" (-> obj bsphere))
(format #t "~Tbuzzer: ~D~%" (-> obj buzzer))
(format #t "~Tbottom-height: (meters ~m)~%" (-> obj bottom-height))
(format #t "~Trun-packages: ~A~%" (-> obj run-packages))
(format #t "~Tprev-level: ~A~%" (-> obj prev-level))
(format #t "~Tnext-level: ~A~%" (-> obj next-level))
(format #t "~Twait-for-load: ~A~%" (-> obj wait-for-load))
obj
)
;; definition of type login-state
(deftype login-state (basic)
((state int32 :offset-assert 4)
(pos uint32 :offset-assert 8)
(elts uint32 :offset-assert 12)
(elt uint32 16 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
)
;; definition for method 3 of type login-state
(defmethod inspect login-state ((obj login-state))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tstate: ~D~%" (-> obj state))
(format #t "~Tpos: ~D~%" (-> obj pos))
(format #t "~Telts: ~D~%" (-> obj elts))
(format #t "~Telt[16] @ #x~X~%" (-> obj elt))
obj
)
;; definition of type level
(deftype level (basic)
((name basic :offset-assert 4)
(load-name basic :offset-assert 8)
(nickname basic :offset-assert 12)
(index int32 :offset-assert 16)
(status basic :offset-assert 20)
(other basic :offset-assert 24)
(heap kheap :inline :offset-assert 32)
(bsp basic :offset-assert 48)
(art-group basic :offset-assert 52)
(info basic :offset-assert 56)
(texture-page basic 9 :offset-assert 60)
(loaded-texture-page basic 16 :offset-assert 96)
(loaded-texture-page-count int32 :offset-assert 160)
(foreground-sink-group dma-foreground-sink-group 3 :inline :offset-assert 176)
(foreground-draw-engine basic 3 :offset-assert 272)
(entity basic :offset-assert 284)
(ambient basic :offset-assert 288)
(closest-object basic 9 :offset-assert 292)
(upload-size uint32 9 :offset-assert 328)
(level-distance float :offset-assert 364)
(inside-sphere? basic :offset-assert 368)
(inside-boxes? basic :offset-assert 372)
(display? basic :offset-assert 376)
(meta-inside? basic :offset-assert 380)
(mood basic :offset-assert 384)
(mood-func basic :offset-assert 388)
(vis-bits uint32 :offset-assert 392)
(all-visible? basic :offset-assert 396)
(force-all-visible? basic :offset-assert 400)
(linking basic :offset-assert 404)
(vis-info level-vis-info 8 :offset-assert 408)
(vis-self-index int32 :offset-assert 440)
(vis-adj-index int32 :offset-assert 444)
(vis-buffer uint8 2048 :offset-assert 448)
(mem-usage-block basic :offset-assert 2496)
(mem-usage int32 :offset-assert 2500)
(code-memory-start uint32 :offset-assert 2504)
(code-memory-end uint32 :offset-assert 2508)
(texture-mask uint32 9 :offset-assert 2512)
(force-inside? basic :offset-assert 2548)
(pad uint8 56 :offset-assert 2552)
)
:method-count-assert 29
:size-assert #xa30
:flag-assert #x1d00000a30
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
(dummy-27 () none 27)
(dummy-28 () none 28)
)
)
;; definition for method 3 of type level
(defmethod inspect level ((obj level))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Tload-name: ~A~%" (-> obj load-name))
(format #t "~Tnickname: ~A~%" (-> obj nickname))
(format #t "~Tindex: ~D~%" (-> obj index))
(format #t "~Tstatus: ~A~%" (-> obj status))
(format #t "~Tother: ~A~%" (-> obj other))
(format #t "~Theap: #<kheap @ #x~X>~%" (-> obj heap))
(format #t "~Tbsp: ~A~%" (-> obj bsp))
(format #t "~Tart-group: ~A~%" (-> obj art-group))
(format #t "~Tinfo: ~A~%" (-> obj info))
(format #t "~Ttexture-page[9] @ #x~X~%" (-> obj texture-page))
(format #t "~Tloaded-texture-page[16] @ #x~X~%" (-> obj loaded-texture-page))
(format
#t
"~Tloaded-texture-page-count: ~D~%"
(-> obj loaded-texture-page-count)
)
(format
#t
"~Tforeground-sink-group[3] @ #x~X~%"
(-> obj foreground-sink-group)
)
(format
#t
"~Tforeground-draw-engine[3] @ #x~X~%"
(-> obj foreground-draw-engine)
)
(format #t "~Tentity: ~A~%" (-> obj entity))
(format #t "~Tambient: ~A~%" (-> obj ambient))
(format #t "~Tclosest-object[9] @ #x~X~%" (-> obj closest-object))
(format #t "~Tupload-size[9] @ #x~X~%" (-> obj upload-size))
(format #t "~Tlevel-distance: (meters ~m)~%" (-> obj level-distance))
(format #t "~Tinside-sphere?: ~A~%" (-> obj inside-sphere?))
(format #t "~Tinside-boxes?: ~A~%" (-> obj inside-boxes?))
(format #t "~Tdisplay?: ~A~%" (-> obj display?))
(format #t "~Tmeta-inside?: ~A~%" (-> obj meta-inside?))
(format #t "~Tmood: ~A~%" (-> obj mood))
(format #t "~Tmood-func: ~A~%" (-> obj mood-func))
(format #t "~Tvis-bits: #x~X~%" (-> obj vis-bits))
(format #t "~Tall-visible?: ~A~%" (-> obj all-visible?))
(format #t "~Tforce-all-visible?: ~A~%" (-> obj force-all-visible?))
(format #t "~Tlinking: ~A~%" (-> obj linking))
(format #t "~Tvis-info[8] @ #x~X~%" (-> obj vis-info))
(format #t "~Tvis-self-index: ~D~%" (-> obj vis-self-index))
(format #t "~Tvis-adj-index: ~D~%" (-> obj vis-adj-index))
(format #t "~Tvis-buffer[2048] @ #x~X~%" (-> obj vis-buffer))
(format #t "~Tmem-usage-block: ~A~%" (-> obj mem-usage-block))
(format #t "~Tmem-usage: ~D~%" (-> obj mem-usage))
(format #t "~Tcode-memory-start: #x~X~%" (-> obj code-memory-start))
(format #t "~Tcode-memory-end: #x~X~%" (-> obj code-memory-end))
(format #t "~Ttexture-mask[9] @ #x~X~%" (-> obj texture-mask))
(format #t "~Tforce-inside?: ~A~%" (-> obj force-inside?))
obj
)
;; definition of type level-group
(deftype level-group (basic)
((length int32 :offset-assert 4)
(unknown-field-1 basic :offset-assert 8)
(unknown-field-2 basic :offset-assert 12)
(entity-link entity-links :offset 16)
(border? basic :offset-assert 20)
(vis? basic :offset-assert 24)
(want-level basic :offset-assert 28)
(receiving-level basic :offset-assert 32)
(load-commands pair :offset-assert 36)
(play? basic :offset-assert 40)
(hack-pad uint8 :offset 90)
(level0 level :inline :offset-assert 96)
(level1 level :inline :offset-assert 2704)
(level-default level :inline :offset-assert 5312)
(level level 3 :inline :offset 96)
(pad uint32 :offset-assert 7920)
)
:method-count-assert 27
:size-assert #x1ef4
:flag-assert #x1b00001ef4
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
)
)
;; definition for method 3 of type level-group
(defmethod inspect level-group ((obj level-group))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tentity-link: ~`entity-links`P~%" (-> obj entity-link))
(format #t "~Tborder?: ~A~%" (-> obj border?))
(format #t "~Tvis?: ~A~%" (-> obj vis?))
(format #t "~Twant-level: ~A~%" (-> obj want-level))
(format #t "~Treceiving-level: ~A~%" (-> obj receiving-level))
(format #t "~Tload-commands: ~A~%" (-> obj load-commands))
(format #t "~Tplay?: ~A~%" (-> obj play?))
(format #t "~Tlevel[3] @ #x~X~%" (-> obj level0))
(format #t "~Tdata[3] @ #x~X~%" (-> obj level0))
(format #t "~Tlevel0: ~`level`P~%" (-> obj level0))
(format #t "~Tlevel1: ~`level`P~%" (-> obj level1))
(format #t "~Tlevel-default: ~`level`P~%" (-> obj level-default))
obj
)
;; failed to figure out what this is:
(if (zero? *level*)
(set!
*level*
(new 'static 'level-group
:length 2
:unknown-field-1 #f
:unknown-field-2 #f
:entity-link #f
:border? #f
:want-level #f
:load-commands '()
:play? #f
:level0
(new 'static 'level
:name #f
:status 'inactive
:foreground-sink-group
(new 'static 'inline-array dma-foreground-sink-group 3
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink :bucket 10)
(new 'static 'generic-dma-foreground-sink
:bucket 11
:foreground-output-bucket 1
)
)
)
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink :bucket 49 :foreground-texture-page 1)
(new 'static 'generic-dma-foreground-sink
:bucket 50
:foreground-texture-page 1
:foreground-output-bucket 1
)
)
)
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink :bucket 58 :foreground-texture-page 2)
(new 'static 'generic-dma-foreground-sink
:bucket 59
:foreground-texture-page 2
:foreground-output-bucket 1
)
)
)
)
:inside-sphere? #f
:inside-boxes? #f
:force-inside? #f
)
:level1
(new 'static 'level
:name #f
:index 1
:status 'inactive
:foreground-sink-group
(new 'static 'inline-array dma-foreground-sink-group 3
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink
:bucket 17
:foreground-texture-level 1
)
(new 'static 'generic-dma-foreground-sink
:bucket 18
:foreground-texture-level 1
:foreground-output-bucket 1
)
)
)
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink
:bucket 52
:foreground-texture-page 1
:foreground-texture-level 1
)
(new 'static 'generic-dma-foreground-sink
:bucket 53
:foreground-texture-page 1
:foreground-texture-level 1
:foreground-output-bucket 1
)
)
)
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink
:bucket 61
:foreground-texture-page 2
:foreground-texture-level 1
)
(new 'static 'generic-dma-foreground-sink
:bucket 62
:foreground-texture-page 2
:foreground-texture-level 1
:foreground-output-bucket 1
)
)
)
)
:inside-sphere? #f
:inside-boxes? #f
:force-inside? #f
)
:level-default
(new 'static 'level
:name 'default
:index 2
:status 'reserved
:foreground-sink-group
(new 'static 'inline-array dma-foreground-sink-group 3
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink
:bucket 45
:foreground-texture-level 2
)
(new 'static 'generic-dma-foreground-sink
:bucket 46
:foreground-texture-level 2
:foreground-output-bucket 1
)
)
)
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink
:bucket 55
:foreground-texture-page 1
:foreground-texture-level 2
)
(new 'static 'generic-dma-foreground-sink
:bucket 56
:foreground-texture-page 1
:foreground-texture-level 2
:foreground-output-bucket 1
)
)
)
(new 'static 'dma-foreground-sink-group
:sink
(new 'static 'array dma-foreground-sink 3
(new 'static 'dma-foreground-sink
:bucket 58
:foreground-texture-page 2
:foreground-texture-level 2
)
(new 'static 'generic-dma-foreground-sink
:bucket 59
:foreground-texture-page 2
:foreground-texture-level 2
:foreground-output-bucket 1
)
)
)
)
:inside-sphere? #f
:inside-boxes? #f
:force-inside? #f
)
)
)
)

View file

@ -0,0 +1,280 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type load-dir
(deftype load-dir (basic)
((unknown basic :offset-assert 4)
(string-array (array string) :offset-assert 8)
(data-array (array basic) :offset-assert 12)
)
:method-count-assert 11
:size-assert #x10
:flag-assert #xb00000010
(:methods
(new (symbol type int basic) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
)
)
;; definition of type load-dir-art-group
(deftype load-dir-art-group (load-dir)
()
:method-count-assert 11
:size-assert #x10
:flag-assert #xb00000010
(:methods
(new (symbol type int basic) _type_ 0)
)
)
;; definition for method 0 of type load-dir
(defmethod
new
load-dir
((allocation symbol) (type-to-make type) (length int) (unk basic))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(set! (-> obj unknown) unk)
(set!
(-> obj string-array)
(the-as
(array string)
((method-of-type array new) allocation array string length)
)
)
(set! (-> obj string-array length) 0)
(set!
(-> obj data-array)
(the-as
(array basic)
((method-of-type array new) allocation array basic length)
)
)
(set! (-> obj data-array length) 0)
obj
)
)
;; definition for method 0 of type load-dir-art-group
;; INFO: Return type mismatch load-dir vs load-dir-art-group.
(defmethod
new
load-dir-art-group
((allocation symbol) (type-to-make type) (length int) (unk basic))
(let
((obj ((method-of-type load-dir new) allocation type-to-make length unk)))
(set! (-> obj data-array content-type) art-group)
(the-as load-dir-art-group obj)
)
)
;; definition of type external-art-buffer
(deftype external-art-buffer (basic)
((index int32 :offset-assert 4)
(other external-art-buffer :offset-assert 8)
(status basic :offset-assert 12)
(locked? basic :offset-assert 16)
(frame-lock basic :offset-assert 20)
(heap kheap :inline :offset-assert 32)
(pending-load-file basic :offset-assert 48)
(pending-load-file-part int32 :offset-assert 52)
(pending-load-file-owner uint64 :offset-assert 56)
(pending-load-file-priority float :offset-assert 64)
(load-file basic :offset-assert 68)
(load-file-part int32 :offset-assert 72)
(load-file-owner uint64 :offset-assert 80)
(load-file-priority float :offset-assert 88)
(buf uint32 :offset-assert 92)
(len int32 :offset-assert 96)
(art-group basic :offset-assert 100)
)
:method-count-assert 16
:size-assert #x68
:flag-assert #x1000000068
(:methods
(new (symbol type int) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
)
)
;; definition for method 3 of type external-art-buffer
(defmethod inspect external-art-buffer ((obj external-art-buffer))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tindex: ~D~%" (-> obj index))
(format #t "~Tother: ~A~%" (-> obj other))
(format #t "~Tstatus: ~A~%" (-> obj status))
(format #t "~Tlocked?: ~A~%" (-> obj locked?))
(format #t "~Tframe-lock: ~A~%" (-> obj frame-lock))
(format #t "~Theap: #<kheap @ #x~X>~%" (-> obj heap))
(format #t "~Tpending-load-file: ~A~%" (-> obj pending-load-file))
(format #t "~Tpending-load-file-part: ~D~%" (-> obj pending-load-file-part))
(format #t "~Tpending-load-file-owner: ~D~%" (-> obj pending-load-file-owner))
(format
#t
"~Tpending-load-file-priority: ~f~%"
(-> obj pending-load-file-priority)
)
(format #t "~Tload-file: ~A~%" (-> obj load-file))
(format #t "~Tload-file-part: ~D~%" (-> obj load-file-part))
(format #t "~Tload-file-owner: ~D~%" (-> obj load-file-owner))
(format #t "~Tload-file-priority: ~f~%" (-> obj load-file-priority))
(format #t "~Tbuf: #x~X~%" (-> obj buf))
(format #t "~Tlen: ~D~%" (-> obj len))
(format #t "~Tart-group: ~A~%" (-> obj art-group))
obj
)
;; definition for method 0 of type external-art-buffer
(defmethod
new
external-art-buffer
((allocation symbol) (type-to-make type) (idx int))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(set! (-> obj index) idx)
(set! (-> obj load-file) #f)
(set! (-> obj load-file-part) -1)
(set! (-> obj load-file-owner) (the-as uint #f))
(set! (-> obj load-file-priority) 100000000.0)
(set! (-> obj pending-load-file) #f)
(set! (-> obj pending-load-file-part) -1)
(set! (-> obj pending-load-file-owner) (the-as uint #f))
(set! (-> obj pending-load-file-priority) 100000000.0)
(set! (-> obj art-group) #f)
(set! (-> obj status) 'initialize)
(set! (-> obj locked?) #f)
(set! (-> obj other) #f)
obj
)
)
;; definition of type spool-anim
(deftype spool-anim (basic)
((name basic :offset 16)
(index int32 :offset-assert 20)
(parts int32 :offset-assert 24)
(priority float :offset-assert 28)
(owner uint64 :offset-assert 32)
(command-list basic :offset-assert 40)
)
:pack-me
:method-count-assert 9
:size-assert #x2c
:flag-assert #x90000002c
)
;; definition for method 3 of type spool-anim
(defmethod inspect spool-anim ((obj spool-anim))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Tindex: ~D~%" (-> obj index))
(format #t "~Tparts: ~D~%" (-> obj parts))
(format #t "~Tpriority: ~f~%" (-> obj priority))
(format #t "~Towner: ~D~%" (-> obj owner))
(format #t "~Tcommand-list: ~A~%" (-> obj command-list))
obj
)
;; definition of type external-art-control
(deftype external-art-control (basic)
((buffer external-art-buffer 2 :offset-assert 4)
(rec spool-anim 3 :inline :offset-assert 16)
(spool-lock uint64 :offset-assert 160)
(reserve-buffer basic :offset-assert 168)
(reserve-buffer-count int32 :offset-assert 172)
(active-stream basic :offset-assert 176)
(preload-stream spool-anim :inline :offset-assert 184)
(last-preload-stream spool-anim :inline :offset-assert 232)
(end-pad uint32 :offset-assert 276)
)
:method-count-assert 17
:size-assert #x118
:flag-assert #x1100000118
(:methods
(new (symbol type) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
)
)
;; definition for method 3 of type external-art-control
(defmethod inspect external-art-control ((obj external-art-control))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tbuffer[2] @ #x~X~%" (-> obj buffer))
(format #t "~Trec[3] @ #x~X~%" (-> obj rec))
(format #t "~Tspool-lock: ~D~%" (-> obj spool-lock))
(format #t "~Treserve-buffer: ~A~%" (-> obj reserve-buffer))
(format #t "~Treserve-buffer-count: ~D~%" (-> obj reserve-buffer-count))
(format #t "~Tactive-stream: ~A~%" (-> obj active-stream))
(format #t "~Tpreload-stream: #<spool-anim @ #x~X>~%" (-> obj preload-stream))
(format
#t
"~Tlast-preload-stream: #<spool-anim @ #x~X>~%"
(-> obj last-preload-stream)
)
obj
)
;; definition for method 0 of type external-art-control
(defmethod new external-art-control ((allocation symbol) (type-to-make type))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(dotimes (buff-idx 2)
(set!
(-> obj buffer buff-idx)
((method-of-type external-art-buffer new)
allocation
external-art-buffer
buff-idx
)
)
)
(set! (-> obj buffer 0 other) (-> obj buffer 1))
(set! (-> obj buffer 1 other) (-> obj buffer 0))
(dotimes (rec-idx 3)
(set! (-> obj rec rec-idx name) #f)
(set! (-> obj rec rec-idx priority) 100000000.0)
(set! (-> obj rec rec-idx owner) (the-as uint #f))
)
(set! (-> obj spool-lock) (the-as uint #f))
(set! (-> obj reserve-buffer) #f)
(set! (-> obj active-stream) #f)
(set! (-> obj preload-stream name) #f)
(set! (-> obj preload-stream priority) 100000000.0)
(set! (-> obj preload-stream owner) (the-as uint #f))
(set! (-> obj last-preload-stream name) #f)
(set! (-> obj last-preload-stream priority) 100000000.0)
(set! (-> obj last-preload-stream owner) (the-as uint #f))
obj
)
)
;; failed to figure out what this is:
(let ((v0-5 0))
)

View file

@ -0,0 +1,196 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type vis-gif-tag
(deftype vis-gif-tag (structure)
((fog0 uint32 :offset-assert 0)
(strip uint32 :offset-assert 4)
(regs uint32 :offset-assert 8)
(fan uint32 :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition for method 3 of type vis-gif-tag
(defmethod inspect vis-gif-tag ((obj vis-gif-tag))
(format #t "[~8x] ~A~%" obj 'vis-gif-tag)
(format #t "~Tfog0: ~D~%" (-> obj fog0))
(format #t "~Tstrip: ~D~%" (-> obj strip))
(format #t "~Tregs: ~D~%" (-> obj regs))
(format #t "~Tfan: ~D~%" (-> obj fan))
obj
)
;; definition of type cull-info
(deftype cull-info (structure)
((x-fact float :offset-assert 0)
(y-fact float :offset-assert 4)
(z-fact float :offset-assert 8)
(cam-radius float :offset-assert 12)
(cam-x float :offset-assert 16)
(cam-y float :offset-assert 20)
(xz-dir-ax float :offset-assert 24)
(xz-dir-az float :offset-assert 28)
(xz-dir-bx float :offset-assert 32)
(xz-dir-bz float :offset-assert 36)
(xz-cross-ab float :offset-assert 40)
(yz-dir-ay float :offset-assert 44)
(yz-dir-az float :offset-assert 48)
(yz-dir-by float :offset-assert 52)
(yz-dir-bz float :offset-assert 56)
(yz-cross-ab float :offset-assert 60)
)
:pack-me
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
;; definition for method 3 of type cull-info
(defmethod inspect cull-info ((obj cull-info))
(format #t "[~8x] ~A~%" obj 'cull-info)
(format #t "~Tx-fact: ~f~%" (-> obj x-fact))
(format #t "~Ty-fact: ~f~%" (-> obj y-fact))
(format #t "~Tz-fact: ~f~%" (-> obj z-fact))
(format #t "~Tcam-radius: ~f~%" (-> obj cam-radius))
(format #t "~Tcam-x: ~f~%" (-> obj cam-x))
(format #t "~Tcam-y: ~f~%" (-> obj cam-y))
(format #t "~Txz-dir-ax: ~f~%" (-> obj xz-dir-ax))
(format #t "~Txz-dir-az: ~f~%" (-> obj xz-dir-az))
(format #t "~Txz-dir-bx: ~f~%" (-> obj xz-dir-bx))
(format #t "~Txz-dir-bz: ~f~%" (-> obj xz-dir-bz))
(format #t "~Txz-cross-ab: ~f~%" (-> obj xz-cross-ab))
(format #t "~Tyz-dir-ay: ~f~%" (-> obj yz-dir-ay))
(format #t "~Tyz-dir-az: ~f~%" (-> obj yz-dir-az))
(format #t "~Tyz-dir-by: ~f~%" (-> obj yz-dir-by))
(format #t "~Tyz-dir-bz: ~f~%" (-> obj yz-dir-bz))
(format #t "~Tyz-cross-ab: ~f~%" (-> obj yz-cross-ab))
obj
)
;; definition of type math-camera
(deftype math-camera (basic)
((d float :offset-assert 4)
(f float :offset-assert 8)
(fov float :offset-assert 12)
(x-ratio float :offset-assert 16)
(y-ratio float :offset-assert 20)
(x-pix float :offset-assert 24)
(x-clip float :offset-assert 28)
(x-clip-ratio-in float :offset-assert 32)
(x-clip-ratio-over float :offset-assert 36)
(y-pix float :offset-assert 40)
(y-clip float :offset-assert 44)
(y-clip-ratio-in float :offset-assert 48)
(y-clip-ratio-over float :offset-assert 52)
(cull-info cull-info :inline :offset-assert 56)
(fog-start float :offset-assert 120)
(fog-end float :offset-assert 124)
(fog-max float :offset-assert 128)
(fog-min float :offset-assert 132)
(reset int32 :offset-assert 136)
(smooth-step float :offset-assert 140)
(smooth-t float :offset-assert 144)
(perspective matrix :inline :offset-assert 160)
(isometric matrix :inline :offset-assert 224)
(sprite-2d matrix :inline :offset-assert 288)
(sprite-2d-hvdf vector :inline :offset-assert 352)
(camera-rot matrix :inline :offset-assert 368)
(inv-camera-rot matrix :inline :offset-assert 432)
(inv-camera-rot-smooth matrix :inline :offset-assert 496)
(inv-camera-rot-smooth-from quaternion :inline :offset-assert 560)
(camera-temp matrix :inline :offset-assert 576)
(prev-camera-temp matrix :inline :offset-assert 640)
(hmge-scale vector :inline :offset-assert 704)
(inv-hmge-scale vector :inline :offset-assert 720)
(hvdf-off vector :inline :offset-assert 736)
(guard vector :inline :offset-assert 752)
(vis-gifs vis-gif-tag 4 :inline :offset-assert 768)
(giftex uint128 :offset 768)
(gifgr uint128 :offset 784)
(giftex-trans uint128 :offset 800)
(gifgr-trans uint128 :offset 816)
(pfog0 float :offset-assert 832)
(pfog1 float :offset-assert 836)
(trans vector :inline :offset-assert 848)
(plane uint128 4 :offset-assert 864)
(guard-plane uint128 4 :offset-assert 928)
(shrub-mat matrix :inline :offset-assert 992)
(fov-correction-factor float :offset-assert 1056)
)
:method-count-assert 9
:size-assert #x424
:flag-assert #x900000424
(:methods
(new (symbol type) _type_ 0)
)
)
;; definition for method 3 of type math-camera
;; Used lq/sq
(defmethod inspect math-camera ((obj math-camera))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Td: (meters ~m)~%" (-> obj d))
(format #t "~Tf: (meters ~m)~%" (-> obj f))
(format #t "~Tfov: (deg ~r)~%" (-> obj fov))
(format #t "~Tx-ratio: ~f~%" (-> obj x-ratio))
(format #t "~Ty-ratio: ~f~%" (-> obj y-ratio))
(format #t "~Tx-pix: ~f~%" (-> obj x-pix))
(format #t "~Tx-clip: ~f~%" (-> obj x-clip))
(format #t "~Tx-clip-ratio-in: ~f~%" (-> obj x-clip-ratio-in))
(format #t "~Tx-clip-ratio-over: ~f~%" (-> obj x-clip-ratio-over))
(format #t "~Ty-pix: ~f~%" (-> obj y-pix))
(format #t "~Ty-clip: ~f~%" (-> obj y-clip))
(format #t "~Ty-clip-ratio-in: ~f~%" (-> obj y-clip-ratio-in))
(format #t "~Ty-clip-ratio-over: ~f~%" (-> obj y-clip-ratio-over))
(format #t "~Tcull-info: #<cull-info @ #x~X>~%" (-> obj cull-info))
(format #t "~Tfog-start: (meters ~m)~%" (-> obj fog-start))
(format #t "~Tfog-end: (meters ~m)~%" (-> obj fog-end))
(format #t "~Tfog-max: ~f~%" (-> obj fog-max))
(format #t "~Tfog-min: ~f~%" (-> obj fog-min))
(format #t "~Treset: ~D~%" (-> obj reset))
(format #t "~Tsmooth-step: ~f~%" (-> obj smooth-step))
(format #t "~Tsmooth-t: ~f~%" (-> obj smooth-t))
(format #t "~Tperspective: #<matrix @ #x~X>~%" (-> obj perspective))
(format #t "~Tisometric: #<matrix @ #x~X>~%" (-> obj isometric))
(format #t "~Tsprite-2d: #<matrix @ #x~X>~%" (-> obj sprite-2d))
(format #t "~Tsprite-2d-hvdf: #<vector @ #x~X>~%" (-> obj sprite-2d-hvdf))
(format #t "~Tcamera-rot: #<matrix @ #x~X>~%" (-> obj camera-rot))
(format #t "~Tinv-camera-rot: #<matrix @ #x~X>~%" (-> obj inv-camera-rot))
(format
#t
"~Tinv-camera-rot-smooth: #<matrix @ #x~X>~%"
(-> obj inv-camera-rot-smooth)
)
(format
#t
"~Tinv-camera-rot-smooth-from: #<quaternion @ #x~X>~%"
(-> obj inv-camera-rot-smooth-from)
)
(format #t "~Tcamera-temp: #<matrix @ #x~X>~%" (-> obj camera-temp))
(format #t "~Tprev-camera-temp: #<matrix @ #x~X>~%" (-> obj prev-camera-temp))
(format #t "~Thmge-scale: #<vector @ #x~X>~%" (-> obj hmge-scale))
(format #t "~Tinv-hmge-scale: #<vector @ #x~X>~%" (-> obj inv-hmge-scale))
(format #t "~Thvdf-off: #<vector @ #x~X>~%" (-> obj hvdf-off))
(format #t "~Tguard: #<vector @ #x~X>~%" (-> obj guard))
(format #t "~Tvis-gifs[4] @ #x~X~%" (-> obj vis-gifs))
(format #t "~Tgiftex: ~D~%" (-> obj giftex))
(format #t "~Tgifgr: ~D~%" (-> obj gifgr))
(format #t "~Tgiftex-trans: ~D~%" (-> obj giftex-trans))
(format #t "~Tgifgr-trans: ~D~%" (-> obj gifgr-trans))
(format #t "~Tpfog0: ~f~%" (-> obj pfog0))
(format #t "~Tpfog1: ~f~%" (-> obj pfog1))
(format #t "~Ttrans: ~`vector`P~%" (-> obj trans))
(format #t "~Tplane[4] @ #x~X~%" (-> obj plane))
(format #t "~Tguard-plane[4] @ #x~X~%" (-> obj guard-plane))
(format #t "~Tshrub-mat: #<matrix @ #x~X>~%" (-> obj shrub-mat))
(format #t "~Tfov-correction-factor: ~f~%" (-> obj fov-correction-factor))
obj
)
;; failed to figure out what this is:
(let ((v0-3 0))
)

View file

@ -103,7 +103,7 @@
(set! (-> pad button0-rel 0) (the-as uint 0))
(dotimes (v1-2 12)
(nop!)
(set! (-> pad abutton v1-2) 0)
(set! (-> pad abutton v1-2) (the-as uint 0))
)
(set! (-> pad stick0-dir) 0.0)
(set! (-> pad stick0-speed) 0.0)
@ -118,7 +118,7 @@
(set! (-> pad align 4) (the-as uint 255))
(set! (-> pad align 5) (the-as uint 255))
(dotimes (v1-14 6)
(set! (-> pad direct v1-14) 0)
(set! (-> pad direct v1-14) (the-as uint 0))
)
(dotimes (v1-17 2)
(set! (-> pad buzz-val 0) (the-as uint 0))
@ -209,7 +209,7 @@
((pad cpad-info) (buzz-idx int) (buzz-amount int) (duration int))
(cond
((zero? buzz-amount)
(set! (-> pad buzz-val buzz-idx) 0)
(set! (-> pad buzz-val buzz-idx) (the-as uint 0))
(let ((v1-2 0))
)
)
@ -223,7 +223,7 @@
)
)
((< (-> pad buzz-val buzz-idx) (the-as uint buzz-amount))
(set! (-> pad buzz-val buzz-idx) buzz-amount)
(set! (-> pad buzz-val buzz-idx) (the-as uint buzz-amount))
(set!
(-> pad buzz-time buzz-idx)
(+ (get-current-time) (the-as uint duration))
@ -280,8 +280,8 @@
)
)
(else
(set! (-> pad buzz-val buzz-idx) 0)
(set! (-> pad direct buzz-idx) 0)
(set! (-> pad buzz-val buzz-idx) (the-as uint 0))
(set! (-> pad direct buzz-idx) (the-as uint 0))
(let ((v1-22 0))
)
)

View file

@ -100,7 +100,7 @@
(+! idx -1)
(nop!)
(nop!)
(set! (-> obj bytes idx) 0)
(set! (-> obj bytes idx) (the-as uint 0))
)
)
obj

View file

@ -305,7 +305,7 @@ TEST_F(DataDecompTest, ContinuePoint) {
" :z -19435708.0\n"
" :w 1.0\n"
" )\n"
" :camera-rot (new 'static 'array 'float 9\n"
" :camera-rot (new 'static 'array float 9\n"
" 0.5883\n"
" 0.0\n"
" -0.8085\n"
@ -340,7 +340,7 @@ TEST_F(DataDecompTest, FloatArray) {
auto decomp = decompile_at_label_with_hint({"(pointer float)", true, 7}, parsed.label("L63"),
parsed.labels, {parsed.words}, *dts);
check_forms_equal(decomp.print(),
"(new 'static 'array 'float 7\n"
"(new 'static 'array float 7\n"
"1.0 0.0 1.0 0.0 1.0 0.0 1.0)");
}

View file

@ -17,7 +17,8 @@ const std::unordered_set<std::string> g_object_files_to_decompile = {
"trigonometry-h", /* transformq-h */ "matrix", "transform", "quaternion",
"euler", /* geometry, trigonometry, */
"gsound-h", "timer-h", "timer", "vif-h", "dma-h", "video-h", "vu1-user-h", "dma", "dma-buffer",
"dma-bucket", "dma-disasm", "pad", "gs", "display-h", "vector",
"dma-bucket", "dma-disasm", "pad", "gs", "display-h", "vector", "file-io", "loader-h",
"level-h", "math-camera-h",
/* gap */
"bounding-box",
/* gap */
@ -32,7 +33,8 @@ const std::vector<std::string> g_object_files_to_check_against_reference = {
/* transformq-h, */
"matrix", "transform", "quaternion", "euler", /* geometry, trigonometry */
"gsound-h", "timer-h", /* timer, */ "vif-h", "dma-h", "video-h", "vu1-user-h", "dma",
"dma-buffer", "dma-bucket", "dma-disasm", "pad", "gs", "display-h", "vector",
"dma-buffer", "dma-bucket", "dma-disasm", "pad", "gs", "display-h", "vector", "file-io",
"loader-h", "level-h", "math-camera-h",
/* gap */ "bounding-box",
/* gap */
"sync-info-h", "sync-info"};