## treecode-hashing-equality-and-display-g.pkg
#
# Common operations on Treecode
# -- Allen Leung
#
# "basic hashing, equality and pretty printing functions,"
# -- http://www.cs.nyu.edu/leunga/MLRISC/Doc/html/mltree-util.html
# Compiled by:
# src/lib/compiler/back/low/lib/treecode.lib### "I have a feeling that if over the next ten years
### we train a third of our undergraduates at M.I.T.
### in programming, this will generate enough worthwhile
### languages for us to be able to stop, and that succeeding
### undergraduates will face the console with such a natural
### keyboard and such a natural language that there will be
### very little left, if anything, to the teaching of programming."
###
### -- Peter Elias
stipulate
package lbl = codelabel; # codelabel is from src/lib/compiler/back/low/code/codelabel.pkg package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkg package rkj = registerkinds_junk; # registerkinds_junk is from src/lib/compiler/back/low/code/registerkinds-junk.pkg package tcp = treecode_pith; # treecode_pith is from src/lib/compiler/back/low/treecode/treecode-pith.pkg package w = unt; # unt is from src/lib/std/unt.pkgherein
# This generic is invoked (only) from:
#
# src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg # src/lib/compiler/back/low/tools/arch/adl-rtl.pkg #
generic package treecode_hashing_equality_and_display_g (
# =======================================
#
package tcf: Treecode_Form; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api # Hashing extensions
#
hash_sext: tcf::Hash_Fns -> tcf::Sext -> Unt;
hash_rext: tcf::Hash_Fns -> tcf::Rext -> Unt;
hash_fext: tcf::Hash_Fns -> tcf::Fext -> Unt;
hash_ccext: tcf::Hash_Fns -> tcf::Ccext -> Unt;
# Equality extensions
#
eq_sext: tcf::Eq_Fns -> (tcf::Sext, tcf::Sext ) -> Bool;
eq_rext: tcf::Eq_Fns -> (tcf::Rext, tcf::Rext ) -> Bool;
eq_fext: tcf::Eq_Fns -> (tcf::Fext, tcf::Fext ) -> Bool;
eq_ccext: tcf::Eq_Fns -> (tcf::Ccext, tcf::Ccext) -> Bool;
# Pretty printing extensions:
#
show_sext: tcf::Prettyprint_Fns -> tcf::Sext -> String;
show_rext: tcf::Prettyprint_Fns -> (tcf::Int_Bitsize, tcf::Rext ) -> String;
show_fext: tcf::Prettyprint_Fns -> (tcf::Float_Bitsize, tcf::Fext ) -> String;
show_ccext: tcf::Prettyprint_Fns -> (tcf::Int_Bitsize, tcf::Ccext) -> String;
)
: (weak) Treecode_Hashing_Equality_And_Display # Treecode_Hashing_Equality_And_Display is from src/lib/compiler/back/low/treecode/treecode-hashing-equality-and-display.api {
# Export to client packages:
#
package tcf = tcf;
stipulate
package mi = tcf::mi; # "mi" == "machine_int".
package lac = tcf::lac; # "lac" == "late_constant".
package rgn = tcf::rgn; # "rgn" == "region"
herein
w = w::from_int;
i2s = int::to_string;
to_lower = string::map char::to_lower;
fun error msg
=
lem::error("treecode_junk", msg);
fun wv (rkj::CODETEMP_INFO { id, ... } )
=
w id;
fun wvs is
=
f (is, 0u0)
where
fun f ([], h) => h;
f (i ! is, h) => f (is, wv i+h);
end;
end;
# Hashing
hash_label = lbl::codelabel_to_hashcode;
fun hasher ()
=
{ void_expression => hash_void_expression,
int_expression => hash_int_expression,
float_expression => hash_float_expression,
flag_expression => hash_flag_expression # flag expressions handle zero/parity/overflow/... flag stuff.
}
also
fun hash_ctrl ctrl
=
wv ctrl
also
fun hash_void_expression void_expression
=
case void_expression
#
tcf::LOAD_INT_REGISTER (t, dst, int_expression) => 0u123 + w t + wv dst + hash_int_expression int_expression;
tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, flag_expression) => 0u1234 + wv dst + hash_flag_expression flag_expression;
tcf::LOAD_FLOAT_REGISTER (fty, dst, float_expression) => 0u12345 + w fty + wv dst + hash_float_expression float_expression;
tcf::MOVE_INT_REGISTERS (type, dst, src) => 0u234 + w type + wvs dst + wvs src;
tcf::MOVE_FLOAT_REGISTERS (fty, dst, src) => 0u456 + w fty + wvs dst + wvs src;
tcf::GOTO (ea, labels) => 0u45 + hash_int_expression ea;
tcf::FLOW_TO (void_expression, _) => hash_void_expression void_expression;
tcf::RET _ => 0u567;
tcf::STORE_INT (type, ea, data, mem) => 0u888 + w type + hash_int_expression ea + hash_int_expression data;
tcf::STORE_FLOAT (fty, ea, data, mem) => 0u7890 + w fty + hash_int_expression ea + hash_float_expression data;
tcf::IF_GOTO (a, lab) => 0u233 + hash_flag_expression a + hash_label lab;
tcf::IF (a, b, c) => 0u233 + hash_flag_expression a + hash_void_expression b + hash_void_expression c;
tcf::NOTE (void_expression, a) => hash_void_expression void_expression;
tcf::PHI { preds, block } => w block;
tcf::SOURCE => 0u123;
tcf::SINK => 0u423;
tcf::REGION (void_expression, ctrl) => hash_void_expression void_expression + hash_ctrl ctrl;
tcf::RTL { hash, ... } => hash;
tcf::SEQ ss => hash_void_expressions (ss, 0u23);
tcf::ASSIGN (type, lhs, rhs) => w type + hash_int_expression lhs + hash_int_expression rhs;
tcf::CALL { funct, targets, defs, uses, region, pops }
=>
hash_int_expression funct + hash_lowhalfs defs + hash_lowhalfs uses;
_ => error "hashStm";
esac
also
fun hash_void_expressions ([], h) => h;
hash_void_expressions (s ! ss, h) => hash_void_expressions (ss, hash_void_expression s + h);
end
also
fun hash_lowhalf (tcf::FLAG_EXPRESSION flag_expression) => hash_flag_expression flag_expression;
hash_lowhalf (tcf::INT_EXPRESSION int_expression) => hash_int_expression int_expression;
hash_lowhalf (tcf::FLOAT_EXPRESSION float_expression) => hash_float_expression float_expression;
end
also
fun hash_lowhalfs [] => 0u123;
hash_lowhalfs (m ! ms) => hash_lowhalf m + hash_lowhalfs ms;
end
also
fun hash2 (type, x, y)
=
w type + hash_int_expression x + hash_int_expression y
also
fun hashm tcf::d::ROUND_TO_ZERO => 0u158; # Special rounding mode just for divide instructions.
hashm tcf::d::ROUND_TO_NEGINF => 0u159; # XXX SUCKO FIXME ? Why do we duplicate this fn from src/lib/compiler/back/low/treecode/treecode-hash-g.pkg end # How much of the rest of this crap is just duplication?
also
fun hash3 (m, type, x, y)
=
hashm m + w type + hash_int_expression x + hash_int_expression y
also
fun hash_int_expression int_expression
=
case int_expression
#
tcf::CODETEMP_INFO (type, src) => w type + wv src;
tcf::LITERAL i => mi::hash i;
tcf::LABEL l => hash_label l;
tcf::LABEL_EXPRESSION le => hash_int_expression int_expression;
tcf::LATE_CONSTANT lateconst => lac::late_constant_to_hashcode lateconst;
tcf::NEG (type, x) => w type + hash_int_expression x + 0u24;
#
tcf::ADD x => hash2 x + 0u234;
tcf::SUB x => hash2 x + 0u456;
tcf::MULS x => hash2 x + 0u2131;
tcf::DIVS x => hash3 x + 0u156;
tcf::REMS x => hash3 x + 0u231;
tcf::MULU x => hash2 x + 0u123;
tcf::DIVU x => hash2 x + 0u1234;
tcf::REMU x => hash2 x + 0u211;
#
tcf::NEG_OR_TRAP (type, x) => w type + hash_int_expression x + 0u1224;
tcf::ADD_OR_TRAP x => hash2 x + 0u1219;
tcf::SUB_OR_TRAP x => hash2 x + 0u999;
tcf::MULS_OR_TRAP x => hash2 x + 0u7887;
tcf::DIVS_OR_TRAP x => hash3 x + 0u88884;
#
tcf::BITWISE_AND x => hash2 x + 0u12312;
tcf::BITWISE_OR x => hash2 x + 0u558;
tcf::BITWISE_XOR x => hash2 x + 0u234;
tcf::BITWISE_EQV x => hash2 x + 0u734;
#
tcf::BITWISE_NOT (type, x) => w type + hash_int_expression x;
#
tcf::RIGHT_SHIFT x => hash2 x + 0u874;
tcf::RIGHT_SHIFT_U x => hash2 x + 0u223;
tcf::LEFT_SHIFT x => hash2 x + 0u499;
#
tcf::CONDITIONAL_LOAD (type, e, e1, e2) => w type + hash_flag_expression e + hash_int_expression e1 + hash_int_expression e2;
tcf::SIGN_EXTEND (type, type', int_expression) => 0u232 + w type + w type' + hash_int_expression int_expression;
tcf::ZERO_EXTEND (type, type', int_expression) => 0u737 + w type + w type' + hash_int_expression int_expression;
#
tcf::FLOAT_TO_INT (type, round, type', float_expression) =>
w type + tcp::hash_rounding_mode round + w type' + hash_float_expression float_expression;
#
tcf::LOAD (type, ea, mem) => w type + hash_int_expression ea + 0u342;
tcf::LET (void_expression, int_expression) => hash_void_expression void_expression + hash_int_expression int_expression;
tcf::PRED (e, ctrl) => hash_int_expression e + hash_ctrl ctrl;
tcf::RNOTE (e, _) => hash_int_expression e;
tcf::REXT (type, rext) => w type + hash_rext (hasher()) rext;
tcf::QQQ => 0u485;
tcf::OP (type, op, es) => hash_rexps (es, w type + hash_operator op);
tcf::ARG _ => 0u23;
tcf::ATATAT(type, k, e) => w type + hash_int_expression e;
tcf::PARAM n => w n;
tcf::BITSLICE (type, sl, e) => w type + hash_int_expression e;
esac
also
fun hash_operator (tcf::OPERATOR { hash, ... } )
=
hash
also
fun hash_rexps ([], h)
=>
h;
hash_rexps (e ! es, h)
=>
hash_rexps (es, hash_int_expression e + h);
end
also
fun hash2'(type, x, y)
=
w type + hash_float_expression x + hash_float_expression y
also
fun hash_float_expression float_expression
=
case float_expression
#
tcf::CODETEMP_INFO_FLOAT (fty, src) => w fty + wv src;
tcf::FLOAD (fty, ea, mem) => w fty + hash_int_expression ea;
tcf::FADD x => hash2' x + 0u123;
tcf::FMUL x => hash2' x + 0u1234;
tcf::FSUB x => hash2' x + 0u12345;
tcf::FDIV x => hash2' x + 0u234;
tcf::COPY_FLOAT_SIGN x => hash2' x + 0u883;
tcf::FCONDITIONAL_LOAD (fty, c, x, y) => w fty + hash_flag_expression c + hash_float_expression x + hash_float_expression y;
tcf::FABS (fty, float_expression) => w fty + hash_float_expression float_expression + 0u2345;
tcf::FNEG (fty, float_expression) => w fty + hash_float_expression float_expression + 0u23456;
tcf::FSQRT (fty, float_expression) => w fty + hash_float_expression float_expression + 0u345;
tcf::INT_TO_FLOAT (fty, type, int_expression) => w fty + w type + hash_int_expression int_expression;
tcf::FLOAT_TO_FLOAT (fty, fty', float_expression) => w fty + hash_float_expression float_expression + w fty';
tcf::FNOTE (e, _) => hash_float_expression e;
tcf::FPRED (e, ctrl) => hash_float_expression e + hash_ctrl ctrl;
tcf::FEXT (fty, fext) => w fty + hash_fext (hasher()) fext;
esac
also
fun hash_fexps ([], h) => h;
hash_fexps (e ! es, h) => hash_fexps (es, hash_float_expression e + h);
end
also
fun hash_flag_expression flag_expression
=
case flag_expression
#
tcf::CC (cc, src) => tcp::hash_cond cc + wv src;
tcf::FCC (fcc, src) => tcp::hash_fcond fcc + wv src;
tcf::CMP (type, cond, x, y) =>
w type + tcp::hash_cond cond + hash_int_expression x + hash_int_expression y;
tcf::FCMP (fty, fcond, x, y) =>
w fty + tcp::hash_fcond fcond + hash_float_expression x + hash_float_expression y;
tcf::NOT x => 0u2321 + hash_flag_expression x;
tcf::AND (x, y) => 0u2321 + hash_flag_expression x + hash_flag_expression y;
tcf::OR (x, y) => 0u8721 + hash_flag_expression x + hash_flag_expression y;
tcf::XOR (x, y) => 0u6178 + hash_flag_expression x + hash_flag_expression y;
tcf::EQV (x, y) => 0u178 + hash_flag_expression x + hash_flag_expression y;
tcf::TRUE => 0u0;
tcf::FALSE => 0u1232;
tcf::CCNOTE (e, _) => hash_flag_expression e;
tcf::CCEXT (type, ccext) => w type + hash_ccext (hasher()) ccext;
esac
also
fun hash_flag_expressions ([], h)
=>
h;
hash_flag_expressions (e ! es, h)
=>
hash_flag_expressions (es, hash_flag_expression e + h);
end;
# Equality
eq_label = lbl::same_codelabel;
fun eq_labels ([],[]) => TRUE;
eq_labels (a ! b, c ! d) => eq_label (a, c) and eq_labels (b, d);
eq_labels _ => FALSE;
end
also
fun eq_cell ( rkj::CODETEMP_INFO { id=>x, ... },
rkj::CODETEMP_INFO { id=>y, ... }
)
=
x == y
also
fun eq_cells ([], []) => TRUE;
eq_cells (x ! xs, y ! ys) => eq_cell (x, y) and eq_cells (xs, ys);
eq_cells _ => FALSE;
end
also
fun eq_copy ((t1, dst1, src1), (t2, dst2, src2))
=
t1==t2 and eq_cells (dst1, dst2) and eq_cells (src1, src2)
also
fun eq_ctrl (c1, c2)
=
eq_cell (c1, c2)
also
fun eq_ctrls (c1, c2)
=
eq_cells (c1, c2)
# void_expressions
also
fun equality ()
=
{ void_expression=>same_void_expression, int_expression=>same_int_expression, float_expression=>same_float_expression, flag_expression=>same_flag_expression }
also
fun same_void_expression (tcf::LOAD_INT_REGISTER (a, b, c), tcf::LOAD_INT_REGISTER (d, e, f))
=>
a==d and eq_cell (b, e) and same_int_expression (c, f);
same_void_expression (tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (a, b), tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (c, d))
=>
eq_cell (a, c) and same_flag_expression (b, d);
same_void_expression (tcf::LOAD_FLOAT_REGISTER (a, b, c), tcf::LOAD_FLOAT_REGISTER (d, e, f))
=>
a==d and eq_cell (b, e) and same_float_expression (c, f);
same_void_expression (tcf::MOVE_INT_REGISTERS x, tcf::MOVE_INT_REGISTERS y) => eq_copy (x, y);
same_void_expression (tcf::MOVE_FLOAT_REGISTERS x, tcf::MOVE_FLOAT_REGISTERS y) => eq_copy (x, y);
same_void_expression (tcf::GOTO (a, b), tcf::GOTO (a', b')) => same_int_expression (a, a');
same_void_expression (tcf::CALL { funct=>a, defs=>b, uses=>c, ... }, tcf::CALL { funct=>d, defs=>e, uses=>f, ... } )
=>
same_int_expression (a, d) and same_expressionlists (b, e) and same_expressionlists (c, f);
same_void_expression (tcf::FLOW_TO (x, a), tcf::FLOW_TO (y, b))
=>
same_void_expression (x, y) and eq_labels (a, b);
same_void_expression (tcf::RET _, tcf::RET _) => TRUE;
same_void_expression (tcf::STORE_INT (a, b, c, _), tcf::STORE_INT (d, e, f, _))
=>
a==d and same_int_expression (b, e) and same_int_expression (c, f);
same_void_expression (tcf::STORE_FLOAT (a, b, c, _), tcf::STORE_FLOAT (d, e, f, _))
=>
a==d and same_int_expression (b, e) and same_float_expression (c, f);
same_void_expression (tcf::NOTE (s1, _), s2) => same_void_expression (s1, s2);
same_void_expression (s1, tcf::NOTE (s2, _)) => same_void_expression (s1, s2);
same_void_expression (tcf::PHI x, tcf::PHI y) => x == y;
same_void_expression (tcf::SOURCE, tcf::SOURCE) => TRUE;
same_void_expression (tcf::SINK, tcf::SINK) => TRUE;
same_void_expression (tcf::IF_GOTO (b, c), tcf::IF_GOTO (b', c'))
=>
same_flag_expression (b, b') and eq_label (c, c');
same_void_expression (tcf::IF (b, c, d), tcf::IF (b', c', d'))
=>
same_flag_expression (b, b') and same_void_expression (c, c') and same_void_expression (d, d');
same_void_expression (tcf::RTL { attributes=>x, ... }, tcf::RTL { attributes=>y, ... } ) => x == y;
same_void_expression (tcf::REGION (a, b), tcf::REGION (a', b')) => eq_ctrl (b, b') and same_void_expression (a, a');
same_void_expression (tcf::EXT a, tcf::EXT a') => eq_sext (equality()) (a, a');
same_void_expression _ => FALSE;
end
also
fun same_void_expressions ([],[]) => TRUE;
same_void_expressions (a ! b, c ! d) => same_void_expression (a, c) and same_void_expressions (b, d);
same_void_expressions _ => FALSE;
end
also
fun eq_lowhalf (tcf::FLAG_EXPRESSION a, tcf::FLAG_EXPRESSION b) => same_flag_expression (a, b);
eq_lowhalf (tcf::INT_EXPRESSION a, tcf::INT_EXPRESSION b) => same_int_expression (a, b);
eq_lowhalf (tcf::FLOAT_EXPRESSION a, tcf::FLOAT_EXPRESSION b) => same_float_expression (a, b);
eq_lowhalf _ => FALSE;
end
also
fun same_expressionlists ([],[]) => TRUE;
same_expressionlists (a ! b, c ! d) => eq_lowhalf (a, c) and same_expressionlists (b, d);
same_expressionlists _ => FALSE;
end
also
fun eq2 ((a, b, c), (d, e, f))
=
a == d and same_int_expression (b, e) and same_int_expression (c, f)
also
fun eq3 ((m, a, b, c), (n, d, e, f))
=
m==n and a==d and same_int_expression (b, e) and same_int_expression (c, f)
also
fun same_int_expression (tcf::CODETEMP_INFO (a, b), tcf::CODETEMP_INFO (c, d)) => a == c and eq_cell (b, d);
same_int_expression (tcf::LITERAL a, tcf::LITERAL b) => a == b;
same_int_expression (tcf::LABEL a, tcf::LABEL b) => eq_label (a, b);
same_int_expression (tcf::LABEL_EXPRESSION a, tcf::LABEL_EXPRESSION b) => same_int_expression (a, b);
same_int_expression (tcf::LATE_CONSTANT a, tcf::LATE_CONSTANT b) => lac::same_late_constant (a, b);
same_int_expression (tcf::NEG (t, x), tcf::NEG (t', x')) => t == t' and same_int_expression (x, x');
same_int_expression (tcf::ADD x, tcf::ADD y) => eq2 (x, y);
same_int_expression (tcf::SUB x, tcf::SUB y) => eq2 (x, y);
same_int_expression (tcf::MULS x, tcf::MULS y) => eq2 (x, y);
same_int_expression (tcf::DIVS x, tcf::DIVS y) => eq3 (x, y);
same_int_expression (tcf::REMS x, tcf::REMS y) => eq3 (x, y);
same_int_expression (tcf::MULU x, tcf::MULU y) => eq2 (x, y);
same_int_expression (tcf::DIVU x, tcf::DIVU y) => eq2 (x, y);
same_int_expression (tcf::REMU x, tcf::REMU y) => eq2 (x, y);
same_int_expression (tcf::NEG_OR_TRAP (t, x), tcf::NEG_OR_TRAP (t', x')) => t == t' and same_int_expression (x, x');
same_int_expression (tcf::ADD_OR_TRAP x, tcf::ADD_OR_TRAP y) => eq2 (x, y);
same_int_expression (tcf::SUB_OR_TRAP x, tcf::SUB_OR_TRAP y) => eq2 (x, y);
same_int_expression (tcf::MULS_OR_TRAP x, tcf::MULS_OR_TRAP y) => eq2 (x, y);
same_int_expression (tcf::DIVS_OR_TRAP x, tcf::DIVS_OR_TRAP y) => eq3 (x, y);
same_int_expression (tcf::BITWISE_AND x, tcf::BITWISE_AND y) => eq2 (x, y);
same_int_expression (tcf::BITWISE_OR x, tcf::BITWISE_OR y) => eq2 (x, y);
same_int_expression (tcf::BITWISE_XOR x, tcf::BITWISE_XOR y) => eq2 (x, y);
same_int_expression (tcf::BITWISE_EQV x, tcf::BITWISE_EQV y) => eq2 (x, y);
same_int_expression (tcf::BITWISE_NOT (a, b), tcf::BITWISE_NOT (c, d)) => a == c and same_int_expression (b, d);
same_int_expression (tcf::RIGHT_SHIFT x, tcf::RIGHT_SHIFT y) => eq2 (x, y);
same_int_expression (tcf::RIGHT_SHIFT_U x, tcf::RIGHT_SHIFT_U y) => eq2 (x, y);
same_int_expression (tcf::LEFT_SHIFT x, tcf::LEFT_SHIFT y) => eq2 (x, y);
#
same_int_expression ( tcf::CONDITIONAL_LOAD (a, b, c, d),
tcf::CONDITIONAL_LOAD (e, f, g, h)
)
=>
a==e
and same_flag_expression (b, f)
and same_int_expression (c, g)
and same_int_expression (d, h);
same_int_expression (tcf::SIGN_EXTEND (a, b, c), tcf::SIGN_EXTEND (a', b', c')) =>
a==a' and b==b' and same_int_expression (c, c');
same_int_expression (tcf::ZERO_EXTEND (a, b, c), tcf::ZERO_EXTEND (a', b', c')) =>
a==a' and b==b' and same_int_expression (c, c');
same_int_expression (tcf::FLOAT_TO_INT (a, b, c, d), tcf::FLOAT_TO_INT (e, f, g, h)) =>
a==e and b==f and c==g and same_float_expression (d, h);
same_int_expression (tcf::LOAD (a, b, _), tcf::LOAD (c, d, _)) => a == c and same_int_expression (b, d);
same_int_expression (tcf::LET (a, b), tcf::LET (c, d)) => same_void_expression (a, c) and same_int_expression (b, d);
same_int_expression (tcf::ARG x, tcf::ARG y) => x == y;
same_int_expression (tcf::PARAM x, tcf::PARAM y) => x == y;
same_int_expression (tcf::QQQ, tcf::QQQ) => TRUE;
same_int_expression (tcf::ATATAT(t1, k1, e1), tcf::ATATAT(t2, k2, e2)) =>
t1==t2 and k1==k2 and same_int_expression (e1, e2);
same_int_expression (tcf::BITSLICE (t1, s1, e1), tcf::BITSLICE (t2, s2, e2)) =>
t1==t2 and s1==s2 and same_int_expression (e1, e2);
same_int_expression (tcf::RNOTE (a, _), b) => same_int_expression (a, b);
same_int_expression (a, tcf::RNOTE (b, _)) => same_int_expression (a, b);
same_int_expression (tcf::PRED (a, b), tcf::PRED (a', b')) => eq_ctrl (b, b') and same_int_expression (a, a');
same_int_expression (tcf::REXT (a, b), tcf::REXT (a', b')) =>
a==a' and eq_rext (equality()) (b, b');
same_int_expression _ => FALSE;
end
also
fun eq_rexps ([],[]) => TRUE;
eq_rexps (a ! b, c ! d) => same_int_expression (a, c) and eq_rexps (b, d);
eq_rexps _ => FALSE;
end
also
fun eq2'((a, b, c), (d, e, f))
=
a==d and same_float_expression (b, e) and same_float_expression (c, f)
also
fun eq1'((a, b), (d, e))
=
a==d and same_float_expression (b, e)
also
fun same_float_expression (tcf::CODETEMP_INFO_FLOAT (t1, x), tcf::CODETEMP_INFO_FLOAT (t2, y)) => t1==t2 and eq_cell (x, y);
same_float_expression (tcf::FLOAD (a, b, _), tcf::FLOAD (c, d, _)) => a==c and same_int_expression (b, d);
same_float_expression (tcf::FADD x, tcf::FADD y) => eq2'(x, y);
same_float_expression (tcf::FMUL x, tcf::FMUL y) => eq2'(x, y);
same_float_expression (tcf::FSUB x, tcf::FSUB y) => eq2'(x, y);
same_float_expression (tcf::FDIV x, tcf::FDIV y) => eq2'(x, y);
same_float_expression (tcf::COPY_FLOAT_SIGN x, tcf::COPY_FLOAT_SIGN y) => eq2'(x, y);
same_float_expression (tcf::FCONDITIONAL_LOAD (t, x, y, z), tcf::FCONDITIONAL_LOAD (t', x', y', z')) =>
t==t' and same_flag_expression (x, x') and same_float_expression (y, y') and same_float_expression (z, z');
same_float_expression (tcf::FABS x, tcf::FABS y) => eq1'(x, y);
same_float_expression (tcf::FNEG x, tcf::FNEG y) => eq1'(x, y);
same_float_expression (tcf::FSQRT x, tcf::FSQRT y) => eq1'(x, y);
same_float_expression (tcf::INT_TO_FLOAT (a, b, c), tcf::INT_TO_FLOAT (a', b', c')) =>
a==a' and b==b' and same_int_expression (c, c');
same_float_expression (tcf::FLOAT_TO_FLOAT (a, b, c), tcf::FLOAT_TO_FLOAT (a', b', c')) =>
a==a' and b==b' and same_float_expression (c, c');
same_float_expression (tcf::FEXT (a, f), tcf::FEXT (b, g)) => a==b and eq_fext (equality()) (f, g);
same_float_expression (tcf::FNOTE (a, _), b) => same_float_expression (a, b);
same_float_expression (a, tcf::FNOTE (b, _)) => same_float_expression (a, b);
same_float_expression (tcf::FPRED (a, b), tcf::FPRED (a', b')) => eq_ctrl (b, b') and same_float_expression (a, a');
same_float_expression _ => FALSE;
end
also
fun eq_fexps ([],[]) => TRUE;
eq_fexps (a ! b, c ! d) => same_float_expression (a, c) and eq_fexps (b, d);
eq_fexps _ => FALSE;
end
also
fun same_flag_expression (tcf::CC (c1, x), tcf::CC (c2, y)) => c1 == c2 and eq_cell (x, y);
same_flag_expression (tcf::FCC (c1, x), tcf::FCC (c2, y)) => c1 == c2 and eq_cell (x, y);
same_flag_expression (tcf::CMP (x, a, b, c), tcf::CMP (y, d, e, f)) =>
a==d and same_int_expression (b, e) and same_int_expression (c, f) and x == y;
same_flag_expression (tcf::FCMP (x, a, b, c), tcf::FCMP (y, d, e, f)) =>
a==d and same_float_expression (b, e) and same_float_expression (c, f) and x == y;
same_flag_expression (tcf::NOT x, tcf::NOT y) => same_flag_expression (x, y);
same_flag_expression (tcf::AND x, tcf::AND y) => same_flag_expression2 (x, y);
same_flag_expression (tcf::OR x, tcf::OR y) => same_flag_expression2 (x, y);
same_flag_expression (tcf::XOR x, tcf::XOR y) => same_flag_expression2 (x, y);
same_flag_expression (tcf::EQV x, tcf::EQV y) => same_flag_expression2 (x, y);
same_flag_expression (tcf::CCNOTE (a, _), b) => same_flag_expression (a, b);
same_flag_expression (a, tcf::CCNOTE (b, _)) => same_flag_expression (a, b);
same_flag_expression (tcf::CCEXT (t, a), tcf::CCEXT (t', b)) =>
t==t' and eq_ccext (equality()) (a, b);
same_flag_expression (tcf::TRUE, tcf::TRUE) => TRUE;
same_flag_expression (tcf::FALSE, tcf::FALSE) => TRUE;
same_flag_expression _ => FALSE;
end
also
fun same_flag_expression2 ((x, y), (x', y'))
=
same_flag_expression (x, x') and same_flag_expression (y, y')
also
fun same_flag_expressions ([],[]) => TRUE;
same_flag_expressions (a ! b, c ! d) => same_flag_expression (a, c) and same_flag_expressions (b, d);
same_flag_expressions _ => FALSE;
end;
# Prettyprinting:
#
fun show { def, uses, region_def, region_use }
=
{ fun type t
=
"." + i2s t;
fun fty 32 => ".s";
fty 64 => ".d";
fty 128 => ".q";
fty t => type t;
end;
fun reg (t, v) = rkj::register_to_string v + type t;
fun freg (t, v) = rkj::register_to_string v + fty t;
fun ccreg v = rkj::register_to_string v;
fun ctrlreg v = rkj::register_to_string v;
fun src_reg (t, v) = reg (t, v);
fun src_freg (t, v) = freg (t, v);
fun src_ccreg v = ccreg v;
fun src_ctrlreg v = ctrlreg v;
fun dst_reg (t, v) = reg (t, v);
fun dst_freg (t, v) = freg (t, v);
fun dst_ccreg v = ccreg v;
fun dst_ctrlreg v = ctrlreg v;
fun src_param (i) = def i except _ = "<" + i2s i + ">";
fun dst_param (i) = uses i except _ = "<" + i2s i + ">";
fun listify f
=
g
where
fun g (t, [] ) => "";
g (t, [r] ) => f (t, r);
g (t, r ! rs) => f (t, r) + ", " + g (t, rs);
end;
end;
fun listify' f
=
(string::join ", ") o (list::map f);
src_regs = listify src_reg;
dst_regs = listify dst_reg;
src_fregs = listify src_freg;
dst_fregs = listify dst_freg;
#
src_ccregs = listify' src_ccreg;
dst_ccregs = listify' dst_ccreg;
src_ctrlregs = listify' src_ctrlreg;
dst_ctrlregs = listify' dst_ctrlreg;
fun usectrl cr = " [" + src_ctrlreg cr + "]";
fun usectrls [] => "";
usectrls cr => " [" + src_ctrlregs cr + "]";
end;
fun defctrl cr
=
"" + dst_ctrlreg cr + " <- ";
fun defctrls [] => "";
defctrls cr => "" + dst_ctrlregs cr + " <- ";
end;
fun copy (t, dst, src)
=
dst_regs (t, dst) + " := " + src_regs (t, src);
fun fcopy (t, dst, src)
=
dst_fregs (t, dst) + " := " + src_fregs (t, src);
fun shower ()
=
{ void_expression, int_expression, float_expression, flag_expression, dst_reg, src_reg }
# pretty print a void_expression
also
fun void_expression (tcf::LOAD_INT_REGISTER (t, dst, e)) => dst_reg (t, dst) + " := " + int_expression e;
void_expression (tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, e)) => dst_ccreg dst + " := " + flag_expression e;
void_expression (tcf::LOAD_FLOAT_REGISTER (fty, dst, e)) => dst_freg (fty, dst) + " := " + float_expression e;
void_expression (tcf::MOVE_INT_REGISTERS (type, dst, src)) => copy (type, dst, src);
void_expression (tcf::MOVE_FLOAT_REGISTERS (fty, dst, src)) => fcopy (fty, dst, src);
void_expression (tcf::GOTO (ea, labels)) => "jmp " + int_expression ea;
void_expression (tcf::IF_GOTO (a, lab)) =>
"bcc " + flag_expression a + " " + lbl::codelabel_to_string lab;
void_expression (tcf::CALL { funct, targets, defs, uses, region, pops } ) =>
"call " + int_expression funct;
void_expression (tcf::FLOW_TO (s, targets)) =>
void_expression s + " [" + listify' lbl::codelabel_to_string targets + "]";
void_expression (tcf::RET (flow)) => "ret";
void_expression (tcf::IF (a, b, tcf::SEQ [])) => "if " + flag_expression a + " then " + void_expression b;
void_expression (tcf::IF (a, b, c)) => "if " + flag_expression a + " then " + void_expression b + " else " + void_expression c;
void_expression (tcf::STORE_INT (type, ea, e, mem)) => store (type, "", ea, mem, e);
void_expression (tcf::STORE_FLOAT (fty, ea, e, mem)) => fstore (fty, "", ea, mem, e);
void_expression (tcf::REGION (s, cr)) => void_expression s + usectrl cr;
void_expression (tcf::SEQ []) => "skip";
void_expression (tcf::SEQ s) => void_expressions(";\n", s);
void_expression (tcf::DEFINE lab) => lbl::codelabel_to_string lab + ":";
void_expression (tcf::NOTE (s, a)) => void_expression s;
void_expression (tcf::EXT x) => show_sext (shower()) x;
void_expression (tcf::LIVE exps) => "live: " + lowhalfs exps;
void_expression (tcf::DEAD exps) => "dead: " + lowhalfs exps;
void_expression (tcf::PHI { preds, block } ) => "phi[" + i2s block + "]";
void_expression (tcf::ASSIGN (type, lhs, tcf::QQQ)) => "define " + int_expression lhs;
void_expression (tcf::ASSIGN (type, tcf::QQQ, rhs)) => "use " + int_expression rhs;
void_expression (tcf::ASSIGN (type, x, rhs)) => lhs x + " := " + int_expression rhs;
void_expression (tcf::SOURCE) => "source";
void_expression (tcf::SINK) => "sink";
void_expression (tcf::RTL { e, ... } ) => void_expression e;
end
also
fun void_expressions (sep,[]) => "";
void_expressions (sep,[s]) => void_expression s;
void_expressions (sep, s ! ss) => void_expression s + sep + void_expressions (sep, ss);
end
also
fun lhs (tcf::PARAM i) => dst_param i;
lhs (tcf::ATATAT(type, k, tcf::PARAM i)) => dst_param i;
lhs (e) => int_expression e;
end
# prettyprint an expression
also
fun int_expression (tcf::CODETEMP_INFO (type, src)) => src_reg (type, src);
int_expression (tcf::LITERAL i) => multiword_int::to_string i;
int_expression (tcf::LABEL l) => lbl::codelabel_to_string l;
int_expression (tcf::LATE_CONSTANT lateconst) => lac::late_constant_to_string lateconst;
int_expression (tcf::LABEL_EXPRESSION le) => int_expression le;
int_expression (tcf::NEG x) => unary("-_", x);
int_expression (tcf::ADD x) => binary("+", x);
int_expression (tcf::SUB x) => binary("-", x);
int_expression (tcf::MULS x) => two("muls", x);
int_expression (tcf::DIVS x) => three("divs", x);
int_expression (tcf::REMS x) => three("rems", x);
int_expression (tcf::MULU x) => two("mulu", x);
int_expression (tcf::DIVU x) => two("divu", x);
int_expression (tcf::REMU x) => two("remu", x);
int_expression (tcf::NEG_OR_TRAP x) => one("negt", x);
int_expression (tcf::ADD_OR_TRAP x) => two("addt", x);
int_expression (tcf::SUB_OR_TRAP x) => two("subt", x);
int_expression (tcf::MULS_OR_TRAP x) => two("mult", x);
int_expression (tcf::DIVS_OR_TRAP x) => three("divt", x);
int_expression (tcf::BITWISE_AND x) => binary("&", x);
int_expression (tcf::BITWISE_OR x) => binary("|", x);
int_expression (tcf::BITWISE_XOR x) => binary("^", x);
int_expression (tcf::BITWISE_EQV x) => binary("eqvb", x);
int_expression (tcf::BITWISE_NOT x) => unary("!", x);
int_expression (tcf::RIGHT_SHIFT x) => binary(">>>", x);
int_expression (tcf::RIGHT_SHIFT_U x) => binary(">>", x);
int_expression (tcf::LEFT_SHIFT x) => binary("<<", x);
#
int_expression (tcf::CONDITIONAL_LOAD (t, cc, e1, e2)) =>
"cond" + type t + "(" + flag_expression cc + ", " + int_expression e1 + ", " + int_expression e2 + ")";
#
int_expression (tcf::SIGN_EXTEND (t, t', e)) => "sx" + type t + type t' + " " + int_expression e;
int_expression (tcf::ZERO_EXTEND (t, t', e)) => "zx" + type t + type t' + " " + int_expression e;
#
int_expression (tcf::FLOAT_TO_INT (t, round, t', e)) =>
"cvtf2i" + type t + to_lower (tcp::rounding_mode_to_string round) +
fty t' + " " + float_expression e;
#
int_expression (tcf::LOAD (type, ea, mem)) => load (type, "", ea, mem);
int_expression (tcf::LET (s, e)) => void_expression s + ";" + int_expression e;
int_expression (tcf::PRED (e, cr)) => int_expression e + usectrl cr;
int_expression (tcf::RNOTE (e, _)) => int_expression e;
int_expression (tcf::REXT e) => show_rext (shower()) e;
int_expression (tcf::QQQ) => "???";
int_expression (tcf::OP (t, opc, es)) => operator opc + type t + " " + rexps es;
int_expression (tcf::ARG (t, REF (tcf::REPX kind), name)) => name + ":" + kind + (if (t == 0) ""; else type t;fi);
int_expression (tcf::PARAM n) => src_param n;
int_expression (tcf::ATATAT(type, k, e)) => "@@@" + rkj::nickname_of_registerkind k + "[" + int_expression e + "]";
int_expression (tcf::BITSLICE (type, sl, e)) => int_expression e + " at " + slices sl;
end
also
fun operator (tcf::OPERATOR { name, ... } )
=
name
also
fun paren_int_expression
(e as (tcf::CODETEMP_INFO _ | tcf::LITERAL _ | tcf::ATATAT _ | tcf::ARG _)) =>
int_expression e;
paren_int_expression e => "(" + int_expression e + ")";
end
also
fun slices sc
=
listify'
(\\ (from, to) = i2s from + ".." + i2s to)
sc
# Prettyprint a float expression:
also
fun float_expression (tcf::CODETEMP_INFO_FLOAT f) => src_freg f;
float_expression (tcf::FLOAD (fty, ea, mem)) => fload (fty, "", ea, mem);
#
float_expression (tcf::FADD x) => two'("fadd", x);
float_expression (tcf::FMUL x) => two'("fmul", x);
float_expression (tcf::FSUB x) => two'("fsub", x);
float_expression (tcf::FDIV x) => two'("fdiv", x);
#
float_expression (tcf::COPY_FLOAT_SIGN x) => two'("fcopysign", x);
#
float_expression (tcf::FABS x) => one'("fabs", x);
float_expression (tcf::FNEG x) => one'("fneg", x);
float_expression (tcf::FSQRT x) => one'("fsqrt", x);
#
float_expression (tcf::FCONDITIONAL_LOAD (t, cc, e1, e2)) => "fcond" + fty t + flag_expression cc + "(" + float_expression e1 + ", " + float_expression e2 + ")";
float_expression (tcf::INT_TO_FLOAT (t, t', e)) => "cvti2f" + type t' + " " + int_expression e;
float_expression (tcf::FLOAT_TO_FLOAT (t, t', e)) => "cvtf2f" + fty t + fty t' + " " + float_expression e;
float_expression (tcf::FPRED (e, cr)) => float_expression e + usectrl cr;
float_expression (tcf::FNOTE (e, _)) => float_expression e;
float_expression (tcf::FEXT e) => show_fext (shower()) e;
end
also
fun flag_expression (tcf::CC (cc, r)) => src_ccreg r + to_lower (tcp::cond_to_string cc);
flag_expression (tcf::FCC (fcc, r)) => src_ccreg r + to_lower (tcp::fcond_to_string fcc);
flag_expression (tcf::CMP (t, tcf::SETCC, x, y)) => "setcc" + type t + pair (x, y);
flag_expression (tcf::CMP (t, cc, x, y)) => "cmp" + to_lower (tcp::cond_to_string cc) + type t + pair (x, y);
flag_expression (tcf::FCMP (t, tcf::SETFCC, x, y)) => "setfcc" + type t + pair'(x, y);
flag_expression (tcf::FCMP (t, fcc, x, y)) => "fcmp" + to_lower (tcp::fcond_to_string fcc) + fty t + pair'(x, y);
flag_expression (tcf::NOT x) => "not " + flag_expression x;
flag_expression (tcf::AND (x, y)) => two''(" and ", x, y);
flag_expression (tcf::OR (x, y)) => two''(" or ", x, y);
flag_expression (tcf::XOR (x, y)) => two''(" xor ", x, y);
flag_expression (tcf::EQV (x, y)) => two''(" eqv ", x, y);
flag_expression (tcf::CCNOTE (e, _)) => flag_expression e;
flag_expression (tcf::TRUE) => "TRUE";
flag_expression (tcf::FALSE) => "FALSE";
flag_expression (tcf::CCEXT (e)) => show_ccext (shower()) e;
end
also
fun lowhalf (tcf::INT_EXPRESSION e) => int_expression e;
lowhalf (tcf::FLOAT_EXPRESSION e) => float_expression e;
lowhalf (tcf::FLAG_EXPRESSION e) => flag_expression e;
end
also
fun lowhalfs l
=
listify' lowhalf l
# Auxiliary functions
also
fun one (opcode, (t, x))
=
opcode + type t + "(" + int_expression x + ")"
also
fun two (opcode, (t, x, y))
=
opcode + type t + pair (x, y)
also
fun three (opcode, (m, t, x, y))
=
opcode + dmr m + type t + pair (x, y)
also
fun dmr tcf::d::ROUND_TO_ZERO => "{ 0 }"; # Special rounding mode just for divide instructions.
dmr tcf::d::ROUND_TO_NEGINF => "{-inf }";
end
also
fun binary (opcode, (t, x, y))
=
paren_int_expression x + " " + opcode + type t + " " + paren_int_expression y
also
fun unary (opcode, (t, x))
=
opcode + type t + " " + paren_int_expression x
also
fun pair (x, y)
=
"(" + int_expression x + ", " + int_expression y + ")"
also
fun one'(opcode, (t, x))
=
opcode + fty t + "(" + float_expression x + ")"
also
fun two'(opcode, (t, x, y))
=
opcode + fty t + pair'(x, y)
also
fun two''(c, x, y)
=
"(" + flag_expression x + c + flag_expression y + ")"
also
fun pair'(x, y)
=
"(" + float_expression x + ", " + float_expression y + ")"
also
fun rexps es
=
"("
+
fold_backward
(\\ (e, "") => int_expression e;
(e, x) => int_expression e + ", " + x;
end)
""
es
+
")"
also
fun fexps es
=
"(" + fold_backward
(\\ (e, "") => float_expression e;
(e, x) => float_expression e + ", " + x;
end ) "" es + ")"
also
fun flag_expressions es
=
"(" + fold_backward (\\ (e, "") => flag_expression e;
(e, x) => flag_expression e + ", " + x;
end
) "" es + ")"
also
fun store (t, u, ea, m, e)
=
memdef (t, u, ea, m) + " := " + int_expression e
also
fun fstore (t, u, ea, m, e)
=
fmemdef (t, u, ea, m) + " := " + float_expression e
also
fun ccstore (u, ea, m, e)
=
ccmemdef (u, ea, m) + " := " + flag_expression e
also
fun load (t, u, ea, m)
=
memuse (t, u, ea, m)
also
fun fload (t, u, ea, m)
=
fmemuse (t, u, ea, m)
also
fun ccload (u, ea, m)
=
ccmemuse (u, ea, m)
also
fun address (u, ea, m, show)
=
{ r = show m
except
_ = rgn::ramregion_to_string m;
r = if (r == "") r;
else ":" + r;
fi;
u + "[" + int_expression ea + r + "]";
}
also
fun mem (t, u, ea, m, show)
=
"mem" + type t + address (u, ea, m, show)
also
fun fmem (t, u, ea, m, show)
=
"mem" + fty t + address (u, ea, m, show)
also
fun ccmem (u, ea, m, show)
=
"mem" + address (u, ea, m, show)
also
fun memdef (t, u, ea, m)
=
mem (t, u, ea, m, region_def)
also
fun fmemdef (t, u, ea, m)
=
fmem (t, u, ea, m, region_def)
also
fun ccmemdef (u, ea, m)
=
ccmem (u, ea, m, region_def)
also
fun memuse (t, u, ea, m)
=
mem (t, u, ea, m, region_use)
also
fun fmemuse (t, u, ea, m)
=
fmem (t, u, ea, m, region_use)
also
fun ccmemuse (u, ea, m)
=
ccmem (u, ea, m, region_use);
shower ();
};
exception NOTHING;
fun dummy _
=
raise exception NOTHING;
dummy
=
{ def => dummy,
uses => dummy,
region_def => dummy,
region_use => dummy
};
fun void_expression_to_string s = (show dummy).void_expression s;
fun int_expression_to_string s = (show dummy).int_expression s;
fun float_expression_to_string s = (show dummy).float_expression s;
fun flag_expression_to_string s = (show dummy).flag_expression s;
end; # stipulate
}; # generic package treecode_hashing_equality_and_display_g
end; # stipulate