[decompiler] clean up if/when/cond and recognize define-perm (#472)

* clean up if and when and cond decisions

* recognize define perm
This commit is contained in:
water111
2021-05-12 19:46:17 -04:00
committed by GitHub
parent 3897258753
commit 129ab54fd4
24 changed files with 1304 additions and 1144 deletions
+3 -3
View File
@@ -821,8 +821,8 @@ CondWithElseElement::CondWithElseElement(std::vector<Entry> _entries, Form* _els
goos::Object CondWithElseElement::to_form_internal(const Env& env) const {
// for now we only turn it into an if statement if both cases won't require a begin at the top
// level. I think it is more common to write these as a two-case cond instead of an if with begin.
if (entries.size() == 1 && entries.front().body->is_single_element() &&
else_ir->is_single_element()) {
if (entries.size() == 1 && entries.front().body->is_reasonable_for_if() &&
else_ir->is_reasonable_for_if()) {
std::vector<goos::Object> list;
list.push_back(pretty_print::to_symbol("if"));
list.push_back(entries.front().condition->to_form_as_condition(env));
@@ -1126,7 +1126,7 @@ CondNoElseElement::CondNoElseElement(std::vector<Entry> _entries) : entries(std:
}
goos::Object CondNoElseElement::to_form_internal(const Env& env) const {
if (entries.size() == 1 && entries.front().body->is_single_element()) {
if (entries.size() == 1 && entries.front().body->is_reasonable_for_if()) {
// print as an if statement if we can put the body in a single form.
std::vector<goos::Object> list;
list.push_back(pretty_print::to_symbol("if"));
+54
View File
@@ -33,6 +33,14 @@ class FormElement {
virtual void get_modified_regs(RegSet& regs) const = 0;
virtual bool active() const;
// is this element reasonable to put directly in an if?
// of course it's possible to put whatever you want, but it looks weird to do something like
// (if (condition?)
// <some huge thing hundreds of lines long>
// <some other huge thing>
// )
virtual bool allow_in_if() const { return true; }
std::string to_string(const Env& env) const;
bool has_side_effects();
@@ -489,6 +497,7 @@ class ConditionElement : public FormElement {
FormPool& pool,
const std::vector<Form*>& source_forms,
const std::vector<TypeSpec>& types);
bool allow_in_if() const override { return false; }
private:
IR2_Condition::Kind m_kind;
@@ -621,6 +630,7 @@ class CondWithElseElement : public FormElement {
void collect_vars(RegAccessSet& vars, bool recursive) const override;
void push_to_stack(const Env& env, FormPool& pool, FormStack& stack) override;
void get_modified_regs(RegSet& regs) const override;
bool allow_in_if() const override { return false; }
};
/*!
@@ -673,6 +683,7 @@ class WhileElement : public FormElement {
void collect_vars(RegAccessSet& vars, bool recursive) const override;
void push_to_stack(const Env& env, FormPool& pool, FormStack& stack) override;
void get_modified_regs(RegSet& regs) const override;
bool allow_in_if() const override { return false; }
Form* condition = nullptr;
Form* body = nullptr;
bool cleaned = false;
@@ -692,6 +703,7 @@ class UntilElement : public FormElement {
void collect_vars(RegAccessSet& vars, bool recursive) const override;
void push_to_stack(const Env& env, FormPool& pool, FormStack& stack) override;
void get_modified_regs(RegSet& regs) const override;
bool allow_in_if() const override { return false; }
Form* condition = nullptr;
Form* body = nullptr;
};
@@ -764,6 +776,7 @@ class CondNoElseElement : public FormElement {
FormStack& stack,
std::vector<FormElement*>* result,
bool allow_side_effects) override;
bool allow_in_if() const override { return false; }
};
/*!
@@ -1247,6 +1260,7 @@ class LetElement : public FormElement {
void get_modified_regs(RegSet& regs) const override;
Form* body() { return m_body; }
void set_body(Form* new_body);
bool allow_in_if() const override { return false; }
struct Entry {
RegisterAccess dest;
@@ -1274,6 +1288,7 @@ class DoTimesElement : public FormElement {
void apply_form(const std::function<void(Form*)>& f) override;
void collect_vars(RegAccessSet& vars, bool recursive) const override;
void get_modified_regs(RegSet& regs) const override;
bool allow_in_if() const override { return false; }
private:
RegisterAccess m_var_init, m_var_check, m_var_inc;
@@ -1421,12 +1436,51 @@ class Form {
return nullptr;
}
FormElement* try_as_single_active_element() const {
int active_count = 0;
FormElement* result = nullptr;
for (auto& elt : m_elements) {
if (elt->active()) {
active_count++;
result = elt;
}
}
if (active_count == 1) {
return result;
} else {
return nullptr;
}
}
template <typename T>
T* try_as_element() const {
return dynamic_cast<T*>(try_as_single_element());
}
bool is_single_element() const { return m_elements.size() == 1; }
bool is_single_active_element() const {
int active_count = 0;
for (auto& elt : m_elements) {
if (elt->active()) {
active_count++;
}
}
return active_count == 1;
}
bool is_reasonable_for_if() const {
int active_count = 0;
for (auto& elt : m_elements) {
if (elt->active()) {
if (!elt->allow_in_if()) {
return false;
}
active_count++;
}
}
return active_count == 1;
}
FormElement* operator[](int idx) { return m_elements.at(idx); }
FormElement*& at(int idx) { return m_elements.at(idx); }
const FormElement* operator[](int idx) const { return m_elements.at(idx); }
+74 -21
View File
@@ -105,6 +105,20 @@ Matcher Matcher::if_with_else(const Matcher& condition,
return m;
}
Matcher Matcher::if_no_else(const Matcher& condition, const Matcher& true_case) {
Matcher m;
m.m_kind = Kind::IF_NO_ELSE;
m.m_sub_matchers = {condition, true_case};
return m;
}
Matcher Matcher::or_expression(const std::vector<Matcher>& elts) {
Matcher m;
m.m_kind = Kind::SC_OR;
m.m_sub_matchers = elts;
return m;
}
Matcher Matcher::deref(const Matcher& root,
bool is_addr_of,
const std::vector<DerefTokenMatcher>& tokens) {
@@ -148,7 +162,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
bool got = false;
RegisterAccess result;
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_var()) {
got = true;
@@ -156,7 +170,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_var()) {
@@ -180,7 +194,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
bool got = false;
int result;
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_label()) {
got = true;
@@ -188,7 +202,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_label()) {
@@ -208,7 +222,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::GENERIC_OP: {
auto as_generic = dynamic_cast<GenericElement*>(input->try_as_single_element());
auto as_generic = dynamic_cast<GenericElement*>(input->try_as_single_active_element());
if (as_generic) {
if (!m_gen_op_matcher->do_match(as_generic->op(), maps_out)) {
return false;
@@ -229,7 +243,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::GENERIC_OP_WITH_REST: {
auto as_generic = dynamic_cast<GenericElement*>(input->try_as_single_element());
auto as_generic = dynamic_cast<GenericElement*>(input->try_as_single_active_element());
if (as_generic) {
if (!m_gen_op_matcher->do_match(as_generic->op(), maps_out)) {
return false;
@@ -271,7 +285,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::CAST: {
auto as_cast = dynamic_cast<CastElement*>(input->try_as_single_element());
auto as_cast = dynamic_cast<CastElement*>(input->try_as_single_active_element());
if (as_cast) {
if (as_cast->type().print() == m_str) {
return m_sub_matchers.at(0).do_match(as_cast->source(), maps_out);
@@ -281,7 +295,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::INT: {
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_int()) {
if (!m_int_match.has_value()) {
@@ -291,7 +305,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_int()) {
@@ -306,7 +320,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::ANY_INT: {
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_int()) {
if (m_int_out_id != -1) {
@@ -316,7 +330,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_int()) {
@@ -331,7 +345,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::ANY_QUOTED_SYMBOL: {
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_sym_ptr()) {
if (m_string_out_id != -1) {
@@ -341,7 +355,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_sym_ptr()) {
@@ -355,7 +369,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
case Kind::ANY_SYMBOL: {
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_sym_val()) {
if (m_string_out_id != -1) {
@@ -365,7 +379,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_sym_val()) {
@@ -379,14 +393,14 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
case Kind::SYMBOL: {
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_element());
auto as_simple_atom = dynamic_cast<SimpleAtomElement*>(input->try_as_single_active_element());
if (as_simple_atom) {
if (as_simple_atom->atom().is_sym_val()) {
return as_simple_atom->atom().get_str() == m_str;
}
}
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_element());
auto as_expr = dynamic_cast<SimpleExpressionElement*>(input->try_as_single_active_element());
if (as_expr && as_expr->expr().is_identity()) {
auto atom = as_expr->expr().get_arg(0);
if (atom.is_sym_val()) {
@@ -397,7 +411,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
case Kind::DEREF_OP: {
auto as_deref = dynamic_cast<DerefElement*>(input->try_as_single_element());
auto as_deref = dynamic_cast<DerefElement*>(input->try_as_single_active_element());
if (as_deref) {
if (as_deref->is_addr_of() != m_deref_is_addr_of) {
return false;
@@ -419,7 +433,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
}
case Kind::SET: {
auto as_set = dynamic_cast<SetFormFormElement*>(input->try_as_single_element());
auto as_set = dynamic_cast<SetFormFormElement*>(input->try_as_single_active_element());
if (!as_set) {
return false;
}
@@ -435,7 +449,7 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
} break;
case Kind::IF_WITH_ELSE: {
auto as_cond = dynamic_cast<CondWithElseElement*>(input->try_as_single_element());
auto as_cond = dynamic_cast<CondWithElseElement*>(input->try_as_single_active_element());
if (!as_cond) {
return false;
}
@@ -458,8 +472,47 @@ bool Matcher::do_match(Form* input, MatchResult::Maps* maps_out) const {
return true;
} break;
case Kind::IF_NO_ELSE: {
auto as_cond = dynamic_cast<CondNoElseElement*>(input->try_as_single_active_element());
if (!as_cond) {
return false;
}
if (as_cond->entries.size() != 1) {
return false;
}
if (!m_sub_matchers.at(0).do_match(as_cond->entries.front().condition, maps_out)) {
return false;
}
if (!m_sub_matchers.at(1).do_match(as_cond->entries.front().body, maps_out)) {
return false;
}
return true;
} break;
case Kind::SC_OR: {
auto as_sc = dynamic_cast<ShortCircuitElement*>(input->try_as_single_active_element());
if (!as_sc || as_sc->kind != ShortCircuitElement::OR) {
return false;
}
if (as_sc->entries.size() != m_sub_matchers.size()) {
return false;
}
for (size_t i = 0; i < m_sub_matchers.size(); i++) {
if (!m_sub_matchers.at(i).do_match(as_sc->entries.at(i).condition, maps_out)) {
return false;
}
}
return true;
} break;
case Kind::WHILE_LOOP: {
auto as_while = dynamic_cast<WhileElement*>(input->try_as_single_element());
auto as_while = dynamic_cast<WhileElement*>(input->try_as_single_active_element());
if (!as_while) {
return false;
}
+4
View File
@@ -45,8 +45,10 @@ class Matcher {
static Matcher if_with_else(const Matcher& condition,
const Matcher& true_case,
const Matcher& false_case);
static Matcher if_no_else(const Matcher& condition, const Matcher& true_case);
static Matcher while_loop(const Matcher& condition, const Matcher& body);
static Matcher any_constant_token(int match_id = -1);
static Matcher or_expression(const std::vector<Matcher>& elts);
enum class Kind {
ANY_REG, // matching any register
@@ -64,8 +66,10 @@ class Matcher {
ANY_LABEL,
SYMBOL,
IF_WITH_ELSE,
IF_NO_ELSE,
WHILE_LOOP,
ANY_CONSTANT_TOKEN,
SC_OR,
INVALID
};
+33
View File
@@ -219,6 +219,19 @@ std::string write_from_top_level(const Function& top_level,
// (set! sym-val <expr>)
auto define_symbol_matcher = Matcher::set(Matcher::any_symbol(0), Matcher::any(1));
// define-perm
// (if (or (not <sym>) (zero? <sym>))
// (set! <sym> <init-val>)
// )
auto define_perm_matcher = Matcher::if_no_else(
Matcher::op(GenericOpMatcher::condition(IR2_Condition::Kind::TRUTHY),
{Matcher::or_expression(
{Matcher::op(GenericOpMatcher::condition(IR2_Condition::Kind::FALSE),
{Matcher::any_symbol(0)}),
Matcher::op(GenericOpMatcher::condition(IR2_Condition::Kind::ZERO),
{Matcher::any_symbol(1)})})}),
Matcher::set(Matcher::any_symbol(2), Matcher::any(3)));
for (auto& x : forms) {
bool something_matched = false;
Form f;
@@ -308,6 +321,26 @@ std::string write_from_top_level(const Function& top_level,
}
}
if (!something_matched) {
auto define_perm_match_result = match(define_perm_matcher, &f);
if (define_perm_match_result.matched &&
define_perm_match_result.maps.strings.at(0) ==
define_perm_match_result.maps.strings.at(1) &&
define_perm_match_result.maps.strings.at(0) ==
define_perm_match_result.maps.strings.at(2)) {
something_matched = true;
auto sym_name = define_perm_match_result.maps.strings.at(0);
auto symbol_type = dts.lookup_symbol_type(sym_name);
result += fmt::format(";; definition (perm) for symbol {}, type {}\n", sym_name,
symbol_type.print());
result += pretty_print::to_string(pretty_print::build_list(
fmt::format("define-perm {} {}", sym_name, symbol_type.print()),
define_perm_match_result.maps.forms.at(3)->to_form(env)));
result += "\n\n";
}
}
if (!something_matched) {
result += ";; failed to figure out what this is:\n";
result += pretty_print::to_string(x->to_form(env));
+2 -10
View File
@@ -91,16 +91,8 @@
(define *subdivide-draw-mode* 0)
(define *ocean-subdivide-draw-mode* 0)
;; this is a bit of a trick.
;; I believe *dproc* is the display process.
;; if it is already created and this file is reloaded, we don't want to write over it.
;; so we only set it to #f if we think it hasn't been set before.
(define-extern *dproc* process)
(when (or (not *dproc*)
(zero? *dproc*))
;; no dproc, safe to write over it.
(set! *dproc* #f)
)
;; don't overwrite the dproc if we're reloading this file.
(define-perm *dproc* process #f)
(define *run* #f)
(define *teleport* #f)
@@ -551,5 +551,5 @@
(define-extern *target* target)
(declare-type sidekick basic)
(define-extern *sidekick* basic)
(define-extern *sidekick* sidekick)
@@ -721,174 +721,189 @@
)
(disasm-dma-tag current-tag stream-2)
)
(if end-condition
(empty-form)
(cond
((or
(= (-> current-tag id) (dma-tag-id ref))
(= (-> current-tag id) (dma-tag-id refs))
(zero? (-> current-tag id))
)
(set! addr (-> current-tag addr))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(let
((v0-9
(disasm-vif-tag (&-> data-2 vif0) 2 stream-2 (= mode-2 'details))
)
)
(disasm-vif-tag
(the-as (pointer vif-tag) (+ (the-as uint addr) (the-as uint v0-9)))
(the-as int (- (shl (the-as int qwc) 2) (the-as uint (sar v0-9 2))))
stream-2
(= mode-2 'details)
)
(cond
(end-condition
)
(else
(cond
((or
(= (-> current-tag id) (dma-tag-id ref))
(= (-> current-tag id) (dma-tag-id refs))
(zero? (-> current-tag id))
)
)
(set!
data-2
(the-as dma-packet (&-> (the-as (pointer uint64) data-2) 2))
)
(if (zero? (-> current-tag id))
(set! end-condition #t)
)
)
(else
(cond
((= (-> current-tag id) (dma-tag-id cnt))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(set! addr (-> current-tag addr))
(set! qwc (the-as int (-> current-tag qwc)))
(when mode-2
(let
((v0-9
(disasm-vif-tag (&-> data-2 vif0) 2 stream-2 (= mode-2 'details))
)
)
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) data-2) 1))
(the-as int (+ (shl (the-as int qwc) 2) 2))
(the-as
(pointer vif-tag)
(+ (the-as uint addr) (the-as uint v0-9))
)
(the-as
int
(- (shl (the-as int qwc) 2) (the-as uint (sar v0-9 2)))
)
stream-2
(= mode-2 'details)
)
)
(set!
data-2
(the-as
dma-packet
(+
(the-as uint data-2)
)
(set!
data-2
(the-as dma-packet (&-> (the-as (pointer uint64) data-2) 2))
)
(if (zero? (-> current-tag id))
(set! end-condition #t)
)
)
(else
(cond
((= (-> current-tag id) (dma-tag-id cnt))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(the-as
uint
(shl (the-as int (+ (the-as uint qwc) (the-as uint 1))) 4)
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
)
)
(let ((v1-68 data-2))
)
)
((= (-> current-tag id) (dma-tag-id next))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) data-2) 1))
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
)
(when (= data-2 (-> current-tag addr))
(format stream-2 "ERROR: next tag creates infinite loop.~%")
(set! end-condition 'error)
)
(set! data-2 (the-as dma-packet (-> current-tag addr)))
(let ((v1-88 data-2))
)
)
(else
(cond
((= (-> current-tag id) (dma-tag-id call))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(set!
data-2
(the-as
dma-packet
(+
(the-as uint data-2)
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
)
(set! data-2 (the-as dma-packet (-> current-tag addr)))
(set! call-depth (+ call-depth 1))
(cond
((zero? call-depth)
(set! ra-1 (&+ addr qwc))
(let ((v1-108 (the-as (pointer uint64) ra-1)))
)
)
(else
(set! ra-2 (&+ addr qwc))
(let ((v1-111 (the-as (pointer uint64) ra-2)))
uint
(shl (the-as int (+ (the-as uint qwc) (the-as uint 1))) 4)
)
)
)
)
((= (-> current-tag id) (dma-tag-id ret))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
(let ((v1-68 data-2))
)
)
((= (-> current-tag id) (dma-tag-id next))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
(let ((v1-123 call-depth))
(cond
((zero? v1-123)
(set! data-2 (the-as dma-packet ra-1))
(let ((v1-125 data-2))
)
(when (= data-2 (-> current-tag addr))
(format stream-2 "ERROR: next tag creates infinite loop.~%")
(set! end-condition 'error)
)
(set! data-2 (the-as dma-packet (-> current-tag addr)))
(let ((v1-88 data-2))
)
)
(else
(cond
((= (-> current-tag id) (dma-tag-id call))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
((= v1-123 1)
(set! data-2 (the-as dma-packet ra-2))
(let ((v1-127 data-2))
)
(set! data-2 (the-as dma-packet (-> current-tag addr)))
(set! call-depth (+ call-depth 1))
(cond
((zero? call-depth)
(set! ra-1 (&+ addr qwc))
(let ((v1-108 (the-as (pointer uint64) ra-1)))
)
)
(else
(set! end-condition #t)
(set! ra-2 (&+ addr qwc))
(let ((v1-111 (the-as (pointer uint64) ra-2)))
)
)
)
)
(set! call-depth (+ call-depth -1))
(let ((v1-131 call-depth))
((= (-> current-tag id) (dma-tag-id ret))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(if mode-2
(disasm-vif-tag
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
)
(let ((v1-123 call-depth))
(cond
((zero? v1-123)
(set! data-2 (the-as dma-packet ra-1))
(let ((v1-125 data-2))
)
)
((= v1-123 1)
(set! data-2 (the-as dma-packet ra-2))
(let ((v1-127 data-2))
)
)
(else
(set! end-condition #t)
)
)
)
(set! call-depth (+ call-depth -1))
(let ((v1-131 call-depth))
)
)
)
((= (-> current-tag id) (dma-tag-id end))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(set! end-condition #t)
(let ((v0-16 (if mode-2
(disasm-vif-tag
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
((= (-> current-tag id) (dma-tag-id end))
(set! addr (&-> (the-as (pointer uint64) data-2) 2))
(set! qwc (the-as int (-> current-tag qwc)))
(set! end-condition #t)
(let ((v0-16 (if mode-2
(disasm-vif-tag
(the-as
(pointer vif-tag)
(&-> (the-as (pointer uint64) data-2) 1)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
(the-as int (+ (shl (the-as int qwc) 2) 2))
stream-2
(= mode-2 'details)
)
)
)
)
)
)
)
(else
(format stream-2 "ERROR: Unknown DMA TAG command.~%")
(set! end-condition 'error)
)
)
(else
(format stream-2 "ERROR: Unknown DMA TAG command.~%")
(set! end-condition 'error)
)
)
)
@@ -914,4 +929,3 @@
)
)
@@ -256,10 +256,8 @@
;; definition for symbol *ocean-subdivide-draw-mode*, type int
(define *ocean-subdivide-draw-mode* 0)
;; failed to figure out what this is:
(when (or (not *dproc*) (zero? *dproc*))
(set! *dproc* #f)
)
;; definition (perm) for symbol *dproc*, type process
(define-perm *dproc* process #f)
;; definition for symbol *run*, type symbol
(define *run* #f)
@@ -330,7 +328,3 @@
;; failed to figure out what this is:
(let ((v0-2 0))
)
@@ -209,12 +209,16 @@
(set! (-> v1-3 origin x) (the float x))
(set! (-> v1-3 origin y) (the float y))
)
(if (= z 0.0)
(let ((v1-4 obj))
(set! (-> v1-4 origin z) (-> *math-camera* isometric data 14))
(cond
((= z 0.0)
(let ((v1-4 obj))
(set! (-> v1-4 origin z) (-> *math-camera* isometric data 14))
)
)
(let ((v1-5 obj))
(set! (-> v1-5 origin z) z)
(else
(let ((v1-5 obj))
(set! (-> v1-5 origin z) z)
)
)
)
(let ((v1-6 obj))
@@ -792,6 +796,3 @@
;; failed to figure out what this is:
(let ((v0-4 0))
)
@@ -153,24 +153,28 @@
(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))
(let* ((expected-version (cond
((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
)
7
)
((zero? v1-0)
30
)
((= v1-0 (file-kind art-group))
6
)
)
)
version-override
(else
version-override
)
)
)
(v1-1 kind)
@@ -215,4 +219,3 @@
)
)
)
+171 -171
View File
@@ -18,7 +18,7 @@
(matrix-identity! arg0)
(let ((s5-0 (new 'stack-no-clear 'vector)))
(set! (-> s5-0 quad) (-> arg1 quad))
(if (= (logand (the int (-> s5-0 w)) 1) 1)
(when (= (logand (the int (-> s5-0 w)) 1) 1)
(let ((f0-2 (-> s5-0 x)))
(set! (-> s5-0 x) (-> s5-0 z))
(set! (-> s5-0 z) f0-2)
@@ -238,220 +238,224 @@
(s2-0 (-> EulNext (+ s3-0 v1-4)))
(s1-0 (-> EulNext (+ (- 1 v1-4) s3-0)))
)
(if (= (logand (sar arg2 1) 1) 1)
(let*
((f0-0
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s3-0 4)) (the-as int arg1))
(cond
((= (logand (sar arg2 1) 1) 1)
(let*
((f0-0
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
(f0-2 (* f0-0 f0-0))
(f1-0
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
(f30-0 (sqrtf (+ f0-2 (* f1-0 f1-0))))
)
(f0-2 (* f0-0 f0-0))
(f1-0
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
(f30-0 (sqrtf (+ f0-2 (* f1-0 f1-0))))
)
(cond
((< 0.00001 f30-0)
(set!
(-> arg0 x)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
(set!
(-> arg0 y)
(atan
f30-0
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
(set!
(-> arg0 z)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
(-
(cond
((< 0.00001 f30-0)
(set!
(-> arg0 x)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s1-0 4)) (the-as int arg1))
(+ (+ (shl s2-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
(set!
(-> arg0 y)
(atan
f30-0
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
(set!
(-> arg0 z)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
(-
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s1-0 4)) (the-as int arg1))
)
)
)
)
)
)
)
(else
(set!
(-> arg0 x)
(atan
(-
(else
(set!
(-> arg0 x)
(atan
(-
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s2-0 4)) (the-as int arg1))
(+ (+ (shl s2-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s2-0 4)) (the-as int arg1))
)
(set!
(-> arg0 y)
(atan
f30-0
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
(set! (-> arg0 z) 0.0)
)
(set!
(-> arg0 y)
(atan
f30-0
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
(set! (-> arg0 z) 0.0)
)
)
)
(let*
((f0-21
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
(f0-23 (* f0-21 f0-21))
(f1-3
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
)
(f30-1 (sqrtf (+ f0-23 (* f1-3 f1-3))))
)
(cond
((< 0.00001 f30-1)
(set!
(-> arg0 x)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s1-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s1-0 4)) (the-as int arg1))
)
(else
(let*
((f0-21
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
(set!
(-> arg0 y)
(atan
(-
(f0-23 (* f0-21 f0-21))
(f1-3
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
)
(f30-1 (sqrtf (+ f0-23 (* f1-3 f1-3))))
)
(cond
((< 0.00001 f30-1)
(set!
(-> arg0 x)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s1-0 4)) (the-as int arg1))
(+ (+ (shl s2-0 2) (shl s1-0 4)) (the-as int arg1))
)
)
)
f30-1
)
)
(set!
(-> arg0 z)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
)
)
(else
(set!
(-> arg0 x)
(atan
(-
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s2-0 4)) (the-as int arg1))
(+ (+ (shl s1-0 2) (shl s1-0 4)) (the-as int arg1))
)
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s2-0 4)) (the-as int arg1))
)
(set!
(-> arg0 y)
(atan
(-
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s1-0 4)) (the-as int arg1))
)
)
)
f30-1
)
)
)
(set!
(-> arg0 y)
(atan
(-
(set!
(-> arg0 z)
(atan
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s1-0 4)) (the-as int arg1))
(+ (+ (shl s3-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s3-0 4)) (the-as int arg1))
)
)
)
f30-1
)
)
(set! (-> arg0 z) 0.0)
(else
(set!
(-> arg0 x)
(atan
(-
(->
(the-as
(pointer float)
(+ (+ (shl s1-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
)
(->
(the-as
(pointer float)
(+ (+ (shl s2-0 2) (shl s2-0 4)) (the-as int arg1))
)
)
)
)
(set!
(-> arg0 y)
(atan
(-
(->
(the-as
(pointer float)
(+ (+ (shl s3-0 2) (shl s1-0 4)) (the-as int arg1))
)
)
)
f30-1
)
)
(set! (-> arg0 z) 0.0)
)
)
)
)
@@ -462,7 +466,7 @@
(set! (-> arg0 y) (- (-> arg0 y)))
(set! (-> arg0 z) (- (-> arg0 z)))
)
(if (= (logand arg2 1) 1)
(when (= (logand arg2 1) 1)
(let ((f0-49 (-> arg0 x)))
(set! (-> arg0 x) (-> arg0 z))
(set! (-> arg0 z) f0-49)
@@ -489,7 +493,3 @@
)
arg0
)
@@ -455,134 +455,138 @@
;; definition for function matrix->quaternion
(defun matrix->quaternion ((arg0 quaternion) (arg1 matrix))
(let ((f0-2 (+ (+ (-> arg1 data 0) (-> arg1 data 5)) (-> arg1 data 10))))
(if (< 0.0 f0-2)
(let ((f0-4 (sqrtf (+ 1.0 f0-2))))
(set! (-> arg0 w) (* 0.5 f0-4))
(let ((f0-5 (/ 0.5 f0-4)))
(set! (-> arg0 x) (* f0-5 (- (-> arg1 data 6) (-> arg1 data 9))))
(set! (-> arg0 y) (* f0-5 (- (-> arg1 data 8) (-> arg1 data 2))))
(set! (-> arg0 z) (* f0-5 (- (-> arg1 data 1) (-> arg1 data 4))))
(cond
((< 0.0 f0-2)
(let ((f0-4 (sqrtf (+ 1.0 f0-2))))
(set! (-> arg0 w) (* 0.5 f0-4))
(let ((f0-5 (/ 0.5 f0-4)))
(set! (-> arg0 x) (* f0-5 (- (-> arg1 data 6) (-> arg1 data 9))))
(set! (-> arg0 y) (* f0-5 (- (-> arg1 data 8) (-> arg1 data 2))))
(set! (-> arg0 z) (* f0-5 (- (-> arg1 data 1) (-> arg1 data 4))))
)
)
)
(let ((a2-0 0)
(a3-0 1)
(v1-1 2)
(else
(let ((a2-0 0)
(a3-0 1)
(v1-1 2)
)
(when (< (-> arg1 data 0) (-> arg1 data 5))
(set! a2-0 1)
(set! a3-0 2)
(set! v1-1 0)
)
(when
(<
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl a2-0 4)) (the-as int arg1))
)
)
(-> arg1 data 10)
)
(set! a2-0 2)
(set! a3-0 0)
(set! v1-1 1)
)
(let
((f0-12
(sqrtf
(+
(-
1.0
(+
(->
(the-as
(pointer float)
(+ (+ (shl a3-0 2) (shl a3-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl v1-1 2) (shl v1-1 4)) (the-as int arg1))
)
)
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl a2-0 4)) (the-as int arg1))
)
)
)
)
(when (< (-> arg1 data 0) (-> arg1 data 5))
(set! a2-0 1)
(set! a3-0 2)
(set! v1-1 0)
)
(when
(<
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl a2-0 4)) (the-as int arg1))
)
)
(-> arg1 data 10)
)
(set! a2-0 2)
(set! a3-0 0)
(set! v1-1 1)
)
(let
((f0-12
(sqrtf
(+
(-
1.0
(+
(->
(the-as
(pointer float)
(+ (+ (shl a3-0 2) (shl a3-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl v1-1 2) (shl v1-1 4)) (the-as int arg1))
)
)
(set!
(-> (the-as (pointer float) (+ (shl a2-0 2) (the-as int arg0))))
(* 0.5 f0-12)
)
(if (!= f0-12 0.0)
(set! f0-12 (/ 0.5 f0-12))
)
(set!
(-> arg0 w)
(*
(-
(->
(the-as
(pointer float)
(+ (+ (shl v1-1 2) (shl a3-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl a2-0 4)) (the-as int arg1))
(+ (+ (shl a3-0 2) (shl v1-1 4)) (the-as int arg1))
)
)
)
f0-12
)
)
)
(set!
(-> (the-as (pointer float) (+ (shl a2-0 2) (the-as int arg0))))
(* 0.5 f0-12)
)
(if (!= f0-12 0.0)
(set! f0-12 (/ 0.5 f0-12))
)
(set!
(-> arg0 w)
(*
(-
(->
(the-as
(pointer float)
(+ (+ (shl v1-1 2) (shl a3-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a3-0 2) (shl v1-1 4)) (the-as int arg1))
(set!
(-> (the-as (pointer float) (+ (shl a3-0 2) (the-as int arg0))))
(*
(+
(->
(the-as
(pointer float)
(+ (+ (shl a3-0 2) (shl a2-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl a3-0 4)) (the-as int arg1))
)
)
)
f0-12
)
f0-12
)
)
(set!
(-> (the-as (pointer float) (+ (shl a3-0 2) (the-as int arg0))))
(*
(+
(->
(the-as
(pointer float)
(+ (+ (shl a3-0 2) (shl a2-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl a3-0 4)) (the-as int arg1))
(set!
(-> (the-as (pointer float) (+ (shl v1-1 2) (the-as int arg0))))
(*
(+
(->
(the-as
(pointer float)
(+ (+ (shl v1-1 2) (shl a2-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl v1-1 4)) (the-as int arg1))
)
)
)
f0-12
)
f0-12
)
)
(set!
(-> (the-as (pointer float) (+ (shl v1-1 2) (the-as int arg0))))
(*
(+
(->
(the-as
(pointer float)
(+ (+ (shl v1-1 2) (shl a2-0 4)) (the-as int arg1))
)
)
(->
(the-as
(pointer float)
(+ (+ (shl a2-0 2) (shl v1-1 4)) (the-as int arg1))
)
)
)
f0-12
)
)
)
@@ -1162,7 +1166,3 @@
(vector-y-angle s5-0)
)
)
@@ -312,7 +312,7 @@
(let ((x-diff (- (-> target x) (-> vec x)))
(z-diff (- (-> target z) (-> vec z)))
)
(if (or (!= x-diff 0.0) (!= z-diff 0.0))
(when (or (!= x-diff 0.0) (!= z-diff 0.0))
(let* ((x-step (* x-diff alpha))
(z-step (* z-diff alpha))
(step-len (sqrtf (+ (* x-step x-step) (* z-step z-step))))
@@ -342,7 +342,7 @@
(let ((y-diff (- (-> target y) (-> vec y)))
(z-diff (- (-> target z) (-> vec z)))
)
(if (or (!= y-diff 0.0) (!= z-diff 0.0))
(when (or (!= y-diff 0.0) (!= z-diff 0.0))
(let* ((y-step (* y-diff alpha))
(z-step (* z-diff alpha))
(step-len (sqrtf (+ (* y-step y-step) (* z-step z-step))))
@@ -373,7 +373,7 @@
(y-diff (- (-> target y) (-> vec y)))
(z-diff (- (-> target z) (-> vec z)))
)
(if (or (!= x-diff 0.0) (!= y-diff 0.0) (!= z-diff 0.0))
(when (or (!= x-diff 0.0) (!= y-diff 0.0) (!= z-diff 0.0))
(let* ((x-step (* x-diff alpha))
(y-step (* y-diff alpha))
(z-step (* z-diff alpha))
@@ -408,20 +408,24 @@
seek-with-smooth
((value float) (target float) (max-step float) (alpha float) (deadband float))
(let ((diff (- target value)))
(if (>= deadband (fabs diff))
target
(let ((step (* diff alpha)))
(let ((min-step (- max-step)))
(cond
((< step min-step)
(set! step min-step)
)
((< max-step step)
(set! step max-step)
(cond
((>= deadband (fabs diff))
target
)
(else
(let ((step (* diff alpha)))
(let ((min-step (- max-step)))
(cond
((< step min-step)
(set! step min-step)
)
((< max-step step)
(set! step max-step)
)
)
)
(+ step value)
)
(+ step value)
)
)
)
@@ -790,12 +794,16 @@
;; Used lq/sq
(defun vector-normalize-copy! ((arg0 vector) (arg1 vector) (arg2 float))
(let ((f0-0 (vector-length arg1)))
(if (= f0-0 0.0)
(set! (-> arg0 quad) (-> arg1 quad))
(let ((v1-1 (/ arg2 f0-0)))
(set! (-> arg0 x) (* (-> arg1 x) v1-1))
(set! (-> arg0 y) (* (-> arg1 y) v1-1))
(set! (-> arg0 z) (* (-> arg1 z) v1-1))
(cond
((= f0-0 0.0)
(set! (-> arg0 quad) (-> arg1 quad))
)
(else
(let ((v1-1 (/ arg2 f0-0)))
(set! (-> arg0 x) (* (-> arg1 x) v1-1))
(set! (-> arg0 y) (* (-> arg1 y) v1-1))
(set! (-> arg0 z) (* (-> arg1 z) v1-1))
)
)
)
)
@@ -806,7 +814,7 @@
;; definition for function vector-xz-normalize!
(defun vector-xz-normalize! ((arg0 vector) (arg1 float))
(let ((f0-0 (vector-xz-length arg0)))
(if (!= f0-0 0.0)
(when (!= f0-0 0.0)
(let ((v1-1 (/ arg1 f0-0)))
(set! (-> arg0 x) (* (-> arg0 x) v1-1))
(set! (-> arg0 z) (* (-> arg0 z) v1-1))
@@ -1228,7 +1236,3 @@
)
(vector-normalize! arg0 (rand-vu-float-range 0.0 arg1))
)
@@ -69,10 +69,8 @@
obj
)
;; failed to figure out what this is:
(when (or (not *target*) (zero? *target*))
(set! *target* #f)
)
;; definition (perm) for symbol *target*, type target
(define-perm *target* target #f)
;; definition of type sidekick
(deftype sidekick (process-drawable)
@@ -99,15 +97,9 @@
obj
)
;; failed to figure out what this is:
(when (or (not *sidekick*) (zero? *sidekick*))
(set! *sidekick* #f)
)
;; definition (perm) for symbol *sidekick*, type sidekick
(define-perm *sidekick* sidekick #f)
;; failed to figure out what this is:
(let ((v0-2 0))
)
@@ -521,14 +521,17 @@
(defmethod dummy-12 delayed-rand-vector ((obj delayed-rand-vector))
(rlet ((vf0 :class vf))
(.lvf vf0 (new 'static 'vector :x 0.0 :y 0.0 :z 0.0 :w 1.0))
(if
(>=
(the-as int (- (-> *display* base-frame-counter) (-> obj start-time)))
(-> obj timer)
(cond
((>=
(the-as int (- (-> *display* base-frame-counter) (-> obj start-time)))
(-> obj timer)
)
((method-of-type delayed-rand-vector dummy-10) obj)
)
((method-of-type delayed-rand-vector dummy-10) obj)
(let ((v1-5 (-> obj value)))
(.svf (&-> v1-5 quad) vf0)
(else
(let ((v1-5 (-> obj value)))
(.svf (&-> v1-5 quad) vf0)
)
)
)
(-> obj value)
@@ -649,7 +652,7 @@
(.svf (&-> a1-4 quad) vf6)
)
(let ((f0-2 (vector-length (-> obj vel))))
(if (< (-> obj max-vel) f0-2)
(when (< (-> obj max-vel) f0-2)
(let ((v1-6 (-> obj vel)))
(let ((a0-8 (-> obj vel))
(f0-3 (/ (-> obj max-vel) f0-2))
@@ -704,7 +707,3 @@
(-> obj value)
)
)
+176 -169
View File
@@ -625,108 +625,110 @@
;; Used lq/sq
(defmethod print array ((obj array))
(format #t "#(")
(if (type-type? (-> obj content-type) integer)
(let ((content-type-sym (-> obj content-type symbol)))
(cond
((= content-type-sym 'int32)
(dotimes (s5-0 (-> obj length))
(format #t (if (zero? s5-0)
"~D"
" ~D"
)
(-> (the-as (array int32) obj) s5-0)
)
)
)
((= content-type-sym 'uint32)
(dotimes (s5-1 (-> obj length))
(format #t (if (zero? s5-1)
"~D"
" ~D"
)
(-> (the-as (array uint32) obj) s5-1)
)
)
)
((= content-type-sym 'int64)
(dotimes (s5-2 (-> obj length))
(format #t (if (zero? s5-2)
"~D"
" ~D"
)
(-> (the-as (array int64) obj) s5-2)
)
)
)
((= content-type-sym 'uint64)
(dotimes (s5-3 (-> obj length))
(format #t (if (zero? s5-3)
"#x~X"
" #x~X"
)
(-> (the-as (array uint64) obj) s5-3)
)
)
)
((= content-type-sym 'int8)
(dotimes (s5-4 (-> obj length))
(format #t (if (zero? s5-4)
"~D"
" ~D"
)
(-> (the-as (array int8) obj) s5-4)
)
)
)
((= content-type-sym 'uint8)
(dotimes (s5-5 (-> obj length))
(format #t (if (zero? s5-5)
"~D"
" ~D"
)
(-> (the-as (array uint8) obj) s5-5)
)
)
)
((= content-type-sym 'int16)
(dotimes (s5-6 (-> obj length))
(format #t (if (zero? s5-6)
"~D"
" ~D"
)
(-> (the-as (array int16) obj) s5-6)
)
)
)
((= content-type-sym 'uint16)
(dotimes (s5-7 (-> obj length))
(format #t (if (zero? s5-7)
"~D"
" ~D"
)
(-> (the-as (array uint16) obj) s5-7)
)
)
)
(else
(cond
((or (= content-type-sym 'uint128) (= content-type-sym 'int128))
(dotimes (s5-8 (-> obj length))
(format #t (if (zero? s5-8)
"#x~X"
" #x~X"
)
(-> (the-as (array uint128) obj) s5-8)
)
(cond
((type-type? (-> obj content-type) integer)
(let ((content-type-sym (-> obj content-type symbol)))
(cond
((= content-type-sym 'int32)
(dotimes (s5-0 (-> obj length))
(format #t (if (zero? s5-0)
"~D"
" ~D"
)
(-> (the-as (array int32) obj) s5-0)
)
)
(else
(dotimes (s5-9 (-> obj length))
(format #t (if (zero? s5-9)
"~D"
" ~D"
)
(-> (the-as (array int32) obj) s5-9)
)
((= content-type-sym 'uint32)
(dotimes (s5-1 (-> obj length))
(format #t (if (zero? s5-1)
"~D"
" ~D"
)
(-> (the-as (array uint32) obj) s5-1)
)
)
)
((= content-type-sym 'int64)
(dotimes (s5-2 (-> obj length))
(format #t (if (zero? s5-2)
"~D"
" ~D"
)
(-> (the-as (array int64) obj) s5-2)
)
)
)
((= content-type-sym 'uint64)
(dotimes (s5-3 (-> obj length))
(format #t (if (zero? s5-3)
"#x~X"
" #x~X"
)
(-> (the-as (array uint64) obj) s5-3)
)
)
)
((= content-type-sym 'int8)
(dotimes (s5-4 (-> obj length))
(format #t (if (zero? s5-4)
"~D"
" ~D"
)
(-> (the-as (array int8) obj) s5-4)
)
)
)
((= content-type-sym 'uint8)
(dotimes (s5-5 (-> obj length))
(format #t (if (zero? s5-5)
"~D"
" ~D"
)
(-> (the-as (array uint8) obj) s5-5)
)
)
)
((= content-type-sym 'int16)
(dotimes (s5-6 (-> obj length))
(format #t (if (zero? s5-6)
"~D"
" ~D"
)
(-> (the-as (array int16) obj) s5-6)
)
)
)
((= content-type-sym 'uint16)
(dotimes (s5-7 (-> obj length))
(format #t (if (zero? s5-7)
"~D"
" ~D"
)
(-> (the-as (array uint16) obj) s5-7)
)
)
)
(else
(cond
((or (= content-type-sym 'uint128) (= content-type-sym 'int128))
(dotimes (s5-8 (-> obj length))
(format #t (if (zero? s5-8)
"#x~X"
" #x~X"
)
(-> (the-as (array uint128) obj) s5-8)
)
)
)
(else
(dotimes (s5-9 (-> obj length))
(format #t (if (zero? s5-9)
"~D"
" ~D"
)
(-> (the-as (array int32) obj) s5-9)
)
)
)
)
@@ -734,20 +736,22 @@
)
)
)
(cond
((= (-> obj content-type) float)
(dotimes (s5-10 (-> obj length))
(if (zero? s5-10)
(format #t "~f" (-> (the-as (array float) obj) s5-10))
(format #t " ~f" (-> (the-as (array float) obj) s5-10))
(else
(cond
((= (-> obj content-type) float)
(dotimes (s5-10 (-> obj length))
(if (zero? s5-10)
(format #t "~f" (-> (the-as (array float) obj) s5-10))
(format #t " ~f" (-> (the-as (array float) obj) s5-10))
)
)
)
)
(else
(dotimes (s5-11 (-> obj length))
(if (zero? s5-11)
(format #t "~A" (-> (the-as (array basic) obj) s5-11))
(format #t " ~A" (-> (the-as (array basic) obj) s5-11))
(else
(dotimes (s5-11 (-> obj length))
(if (zero? s5-11)
(format #t "~A" (-> (the-as (array basic) obj) s5-11))
(format #t " ~A" (-> (the-as (array basic) obj) s5-11))
)
)
)
)
@@ -765,79 +769,83 @@
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tcontent-type: ~A~%" (-> obj content-type))
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data))
(if (type-type? (-> obj content-type) integer)
(let ((content-type-sym (-> obj content-type symbol)))
(cond
((= content-type-sym 'int32)
(dotimes (s5-0 (-> obj length))
(format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0))
(cond
((type-type? (-> obj content-type) integer)
(let ((content-type-sym (-> obj content-type symbol)))
(cond
((= content-type-sym 'int32)
(dotimes (s5-0 (-> obj length))
(format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0))
)
)
)
((= content-type-sym 'uint32)
(dotimes (s5-1 (-> obj length))
(format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) obj) s5-1))
((= content-type-sym 'uint32)
(dotimes (s5-1 (-> obj length))
(format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) obj) s5-1))
)
)
)
((= content-type-sym 'int64)
(dotimes (s5-2 (-> obj length))
(format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) obj) s5-2))
((= content-type-sym 'int64)
(dotimes (s5-2 (-> obj length))
(format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) obj) s5-2))
)
)
)
((= content-type-sym 'uint64)
(dotimes (s5-3 (-> obj length))
(format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) obj) s5-3))
((= content-type-sym 'uint64)
(dotimes (s5-3 (-> obj length))
(format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) obj) s5-3))
)
)
)
((= content-type-sym 'int8)
(dotimes (s5-4 (-> obj length))
(format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) obj) s5-4))
((= content-type-sym 'int8)
(dotimes (s5-4 (-> obj length))
(format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) obj) s5-4))
)
)
)
((= content-type-sym 'uint8)
(dotimes (s5-5 (-> obj length))
(format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) obj) s5-5))
((= content-type-sym 'uint8)
(dotimes (s5-5 (-> obj length))
(format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) obj) s5-5))
)
)
)
((= content-type-sym 'int16)
(dotimes (s5-6 (-> obj length))
(format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) obj) s5-6))
((= content-type-sym 'int16)
(dotimes (s5-6 (-> obj length))
(format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) obj) s5-6))
)
)
)
((= content-type-sym 'uint16)
(dotimes (s5-7 (-> obj length))
(format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) obj) s5-7))
((= content-type-sym 'uint16)
(dotimes (s5-7 (-> obj length))
(format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) obj) s5-7))
)
)
)
(else
(cond
((or (= content-type-sym 'int128) (= content-type-sym 'uint128))
(dotimes (s5-8 (-> obj length))
(format
#t
"~T [~D] #x~X~%"
s5-8
(-> (the-as (array uint128) obj) s5-8)
(else
(cond
((or (= content-type-sym 'int128) (= content-type-sym 'uint128))
(dotimes (s5-8 (-> obj length))
(format
#t
"~T [~D] #x~X~%"
s5-8
(-> (the-as (array uint128) obj) s5-8)
)
)
)
)
(else
(dotimes (s5-9 (-> obj length))
(format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) obj) s5-9))
(else
(dotimes (s5-9 (-> obj length))
(format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) obj) s5-9))
)
)
)
)
)
)
)
(cond
((= (-> obj content-type) float)
(dotimes (s5-10 (-> obj length))
(format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) obj) s5-10))
(else
(cond
((= (-> obj content-type) float)
(dotimes (s5-10 (-> obj length))
(format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) obj) s5-10))
)
)
)
(else
(dotimes (s5-11 (-> obj length))
(format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) obj) s5-11))
(else
(dotimes (s5-11 (-> obj length))
(format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) obj) s5-11))
)
)
)
)
@@ -1291,4 +1299,3 @@
;; failed to figure out what this is:
(let ((v0-3 0))
)
@@ -289,26 +289,30 @@
;; WARN: Unsupported inline assembly instruction kind - [sllv a2, v1, r0]
(defmethod print handle ((obj handle))
(local-vars (r0-0 none) (a2-0 int) (a2-2 (pointer process)) (s7-0 none))
(if (nonzero? obj)
(let ((t9-0 format)
(a0-1 #t)
(a1-0 "#<handle :process ~A :pid ~D>")
(v1-0 obj)
)
(.subu a2-0 v1-0 s7-0)
(t9-0 a0-1 a1-0 (and (nonzero? a2-0) (begin
(.sllv a2-2 v1-0 r0-0)
(let ((a3-0 (-> a2-2 0)))
(if (= (-> v1-0 pid) (-> a3-0 pid))
a3-0
(cond
((nonzero? obj)
(let ((t9-0 format)
(a0-1 #t)
(a1-0 "#<handle :process ~A :pid ~D>")
(v1-0 obj)
)
(.subu a2-0 v1-0 s7-0)
(t9-0 a0-1 a1-0 (and (nonzero? a2-0) (begin
(.sllv a2-2 v1-0 r0-0)
(let ((a3-0 (-> a2-2 0)))
(if (= (-> v1-0 pid) (-> a3-0 pid))
a3-0
)
)
)
)
)
(-> obj pid)
)
(-> obj pid)
)
)
)
(format #t "#<handle :process 0 :pid 0>")
(else
(format #t "#<handle :process 0 :pid 0>")
)
)
obj
)
@@ -370,5 +374,3 @@
;; failed to figure out what this is:
(let ((v0-11 0))
)
+65 -58
View File
@@ -157,30 +157,34 @@
(arg2 int)
(arg3 pointer)
)
(let ((obj (the-as cpu-thread (if (-> arg0 top-thread)
(&+ arg3 -7164)
(let
((v1-2
(logand
-16
(the-as int (&+ (-> arg0 heap-cur) 15))
)
)
)
(set!
(-> arg0 heap-cur)
(the-as
pointer
(+
(+
v1-2
(the-as int (-> type-to-make size))
(let ((obj (the-as cpu-thread (cond
((-> arg0 top-thread)
(&+ arg3 -7164)
)
(else
(let
((v1-2
(logand
-16
(the-as int (&+ (-> arg0 heap-cur) 15))
)
arg2
)
)
(set!
(-> arg0 heap-cur)
(the-as
pointer
(+
(+
v1-2
(the-as int (-> type-to-make size))
)
arg2
)
)
)
(+ v1-2 4)
)
(+ v1-2 4)
)
)
)
@@ -209,7 +213,7 @@
;; definition for function remove-exit
(defun remove-exit ()
(local-vars (pp process))
(if (-> pp stack-frame-top)
(when (-> pp stack-frame-top)
(let ((v0-0 (-> pp stack-frame-top next)))
(set! (-> pp stack-frame-top) v0-0)
v0-0
@@ -591,7 +595,7 @@
(!= obj *debug-dead-pool*)
)
(set! s4-0 (get-process *debug-dead-pool* arg0 arg1))
(if (the-as process s4-0)
(when (the-as process s4-0)
(let ((t9-1 format)
(a0-2 0)
(a1-2
@@ -720,26 +724,30 @@
gap-size
dead-pool-heap
((obj dead-pool-heap) (arg0 dead-pool-heap-rec))
(if (-> arg0 process)
(let
((v1-3
(&+
(&+ (the-as pointer (-> arg0 process)) (-> process size))
(-> arg0 process allocated-length)
(cond
((-> arg0 process)
(let
((v1-3
(&+
(&+ (the-as pointer (-> arg0 process)) (-> process size))
(-> arg0 process allocated-length)
)
)
)
)
(if (-> arg0 next)
(&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3))
(&- (-> obj heap top) (the-as uint (&+ v1-3 4)))
(if (-> arg0 next)
(&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3))
(&- (-> obj heap top) (the-as uint (&+ v1-3 4)))
)
)
)
(if (-> arg0 next)
(&-
(the-as pointer (-> arg0 next process))
(the-as uint (&+ (-> obj heap base) 4))
(else
(if (-> arg0 next)
(&-
(the-as pointer (-> arg0 next process))
(the-as uint (&+ (-> obj heap base) 4))
)
(&- (-> obj heap top) (the-as uint (-> obj heap base)))
)
(&- (-> obj heap top) (the-as uint (-> obj heap base)))
)
)
)
@@ -973,7 +981,7 @@
)
(when (= (-> obj first-shrink) s5-1)
(set! (-> obj first-shrink) (the-as dead-pool-heap-rec (-> s5-1 1)))
(when (not (-> obj first-shrink process))
(if (not (-> obj first-shrink process))
(set! (-> obj first-shrink) #f)
)
)
@@ -993,7 +1001,7 @@
;; definition for method 17 of type dead-pool-heap
(defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (arg0 process))
(if arg0
(when arg0
(let ((s5-0 (-> arg0 ppointer)))
(when
(not
@@ -1058,7 +1066,7 @@
)
)
(let ((s4-1 (-> obj first-gap)))
(if (-> s4-1 next)
(when (-> s4-1 next)
(let ((s3-0 (-> s4-1 next process))
(s2-0 (gap-size obj s4-1))
)
@@ -1101,7 +1109,7 @@
)
(when (= (-> obj first-shrink) s4-0)
(set! (-> obj first-shrink) (-> s4-0 prev))
(when (not (-> obj first-shrink process))
(if (not (-> obj first-shrink process))
(set! (-> obj first-shrink) #f)
)
)
@@ -1323,7 +1331,7 @@
(defun
search-process-tree
((arg0 process-tree) (arg1 (function process-tree object)))
(if (zero? (logand (-> arg0 mask) (process-mask process-tree)))
(when (zero? (logand (-> arg0 mask) (process-mask process-tree)))
(if (arg1 arg0)
(return arg0)
)
@@ -1562,7 +1570,7 @@
;; definition for function change-parent
(defun change-parent ((arg0 process-tree) (arg1 process-tree))
(let ((a2-0 (-> arg0 parent)))
(if a2-0
(when a2-0
(let* ((v1-2 (-> a2-0 0 child))
(a3-0 v1-2)
)
@@ -1601,9 +1609,9 @@
;; definition for function change-brother
(defun change-brother ((arg0 process-tree) (arg1 process-tree))
(if (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1))
(when (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1))
(let ((a2-1 (-> arg0 parent)))
(if a2-1
(when a2-1
(let ((t0-0 (-> a2-1 0 child))
(a3-1 (the-as (pointer process-tree) #f))
(v1-4 (the-as (pointer process-tree) #f))
@@ -1651,11 +1659,15 @@
)
(set! t0-0 (-> t0-0 0 brother))
)
(if (or (not a3-1) (not v1-4))
(return 0)
(if (= a3-1 a2-1)
(set! (-> a3-1 4) (the-as process-tree (-> arg0 brother)))
(set! (-> a3-1 3) (the-as process-tree (-> arg0 brother)))
(cond
((or (not a3-1) (not v1-4))
(return 0)
)
(else
(if (= a3-1 a2-1)
(set! (-> a3-1 4) (the-as process-tree (-> arg0 brother)))
(set! (-> a3-1 3) (the-as process-tree (-> arg0 brother)))
)
)
)
(cond
@@ -1741,13 +1753,9 @@
(set! (-> obj event-hook) #f)
(set! (-> obj state) #f)
(set! (-> obj next-state) #f)
(cond
((nonzero? (logand (-> arg0 mask) (process-mask process-tree)))
(set! (-> obj entity) #f)
)
(else
(set! (-> obj entity) (-> (the-as process arg0) entity))
)
(if (nonzero? (logand (-> arg0 mask) (process-mask process-tree)))
(set! (-> obj entity) #f)
(set! (-> obj entity) (-> (the-as process arg0) entity))
)
(set! (-> obj connection-list next1) #f)
(set! (-> obj connection-list prev1) #f)
@@ -2004,4 +2012,3 @@
(set! *default-pool* a0-63)
(gp-5 a0-63 *active-pool*)
)
+5 -10
View File
@@ -106,13 +106,9 @@
(set! (-> pp mask) (logand (lognot (process-mask going)) (-> pp mask)))
(let ((s0-2 (-> pp state)))
(set! (-> pp event-hook) (-> s0-2 event))
(cond
((-> s0-2 exit)
(set! (-> pp stack-frame-top) s0-2)
)
(else
(set! (-> pp stack-frame-top) #f)
)
(if (-> s0-2 exit)
(set! (-> pp stack-frame-top) s0-2)
(set! (-> pp stack-frame-top) #f)
)
(set! (-> pp post-hook) (-> s0-2 post))
(set! (-> pp trans-hook) (-> s0-2 trans))
@@ -139,7 +135,7 @@
(else
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(if (!= (-> pp top-thread name) 'post)
(when (!= (-> pp top-thread name) 'post)
(let ((v0-2 (the-as object return-from-thread)))
(.sw (the-as (function none) v0-2) 0 sp-0)
v0-2
@@ -151,7 +147,7 @@
;; definition for function send-event-function
(defun send-event-function ((arg0 process) (arg1 event-message-block))
(if (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
(when (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
(let ((gp-0 pp))
(let ((s6-1 arg0))
)
@@ -181,4 +177,3 @@
)
(the-as symbol #f)
)
+62 -53
View File
@@ -39,30 +39,34 @@
new
string
((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
(if arg1
(let* ((s2-1 (max ((method-of-type string length) arg1) arg0))
(a0-4
(object-new
allocation
type-to-make
(+ (+ s2-1 1) (the-as int (-> type-to-make size)))
(cond
(arg1
(let* ((s2-1 (max ((method-of-type string length) arg1) arg0))
(a0-4
(object-new
allocation
type-to-make
(+ (+ s2-1 1) (the-as int (-> type-to-make size)))
)
)
)
)
(set! (-> a0-4 allocated-length) s2-1)
(copy-string<-string a0-4 arg1)
(set! (-> a0-4 allocated-length) s2-1)
(copy-string<-string a0-4 arg1)
)
)
(let
((v0-2
(object-new
allocation
type-to-make
(+ (+ arg0 1) (the-as int (-> type-to-make size)))
(else
(let
((v0-2
(object-new
allocation
type-to-make
(+ (+ arg0 1) (the-as int (-> type-to-make size)))
)
)
)
(set! (-> v0-2 allocated-length) arg0)
v0-2
)
(set! (-> v0-2 allocated-length) arg0)
v0-2
)
)
)
@@ -562,35 +566,38 @@
(>= (the-as uint 102) (-> next-char-2 0))
)
)
(if
(and
(>= (-> next-char-2 0) (the-as uint 65))
(>= (the-as uint 70) (-> next-char-2 0))
)
(set!
result
(the-as
int
(+ (+ (-> next-char-2 0) -55) (the-as uint (shl result 4)))
)
)
(if
(and
(>= (-> next-char-2 0) (the-as uint 97))
(>= (the-as uint 102) (-> next-char-2 0))
(cond
((and
(>= (-> next-char-2 0) (the-as uint 65))
(>= (the-as uint 70) (-> next-char-2 0))
)
(set!
result
(the-as
int
(+ (+ (-> next-char-2 0) -87) (the-as uint (shl result 4)))
(+ (+ (-> next-char-2 0) -55) (the-as uint (shl result 4)))
)
)
(set!
result
(the-as
int
(+ (+ (-> next-char-2 0) -48) (the-as uint (shl result 4)))
)
(else
(if
(and
(>= (-> next-char-2 0) (the-as uint 97))
(>= (the-as uint 102) (-> next-char-2 0))
)
(set!
result
(the-as
int
(+ (+ (-> next-char-2 0) -87) (the-as uint (shl result 4)))
)
)
(set!
result
(the-as
int
(+ (+ (-> next-char-2 0) -48) (the-as uint (shl result 4)))
)
)
)
)
@@ -687,20 +694,24 @@
(first-flag string)
(second-flag string)
)
(if (string-get-arg!! *string-tmp-str* in)
(cond
((or
(string= *string-tmp-str* first-flag)
(string= *string-tmp-str* second-flag)
(cond
((string-get-arg!! *string-tmp-str* in)
(cond
((or
(string= *string-tmp-str* first-flag)
(string= *string-tmp-str* second-flag)
)
(set! (-> result 0) (string= *string-tmp-str* first-flag))
#t
)
(else
#f
)
(set! (-> result 0) (string= *string-tmp-str* first-flag))
#t
)
(else
#f
)
)
#f
(else
#f
)
)
)
@@ -718,5 +729,3 @@
;; definition for symbol *temp-string*, type string
(define *temp-string* (new 'global 'string 256 (the-as string #f)))
+185 -188
View File
@@ -539,110 +539,110 @@ TEST_F(FormRegressionTest, ExprArrayMethod2) {
std::string expected =
"(begin\n"
" (format #t \"#(\")\n"
" (if\n"
" (type-type? (-> arg0 content-type) integer)\n"
" (let\n"
" ((v1-1 (-> arg0 content-type symbol)))\n"
" (cond\n"
" ((= v1-1 (quote int32))\n"
" (dotimes\n"
" (s5-0 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-0) \"~D\" \" ~D\")\n"
" (-> (the-as (array int32) arg0) s5-0)\n"
" (cond\n"
" ((type-type? (-> arg0 content-type) integer)\n"
" (let ((v1-1 (-> arg0 content-type symbol)))\n"
" (cond\n"
" ((= v1-1 (quote int32))\n"
" (dotimes (s5-0 (-> arg0 length))\n"
" (format #t (if (zero? s5-0)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array int32) arg0) s5-0)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint32))\n"
" (dotimes\n"
" (s5-1 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-1) \"~D\" \" ~D\")\n"
" (-> (the-as (array uint32) arg0) s5-1)\n"
" ((= v1-1 (quote uint32))\n"
" (dotimes (s5-1 (-> arg0 length))\n"
" (format #t (if (zero? s5-1)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array uint32) arg0) s5-1)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote int64))\n"
" (dotimes\n"
" (s5-2 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-2) \"~D\" \" ~D\")\n"
" (-> (the-as (array int64) arg0) s5-2)\n"
" ((= v1-1 (quote int64))\n"
" (dotimes (s5-2 (-> arg0 length))\n"
" (format #t (if (zero? s5-2)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array int64) arg0) s5-2)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint64))\n"
" (dotimes\n"
" (s5-3 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-3) \"#x~X\" \" #x~X\")\n"
" (-> (the-as (array uint64) arg0) s5-3)\n"
" ((= v1-1 (quote uint64))\n"
" (dotimes (s5-3 (-> arg0 length))\n"
" (format #t (if (zero? s5-3)\n"
" \"#x~X\"\n"
" \" #x~X\"\n"
" )\n"
" (-> (the-as (array uint64) arg0) s5-3)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote int8))\n"
" (dotimes\n"
" (s5-4 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-4) \"~D\" \" ~D\")\n"
" (-> (the-as (array int8) arg0) s5-4)\n"
" ((= v1-1 (quote int8))\n"
" (dotimes (s5-4 (-> arg0 length))\n"
" (format #t (if (zero? s5-4)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array int8) arg0) s5-4)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint8))\n"
" (dotimes\n"
" (s5-5 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-5) \"~D\" \" ~D\")\n"
" (-> (the-as (array uint8) arg0) s5-5)\n"
" ((= v1-1 (quote uint8))\n"
" (dotimes (s5-5 (-> arg0 length))\n"
" (format #t (if (zero? s5-5)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array uint8) arg0) s5-5)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote int16))\n"
" (dotimes\n"
" (s5-6 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-6) \"~D\" \" ~D\")\n"
" (-> (the-as (array int16) arg0) s5-6)\n"
" ((= v1-1 (quote int16))\n"
" (dotimes (s5-6 (-> arg0 length))\n"
" (format #t (if (zero? s5-6)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array int16) arg0) s5-6)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint16))\n"
" (dotimes\n"
" (s5-7 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-7) \"~D\" \" ~D\")\n"
" (-> (the-as (array uint16) arg0) s5-7)\n"
" ((= v1-1 (quote uint16))\n"
" (dotimes (s5-7 (-> arg0 length))\n"
" (format #t (if (zero? s5-7)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array uint16) arg0) s5-7)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" (else\n"
" (cond\n"
" ((or (= v1-1 (quote uint128)) (= v1-1 (quote int128)))\n"
" (dotimes (s5-8 (-> arg0 length))\n"
" (format #t (if (zero? s5-8)\n"
" \"#x~X\"\n"
" \" #x~X\"\n"
" )\n"
" (-> (the-as (array uint128) arg0) s5-8)\n"
" (else\n"
" (cond\n"
" ((or (= v1-1 (quote uint128)) (= v1-1 (quote int128)))\n"
" (dotimes (s5-8 (-> arg0 length))\n"
" (format #t (if (zero? s5-8)\n"
" \"#x~X\"\n"
" \" #x~X\"\n"
" )\n"
" (-> (the-as (array uint128) arg0) s5-8)\n"
" )\n"
" )\n"
" )\n"
" )"
" (else\n"
" (dotimes\n"
" (s5-9 (-> arg0 length))\n"
" (format\n"
" #t\n"
" (if (zero? s5-9) \"~D\" \" ~D\")\n"
" (-> (the-as (array int32) arg0) s5-9)\n"
" (else\n"
" (dotimes (s5-9 (-> arg0 length))\n"
" (format #t (if (zero? s5-9)\n"
" \"~D\"\n"
" \" ~D\"\n"
" )\n"
" (-> (the-as (array int32) arg0) s5-9)\n"
" )\n"
" )\n"
" )\n"
" )\n"
@@ -650,24 +650,22 @@ TEST_F(FormRegressionTest, ExprArrayMethod2) {
" )\n"
" )\n"
" )\n"
" (cond\n"
" ((= (-> arg0 content-type) float)\n"
" (dotimes\n"
" (s5-10 (-> arg0 length))\n"
" (if\n"
" (zero? s5-10)\n"
" (format #t \"~f\" (-> (the-as (array float) arg0) s5-10))\n"
" (format #t \" ~f\" (-> (the-as (array float) arg0) s5-10))\n"
" (else\n"
" (cond\n"
" ((= (-> arg0 content-type) float)\n"
" (dotimes (s5-10 (-> arg0 length))\n"
" (if (zero? s5-10)\n"
" (format #t \"~f\" (-> (the-as (array float) arg0) s5-10))\n"
" (format #t \" ~f\" (-> (the-as (array float) arg0) s5-10))\n"
" )\n"
" )\n"
" )\n"
" )\n"
" (else\n"
" (dotimes\n"
" (s5-11 (-> arg0 length))\n"
" (if\n"
" (zero? s5-11)\n"
" (format #t \"~A\" (-> (the-as (array basic) arg0) s5-11))\n"
" (format #t \" ~A\" (-> (the-as (array basic) arg0) s5-11))\n"
" (else\n"
" (dotimes (s5-11 (-> arg0 length))\n"
" (if (zero? s5-11)\n"
" (format #t \"~A\" (-> (the-as (array basic) arg0) s5-11))\n"
" (format #t \" ~A\" (-> (the-as (array basic) arg0) s5-11))\n"
" )\n"
" )\n"
" )\n"
" )\n"
@@ -1164,92 +1162,88 @@ TEST_F(FormRegressionTest, ExprArrayMethod3) {
" (format #t \"~Tlength: ~D~%\" (-> arg0 length))\n"
" (format #t \" ~Tcontent-type: ~A~%\" (-> arg0 content-type))\n"
" (format #t \"~Tdata[~D]: @ #x~X~%\" (-> arg0 allocated-length) (-> arg0 data))\n"
" (if\n"
" (type-type? (-> arg0 content-type) integer)\n"
" (let\n"
" ((v1-1 (-> arg0 content-type symbol)))\n"
" (cond\n"
" ((= v1-1 (quote int32))\n"
" (dotimes\n"
" (s5-0 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-0 (-> (the-as (array int32) arg0) s5-0))\n"
" (cond\n"
" ((type-type? (-> arg0 content-type) integer)\n"
" (let ((v1-1 (-> arg0 content-type symbol)))\n"
" (cond\n"
" ((= v1-1 (quote int32))\n"
" (dotimes (s5-0 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-0 (-> (the-as (array int32) arg0) s5-0))\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint32))\n"
" (dotimes\n"
" (s5-1 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-1 (-> (the-as (array uint32) arg0) s5-1))\n"
" ((= v1-1 (quote uint32))\n"
" (dotimes (s5-1 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-1 (-> (the-as (array uint32) arg0) s5-1))\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote int64))\n"
" (dotimes\n"
" (s5-2 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-2 (-> (the-as (array int64) arg0) s5-2))\n"
" ((= v1-1 (quote int64))\n"
" (dotimes (s5-2 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-2 (-> (the-as (array int64) arg0) s5-2))\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint64))\n"
" (dotimes\n"
" (s5-3 (-> arg0 length))\n"
" (format #t \"~T [~D] #x~X~%\" s5-3 (-> (the-as (array uint64) arg0) s5-3))\n"
" ((= v1-1 (quote uint64))\n"
" (dotimes (s5-3 (-> arg0 length))\n"
" (format\n"
" #t\n"
" \"~T [~D] #x~X~%\"\n"
" s5-3\n"
" (-> (the-as (array uint64) arg0) s5-3)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote int8))\n"
" (dotimes\n"
" (s5-4 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-4 (-> (the-as (array int8) arg0) s5-4))\n"
" ((= v1-1 (quote int8))\n"
" (dotimes (s5-4 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-4 (-> (the-as (array int8) arg0) s5-4))\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint8))\n"
" (dotimes\n"
" (s5-5 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-5 (-> (the-as (array int8) arg0) s5-5))\n"
" ((= v1-1 (quote uint8))\n"
" (dotimes (s5-5 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-5 (-> (the-as (array int8) arg0) s5-5))\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote int16))\n"
" (dotimes\n"
" (s5-6 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-6 (-> (the-as (array int16) arg0) s5-6))\n"
" ((= v1-1 (quote int16))\n"
" (dotimes (s5-6 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-6 (-> (the-as (array int16) arg0) s5-6))\n"
" )\n"
" )\n"
" )\n"
" ((= v1-1 (quote uint16))\n"
" (dotimes\n"
" (s5-7 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-7 (-> (the-as (array uint16) arg0) s5-7))\n"
" ((= v1-1 (quote uint16))\n"
" (dotimes (s5-7 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-7 (-> (the-as (array uint16) arg0) s5-7))\n"
" )\n"
" )\n"
" )\n"
" (else\n"
" (cond\n"
" ((or (= v1-1 (quote int128)) (= v1-1 (quote uint128)))\n"
" (dotimes (s5-8 (-> arg0 length))\n"
" (format\n"
" #t\n"
" \"~T [~D] #x~X~%\"\n"
" s5-8\n"
" (-> (the-as (array uint128) arg0) s5-8)\n"
" (else\n"
" (cond\n"
" ((or (= v1-1 (quote int128)) (= v1-1 (quote uint128)))\n"
" (dotimes (s5-8 (-> arg0 length))\n"
" (format\n"
" #t\n"
" \"~T [~D] #x~X~%\"\n"
" s5-8\n"
" (-> (the-as (array uint128) arg0) s5-8)\n"
" )\n"
" )\n"
" )\n"
" )"
" (else\n"
" (dotimes\n"
" (s5-9 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-9 (-> (the-as (array int32) arg0) s5-9))\n"
" (else\n"
" (dotimes (s5-9 (-> arg0 length))\n"
" (format #t \"~T [~D] ~D~%\" s5-9 (-> (the-as (array int32) arg0) s5-9))\n"
" )\n"
" )\n"
" )\n"
" )\n"
" )\n"
" )\n"
" )\n"
" (cond\n"
" ((= (-> arg0 content-type) float)\n"
" (dotimes\n"
" (s5-10 (-> arg0 length))\n"
" (format #t \"~T [~D] ~f~%\" s5-10 (-> (the-as (array float) arg0) s5-10))\n"
" (else\n"
" (cond\n"
" ((= (-> arg0 content-type) float)\n"
" (dotimes (s5-10 (-> arg0 length))\n"
" (format #t \"~T [~D] ~f~%\" s5-10 (-> (the-as (array float) arg0) s5-10))\n"
" )\n"
" )\n"
" )\n"
" (else\n"
" (dotimes\n"
" (s5-11 (-> arg0 length))\n"
" (format #t \"~T [~D] ~A~%\" s5-11 (-> (the-as (array basic) arg0) s5-11))\n"
" (else\n"
" (dotimes (s5-11 (-> arg0 length))\n"
" (format #t \"~T [~D] ~A~%\" s5-11 (-> (the-as (array basic) arg0) s5-11))\n"
" )\n"
" )\n"
" )\n"
" )\n"
@@ -2373,27 +2367,30 @@ TEST_F(FormRegressionTest, ExprStringToInt) {
" (>= (the-as uint 102) (-> a0-3 0))\n"
" )\n"
" )\n"
" (if\n"
" (and\n"
" (>= (-> a0-3 0) (the-as uint 65))\n"
" (>= (the-as uint 70) (-> a0-3 0))\n"
" )\n"
" (set!\n"
" v0-0\n"
" (the-as int (+ (+ (-> a0-3 0) -55) (the-as uint (shl v0-0 4))))\n"
" )\n"
" (if\n"
" (and\n"
" (>= (-> a0-3 0) (the-as uint 97))\n"
" (>= (the-as uint 102) (-> a0-3 0))\n"
" (cond\n"
" ((and\n"
" (>= (-> a0-3 0) (the-as uint 65))\n"
" (>= (the-as uint 70) (-> a0-3 0))\n"
" )\n"
" (set!\n"
" v0-0\n"
" (the-as int (+ (+ (-> a0-3 0) -87) (the-as uint (shl v0-0 4))))\n"
" (the-as int (+ (+ (-> a0-3 0) -55) (the-as uint (shl v0-0 4))))\n"
" )\n"
" (set!\n"
" v0-0\n"
" (the-as int (+ (+ (-> a0-3 0) -48) (the-as uint (shl v0-0 4))))\n"
" )\n"
" (else\n"
" (if\n"
" (and\n"
" (>= (-> a0-3 0) (the-as uint 97))\n"
" (>= (the-as uint 102) (-> a0-3 0))\n"
" )\n"
" (set!\n"
" v0-0\n"
" (the-as int (+ (+ (-> a0-3 0) -87) (the-as uint (shl v0-0 4))))\n"
" )\n"
" (set!\n"
" v0-0\n"
" (the-as int (+ (+ (-> a0-3 0) -48) (the-as uint (shl v0-0 4))))\n"
" )\n"
" )\n"
" )\n"
" )\n"
+111 -111
View File
@@ -335,24 +335,28 @@ TEST_F(FormRegressionTest, ExprMethod0Thread) {
" daddu sp, sp, r0";
std::string type = "(function symbol type process symbol int pointer cpu-thread)";
std::string expected =
"(let ((obj (the-as cpu-thread (if (-> arg2 top-thread)\n"
" (&+ arg5 -7164)\n"
" (let\n"
" ((v1-2\n"
" (logand\n"
" -16\n"
" (the-as int (&+ (-> arg2 heap-cur) 15))\n"
"(let ((obj (the-as cpu-thread (cond\n"
" ((-> arg2 top-thread)\n"
" (&+ arg5 -7164)\n"
" )\n"
" (else\n"
" (let\n"
" ((v1-2\n"
" (logand\n"
" -16\n"
" (the-as int (&+ (-> arg2 heap-cur) 15))\n"
" )\n"
" )\n"
" )\n"
" )\n"
" (set!\n"
" (-> arg2 heap-cur)\n"
" (the-as\n"
" pointer\n"
" (+ (+ v1-2 (the-as int (-> arg1 size))) arg4)\n"
" (set!\n"
" (-> arg2 heap-cur)\n"
" (the-as\n"
" pointer\n"
" (+ (+ v1-2 (the-as int (-> arg1 size))) arg4)\n"
" )\n"
" )\n"
" (+ v1-2 4)\n"
" )\n"
" (+ v1-2 4)\n"
" )\n"
" )\n"
" )\n"
@@ -407,10 +411,8 @@ TEST_F(FormRegressionTest, RemoveExit) {
" daddu sp, sp, r0";
std::string type = "(function stack-frame)";
std::string expected =
"(if\n"
" (-> pp stack-frame-top)\n"
" (let\n"
" ((v0-0 (-> pp stack-frame-top next)))\n"
"(when (-> pp stack-frame-top)\n"
" (let ((v0-0 (-> pp stack-frame-top next)))\n"
" (set! (-> pp stack-frame-top) v0-0)\n"
" v0-0\n"
" )\n"
@@ -1079,7 +1081,7 @@ TEST_F(FormRegressionTest, ExprMethod14DeadPool) {
" (!= arg0 *debug-dead-pool*)\n"
" )\n"
" (set! s4-0 (get-process *debug-dead-pool* arg1 arg2))\n"
" (if (the-as process s4-0)\n"
" (when (the-as process s4-0)\n"
" (let ((t9-1 format)\n"
" (a0-2 0)\n"
" (a1-2\n"
@@ -1402,26 +1404,30 @@ TEST_F(FormRegressionTest, ExprMethod21DeadPoolHeap) {
" daddu sp, sp, r0";
std::string type = "(function dead-pool-heap dead-pool-heap-rec int)";
std::string expected =
"(if (-> arg1 process)\n"
" (let\n"
" ((v1-3\n"
" (&+\n"
" (&+ (the-as pointer (-> arg1 process)) (-> process size))\n"
" (-> arg1 process allocated-length)\n"
"(cond\n"
" ((-> arg1 process)\n"
" (let\n"
" ((v1-3\n"
" (&+\n"
" (&+ (the-as pointer (-> arg1 process)) (-> process size))\n"
" (-> arg1 process allocated-length)\n"
" )\n"
" )\n"
" )\n"
" )\n"
" (if (-> arg1 next)\n"
" (&- (the-as pointer (-> arg1 next process)) (the-as uint v1-3))\n"
" (&- (-> arg0 heap top) (the-as uint (&+ v1-3 4)))\n"
" (if (-> arg1 next)\n"
" (&- (the-as pointer (-> arg1 next process)) (the-as uint v1-3))\n"
" (&- (-> arg0 heap top) (the-as uint (&+ v1-3 4)))\n"
" )\n"
" )\n"
" )\n"
" (if (-> arg1 next)\n"
" (&-\n"
" (the-as pointer (-> arg1 next process))\n"
" (the-as uint (&+ (-> arg0 heap base) 4))\n"
" (else\n"
" (if (-> arg1 next)\n"
" (&-\n"
" (the-as pointer (-> arg1 next process))\n"
" (the-as uint (&+ (-> arg0 heap base) 4))\n"
" )\n"
" (&- (-> arg0 heap top) (the-as uint (-> arg0 heap base)))\n"
" )\n"
" (&- (-> arg0 heap top) (the-as uint (-> arg0 heap base)))\n"
" )\n"
" )";
test_with_expr(func, type, expected, false, "", {},
@@ -2235,7 +2241,7 @@ TEST_F(FormRegressionTest, ExprMethod15DeadPoolHeap) {
" )\n"
" (when (= (-> arg0 first-shrink) s5-1)\n"
" (set! (-> arg0 first-shrink) (the-as dead-pool-heap-rec (-> s5-1 1)))\n"
" (when (not (-> arg0 first-shrink process))\n"
" (if (not (-> arg0 first-shrink process))\n"
" (set! (-> arg0 first-shrink) #f)\n"
" )\n"
" )\n"
@@ -2348,38 +2354,33 @@ TEST_F(FormRegressionTest, ExprMethod17DeadPoolHeap) {
// NOTE - this has bad types.
std::string expected =
"(begin\n"
" (if arg1 (let ((s5-0 (-> arg1 ppointer)))\n"
" (when\n"
" (not\n"
" (or\n"
" (nonzero? (logand (-> arg1 mask) (process-mask heap-shrunk)))\n"
" (and (not (-> arg1 next-state)) (not (-> arg1 state)))\n"
" )\n"
" )\n"
" (set!\n"
" (-> arg1 allocated-length)\n"
" (&- (-> arg1 heap-cur) (the-as uint (-> arg1 stack)))\n"
" )\n"
" (set!\n"
" (-> arg1 heap-top)\n"
" (&-> arg1 stack (-> arg1 allocated-length))\n"
" )\n"
" (if\n"
" (<\n"
" (the-as int arg1)\n"
" (the-as int (gap-location arg0 (-> arg0 first-gap)))\n"
" )\n"
" (set! (-> arg0 first-gap) (find-gap arg0 (the-as dead-pool-heap-rec s5-0)))\n"
" )\n"
" (set! (-> arg1 mask) (logior (-> arg1 mask) (process-mask heap-shrunk)))\n"
" )\n"
" (if (= (-> arg0 first-shrink) s5-0)\n"
" (set!\n"
" (-> arg0 first-shrink)\n"
" (the-as dead-pool-heap-rec (-> s5-0 2))\n"
" )\n"
" )\n"
" )\n"
" (when arg1\n"
" (let ((s5-0 (-> arg1 ppointer)))\n"
" (when\n"
" (not\n"
" (or\n"
" (nonzero? (logand (-> arg1 mask) (process-mask heap-shrunk)))\n"
" (and (not (-> arg1 next-state)) (not (-> arg1 state)))\n"
" )\n"
" )\n"
" (set!\n"
" (-> arg1 allocated-length)\n"
" (&- (-> arg1 heap-cur) (the-as uint (-> arg1 stack)))\n"
" )\n"
" (set! (-> arg1 heap-top) (&-> arg1 stack (-> arg1 allocated-length)))\n"
" (if\n"
" (< (the-as int arg1) (the-as int (gap-location arg0 (-> arg0 first-gap))))\n"
" (set!\n"
" (-> arg0 first-gap)\n"
" (find-gap arg0 (the-as dead-pool-heap-rec s5-0))\n"
" )\n"
" )\n"
" (set! (-> arg1 mask) (logior (-> arg1 mask) (process-mask heap-shrunk)))\n"
" )\n"
" (if (= (-> arg0 first-shrink) s5-0)\n"
" (set! (-> arg0 first-shrink) (the-as dead-pool-heap-rec (-> s5-0 2)))\n"
" )\n"
" )\n"
" )\n"
" arg0\n"
" )";
@@ -2578,46 +2579,49 @@ TEST_F(FormRegressionTest, ExprMethod16DeadPoolHeap) {
std::string expected =
"(begin\n"
" (let*\n"
" ((s4-0 (memory-free arg0))\n"
" (v1-2 (memory-total arg0))\n"
" (f0-2 (/ (the float s4-0) (the float v1-2)))\n"
" )\n"
" (let* ((s4-0 (memory-free arg0))\n"
" (v1-2 (memory-total arg0))\n"
" (f0-2 (/ (the float s4-0) (the float v1-2)))\n"
" )\n"
" (cond\n"
" ((< f0-2 (l.f L346))\n"
" (set! arg1 1000)\n"
" (if\n"
" (and *debug-segment* (-> *kernel-context* low-memory-message))\n"
" (if (and *debug-segment* (-> *kernel-context* low-memory-message))\n"
" (format *stdcon* \"~3LLow Actor Memory~%~0L\" a2-0)\n"
" )\n"
" )\n"
" ((< f0-2 (l.f L347)) (set! arg1 (shl arg1 2)))\n"
" ((< f0-2 (l.f L348)) (set! arg1 (shl arg1 1)))\n"
" ((< f0-2 (l.f L347))\n"
" (set! arg1 (shl arg1 2))\n"
" )\n"
" ((< f0-2 (l.f L348))\n"
" (set! arg1 (shl arg1 1))\n"
" )\n"
" )\n"
" )\n"
" (set! (-> arg0 compact-count-targ) (the-as uint arg1))\n"
" (set! (-> arg0 compact-count) (the-as uint 0))\n"
" (while\n"
" (nonzero? arg1)\n"
" (while (nonzero? arg1)\n"
" (+! arg1 -1)\n"
" (let\n"
" ((v1-13 (-> arg0 first-shrink)))\n"
" (when\n"
" (not v1-13)\n"
" (let ((v1-13 (-> arg0 first-shrink)))\n"
" (when (not v1-13)\n"
" (set! v1-13 (-> arg0 alive-list next))\n"
" (set! (-> arg0 first-shrink) v1-13)\n"
" )\n"
" (if v1-13 (shrink-heap arg0 (-> v1-13 process)))\n"
" (if v1-13\n"
" (shrink-heap arg0 (-> v1-13 process))\n"
" )\n"
" )\n"
" (let\n"
" ((s4-1 (-> arg0 first-gap)))\n"
" (if\n"
" (-> s4-1 next)\n"
" (let\n"
" ((s3-0 (-> s4-1 next process)) (s2-0 (gap-size arg0 s4-1)))\n"
" (when\n"
" (nonzero? s2-0)\n"
" (when (< s2-0 0) (break!) (let ((v1-20 0))))\n"
" (let ((s4-1 (-> arg0 first-gap)))\n"
" (when (-> s4-1 next)\n"
" (let ((s3-0 (-> s4-1 next process))\n"
" (s2-0 (gap-size arg0 s4-1))\n"
" )\n"
" (when (nonzero? s2-0)\n"
" (when (< s2-0 0)\n"
" (break!)\n"
" (let ((v1-20 0))\n"
" )\n"
" )\n"
" (shrink-heap arg0 s3-0)\n"
" (relocate s3-0 (- s2-0))\n"
" (set! (-> arg0 first-gap) (find-gap arg0 s4-1))\n"
@@ -2627,7 +2631,8 @@ TEST_F(FormRegressionTest, ExprMethod16DeadPoolHeap) {
" )\n"
" )\n"
" )\n"
" (let ((v0-8 0)))\n"
" (let ((v0-8 0))\n"
" )\n"
" (none)\n"
" )";
test_with_expr(func, type, expected, false, "", {{"L296", "~3LLow Actor Memory~%~0L"}});
@@ -2778,13 +2783,10 @@ TEST_F(FormRegressionTest, ExprMethod18DeadPoolHeap) {
std::string type = "(function dead-pool-heap int none)";
std::string expected =
"(begin\n"
" (while\n"
" (nonzero? arg1)\n"
" (while (nonzero? arg1)\n"
" (+! arg1 -1)\n"
" (let\n"
" ((s4-0 (-> arg0 alive-list next)))\n"
" (when\n"
" s4-0\n"
" (let ((s4-0 (-> arg0 alive-list next)))\n"
" (when s4-0\n"
" (if\n"
" (or\n"
" (= (-> arg0 first-gap) s4-0)\n"
@@ -2795,27 +2797,24 @@ TEST_F(FormRegressionTest, ExprMethod18DeadPoolHeap) {
" )\n"
" (set! (-> arg0 first-gap) (-> s4-0 prev))\n"
" )\n"
" (when\n"
" (= (-> arg0 first-shrink) s4-0)\n"
" (when (= (-> arg0 first-shrink) s4-0)\n"
" (set! (-> arg0 first-shrink) (-> s4-0 prev))\n"
" (when\n"
" (not (-> arg0 first-shrink process))\n"
" (if (not (-> arg0 first-shrink process))\n"
" (set! (-> arg0 first-shrink) #f)\n"
" )\n"
" )\n"
" (set! (-> s4-0 prev next) (-> s4-0 next))\n"
" (if\n"
" (-> s4-0 next)\n"
" (if (-> s4-0 next)\n"
" (set! (-> s4-0 next prev) (-> s4-0 prev))\n"
" (set! (-> arg0 alive-list prev) (-> s4-0 prev))\n"
" )\n"
" (let\n"
" ((a1-3 (-> arg0 alive-list prev)))\n"
" (let\n"
" ((v1-19 (-> a1-3 next)))\n"
" (let ((a1-3 (-> arg0 alive-list prev)))\n"
" (let ((v1-19 (-> a1-3 next)))\n"
" (set! (-> a1-3 next) s4-0)\n"
" (set! (-> s4-0 next) v1-19)\n"
" (if v1-19 (set! (-> v1-19 prev) s4-0))\n"
" (if v1-19\n"
" (set! (-> v1-19 prev) s4-0)\n"
" )\n"
" )\n"
" (set! (-> s4-0 prev) a1-3)\n"
" (set! (-> arg0 alive-list prev) s4-0)\n"
@@ -2830,7 +2829,8 @@ TEST_F(FormRegressionTest, ExprMethod18DeadPoolHeap) {
" )\n"
" )\n"
" )\n"
" (let ((v0-4 0)))\n"
" (let ((v0-4 0))\n"
" )\n"
" (none)\n"
" )";
test_with_expr(func, type, expected);
+2 -2
View File
@@ -470,8 +470,8 @@ TEST_F(OfflineDecompilation, Reference) {
if (g_dump_mode) {
if (reference != src) {
fmt::print("----------------- {}\n", file.first);
fmt::print("{}\n", src);
file_util::create_dir_if_needed("./failures");
file_util::write_text_file("./failures/" + file.first + "_REF.gc", src);
EXPECT_TRUE(false);
}
} else {