[decompile] fact-h (#556)

* decompile fact-h

* fix unused var

* codacy again
This commit is contained in:
water111 2021-06-05 11:15:34 -04:00 committed by GitHub
parent 542edfb164
commit 2851cae13b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
27 changed files with 2789 additions and 231 deletions

View File

@ -213,6 +213,10 @@ bool Object::operator==(const Object& other) const {
}
}
bool Object::is_symbol(const std::string& name) const {
return is_symbol() && as_symbol()->name == name;
}
template <>
Object Object::make_number(FloatType value) {
return Object::make_float(value);

View File

@ -325,6 +325,7 @@ class Object {
bool is_float() const { return type == ObjectType::FLOAT; }
bool is_char() const { return type == ObjectType::CHAR; }
bool is_symbol() const { return type == ObjectType::SYMBOL; }
bool is_symbol(const std::string& name) const;
bool is_string() const { return type == ObjectType::STRING; }
bool is_pair() const { return type == ObjectType::PAIR; }
bool is_array() const { return type == ObjectType::ARRAY; }

View File

@ -32,7 +32,7 @@ std::string reg_kind_to_string(RegClass kind) {
*/
bool MethodInfo::operator==(const MethodInfo& other) const {
return id == other.id && name == other.name && type == other.type &&
defined_in_type == other.defined_in_type;
defined_in_type == other.defined_in_type && other.no_virtual == no_virtual;
}
/*!

View File

@ -20,6 +20,7 @@ struct MethodInfo {
std::string name;
TypeSpec type;
std::string defined_in_type;
bool no_virtual = false;
bool operator==(const MethodInfo& other) const;
std::string print_one_line() const;

View File

@ -328,11 +328,11 @@ Type* TypeSystem::lookup_type_allow_partial_def(const std::string& name) const {
throw_typesystem_error("The type {} is unknown.\n", name);
}
MethodInfo TypeSystem::add_method(const std::string& type_name,
const std::string& method_name,
const TypeSpec& ts,
bool allow_new_method) {
return add_method(lookup_type(make_typespec(type_name)), method_name, ts, allow_new_method);
MethodInfo TypeSystem::declare_method(const std::string& type_name,
const std::string& method_name,
bool no_virtual,
const TypeSpec& ts) {
return declare_method(lookup_type(make_typespec(type_name)), method_name, no_virtual, ts);
}
/*!
@ -344,32 +344,74 @@ MethodInfo TypeSystem::add_method(const std::string& type_name,
* is overriding the "new" method - the TypeSystem will track that because overridden new methods
* may have different arguments.
*/
MethodInfo TypeSystem::add_method(Type* type,
const std::string& method_name,
const TypeSpec& ts,
bool allow_new_method) {
MethodInfo TypeSystem::declare_method(Type* type,
const std::string& method_name,
bool no_virtual,
const TypeSpec& ts) {
if (method_name == "new") {
return add_new_method(type, ts);
}
// look up the method
MethodInfo existing_info;
bool got_existing = false;
auto* iter_type = type;
bool got_existing = try_lookup_method(type, method_name, &existing_info);
while (true) {
if (iter_type->get_my_method(method_name, &existing_info)) {
got_existing = true;
break;
if (got_existing) {
// make sure we aren't changing anything.
if (!existing_info.type.is_compatible_child_method(ts, type->get_name())) {
throw_typesystem_error(
"The method {} of type {} was originally declared as {}, but has been "
"redeclared as {}\n",
method_name, type->get_name(), existing_info.type.print(), ts.print());
}
if (iter_type->has_parent()) {
iter_type = lookup_type(iter_type->get_parent());
} else {
// couldn't find method.
break;
if ((existing_info.no_virtual || no_virtual) &&
existing_info.defined_in_type != type->get_name()) {
throw_typesystem_error(
"Cannot define method {} in type {} when it was defined as no_virtual in parent type {}",
method_name, type->get_name(), existing_info.defined_in_type);
}
if (no_virtual != existing_info.no_virtual) {
throw_typesystem_error(
"The method {} of type {} was originally declared with no_virtual = {}, but has been "
"redeclared as {}",
method_name, type->get_name(), existing_info.no_virtual, no_virtual);
}
return existing_info;
} else {
// add a new method!
return type->add_method(
{get_next_method_id(type), method_name, ts, type->get_name(), no_virtual});
}
}
MethodInfo TypeSystem::define_method(const std::string& type_name,
const std::string& method_name,
const TypeSpec& ts) {
return define_method(lookup_type(make_typespec(type_name)), method_name, ts);
}
/*!
* Add a method, if it doesn't exist. If the method already exists (possibly in a parent), checks to
* see if this is an identical definition. If not, it's an error, and if so, nothing happens.
* Returns the info of either the existing or newly created method.
*
* This is not used to override methods, but instead to create truly new methods. The one exception
* is overriding the "new" method - the TypeSystem will track that because overridden new methods
* may have different arguments.
*/
MethodInfo TypeSystem::define_method(Type* type,
const std::string& method_name,
const TypeSpec& ts) {
if (method_name == "new") {
return add_new_method(type, ts);
}
// look up the method
MethodInfo existing_info;
bool got_existing = try_lookup_method(type, method_name, &existing_info);
if (got_existing) {
// make sure we aren't changing anything.
@ -382,12 +424,8 @@ MethodInfo TypeSystem::add_method(Type* type,
return existing_info;
} else {
if (!allow_new_method) {
throw_typesystem_error("Cannot add method {} to type {} because it was not declared.\n",
method_name, type->get_name());
}
// add a new method!
return type->add_method({get_next_method_id(type), method_name, ts, type->get_name()});
throw_typesystem_error("Cannot add method {} to type {} because it was not declared.\n",
method_name, type->get_name());
}
}
@ -454,27 +492,7 @@ bool TypeSystem::try_lookup_method(const std::string& type_name,
return false;
}
auto* iter_type = kv->second.get();
// look up the method
while (true) {
if (method_name == "new") {
if (iter_type->get_my_new_method(info)) {
return true;
}
} else {
if (iter_type->get_my_method(method_name, info)) {
return true;
}
}
if (iter_type->has_parent()) {
iter_type = lookup_type(iter_type->get_parent());
} else {
// couldn't find method.
break;
}
}
return false;
return try_lookup_method(kv->second.get(), method_name, info);
}
/*!
@ -511,6 +529,31 @@ bool TypeSystem::try_lookup_method(const std::string& type_name,
return false;
}
bool TypeSystem::try_lookup_method(const Type* type,
const std::string& method_name,
MethodInfo* info) const {
// look up the method
while (true) {
if (method_name == "new") {
if (type->get_my_new_method(info)) {
return true;
}
} else {
if (type->get_my_method(method_name, info)) {
return true;
}
}
if (type->has_parent()) {
type = lookup_type(type->get_parent());
} else {
// couldn't find method.
break;
}
}
return false;
}
/*!
* Lookup information on a method by ID number. Error if it can't be found. Will check parent types
* if the given type doesn't specialize the method.
@ -763,22 +806,24 @@ void TypeSystem::add_builtin_types() {
forward_declare_type_as_structure("memory-usage-block");
// OBJECT
add_method(obj_type, "new", make_function_typespec({"symbol", "type", "int"}, "_type_"));
add_method(obj_type, "delete", make_function_typespec({"_type_"}, "none"));
add_method(obj_type, "print", make_function_typespec({"_type_"}, "_type_"));
add_method(obj_type, "inspect", make_function_typespec({"_type_"}, "_type_"));
add_method(obj_type, "length",
make_function_typespec({"_type_"}, "int")); // todo - this integer type?
add_method(obj_type, "asize-of", make_function_typespec({"_type_"}, "int"));
add_method(obj_type, "copy", make_function_typespec({"_type_", "symbol"}, "_type_"));
add_method(obj_type, "relocate", make_function_typespec({"_type_", "int"}, "_type_"));
add_method(obj_type, "mem-usage",
make_function_typespec({"_type_", "memory-usage-block"}, "_type_"));
declare_method(obj_type, "new", false,
make_function_typespec({"symbol", "type", "int"}, "_type_"));
declare_method(obj_type, "delete", false, make_function_typespec({"_type_"}, "none"));
declare_method(obj_type, "print", false, make_function_typespec({"_type_"}, "_type_"));
declare_method(obj_type, "inspect", false, make_function_typespec({"_type_"}, "_type_"));
declare_method(obj_type, "length", false,
make_function_typespec({"_type_"}, "int")); // todo - this integer type?
declare_method(obj_type, "asize-of", false, make_function_typespec({"_type_"}, "int"));
declare_method(obj_type, "copy", false, make_function_typespec({"_type_", "symbol"}, "_type_"));
declare_method(obj_type, "relocate", false, make_function_typespec({"_type_", "int"}, "_type_"));
declare_method(obj_type, "mem-usage", false,
make_function_typespec({"_type_", "memory-usage-block"}, "_type_"));
// STRUCTURE
// structure new doesn't support dynamic sizing, which is kinda weird - it grabs the size from
// the type. Dynamic structures use new-dynamic-structure, which is used exactly once ever.
add_method(structure_type, "new", make_function_typespec({"symbol", "type"}, "_type_"));
declare_method(structure_type, "new", false,
make_function_typespec({"symbol", "type"}, "_type_"));
// structure_type is a field-less StructureType, so we have to do this to match the runtime.
// structure_type->override_size_in_memory(4);
@ -787,17 +832,18 @@ void TypeSystem::add_builtin_types() {
add_field_to_type(basic_type, "type", make_typespec("type"));
// the default new basic doesn't support dynamic sizing. anything dynamic will override this
// and then call (method object new) to do the dynamically-sized allocation.
add_method(basic_type, "new", make_function_typespec({"symbol", "type"}, "_type_"));
declare_method(basic_type, "new", false, make_function_typespec({"symbol", "type"}, "_type_"));
// SYMBOL
builtin_structure_inherit(symbol_type);
add_field_to_type(symbol_type, "value", make_typespec("object"));
// a new method which returns type none means new is illegal.
add_method(symbol_type, "new", make_function_typespec({}, "none"));
declare_method(symbol_type, "new", false, make_function_typespec({}, "none"));
// TYPE
builtin_structure_inherit(type_type);
add_method(type_type, "new", make_function_typespec({"symbol", "type", "int"}, "_type_"));
declare_method(type_type, "new", false,
make_function_typespec({"symbol", "type", "int"}, "_type_"));
add_field_to_type(type_type, "symbol", make_typespec("symbol"));
add_field_to_type(type_type, "parent", make_typespec("type"));
add_field_to_type(type_type, "size", make_typespec("uint16")); // actually u16
@ -813,8 +859,8 @@ void TypeSystem::add_builtin_types() {
add_field_to_type(string_type, "data", make_typespec("uint8"), false, true); // todo integer type
// string is never deftype'd for the decompiler, so we need to manually give the constructor
// type here.
add_method(string_type, "new",
make_function_typespec({"symbol", "type", "int", "string"}, "_type_"));
declare_method(string_type, "new", false,
make_function_typespec({"symbol", "type", "int", "string"}, "_type_"));
// FUNCTION
builtin_structure_inherit(function_type);
@ -842,8 +888,8 @@ void TypeSystem::add_builtin_types() {
// todo
builtin_structure_inherit(array_type);
add_method(array_type, "new",
make_function_typespec({"symbol", "type", "type", "int"}, "_type_"));
declare_method(array_type, "new", false,
make_function_typespec({"symbol", "type", "type", "int"}, "_type_"));
// array has: number, number, type
add_field_to_type(array_type, "length", make_typespec("int32"));
add_field_to_type(array_type, "allocated-length", make_typespec("int32"));
@ -852,8 +898,8 @@ void TypeSystem::add_builtin_types() {
// pair
pair_type->override_offset(2);
add_method(pair_type, "new",
make_function_typespec({"symbol", "type", "object", "object"}, "_type_"));
declare_method(pair_type, "new", false,
make_function_typespec({"symbol", "type", "object", "object"}, "_type_"));
add_field_to_type(pair_type, "car", make_typespec("object"));
add_field_to_type(pair_type, "cdr", make_typespec("object"));
@ -870,8 +916,8 @@ void TypeSystem::add_builtin_types() {
add_field_to_type(file_stream_type, "mode", make_typespec("basic"));
add_field_to_type(file_stream_type, "name", make_typespec("string"));
add_field_to_type(file_stream_type, "file", make_typespec("uint32"));
add_method(file_stream_type, "new",
make_function_typespec({"symbol", "type", "string", "basic"}, "_type_"));
declare_method(file_stream_type, "new", false,
make_function_typespec({"symbol", "type", "string", "basic"}, "_type_"));
}
/*!
@ -1541,15 +1587,15 @@ std::string TypeSystem::generate_deftype(const Type* type) const {
type->get_name(), type->get_parent());
}
bool TypeSystem::should_use_virtual_methods(const Type* type) const {
bool TypeSystem::should_use_virtual_methods(const Type* type, int method_id) const {
auto as_basic = dynamic_cast<const BasicType*>(type);
if (as_basic && !as_basic->final()) {
if (as_basic && !as_basic->final() && !lookup_method(type->get_name(), method_id).no_virtual) {
return true;
} else {
return false;
}
}
bool TypeSystem::should_use_virtual_methods(const TypeSpec& type) const {
return should_use_virtual_methods(lookup_type(type));
bool TypeSystem::should_use_virtual_methods(const TypeSpec& type, int method_id) const {
return should_use_virtual_methods(lookup_type(type), method_id);
}

View File

@ -118,17 +118,23 @@ class TypeSystem {
Type* lookup_type_allow_partial_def(const TypeSpec& ts) const;
Type* lookup_type_allow_partial_def(const std::string& name) const;
MethodInfo add_method(const std::string& type_name,
const std::string& method_name,
const TypeSpec& ts,
bool allow_new_method = true);
MethodInfo add_method(Type* type,
const std::string& method_name,
const TypeSpec& ts,
bool allow_new_method = true);
MethodInfo declare_method(const std::string& type_name,
const std::string& method_name,
bool no_virtual,
const TypeSpec& ts);
MethodInfo declare_method(Type* type,
const std::string& method_name,
bool no_virtual,
const TypeSpec& ts);
MethodInfo define_method(const std::string& type_name,
const std::string& method_name,
const TypeSpec& ts);
MethodInfo define_method(Type* type, const std::string& method_name, const TypeSpec& ts);
MethodInfo add_new_method(Type* type, const TypeSpec& ts);
MethodInfo lookup_method(const std::string& type_name, const std::string& method_name) const;
MethodInfo lookup_method(const std::string& type_name, int method_id) const;
bool try_lookup_method(const Type* type, const std::string& method_name, MethodInfo* info) const;
bool try_lookup_method(const std::string& type_name,
const std::string& method_name,
MethodInfo* info) const;
@ -174,8 +180,8 @@ class TypeSystem {
int offset,
int field_size);
bool should_use_virtual_methods(const Type* type) const;
bool should_use_virtual_methods(const TypeSpec& type) const;
bool should_use_virtual_methods(const Type* type, int method_id) const;
bool should_use_virtual_methods(const TypeSpec& type, int method_id) const;
/*!
* Get a type by name and cast to a child class of Type*. Must succeed.

View File

@ -166,20 +166,30 @@ void add_bitfield(BitFieldType* bitfield_type, TypeSystem* ts, const goos::Objec
void declare_method(Type* type, TypeSystem* type_system, const goos::Object& def) {
for_each_in_list(def, [&](const goos::Object& _obj) {
auto obj = &_obj;
// (name args return-type [id])
// (name args return-type [:no-virtual] [id])
auto method_name = symbol_string(car(obj));
obj = cdr(obj);
auto& args = car(obj);
obj = cdr(obj);
auto& return_type = car(obj);
obj = cdr(obj);
bool no_virtual = false;
if (!obj->is_empty_list() && car(obj).is_symbol(":no-virtual")) {
obj = cdr(obj);
no_virtual = true;
}
int id = -1;
if (!obj->is_empty_list()) {
if (!obj->is_empty_list() && car(obj).is_int()) {
auto& id_obj = car(obj);
id = get_int(id_obj);
if (!cdr(obj)->is_empty_list()) {
throw std::runtime_error("too many things in method def: " + def.print());
}
obj = cdr(obj);
}
if (!obj->is_empty_list()) {
throw std::runtime_error("too many things in method def: " + def.print());
}
TypeSpec function_typespec("function");
@ -189,7 +199,7 @@ void declare_method(Type* type, TypeSystem* type_system, const goos::Object& def
});
function_typespec.add_arg(parse_typespec(type_system, return_type));
auto info = type_system->add_method(type, method_name, function_typespec);
auto info = type_system->declare_method(type, method_name, no_virtual, function_typespec);
// check the method assert
if (id != -1) {

View File

@ -746,9 +746,9 @@ TP_Type LoadVarOp::get_src_type(const TypeState& input,
if (method_id == GOAL_NEW_METHOD) {
return TP_Type::make_from_ts(method_type);
} else if (input_type.kind == TP_Type::Kind::TYPE_OF_TYPE_NO_VIRTUAL) {
return TP_Type::make_non_virtual_method(method_type, TypeSpec(type_name));
return TP_Type::make_non_virtual_method(method_type, TypeSpec(type_name), method_id);
} else {
return TP_Type::make_virtual_method(method_type, TypeSpec(type_name));
return TP_Type::make_virtual_method(method_type, TypeSpec(type_name), method_id);
}
}
@ -760,7 +760,7 @@ TP_Type LoadVarOp::get_src_type(const TypeState& input,
if (method_id != GOAL_NEW_METHOD && method_id != GOAL_RELOC_METHOD) {
// this can get us the wrong thing for `new` methods. And maybe relocate?
return TP_Type::make_non_virtual_method(
method_info.type.substitute_for_method_call("object"), TypeSpec("object"));
method_info.type.substitute_for_method_call("object"), TypeSpec("object"), method_id);
}
}

View File

@ -1790,12 +1790,20 @@ void FunctionCallElement::update_from_stack(const Env& env,
function_type = tp_type.typespec();
}
bool swap_function = tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD && true;
if (tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD) {
// this is a hack to make some weird macro for calling res-lump methods work
if (env.dts->ts.tc(TypeSpec("res-lump"), tp_type.method_from_type())) {
swap_function = false;
}
}
if (swap_function) {
std::swap(all_pop_vars.at(0), all_pop_vars.at(1));
}
auto unstacked = pop_to_forms(all_pop_vars, env, pool, stack, allow_side_effects);
if (tp_type.kind == TP_Type::Kind::NON_VIRTUAL_METHOD) {
if (swap_function) {
std::swap(unstacked.at(0), unstacked.at(1));
std::swap(all_pop_vars.at(0), all_pop_vars.at(1));
}
@ -1848,10 +1856,11 @@ void FunctionCallElement::update_from_stack(const Env& env,
"type.");
}
if (!env.dts->ts.should_use_virtual_methods(tp_type.method_from_type())) {
if (!env.dts->ts.should_use_virtual_methods(tp_type.method_from_type(),
tp_type.method_id())) {
throw std::runtime_error(
fmt::format("Method call on {} used a virtual call unexpectedly.",
tp_type.method_from_type().print()));
fmt::format("Method call on {} id {} used a virtual call unexpectedly.",
tp_type.method_from_type().print(), tp_type.method_id()));
}
// fmt::print("STACK\n{}\n\n", stack.print(env));
auto pop =
@ -1994,11 +2003,12 @@ void FunctionCallElement::update_from_stack(const Env& env,
tp_type.print()));
}
if (env.dts->ts.should_use_virtual_methods(tp_type.method_from_type())) {
throw std::runtime_error(
fmt::format("Expected type {} to use virtual methods, but it didn't. Set option "
":final in the deftype to disable virtual method calls",
tp_type.method_from_type().print()));
if (env.dts->ts.should_use_virtual_methods(tp_type.method_from_type(),
tp_type.method_id())) {
throw std::runtime_error(fmt::format(
"Expected type {} method id {} to use virtual methods, but it didn't. Set option "
":final in the deftype to disable virtual method calls",
tp_type.method_from_type().print(), tp_type.method_id()));
}
}

View File

@ -8889,10 +8889,10 @@
;; field extra is a basic loaded with a signed load
(:methods
(new (symbol type int int) _type_ 0)
(get-property-data (_type_ symbol symbol float pointer (pointer res-tag) pointer) pointer 9)
(get-property-struct (_type_ symbol symbol float structure (pointer res-tag) pointer) structure 10)
(get-property-value (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 11)
(get-property-value2 (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 12)
(get-property-data (_type_ symbol symbol float pointer (pointer res-tag) pointer) pointer :no-virtual 9)
(get-property-struct (_type_ symbol symbol float structure (pointer res-tag) pointer) structure :no-virtual 10)
(get-property-value (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 :no-virtual 11)
(get-property-value2 (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 :no-virtual 12)
(get-tag-index-data (_type_ int) pointer 13)
(get-tag-data (_type_ res-tag) pointer 14)
(dummy-15 (_type_ res-tag) res-tag 15)

View File

@ -396,71 +396,63 @@
"(method 10 shadow-control)": [[1, "v1", "int"]],
// FACT-H
"(method 0 fact-info-enemy)": [[3, "v0", "fact-info-enemy"]],
"(method 0 fact-info-target)": [[3, "v0", "fact-info-target"]],
"(method 0 fact-info-enemy)": [
[[3,92], "gp", "fact-info-enemy"],
[16, "v0", "float"],
[28, "v0", "float"],
[40, "v0", "float"],
[52, "v0", "float"],
[64, "v0", "float"],
[76, "v0", "float"],
[88, "v0", "float"]
],
"(method 0 fact-info)": [
[81, "v0", "float"],
[16, "t9", "(function string none)"],
["_stack_", 16, "res-tag"],
[[32, 43], "v1", "(pointer int32)"],
[86, "gp", "fact-info"]
],
"(method 0 fact-info-target)": [[[3,20], "gp", "fact-info-target"]],
"(method 0 align-control)": [
[[8, 13], "t9", "(function object object)"],
[[14,18], "v0", "align-control"]
[[14, 18], "v0", "align-control"]
],
"str-load": [
[[20, 36], "s2", "load-chunk-msg"]
],
"str-load": [[[20, 36], "s2", "load-chunk-msg"]],
"str-load-status":[
"str-load-status": [
[[18, 22], "v1", "load-chunk-msg"],
[26, "v1", "load-chunk-msg"]
],
"str-play-async": [
[[8, 16], "s4", "load-chunk-msg"]
],
"str-play-async": [[[8, 16], "s4", "load-chunk-msg"]],
"str-play-stop": [
[[7, 14], "s5", "load-chunk-msg"]
],
"str-play-stop": [[[7, 14], "s5", "load-chunk-msg"]],
"str-play-queue": [
[[19, 27], "s5", "load-chunk-msg"]
],
"str-play-queue": [[[19, 27], "s5", "load-chunk-msg"]],
"str-ambient-play": [
[[7, 15], "s5", "load-chunk-msg"]
],
"str-ambient-play": [[[7, 15], "s5", "load-chunk-msg"]],
"str-ambient-stop": [
[[7, 16], "s5", "load-chunk-msg"]
],
"str-ambient-stop": [[[7, 16], "s5", "load-chunk-msg"]],
"dgo-load-begin": [
[[21, 40], "s2", "load-dgo-msg"]
],
"dgo-load-begin": [[[21, 40], "s2", "load-dgo-msg"]],
"dgo-load-get-next": [
[[14, 31], "v1", "load-dgo-msg"]
],
"dgo-load-get-next": [[[14, 31], "v1", "load-dgo-msg"]],
"dgo-load-continue": [
[[5, 21], "gp", "load-dgo-msg"]
],
"dgo-load-continue": [[[5, 21], "gp", "load-dgo-msg"]],
"string->sound-name": [
[[2, 18], "a1", "(pointer uint8)"]
],
"string->sound-name": [[[2, 18], "a1", "(pointer uint8)"]],
"ramdisk-load": [
[[8, 12], "v1", "ramdisk-rpc-load"]
],
"ramdisk-load": [[[8, 12], "v1", "ramdisk-rpc-load"]],
"(method 3 generic-tie-interp-point)": [
[15, "gp", "(pointer uint128)"]
],
"(method 3 generic-tie-interp-point)": [[15, "gp", "(pointer uint128)"]],
"ripple-find-height": [[[22, 72], "s4", "mei-ripple"]],
"ripple-find-height": [
[[22, 72], "s4", "mei-ripple"]
],
"(method 0 collide-shape-prim-sphere)": [
[[4, 8], "v0", "collide-shape-prim-sphere"]
],
@ -471,11 +463,7 @@
[[11, 18], "v0", "collide-shape-prim-group"]
],
"camera-teleport-to-entity": [
[9, "a0", "transform"]
],
"camera-teleport-to-entity": [[9, "a0", "transform"]],
"entity-actor-count": [
["_stack_", 16, "res-tag"]
]
"entity-actor-count": [["_stack_", 16, "res-tag"]]
}

View File

@ -1659,6 +1659,16 @@
}
},
"(method 0 fact-info)": {
"args":["allocation", "type-to-make", "proc", "pkup-type", "pkup-amount"],
"vars": {
"gp-0":["obj", "fact-info"],
"s5-0":"ent",
"sv-16":"tag",
"t9-1":["go-func", "(function string none)"]
}
},
"(method 0 align-control)": {
"vars": { "v0-0": ["obj", "align-control"] }
},

View File

@ -111,19 +111,25 @@ class TP_Type {
static TP_Type make_from_ts(const std::string& ts) { return make_from_ts(TypeSpec(ts)); }
static TP_Type make_virtual_method(const TypeSpec& method_type, const TypeSpec& obj_type) {
static TP_Type make_virtual_method(const TypeSpec& method_type,
const TypeSpec& obj_type,
int method_id) {
TP_Type result;
result.kind = Kind::VIRTUAL_METHOD;
result.m_ts = method_type;
result.m_method_from_type = obj_type;
result.m_method_id = method_id;
return result;
}
static TP_Type make_non_virtual_method(const TypeSpec& method_type, const TypeSpec& obj_type) {
static TP_Type make_non_virtual_method(const TypeSpec& method_type,
const TypeSpec& obj_type,
int method_id) {
TP_Type result;
result.kind = Kind::NON_VIRTUAL_METHOD;
result.m_method_from_type = obj_type;
result.m_ts = method_type;
result.m_method_id = method_id;
return result;
}
@ -295,9 +301,15 @@ class TP_Type {
return m_method_from_type;
}
int method_id() const {
assert(kind == Kind::VIRTUAL_METHOD || kind == Kind::NON_VIRTUAL_METHOD);
return m_method_id;
}
private:
TypeSpec m_ts;
TypeSpec m_method_from_type;
int m_method_id = -1;
std::string m_str;
int64_t m_int = 0;
bool m_pcpyud = false; // have we extracted the top doubleword of a bitfield?

View File

@ -124,3 +124,4 @@
:flag-assert #x900000090
)
(define-extern vu-lights<-light-group! (function vu-lights light-group none))

View File

@ -41,10 +41,10 @@
;; field extra is a basic loaded with a signed load
(:methods
(new (symbol type int int) _type_ 0)
(get-property-data (_type_ symbol symbol float pointer (pointer res-tag) pointer) pointer 9)
(get-property-struct (_type_ symbol symbol float structure (pointer res-tag) pointer) structure 10)
(get-property-value (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 11)
(get-property-value2 (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 12)
(get-property-data (_type_ symbol symbol float pointer (pointer res-tag) pointer) pointer :no-virtual 9)
(get-property-struct (_type_ symbol symbol float structure (pointer res-tag) pointer) structure :no-virtual 10)
(get-property-value (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 :no-virtual 11)
(get-property-value2 (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 :no-virtual 12)
(get-tag-index-data (_type_ int) pointer 13)
(get-tag-data (_type_ res-tag) pointer 14)
(dummy-15 (_type_ res-tag) res-tag 15)

View File

@ -439,6 +439,20 @@
default
)
(defmacro res-lump-data (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)))
"Helper macro to get data from a res-lump without interpolation."
`(the-as ,type ((method-of-type res-lump get-property-data)
,lump
,name
'interp
0.0
(the-as pointer #f)
,tag-ptr
*res-static-buf*
)
)
)
(defmethod get-property-struct res-lump ((obj res-lump) (name symbol) (mode symbol) (time float) (default structure) (tag-addr (pointer res-tag)) (buf-addr pointer))
"Returns a given struct property's value at a specific time stamp, or default on error.
name is the name of the property you want, mode is its lookup mode ('interp 'base 'exact), time is the timestamp.
@ -521,6 +535,20 @@
default
)
(defmacro res-lump-value (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)))
"Helper macro to get a value from a res-lump with no interpolation."
`(the-as ,type ((method-of-type res-lump get-property-value)
,lump
,name
'interp
-1000000000.0
(the-as uint128 0)
,tag-ptr
*res-static-buf*
)
)
)
(defmethod get-property-value2 res-lump ((obj res-lump) (name symbol) (mode symbol) (time float) (default uint128) (tag-addr (pointer res-tag)) (buf-addr pointer))
"same as get-property-value but float type is checked first?"
@ -570,6 +598,20 @@
default
)
(defmacro res-lump-float (lump name &key (tag-ptr (the-as (pointer res-tag) #f)) &key (default 0.0))
"Helper macro to get a float from a res-lump with no interpolation."
`(the-as float ((method-of-type res-lump get-property-value2)
,lump
,name
'interp
-1000000000.0
(the-as uint128 ,default)
,tag-ptr
*res-static-buf*
)
)
)
(defmethod sort! res-lump ((obj res-lump))
"Sort all tags based on name, then key-frame."

View File

@ -5,7 +5,8 @@
;; name in dgo: fact-h
;; dgos: GAME, ENGINE
;; NOT FINISHED
;; The fact bank is a single static object containing health/eco parameters
;; All game code should reference *FACT-bank* to determine these parameters
(deftype fact-bank (basic)
((eco-level-max float :offset-assert 4)
@ -76,12 +77,16 @@
)
)
;; Each individual enemy and pickup process will allocate a fact-info on its process heap
;; The settings may be different per object - for example some eco pickups may have different
;; amounts or timings
;; The fact-info class stores data that is common to all fact-infos.
(deftype fact-info (basic)
((process process :offset-assert 4)
((process process :offset-assert 4) ;; the process that this info is for
(pickup-type pickup-type :offset-assert 8)
(pickup-amount float :offset-assert 12)
(pickup-amount float :offset-assert 12) ;; eco increment on pickup
(pickup-spawn-amount float :offset-assert 16)
(options uint64 :offset-assert 24)
(options uint64 :offset-assert 24) ;; actually bitfield enum
(fade-time uint64 :offset-assert 32)
)
:method-count-assert 12
@ -139,8 +144,93 @@
)
)
(defmethod new fact-info ((allocation symbol) (type-to-make type) (proc process) (pkup-type pickup-type) (pkup-amount float))
"Create information about a pickup. This should be called from a process which is a pickup. This will read settings from
the entity of the process automatically. Will attempt to read pickup-type and amount from the entity, but if this
fails will use the values in the arguments"
(local-vars (tag res-tag))
(with-pp
;; allocate.
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(let ((ent (the res-lump (-> proc entity))))
;; confirm that we allocated successfully
(when (zero? obj)
(go process-drawable-art-error "memory")
;; this is already true...
(set! obj (the-as fact-info 0))
(goto cfg-10)
)
;; remember who we belong to
(set! (-> obj process) proc)
;; eco may override the pickup type and amount, so try to get this.
(let ((v1-6 (res-lump-data ent 'eco-info (pointer int32) :tag-ptr (& tag))))
(cond
(v1-6
;; eco-info lookup succeeded,
(let ((a0-6 (-> tag elt-count)))
;; first thing is pickup type, it's always there
(set! (-> obj pickup-type) (the-as pickup-type (-> v1-6 0)))
;; pickup amount is optional.
(set! pkup-amount (if (< (the-as uint 1) (the-as uint a0-6))
(the float (-> v1-6 1))
pkup-amount
)
)
)
(set! (-> obj pickup-amount) pkup-amount)
)
(else
;; no eco-info, use stuff from args
(set! (-> obj pickup-type) pkup-type)
(set! (-> obj pickup-amount) pkup-amount)
)
)
)
;; read the options
(set! (-> obj options) (res-lump-value ent 'options uint))
;; TODO - some enum bitfield here.
(if (nonzero? (logand #x80200 (the-as int (-> obj options))))
(set! (-> obj fade-time) (the-as uint (the int (* 300.0 (res-lump-float ent 'timeout)))))
)
)
(label cfg-10)
obj
)
)
)
(defmethod dummy-11 fact-info ((obj fact-info))
0.0
)
(defmethod new fact-info-enemy ((allocation symbol) (type-to-make type) (proc process) (kind pickup-type) (amount float))
"Create information about an enemy. Possibly includes what the enemy will drop when it is killed?"
;; base class ctor
(let ((obj (the-as fact-info-enemy ((method-of-type fact-info new) allocation type-to-make proc kind amount))))
;; read values from the process entity
(let ((entity (the res-lump (-> obj process entity))))
(set! (-> obj speed) (res-lump-float entity 'speed :default 1.0))
(set! (-> obj idle-distance) (res-lump-float entity 'idle-distance :default 327680.0))
(set! (-> obj notice-top) (res-lump-float entity 'notice-top :default 4096000.0))
(set! (-> obj notice-bottom) (res-lump-float entity 'notice-bottom :default 4096000.0))
(set! (-> obj cam-horz) (res-lump-float entity 'cam-horz))
(set! (-> obj cam-vert) (res-lump-float entity 'cam-vert))
(set! (-> obj cam-notice-dist) (res-lump-float entity 'cam-notice-dist :default -4096.0))
)
obj
)
)
(defmethod new fact-info-target ((allocation symbol) (type-to-make type) (arg0 process) (arg1 pickup-type) (arg2 float))
"Create information about target. Not sure why this has stuff like pickup-type."
(let ((obj (the-as fact-info-target ((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2))))
(set! (-> obj eco-source) (the-as uint #f))
(dummy-10 obj #f)
obj
)
)

View File

@ -40,9 +40,6 @@
out
)
;; TODO - temporary for lights.gc
(define-extern vu-lights<-light-group! (function vu-lights light-group none))
(defun light-group-process! ((lights vu-lights) (group light-group) (vector-1 vector) (vector-2 vector))
"Unused - Seems to do effectively nothing"
;; NOTE - dead code

View File

@ -72,7 +72,7 @@ RegVal* Compiler::compile_get_method_of_object(const goos::Object& form,
auto fe = get_parent_env_of_type<FunctionEnv>(env);
RegVal* runtime_type = nullptr;
if (m_ts.should_use_virtual_methods(compile_time_type)) {
if (m_ts.should_use_virtual_methods(compile_time_type, method_info.id)) {
runtime_type = fe->make_gpr(m_ts.make_typespec("type"));
MemLoadInfo info;
info.size = 4;
@ -496,8 +496,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
m_symbol_info.add_method(symbol_string(method_name), symbol_string(type_name), form);
auto info =
m_ts.add_method(symbol_string(type_name), symbol_string(method_name), lambda_ts, false);
auto info = m_ts.define_method(symbol_string(type_name), symbol_string(method_name), lambda_ts);
auto type_obj = compile_get_symbol_value(form, symbol_string(type_name), env)->to_gpr(env);
auto id_val = compile_integer(info.id, env)->to_gpr(env);
auto method_val = place->to_gpr(env);

View File

@ -722,45 +722,92 @@
;; TODO - for entity-h
(declare-type nav-mesh basic)
(define-extern entity-nav-login function)
(deftype res-tag (uint128)
((unk0 uint32 :offset 0 :size 32)
(unk1 uint16 :offset 32 :size 16)
(unk2 uint64 :offset 64 :size 64)
)
:flag-assert #x900000010
)
(deftype res-lump (basic)
((length int32 :offset-assert 4)
(allocated-length int32 :offset-assert 8)
(data-base pointer :offset-assert 12)
(data-top pointer :offset-assert 16)
(data-size int32 :offset-assert 20)
(extra basic :offset-assert 24)
(tag (pointer res-tag) :offset-assert 28)
)
:method-count-assert 22
:size-assert #x20
:flag-assert #x1600000020
;; field extra is a basic loaded with a signed load
(:methods
(new (symbol type int int) _type_ 0)
(dummy-9 (_type_ symbol symbol int symbol (pointer res-tag) pointer) symbol 9)
(dummy-10 (_type_ symbol symbol int symbol symbol pointer) int 10)
(dummy-11 (_type_ symbol symbol int int symbol pointer) int 11)
(dummy-12 (_type_ symbol symbol float float symbol pointer) float 12)
(dummy-13 (_type_ int) pointer 13) ;; advance tag pointer
(dummy-14 (_type_ uint) pointer 14)
(dummy-15 (_type_) none 15)
(dummy-16 (_type_ int int int int) none 16)
(dummy-17 (_type_ int int) res-lump 17)
(dummy-18 (_type_ int int) none 18)
(dummy-19 (_type_ symbol symbol int) int 19)
(dummy-20 (_type_ int int) none 20)
(dummy-21 (_type_ int int int int int) none 21)
)
)
;; NOTE - forward declaration needed for cam-interface
(define-extern *camera-dummy-vector* vector)
(define-extern send-event-function (function process event-message-block object))
(define-extern *debug-engine* engine)
(deftype res-tag-pair (uint64)
((lo uint32 :offset 0)
(hi uint32 :offset 32)
)
)
(declare-type surface basic)
(define-extern *tread-surface* surface)
(define-extern *ice-surface* surface)
(define-extern *tar-surface* surface)
(define-extern *quicksand-surface* surface)
(define-extern *slope-surface* surface)
(define-extern *wade-surface* surface)
(define-extern *edge-surface* surface)
(define-extern *stone-surface* surface)
(define-extern *flop-land-mods* surface)
(define-extern *uppercut-jump-mods* surface)
(define-extern *duck-mods* surface)
(define-extern *pole-mods* surface)
(define-extern *grab-mods* surface)
(define-extern *edge-grab-mods* surface)
(define-extern *grass-surface* surface)
(defenum pat-material
:type uint8
(stone)
(ice)
(quicksand)
(waterbottom)
(tar)
(sand)
(wood)
(grass)
(pcmetal)
(snow)
(deepsnow)
(hotcoals)
(lava)
(crwood)
(gravel)
(dirt)
(metal)
(straw)
(tube)
(swamp)
(stopproj)
(rotate)
(neutral)
)
(defenum pat-mode
:type uint8
(ground)
(wall)
(obstacle)
)
(defenum pat-event
:type uint8
(none)
(deadly)
(endlessfall)
(burn)
(deadlyup)
(burnup)
(melt)
)
(defenum pickup-type
(none)
(eco-yellow)
(eco-red)
(eco-blue)
(eco-green)
(money)
(fuel-cell)
(eco-pill)
(buzzer)
(eco-pill-random)
)
(define-extern process-drawable-art-error state)
(define-extern *res-static-buf* pointer)

View File

@ -0,0 +1,69 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type res-tag
(deftype res-tag (uint128)
((name symbol :offset 0 :size 32)
(key-frame float :offset 32 :size 32)
(elt-type type :offset 64 :size 32)
(data-offset uint16 :offset 96 :size 16)
(elt-count uint32 :offset 112 :size 15)
(inlined? uint8 :offset 127 :size 1)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition of type res-lump
(deftype res-lump (basic)
((length int32 :offset-assert 4)
(allocated-length int32 :offset-assert 8)
(data-base pointer :offset-assert 12)
(data-top pointer :offset-assert 16)
(data-size int32 :offset-assert 20)
(extra basic :offset-assert 24)
(tag (pointer res-tag) :offset-assert 28)
)
:method-count-assert 22
:size-assert #x20
:flag-assert #x1600000020
(:methods
(new (symbol type int int) _type_ 0)
(get-property-data (_type_ symbol symbol float pointer (pointer res-tag) pointer) pointer 9)
(get-property-struct (_type_ symbol symbol float structure (pointer res-tag) pointer) structure 10)
(get-property-value (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 11)
(get-property-value2 (_type_ symbol symbol float uint128 (pointer res-tag) pointer) uint128 12)
(get-tag-index-data (_type_ int) pointer 13)
(get-tag-data (_type_ res-tag) pointer 14)
(dummy-15 (_type_ res-tag) res-tag 15)
(sort! (_type_) _type_ 16)
(dummy-17 (_type_ res-tag pointer) res-lump 17)
(dummy-18 (_type_ res-tag res-tag) res-lump 18)
(lookup-tag-idx (_type_ symbol symbol float) res-tag-pair 19)
(make-property-data (_type_ float res-tag-pair pointer) pointer 20)
(dummy-21 (_type_ pointer symbol symbol float) symbol 21)
)
)
;; definition for method 3 of type res-lump
(defmethod inspect res-lump ((obj res-lump))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tallocated-length: ~D~%" (-> obj allocated-length))
(format #t "~Tdata-base: #x~X~%" (-> obj data-base))
(format #t "~Tdata-top: #x~X~%" (-> obj data-top))
(format #t "~Tdata-size: ~D~%" (-> obj data-size))
(format #t "~Textra: ~A~%" (-> obj extra))
(format #t "~Ttag: #x~X~%" (-> obj tag))
obj
)
;; definition for symbol *res-key-string*, type string
(define *res-key-string* (new 'global 'string 64 (the-as string #f)))
;; failed to figure out what this is:
(let ((v0-3 0))
)

View File

@ -0,0 +1,514 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type fact-bank
(deftype fact-bank (basic)
((eco-level-max float :offset-assert 4)
(eco-single-inc float :offset-assert 8)
(eco-full-inc float :offset-assert 12)
(eco-single-timeout uint64 :offset-assert 16)
(eco-full-timeout uint64 :offset-assert 24)
(dummy uint64 :offset-assert 32)
(health-max-default float :offset-assert 40)
(health-single-inc float :offset-assert 44)
(eco-pill-max-default float :offset-assert 48)
(health-small-inc float :offset-assert 52)
(buzzer-max-default float :offset-assert 56)
(buzzer-single-inc float :offset-assert 60)
(suck-bounce-dist float :offset-assert 64)
(suck-suck-dist float :offset-assert 68)
(default-pill-inc float :offset-assert 72)
)
:method-count-assert 9
:size-assert #x4c
:flag-assert #x90000004c
)
;; definition for method 3 of type fact-bank
(defmethod inspect fact-bank ((obj fact-bank))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Teco-level-max: ~f~%" (-> obj eco-level-max))
(format #t "~Teco-single-inc: ~f~%" (-> obj eco-single-inc))
(format #t "~Teco-full-inc: ~f~%" (-> obj eco-full-inc))
(format #t "~Teco-single-timeout: (seconds ~e)~%" (-> obj eco-single-timeout))
(format #t "~Teco-full-timeout: (seconds ~e)~%" (-> obj eco-full-timeout))
(format #t "~Tdummy: (seconds ~e)~%" (-> obj dummy))
(format #t "~Thealth-max-default: ~f~%" (-> obj health-max-default))
(format #t "~Thealth-single-inc: ~f~%" (-> obj health-single-inc))
(format #t "~Teco-pill-max-default: ~f~%" (-> obj eco-pill-max-default))
(format #t "~Thealth-small-inc: ~f~%" (-> obj health-small-inc))
(format #t "~Tbuzzer-max-default: ~f~%" (-> obj buzzer-max-default))
(format #t "~Tbuzzer-single-inc: ~f~%" (-> obj buzzer-single-inc))
(format #t "~Tsuck-bounce-dist: (meters ~m)~%" (-> obj suck-bounce-dist))
(format #t "~Tsuck-suck-dist: (meters ~m)~%" (-> obj suck-suck-dist))
(format #t "~Tdefault-pill-inc: ~f~%" (-> obj default-pill-inc))
obj
)
;; definition for symbol *FACT-bank*, type fact-bank
(define
*FACT-bank*
(new 'static 'fact-bank
:eco-level-max 2.0
:eco-single-inc 1.0
:eco-full-inc 5.0
:eco-single-timeout #x5dc
:eco-full-timeout #x1770
:dummy #x1194
:health-max-default 3.0
:health-single-inc 1.0
:eco-pill-max-default 50.0
:health-small-inc 1.0
:buzzer-max-default 7.0
:buzzer-single-inc 1.0
:suck-bounce-dist 73728.0
:suck-suck-dist 30720.0
)
)
;; definition for function pickup-type->string
(defun pickup-type->string ((arg0 pickup-type))
(let ((v1-0 arg0))
(cond
((= v1-0 (pickup-type eco-pill-random))
"eco-pill-random"
)
((= v1-0 (pickup-type buzzer))
"buzzer"
)
((= v1-0 (pickup-type eco-pill))
"eco-pill"
)
((= v1-0 (pickup-type fuel-cell))
"fuel-cell"
)
((= v1-0 (pickup-type money))
"money"
)
((= v1-0 (pickup-type eco-green))
"eco-green"
)
((= v1-0 (pickup-type eco-blue))
"eco-blue"
)
((= v1-0 (pickup-type eco-red))
"eco-red"
)
((= v1-0 (pickup-type eco-yellow))
"eco-yellow"
)
((= v1-0 (pickup-type none))
"none"
)
(else
"*unknown*"
)
)
)
)
;; definition of type fact-info
(deftype fact-info (basic)
((process process :offset-assert 4)
(pickup-type pickup-type :offset-assert 8)
(pickup-amount float :offset-assert 12)
(pickup-spawn-amount float :offset-assert 16)
(options uint64 :offset-assert 24)
(fade-time uint64 :offset-assert 32)
)
:method-count-assert 12
:size-assert #x28
:flag-assert #xc00000028
(:methods
(new (symbol type process pickup-type float) _type_ 0)
(dummy-9 () none 9)
(dummy-10 (_type_ symbol) none 10)
(dummy-11 (_type_) float 11)
)
)
;; definition for method 3 of type fact-info
(defmethod inspect fact-info ((obj fact-info))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tpickup-type: ~D~%" (-> obj pickup-type))
(format #t "~Tpickup-amount: ~f~%" (-> obj pickup-amount))
(format #t "~Tpickup-spawn-amount: ~f~%" (-> obj pickup-spawn-amount))
(format #t "~Toptions: ~D~%" (-> obj options))
(format #t "~Tfade-time: ~D~%" (-> obj fade-time))
obj
)
;; definition of type fact-info-target
(deftype fact-info-target (fact-info)
((eco-type int32 :offset-assert 40)
(eco-level float :offset-assert 44)
(eco-pickup-time uint64 :offset-assert 48)
(eco-timeout uint64 :offset-assert 56)
(health float :offset-assert 64)
(health-max float :offset-assert 68)
(buzzer float :offset-assert 72)
(buzzer-max float :offset-assert 76)
(eco-pill float :offset-assert 80)
(eco-pill-max float :offset-assert 84)
(health-pickup-time uint64 :offset-assert 88)
(eco-source uint64 :offset-assert 96)
(eco-source-time uint64 :offset-assert 104)
(money-pickup-time uint64 :offset-assert 112)
(buzzer-pickup-time uint64 :offset-assert 120)
(fuel-cell-pickup-time uint64 :offset-assert 128)
(eco-pill-pickup-time uint64 :offset-assert 136)
)
:method-count-assert 12
:size-assert #x90
:flag-assert #xc00000090
(:methods
(new (symbol type process pickup-type float) _type_ 0)
)
)
;; definition for method 3 of type fact-info-target
(defmethod inspect fact-info-target ((obj fact-info-target))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tpickup-type: ~D~%" (-> obj pickup-type))
(format #t "~Tpickup-amount: ~f~%" (-> obj pickup-amount))
(format #t "~Tpickup-spawn-amount: ~f~%" (-> obj pickup-spawn-amount))
(format #t "~Toptions: ~D~%" (-> obj options))
(format #t "~Tfade-time: ~D~%" (-> obj fade-time))
(format #t "~Teco-type: ~D~%" (-> obj eco-type))
(format #t "~Teco-level: ~f~%" (-> obj eco-level))
(format #t "~Teco-pickup-time: ~D~%" (-> obj eco-pickup-time))
(format #t "~Teco-timeout: (seconds ~e)~%" (-> obj eco-timeout))
(format #t "~Thealth: ~f~%" (-> obj health))
(format #t "~Thealth-max: ~f~%" (-> obj health-max))
(format #t "~Tbuzzer: ~f~%" (-> obj buzzer))
(format #t "~Tbuzzer-max: ~f~%" (-> obj buzzer-max))
(format #t "~Teco-pill: ~f~%" (-> obj eco-pill))
(format #t "~Teco-pill-max: ~f~%" (-> obj eco-pill-max))
(format #t "~Thealth-pickup-time: ~D~%" (-> obj health-pickup-time))
(format #t "~Teco-source: ~D~%" (-> obj eco-source))
(format #t "~Teco-source-time: ~D~%" (-> obj eco-source-time))
(format #t "~Tmoney-pickup-time: ~D~%" (-> obj money-pickup-time))
(format #t "~Tbuzzer-pickup-time: ~D~%" (-> obj buzzer-pickup-time))
(format #t "~Tfuel-cell-pickup-time: ~D~%" (-> obj fuel-cell-pickup-time))
(format #t "~Teco-pill-pickup-time: ~D~%" (-> obj eco-pill-pickup-time))
obj
)
;; definition of type fact-info-enemy
(deftype fact-info-enemy (fact-info)
((speed float :offset-assert 40)
(idle-distance float :offset-assert 44)
(notice-top float :offset-assert 48)
(notice-bottom float :offset-assert 52)
(cam-horz float :offset-assert 56)
(cam-vert float :offset-assert 60)
(cam-notice-dist float :offset-assert 64)
)
:method-count-assert 12
:size-assert #x44
:flag-assert #xc00000044
(:methods
(new (symbol type process pickup-type float) _type_ 0)
)
)
;; definition for method 3 of type fact-info-enemy
(defmethod inspect fact-info-enemy ((obj fact-info-enemy))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tprocess: ~A~%" (-> obj process))
(format #t "~Tpickup-type: ~D~%" (-> obj pickup-type))
(format #t "~Tpickup-amount: ~f~%" (-> obj pickup-amount))
(format #t "~Tpickup-spawn-amount: ~f~%" (-> obj pickup-spawn-amount))
(format #t "~Toptions: ~D~%" (-> obj options))
(format #t "~Tfade-time: ~D~%" (-> obj fade-time))
(format #t "~Tspeed: ~f~%" (-> obj speed))
(format #t "~Tidle-distance: (meters ~m)~%" (-> obj idle-distance))
(format #t "~Tnotice-top: (meters ~m)~%" (-> obj notice-top))
(format #t "~Tnotice-bottom: (meters ~m)~%" (-> obj notice-bottom))
(format #t "~Tcam-horz: (meters ~m)~%" (-> obj cam-horz))
(format #t "~Tcam-vert: (meters ~m)~%" (-> obj cam-vert))
(format #t "~Tcam-notice-dist: (meters ~m)~%" (-> obj cam-notice-dist))
obj
)
;; definition for method 0 of type fact-info
;; Used lq/sq
(defmethod
new
fact-info
((allocation symbol)
(type-to-make type)
(proc process)
(pkup-type pickup-type)
(pkup-amount float)
)
(local-vars (pp process) (tag res-tag))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(let ((ent (-> proc entity)))
(if (zero? obj)
(begin
(let ((go-func (the-as (function string none) enter-state))
(a0-1 "memory")
)
(set! (-> pp next-state) process-drawable-art-error)
(go-func a0-1)
)
(set! obj (the-as fact-info 0))
(goto cfg-10)
)
)
(set! (-> obj process) proc)
(set! tag (new 'static 'res-tag))
(let
((v1-6
(the-as
(pointer int32)
((method-of-type res-lump get-property-data)
(the-as res-lump ent)
'eco-info
'interp
0.0
(the-as pointer #f)
(& tag)
*res-static-buf*
)
)
)
)
(cond
(v1-6
(let ((a0-6 (-> tag elt-count)))
(set! (-> obj pickup-type) (the-as pickup-type (-> v1-6 0)))
(set! pkup-amount (cond
((< (the-as uint 1) (the-as uint a0-6))
(the float (-> v1-6 1))
)
(else
(empty)
pkup-amount
)
)
)
)
(set! (-> obj pickup-amount) pkup-amount)
)
(else
(set! (-> obj pickup-type) pkup-type)
(set! (-> obj pickup-amount) pkup-amount)
)
)
)
(set!
(-> obj options)
(the-as
uint
((method-of-type res-lump get-property-value)
(the-as res-lump ent)
'options
'interp
-1000000000.0
(the-as uint128 0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(if (nonzero? (logand #x80200 (the-as int (-> obj options))))
(set!
(-> obj fade-time)
(the-as
uint
(the
int
(*
300.0
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump ent)
'timeout
'interp
-1000000000.0
(the-as uint128 0.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
)
)
)
)
)
(label cfg-10)
obj
)
)
;; definition for method 11 of type fact-info
(defmethod dummy-11 fact-info ((obj fact-info))
0.0
)
;; definition for method 0 of type fact-info-enemy
(defmethod
new
fact-info-enemy
((allocation symbol)
(type-to-make type)
(arg0 process)
(arg1 pickup-type)
(arg2 float)
)
(let
((obj
(the-as
fact-info-enemy
((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2)
)
)
)
(let ((entity (-> obj process entity)))
(set!
(-> obj speed)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'speed
'interp
-1000000000.0
(the-as uint128 1.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> obj idle-distance)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'idle-distance
'interp
-1000000000.0
(the-as uint128 327680.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> obj notice-top)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'notice-top
'interp
-1000000000.0
(the-as uint128 4096000.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> obj notice-bottom)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'notice-bottom
'interp
-1000000000.0
(the-as uint128 4096000.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> obj cam-horz)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'cam-horz
'interp
-1000000000.0
(the-as uint128 0.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> obj cam-vert)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'cam-vert
'interp
-1000000000.0
(the-as uint128 0.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(set!
(-> obj cam-notice-dist)
(the-as
float
((method-of-type res-lump get-property-value2)
(the-as res-lump entity)
'cam-notice-dist
'interp
-1000000000.0
(the-as uint128 -4096.0)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
)
obj
)
)
;; definition for method 0 of type fact-info-target
(defmethod
new
fact-info-target
((allocation symbol)
(type-to-make type)
(arg0 process)
(arg1 pickup-type)
(arg2 float)
)
(let
((obj
(the-as
fact-info-target
((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2)
)
)
)
(set! (-> obj eco-source) (the-as uint #f))
(dummy-10 obj #f)
obj
)
)

View File

@ -0,0 +1,72 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type dynamics
(deftype dynamics (basic)
((name basic :offset-assert 4)
(gravity-max float :offset-assert 8)
(gravity-length float :offset-assert 12)
(gravity vector :inline :offset-assert 16)
(gravity-normal vector :inline :offset-assert 32)
(walk-distance float :offset-assert 48)
(run-distance float :offset-assert 52)
)
:method-count-assert 9
:size-assert #x38
:flag-assert #x900000038
)
;; definition for method 3 of type dynamics
(defmethod inspect dynamics ((obj dynamics))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Tgravity-max: (meters ~m)~%" (-> obj gravity-max))
(format #t "~Tgravity-length: (meters ~m)~%" (-> obj gravity-length))
(format #t "~Tgravity: ~`vector`P~%" (-> obj gravity))
(format #t "~Tgravity-normal: ~`vector`P~%" (-> obj gravity-normal))
(format #t "~Twalk-distance: (meters ~m)~%" (-> obj walk-distance))
(format #t "~Trun-distance: (meters ~m)~%" (-> obj run-distance))
obj
)
;; definition for function time-to-apex
(defun time-to-apex ((arg0 float) (arg1 float))
(the int (/ arg0 (- (* 0.0033333334 arg1))))
)
;; definition for function time-to-ground
(defun time-to-ground ((arg0 float) (arg1 float) (arg2 float))
(let ((f0-0 0.0)
(v0-0 0)
)
(while (< (- arg2) f0-0)
(set! arg0 (- arg0 (* 0.0033333334 arg1)))
(+! f0-0 (* 0.0033333334 arg0))
(+! v0-0 1)
)
v0-0
)
)
;; definition for symbol *standard-dynamics*, type dynamics
(define
*standard-dynamics*
(new 'static 'dynamics
:name 'standard
:gravity-max 163840.0
:gravity-length 245760.0
:gravity
(new 'static 'vector :y 245760.0 :w 1.0)
:gravity-normal (new 'static 'vector :y 1.0 :w 1.0)
:walk-distance 8192.0
:run-distance 20480.0
)
)
;; failed to figure out what this is:
(let ((v0-1 0))
)

View File

@ -0,0 +1,231 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type pat-surface
(deftype pat-surface (uint32)
((skip uint8 :offset 0 :size 3)
(mode pat-mode :offset 3 :size 3)
(material pat-material :offset 6 :size 6)
(camera uint8 :offset 12 :size 2)
(event pat-event :offset 14 :size 6)
(noentity uint8 :offset 0 :size 1)
(nocamera uint8 :offset 1 :size 1)
(noedge uint8 :offset 2 :size 1)
(nolineofsight uint8 :offset 12 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
;; definition for method 3 of type pat-surface
(defmethod inspect pat-surface ((obj pat-surface))
(format #t "[~8x] ~A~%" obj 'pat-surface)
(format #t "~Tskip: ~D~%" (-> obj skip))
(format #t "~Tmode: ~D~%" (-> obj mode))
(format #t "~Tmaterial: ~D~%" (-> obj material))
(format #t "~Tcamera: ~D~%" (-> obj camera))
(format #t "~Tevent: ~D~%" (-> obj event))
(format #t "~Tnoentity: ~D~%" (-> obj noentity))
(format #t "~Tnocamera: ~D~%" (-> obj nocamera))
(format #t "~Tnoedge: ~D~%" (-> obj noedge))
(format #t "~Tnolineofsight: ~D~%" (-> obj nolineofsight))
obj
)
;; definition (debug) for function pat-material->string
(defun-debug pat-material->string ((arg0 pat-surface))
(let ((v1-1 (-> arg0 material)))
(cond
((= v1-1 (pat-material neutral))
"neutral"
)
((= v1-1 (pat-material rotate))
"rotate"
)
((= v1-1 (pat-material stopproj))
"stopproj"
)
((= v1-1 (pat-material swamp))
"swamp"
)
((= v1-1 (pat-material tube))
"tube"
)
((= v1-1 (pat-material straw))
"straw"
)
((= v1-1 (pat-material metal))
"metal"
)
((= v1-1 (pat-material dirt))
"dirt"
)
((= v1-1 (pat-material gravel))
"gravel"
)
((= v1-1 (pat-material crwood))
"crwood"
)
((= v1-1 (pat-material lava))
"lava"
)
((= v1-1 (pat-material hotcoals))
"hotcoals"
)
((= v1-1 (pat-material deepsnow))
"deepsnow"
)
((= v1-1 (pat-material snow))
"snow"
)
((= v1-1 (pat-material pcmetal))
"pcmetal"
)
((= v1-1 (pat-material grass))
"grass"
)
((= v1-1 (pat-material wood))
"wood"
)
((= v1-1 (pat-material sand))
"sand"
)
((= v1-1 (pat-material tar))
"tar"
)
((= v1-1 (pat-material waterbottom))
"waterbottom"
)
((= v1-1 (pat-material quicksand))
"quicksand"
)
((= v1-1 (pat-material ice))
"ice"
)
((= v1-1 (pat-material stone))
"stone"
)
(else
"*unknown*"
)
)
)
)
;; definition (debug) for function pat-mode->string
(defun-debug pat-mode->string ((arg0 pat-surface))
(let ((v1-1 (-> arg0 mode)))
(cond
((= v1-1 (pat-mode obstacle))
"obstacle"
)
((= v1-1 (pat-mode wall))
"wall"
)
((= v1-1 (pat-mode ground))
"ground"
)
(else
"*unknown*"
)
)
)
)
;; definition (debug) for function pat-event->string
(defun-debug pat-event->string ((arg0 pat-surface))
(let ((v1-1 (-> arg0 event)))
(cond
((= v1-1 (pat-event melt))
"melt"
)
((= v1-1 (pat-event burnup))
"burnup"
)
((= v1-1 (pat-event deadlyup))
"deadlyup"
)
((= v1-1 (pat-event burn))
"burn"
)
((= v1-1 (pat-event endlessfall))
"endlessfall"
)
((= v1-1 (pat-event deadly))
"deadly"
)
((= v1-1 (pat-event none))
"none"
)
(else
"*unknown*"
)
)
)
)
;; definition of type pat-mode-info
(deftype pat-mode-info (structure)
((name string :offset-assert 0)
(wall-angle float :offset-assert 4)
(color rgba :offset-assert 8)
(hilite-color rgba :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition for method 3 of type pat-mode-info
(defmethod inspect pat-mode-info ((obj pat-mode-info))
(format #t "[~8x] ~A~%" obj 'pat-mode-info)
(format #t "~Tname: ~A~%" (-> obj name))
(format #t "~Twall-angle: ~f~%" (-> obj wall-angle))
(format #t "~Tcolor: ~D~%" (-> obj color))
(format #t "~Thilite-color: ~D~%" (-> obj hilite-color))
obj
)
;; definition for symbol *pat-mode-info*, type (inline-array pat-mode-info)
(define
*pat-mode-info*
(new 'static 'inline-array pat-mode-info 4
(new 'static 'pat-mode-info
:name "ground"
:wall-angle 0.2
:color (new 'static 'rgba :r #x7f :a #x40)
:hilite-color (new 'static 'rgba :r #xff :a #x80)
)
(new 'static 'pat-mode-info
:name "wall"
:wall-angle 2.0
:color (new 'static 'rgba :b #x7f :a #x40)
:hilite-color (new 'static 'rgba :b #xff :a #x80)
)
(new 'static 'pat-mode-info
:name "obstacle"
:wall-angle 0.82
:color
(new 'static 'rgba :r #x7f :b #x7f :a #x40)
:hilite-color
(new 'static 'rgba :r #xff :b #xff :a #x80)
)
(new 'static 'pat-mode-info
:name "pole"
:wall-angle 2.0
:color
(new 'static 'rgba :r #x7f :g #x7f :a #x40)
:hilite-color
(new 'static 'rgba :r #xff :g #xff :a #x80)
)
)
)
;; failed to figure out what this is:
(let ((v0-2 0))
)

File diff suppressed because it is too large Load Diff

View File

@ -230,28 +230,28 @@ TEST(TypeSystem, AddMethodAndLookupMethod) {
TypeSystem ts;
ts.add_builtin_types();
auto parent_info = ts.add_method(ts.lookup_type("structure"), "test-method-1",
ts.make_function_typespec({"integer"}, "string"));
auto parent_info = ts.declare_method(ts.lookup_type("structure"), "test-method-1", false,
ts.make_function_typespec({"integer"}, "string"));
// when trying to add the same method to a child, should return the parent's method
auto child_info_same = ts.add_method(ts.lookup_type("basic"), "test-method-1",
ts.make_function_typespec({"integer"}, "string"));
auto child_info_same = ts.declare_method(ts.lookup_type("basic"), "test-method-1", false,
ts.make_function_typespec({"integer"}, "string"));
EXPECT_EQ(parent_info.id, child_info_same.id);
EXPECT_EQ(parent_info.id, GOAL_MEMUSAGE_METHOD + 1);
// any amount of fiddling with method types should cause an error
EXPECT_ANY_THROW(ts.add_method(ts.lookup_type("basic"), "test-method-1",
ts.make_function_typespec({"integer"}, "integer")));
EXPECT_ANY_THROW(ts.add_method(ts.lookup_type("basic"), "test-method-1",
ts.make_function_typespec({}, "string")));
EXPECT_ANY_THROW(ts.add_method(ts.lookup_type("basic"), "test-method-1",
ts.make_function_typespec({"integer", "string"}, "string")));
EXPECT_ANY_THROW(ts.add_method(ts.lookup_type("basic"), "test-method-1",
ts.make_function_typespec({"string"}, "string")));
EXPECT_ANY_THROW(ts.declare_method(ts.lookup_type("basic"), "test-method-1", false,
ts.make_function_typespec({"integer"}, "integer")));
EXPECT_ANY_THROW(ts.declare_method(ts.lookup_type("basic"), "test-method-1", false,
ts.make_function_typespec({}, "string")));
EXPECT_ANY_THROW(ts.declare_method(ts.lookup_type("basic"), "test-method-1", false,
ts.make_function_typespec({"integer", "string"}, "string")));
EXPECT_ANY_THROW(ts.declare_method(ts.lookup_type("basic"), "test-method-1", false,
ts.make_function_typespec({"string"}, "string")));
ts.add_method(ts.lookup_type("basic"), "test-method-2",
ts.make_function_typespec({"integer"}, "string"));
ts.declare_method(ts.lookup_type("basic"), "test-method-2", false,
ts.make_function_typespec({"integer"}, "string"));
EXPECT_EQ(parent_info.id, ts.lookup_method("basic", "test-method-1").id);
EXPECT_EQ(parent_info.id, ts.lookup_method("structure", "test-method-1").id);
@ -273,11 +273,11 @@ TEST(TypeSystem, NewMethod) {
TypeSystem ts;
ts.add_builtin_types();
ts.add_type("test-1", std::make_unique<BasicType>("basic", "test-1", false, 0));
ts.add_method(ts.lookup_type("test-1"), "new",
ts.make_function_typespec({"symbol", "string"}, "test-1"));
ts.declare_method(ts.lookup_type("test-1"), "new", false,
ts.make_function_typespec({"symbol", "string"}, "test-1"));
ts.add_type("test-2", std::make_unique<BasicType>("test-1", "test-2", false, 0));
ts.add_method(ts.lookup_type("test-2"), "new",
ts.make_function_typespec({"symbol", "string", "symbol"}, "test-2"));
ts.declare_method(ts.lookup_type("test-2"), "new", false,
ts.make_function_typespec({"symbol", "string", "symbol"}, "test-2"));
EXPECT_EQ(ts.lookup_method("test-1", "new").type.print(), "(function symbol string test-1)");
EXPECT_EQ(ts.lookup_method("test-2", "new").type.print(),
@ -295,8 +295,8 @@ TEST(TypeSystem, MethodSubstitute) {
TypeSystem ts;
ts.add_builtin_types();
ts.add_type("test-1", std::make_unique<BasicType>("basic", "test-1", false, 0));
ts.add_method(ts.lookup_type("test-1"), "new",
ts.make_function_typespec({"symbol", "string", "_type_"}, "_type_"));
ts.declare_method(ts.lookup_type("test-1"), "new", false,
ts.make_function_typespec({"symbol", "string", "_type_"}, "_type_"));
auto final_type = ts.lookup_method("test-1", "new").type.substitute_for_method_call("test-1");
EXPECT_EQ(final_type.print(), "(function symbol string test-1 test-1)");