## treecode-hash-g.pkg
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib# We get invoked from
#
# src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg# src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg# src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkgstipulate
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 unt = unt; # unt is from src/lib/std/unt.pkgherein
generic package treecode_hash_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;
)
: (weak) Treecode_Hash # Treecode_Hash is from src/lib/compiler/back/low/treecode/treecode-hash.api {
# Export to client packages:
#
package tcf = tcf;
stipulate
package mi = tcf::mi; # "mi" == "machine_int".
package lac = tcf::lac; # "lac" == "late_constant".
herein
unt = unt::from_int;
i2s = int::to_string;
to_lower = string::map char::to_lower;
fun error msg
=
lem::error("label_expression", msg);
fun wv (rkj::CODETEMP_INFO { id, ... } )
=
unt 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
}
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 + unt 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 + unt fty + wv dst + hash_float_expression float_expression;
tcf::MOVE_INT_REGISTERS (type, dst, src) => 0u234 + unt type + wvs dst + wvs src;
tcf::MOVE_FLOAT_REGISTERS (fty, dst, src) => 0u456 + unt fty + wvs dst + wvs src;
tcf::GOTO (ea, labels) => 0u45 + hash_int_expression ea;
tcf::CALL { funct, targets, defs, uses, region, pops } =>
hash_int_expression funct + hash_lowhalfs defs + hash_lowhalfs uses;
tcf::RET _ => 0u567;
tcf::STORE_INT (type, ea, data, mem) => 0u888 + unt type + hash_int_expression ea + hash_int_expression data;
tcf::STORE_FLOAT (fty, ea, data, mem) => 0u7890 + unt 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 } => unt 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) => unt type + hash_int_expression lhs + hash_int_expression rhs;
_ => 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)
=
unt type + hash_int_expression x + hash_int_expression y
also
fun hashm tcf::d::ROUND_TO_ZERO => 0u158; # Rounding-mode for divide operations.
hashm tcf::d::ROUND_TO_NEGINF => 0u159;
end
also
fun hash3 (m, type, x, y)
=
hashm m + unt type + hash_int_expression x + hash_int_expression y
also
fun hash_int_expression int_expression
=
case int_expression
#
tcf::CODETEMP_INFO (type, src) => unt 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) => unt type + hash_int_expression x + 0u24;
tcf::NEG_OR_TRAP (type, x) => unt type + hash_int_expression x + 0u1224;
tcf::BITWISE_NOT (type, x) => unt type + hash_int_expression x;
#
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::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::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) => unt type + hash_flag_expression e + hash_int_expression e1 + hash_int_expression e2;
#
tcf::SIGN_EXTEND (type, type', int_expression) => 0u232 + unt type + unt type' + hash_int_expression int_expression;
tcf::ZERO_EXTEND (type, type', int_expression) => 0u737 + unt type + unt type' + hash_int_expression int_expression;
#
tcf::FLOAT_TO_INT (type, round, type', float_expression) =>
unt type + tcp::hash_rounding_mode round + unt type' + hash_float_expression float_expression;
tcf::LOAD (type, ea, mem) => unt 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) => unt type + hash_rext (hasher()) rext;
tcf::QQQ => 0u485;
tcf::OP (type, op, es) => hash_rexps (es, unt type + hash_operator op);
tcf::ARG _ => 0u23;
tcf::ATATAT(type, k, e) => unt type + hash_int_expression e;
tcf::PARAM n => unt n;
tcf::BITSLICE (type, sl, e) => unt 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)
=
unt 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) => unt fty + wv src;
#
tcf::FLOAD (fty, ea, mem) => unt 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) => unt fty + hash_flag_expression c + hash_float_expression x + hash_float_expression y;
#
tcf::FABS (fty, float_expression) => unt fty + hash_float_expression float_expression + 0u2345;
tcf::FNEG (fty, float_expression) => unt fty + hash_float_expression float_expression + 0u23456;
tcf::FSQRT (fty, float_expression) => unt fty + hash_float_expression float_expression + 0u345;
#
tcf::INT_TO_FLOAT (fty, type, int_expression ) => unt fty + unt type + hash_int_expression int_expression;
tcf::FLOAT_TO_FLOAT (fty, fty', float_expression) => unt fty + hash_float_expression float_expression + unt fty';
#
tcf::FNOTE (e, _) => hash_float_expression e;
tcf::FPRED (e, ctrl) => hash_float_expression e + hash_ctrl ctrl;
tcf::FEXT (fty, fext) => unt 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) =>
unt type + tcp::hash_cond cond + hash_int_expression x + hash_int_expression y;
tcf::FCMP (fty, fcond, x, y) =>
unt 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) => unt 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;
hash = hash_int_expression;
end; # stipulate
}; # generic package treecode_hash_g
end; # stipulate
## COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.