## adl-rtl-tools-g.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-rtl-tools.sml
#
# Process rtl descriptions.
# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "Seek simplicity but distrust it."
###
### -- Alfred North Whitehead
stipulate
package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkg package raw = adl_raw_syntax_form; # adl_raw_syntax_form is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-form.pkg package rkj = registerkinds_junk; # registerkinds_junk is from src/lib/compiler/back/low/code/registerkinds-junk.pkg package rsj = adl_raw_syntax_junk; # adl_raw_syntax_junk is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-junk.pkg package tcp = treecode_pith; # treecode_pith is from src/lib/compiler/back/low/treecode/treecode-pith.pkgherein
# We are invoked (only) in:
#
# src/lib/compiler/back/low/tools/arch/adl-rtl-tools.pkg #
generic package adl_rtl_tools_g (
# ===============
# # adl_treecode_rtl is from src/lib/compiler/back/low/tools/arch/adl-rtl.pkg package rtl: Treecode_Rtl; # Treecode_Rtl is from src/lib/compiler/back/low/treecode/treecode-rtl.api )
: (weak) Adl_Rtl_Tools # Adl_Rtl_Tools is from src/lib/compiler/back/low/tools/arch/adl-rtl-tools.api {
# Export to client packages:
#
package rtl = rtl;
stipulate
package tcf = rtl::tcf; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api herein
fun error msg = lem::error("MDRTLTools", msg);
##########################################################################
#
# Simplify an RTL expression
#
fun simplify rtl
=
rewriter.void_expression rtl
where
fun void_expression reduce (tcf::SEQ [s]) => s;
void_expression reduce (tcf::IF (tcf::TRUE, y, n)) => y;
void_expression reduce (tcf::IF (tcf::FALSE, y, n)) => n;
void_expression reduce s => s;
end
also
fun
# int_expression reduce (tcf::ADD(_, tcf::LITERAL 0, x)) => x;
# int_expression reduce (tcf::ADD(_, x, tcf::LITERAL 0)) => x;
# int_expression reduce (tcf::SUB(_, x, tcf::LITERAL 0)) => x;
# int_expression reduce (tcf::MULS(_, _, zero as tcf::LITERAL 0)) => zero;
# int_expression reduce (tcf::MULU(_, _, zero as tcf::LITERAL 0)) => zero;
# int_expression reduce (tcf::MULS_OR_TRAP(_, _, zero as tcf::LITERAL 0)) => zero;
# int_expression reduce (tcf::MULS(_, zero as tcf::LITERAL 0, _)) => zero;
# int_expression reduce (tcf::MULU(_, zero as tcf::LITERAL 0, _)) => zero;
# int_expression reduce (tcf::MULS_OR_TRAP(_, zero as tcf::LITERAL 0, _)) => zero;
# int_expression reduce (tcf::MULS(_, x, tcf::LITERAL 1)) => x;
# int_expression reduce (tcf::MULU(_, x, tcf::LITERAL 1)) => x;
# int_expression reduce (tcf::MULS_OR_TRAP(_, x, tcf::LITERAL 1)) => x;
# int_expression reduce (tcf::DIVS(_, x, tcf::LITERAL 1)) => x;
# int_expression reduce (tcf::DIVU(_, x, tcf::LITERAL 1)) => x;
# int_expression reduce (tcf::DIVS_OR_TRAP(_, x, tcf::LITERAL 1)) => x;
# int_expression reduce (tcf::BITWISE_AND(_, _, zero as tcf::LITERAL 0)) => zero;
# int_expression reduce (tcf::BITWISE_AND(_, zero as tcf::LITERAL 0, _)) => zero;
int_expression reduce (e as tcf::BITWISE_AND(_, x, y))
=>
if (rtl::tcj::same_int_expression (x, y)) x;
else e;
fi;
# int_expression reduce (tcf::BITWISE_OR(_, x, tcf::LITERAL 0)) = x
# int_expression reduce (tcf::BITWISE_OR(_, tcf::LITERAL 0, x)) = x
int_expression reduce (e as tcf::BITWISE_OR(_, x, y))
=>
if (rtl::tcj::same_int_expression (x, y)) x;
else e;
fi;
int_expression reduce (e as tcf::SIGN_EXTEND (t1, t2, x)) => if (t1 == t2) x; else e; fi;
int_expression reduce (e as tcf::ZERO_EXTEND (t1, t2, x)) => if (t1 == t2) x; else e; fi;
#
int_expression reduce (tcf::BITWISE_NOT(_, tcf::BITWISE_NOT(_, x))) => x;
int_expression reduce e => e;
end
also
fun float_expression reduce e
=
e
also
fun flag_expression reduce (tcf::NOT tcf::TRUE ) => tcf::FALSE;
flag_expression reduce (tcf::NOT tcf::FALSE) => tcf::TRUE;
#
flag_expression reduce (tcf::AND (tcf::FALSE, _)) => tcf::FALSE;
flag_expression reduce (tcf::AND (_, tcf::FALSE)) => tcf::FALSE;
#
flag_expression reduce (tcf::AND (tcf::TRUE, x)) => x;
flag_expression reduce (tcf::AND (x, tcf::TRUE)) => x;
#
flag_expression reduce (tcf::OR (tcf::FALSE, x)) => x;
flag_expression reduce (tcf::OR (x, tcf::FALSE)) => x;
#
flag_expression reduce (tcf::OR (tcf::TRUE, _)) => tcf::TRUE;
flag_expression reduce (tcf::OR (_, tcf::TRUE)) => tcf::TRUE;
#
flag_expression reduce (e as tcf::CMP(_, tcf::EQ, x, y)) => if (rtl::tcj::same_int_expression (x, y)) tcf::TRUE ; else e; fi;
flag_expression reduce (e as tcf::CMP(_, tcf::NE, x, y)) => if (rtl::tcj::same_int_expression (x, y)) tcf::FALSE; else e; fi;
#
flag_expression reduce e => e;
end;
rewriter = rtl::tcr::rewrite { int_expression, float_expression, flag_expression, void_expression };
end;
##########################################################################
#
# Translate an RTL into something else
#
fun trans_rtl
{ apply, id, int, integer, one_word_unt, string, list, nil, tuple, record, arg, registerkind, op, region }
rtl
=
void_expression rtl
where
fun word w # This function is apparently never referenced. XXX SUCKO FIXME
=
one_word_unt (unt::to_large_unt w);
fun tern_op n (x, type, y, z)
=
apply (n, [x, int type, int_expression y, int_expression z])
also
fun bin_op n (type, x, y)
=
apply (n, [int type, int_expression x, int_expression y])
also
fun unary_op n (type, x)
=
apply (n, [int type, int_expression x])
also
fun int_expression (tcf::LITERAL i) => apply ("LITERAL",[integer i]);
#
int_expression (tcf::NEG x) => unary_op "NEG" x;
int_expression (tcf::ADD x) => bin_op "ADD" x;
int_expression (tcf::SUB x) => bin_op "SUB" x;
int_expression (tcf::MULS x) => bin_op "MULS" x;
# int_expression (tcf::DIVS x) => tern_op "DIVS" x; # XXX SUCKO FIXME
# int_expression (tcf::REMS x) => tern_op "REMS" x; # XXX SUCKO FIXME
int_expression (tcf::MULU x) => bin_op "MULU" x;
int_expression (tcf::DIVU x) => bin_op "DIVU" x;
int_expression (tcf::REMU x) => bin_op "REMU" x;
int_expression (tcf::NEG_OR_TRAP x) => unary_op "NEGT" x;
int_expression (tcf::ADD_OR_TRAP x) => bin_op "ADDT" x;
int_expression (tcf::SUB_OR_TRAP x) => bin_op "SUBT" x;
int_expression (tcf::MULS_OR_TRAP x) => bin_op "MULT" x;
# int_expression (tcf::DIVS_OR_TRAP x) => tern_op "DIVT" x; # XXX SUCKO FIXME
int_expression (tcf::BITWISE_NOT x) => unary_op "BITWISE_NOT" x;
int_expression (tcf::BITWISE_AND x) => bin_op "BITWISE_AND" x;
int_expression (tcf::BITWISE_OR x) => bin_op "BITWISE_OR" x;
int_expression (tcf::BITWISE_XOR x) => bin_op "BITWISE_XOR" x;
int_expression (tcf::BITWISE_EQV x) => bin_op "BITWISE_EQV" x;
int_expression (tcf::LEFT_SHIFT x) => bin_op "LEFT_SHIFT" x;
int_expression (tcf::RIGHT_SHIFT_U x) => bin_op "RIGHT_SHIFT_U" x;
int_expression (tcf::RIGHT_SHIFT x) => bin_op "RIGHT_SHIFT" x;
#
int_expression (tcf::SIGN_EXTEND (t1, t2, x)) => apply ("SIGN_EXTEND", [int t1, int t2, int_expression x]);
int_expression (tcf::ZERO_EXTEND (t1, t2, x)) => apply ("ZERO_EXTEND", [int t1, int t2, int_expression x]);
int_expression (tcf::FLOAT_TO_INT (t1, r, t2, x))
=>
apply ("CONVERT_FLOAT_TO_INT", [int t1, id (tcp::rounding_mode_to_string r), int t2, float_expression x]);
int_expression (tcf::CONDITIONAL_LOAD (type, cc, a, b))
=>
apply ("CONDITIONAL_LOAD",[int type, flag_expression cc, int_expression a, int_expression b]);
int_expression (tcf::ATATAT(type, k, e)) => apply ("@@@",[int type, registerkind k, int_expression e]);
int_expression (tcf::PARAM i ) => apply ("PARAM",[int i]);
int_expression (tcf::ARG (type, a, b)) => arg (type, a, b);
int_expression (tcf::QQQ) => id "???";
int_expression (tcf::OP (type, opc, es))
=>
apply ("OP", [int type, op opc, list (map int_expression es, NULL)]);
int_expression (tcf::BITSLICE (type, sl, e))
=>
apply ("BITSLICE", [int type, slice sl, int_expression e]);
int_expression e
=>
error ("trans_rtl: " + rtl::tcj::int_expression_to_string e);
end
also
fun slice sl
=
list ( map (\\ (x, y) = tuple [int x, int y]) sl,
NULL
)
also fun fbin_op n (type, x, y) = apply (n, [int type, float_expression x, float_expression y])
also fun funary_op n (type, x ) = apply (n, [int type, float_expression x ])
also
fun float_expression (tcf::FADD x) => fbin_op "FADD" x;
float_expression (tcf::FSUB x) => fbin_op "FSUB" x;
float_expression (tcf::FMUL x) => fbin_op "FMUL" x;
float_expression (tcf::FDIV x) => fbin_op "FDIV" x;
float_expression (tcf::COPY_FLOAT_SIGN x) => fbin_op "FCOPYSIGN" x;
float_expression (tcf::FNEG x) => funary_op "FNEG" x;
float_expression (tcf::FABS x) => funary_op "FABS" x;
float_expression (tcf::FSQRT x) => funary_op "FSQRT" x;
float_expression (tcf::FCONDITIONAL_LOAD (type, cc, x, y))
=>
apply ("FCONDITIONAL_LOAD", [int type, flag_expression cc, float_expression x, float_expression y]);
float_expression (tcf::INT_TO_FLOAT (t1, t2, x)) => apply ("CONVERT_INT_TO_FLOAT", [int t1, int t2, int_expression x]);
float_expression (tcf::FLOAT_TO_FLOAT (t1, t2, x)) => apply ("CONVERT_FLOAT_TO_FLOAT", [int t1, int t2, float_expression x]);
#
float_expression e
=>
error ("trans_rtl: " + rtl::tcj::float_expression_to_string e);
end
also
fun void_expression (tcf::ASSIGN (type, x, y)) => apply ("ASSIGN",[int type, int_expression x, int_expression y]);
void_expression (tcf::GOTO (e, _)) => apply ("JMP", [int_expression e, nil]);
void_expression (tcf::RET _) => apply ("RET", [nil]);
void_expression (tcf::IF (x, y, z)) => apply ("IF", [flag_expression x, void_expression y, void_expression z]);
void_expression (tcf::SEQ ss) => apply ("SEQ", [list (map void_expression ss, NULL)]);
#
void_expression (tcf::RTL { e, ... } ) => void_expression e;
#
void_expression (tcf::CALL { funct, ... } )
=>
apply
( "CALL",
[ record [ ("defs", nil),
("uses", nil),
("funct", int_expression funct),
("targets", nil),
("region", region)
]
]
);
void_expression s
=>
error ("trans_rtl: " + rtl::tcj::void_expression_to_string s);
end
also
fun flag_expression (tcf::CMP (type, cc, x, y)) => apply ( "CMP", [int type, id (tcp::cond_to_string cc), int_expression x, int_expression y]);
flag_expression (tcf::FCMP (type, cc, x, y)) => apply ("FCMP", [int type, id (tcp::fcond_to_string cc), float_expression x, float_expression y]);
#
flag_expression (tcf::TRUE) => id "TRUE";
flag_expression (tcf::FALSE) => id "FALSE";
#
flag_expression (tcf::AND (x, y)) => apply ("AND", [flag_expression x, flag_expression y]);
flag_expression (tcf::OR (x, y)) => apply ("OR", [flag_expression x, flag_expression y]);
flag_expression (tcf::XOR (x, y)) => apply ("XOR", [flag_expression x, flag_expression y]);
flag_expression (tcf::EQV (x, y)) => apply ("EQV", [flag_expression x, flag_expression y]);
flag_expression (tcf::NOT x ) => apply ("NOT", [flag_expression x]);
#
flag_expression e => error("transRTL: " + rtl::tcj::flag_expression_to_string e);
end;
end; # fun trans_rtl
##########################################################################
#
# Translate an RTL to an expression
#
fun rtl_to_expression rtl
=
trans_rtl
{ id,
apply,
list => raw::LIST_IN_EXPRESSION,
string,
int,
integer => rsj::integerexp,
one_word_unt => rsj::unt1expression,
nil => raw::LIST_IN_EXPRESSION ([], NULL),
tuple => raw::TUPLE_IN_EXPRESSION,
record => raw::RECORD_IN_EXPRESSION,
region,
arg,
registerkind,
op
}
rtl
where
fun id name
=
raw::ID_IN_EXPRESSION (raw::IDENT(["T"], name));
fun apply (n, es)
=
raw::APPLY_EXPRESSION (id n, raw::TUPLE_IN_EXPRESSION es);
int = rsj::integer_constant_in_expression;
string = rsj::string_constant_in_expression;
fun arg (type, a, name)
=
raw::ID_IN_EXPRESSION (raw::IDENT([], name));
fun registerkind k
=
raw::ID_IN_EXPRESSION (raw::IDENT(["C"], rkj::name_of_registerkind k));
fun op (tcf::OPERATOR { name, ... } )
=
raw::ID_IN_EXPRESSION (raw::IDENT (["P"], name));
region = raw::ID_IN_EXPRESSION (raw::IDENT(["T", "Region"], "memory"));
end;
##########################################################################
# Translate an RTL to a pattern
#
fun rtl_to_pattern rtl
=
trans_rtl
{ id,
apply,
list => raw::LISTPAT,
string,
int,
integer,
one_word_unt => rsj::unt1pattern,
nil => raw::LISTPAT ([], NULL),
tuple => raw::TUPLEPAT,
record,
region,
arg,
registerkind,
op
}
rtl
where
fun mk_id name = raw::IDENT(["T"], name);
fun id name = raw::CONSPAT (mk_id name, NULL);
fun apply (n, [x]) => raw::CONSPAT (mk_id n, THE x);
apply (n, es) => raw::CONSPAT (mk_id n, THE (raw::TUPLEPAT es));
end;
fun record ps
=
raw::RECORD_PATTERN (ps, FALSE);
int = rsj::integer_constant_in_pattern;
integer = rsj::integerpat;
string = rsj::string_constant_in_pattern;
fun arg (type, a, name)
=
raw::IDPAT name;
fun registerkind k
=
raw::IDPAT (rkj::name_of_registerkind k);
fun op (tcf::OPERATOR { name, ... } )
=
raw::CONSPAT
( raw::IDENT (["T"], "OPER"),
THE
( raw::RECORD_PATTERN
( [ ("name", rsj::string_constant_in_pattern name) ],
TRUE
)
)
);
region = raw::WILDCARD_PATTERN;
end;
##########################################################################
#
# Translate an RTL to a function with arguments
#
fun rtl_to_fun (rtl_name, rtl_args, rtl)
=
{ body = rtl_to_expression rtl;
#
args = raw::RECORD_PATTERN
(
map (\\ id = (id, raw::IDPAT id)) rtl_args,
FALSE
);
#
raw::FUN_DECL
[ raw::FUN
( rtl_name,
[ raw::CLAUSE ([args], NULL, body) ]
)
];
};
##########################################################################
#
# Create a new_op
#
fun create_new_op { name, hash, attributes }
=
raw::VAL_DECL
[
raw::NAMED_VARIABLE
(
raw::IDPAT name,
raw::APPLY_EXPRESSION
(
raw::ID_IN_EXPRESSION (raw::IDENT(["T"], "OPER")),
raw::APPLY_EXPRESSION
(
raw::ID_IN_EXPRESSION (raw::IDENT (["RTL"], "newOp")),
raw::RECORD_IN_EXPRESSION
[
("name", rsj::string_constant_in_expression name ),
("attributes", rsj::unt_constant_in_expression *attributes)
]
)
)
)
];
end;
};
end;