## adl-gen-rewrite.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-gen-rewrite.sml
#
# Generate the <architecture>Rewrite generic.
# which performs register renaming.
#
# Currently compiled but never run.
# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "God exists since mathematics is consistent,
### and the Devil exists since we cannot prove it."
###
### -- Andre Weil
stipulate
package ard = architecture_description; # architecture_description is from src/lib/compiler/back/low/tools/arch/architecture-description.pkg package err = adl_error; # adl_error is from src/lib/compiler/back/low/tools/line-number-db/adl-error.pkg package smj = sourcecode_making_junk; # sourcecode_making_junk is from src/lib/compiler/back/low/tools/arch/sourcecode-making-junk.pkg package mst = adl_symboltable; # adl_symboltable is from src/lib/compiler/back/low/tools/arch/adl-symboltable.pkg package rkj = registerkinds_junk; # registerkinds_junk is from src/lib/compiler/back/low/code/registerkinds-junk.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 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 rst = adl_raw_syntax_translation; # adl_raw_syntax_translation is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-translation.pkgherein
# This generic is invoked in:
#
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-pwrpc32.pkg # src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-intel32.pkg # src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-sparc32.pkg # src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.pkg #
generic package adl_gen_rewrite (
# ===============
#
arc: Adl_Rtl_Comp # Adl_Rtl_Comp is from src/lib/compiler/back/low/tools/arch/adl-rtl-comp.api )
: (weak) Adl_Gen_Module2 # Adl_Gen_Module2 is from src/lib/compiler/back/low/tools/arch/adl-gen-module2.api {
# Export to client packages:
#
package arc = arc; # "arc" == "adl_rtl_compiler".
stipulate
package rtl = arc::rtl; # "rtl" == "register transfer language".
package lct = arc::lct; # "lct" == "lowhalf_types".
package tcf = rtl::tcf; # "tcf" == "treecode_form".
#
include package rsj;
include package err;
herein
# Change these definitions if the register type has changed:
#
fun how_to_rename registerkind
=
raw::VERBATIM_CODE
[
"fun rename r = if regmap r == rs then rt else r",
"fun renameregisterset registerset =",
" rkj::registerset::map C." + rkj::name_of_registerkind registerkind + " rename registerset"
];
# Main function:
#
fun gen compiled_rtls
=
smj::write_sourcecode_file
{
architecture_description,
created_by_package => "src/lib/compiler/back/low/tools/arch/adl-gen-rewrite.pkg",
#
subdir => "regor", # Relative to file containing architecture description.
make_filename => \\ architecture_name = sprintf "Rewrite2-%s.pkg" architecture_name, # architecture_name can be "pwrpc32" | "sparc32" | "intel32".
code => [ smj::make_generic
architecture_description
(\\ architecture_name = sprintf "rewrite2_%s_g" architecture_name)
args
smj::STRONG_SEAL
sig_name
str_body
]
}
where
architecture_description = arc::architecture_description_of compiled_rtls;
# Name of the package/api:
#
str_name = smj::make_package_name architecture_description "Rewrite";
sig_name = "Rewrite_Machine_Instructions";
instructions = ard::base_ops_of architecture_description; # The instructions.
symboltable # The Instruction symboltable.
=
mst::find_package
(ard::symboltable_of architecture_description)
(raw::IDENT([], "Instruction"));
args = [ "Instr: " + smj::make_api_name architecture_description "INSTR" ]; # Arguments to the instruction generic.
Def_Use = DEF | USE;
# Make a rewrite function of type:
# (Regmap, Instruction, From_Reg, To_Reg) -> Instruction)
#
fun mk_fun (fun_name, rw_opnd, registerkind, def_use)
=
arc::make_query compiled_rtls
{
name => fun_name,
named_arguments => FALSE,
args => [ [ "regmap", "instruction", "rs", "rt" ] ],
decls => decls,
case_args => [],
body => mk_rewrite_body
}
where
fun mk_rewrite_body { instruction, rtl, const }
=
{ expression, case_pats => [] }
where
fun apply (f, x)
=
THE (rsj::app (f, rsj::id x));
fun rewrite (x, type, tcf::ATATAT(_, c, _))
=>
if (c == registerkind) apply ("rename", x);
else NULL;
fi;
rewrite (x, type, tcf::ARG(_, REF (rep as tcf::REPX k), _))
=>
if (lct::is_const rep) NULL;
else apply("rename" + k, x);
fi;
rewrite (x, type, _)
=>
fail ("bad argument " + x);
end;
fun non_rtl_arg _
=
NULL;
fun rtl_arg (name, type, expression, rtl::IN _)
=>
if (def_use == USE) rewrite (name, type, expression);
else NULL;
fi;
rtl_arg (name, type, expression, rtl::OUT _)
=>
if (def_use == DEF) rewrite (name, type, expression);
else NULL;
fi;
rtl_arg (name, type, expression, rtl::IO _)
=>
rewrite (name, type, expression);
end;
expression
=
arc::map_instr { instruction, rtl, non_rtl_arg, rtl_arg };
end;
decls = [ raw::VERBATIM_CODE [ "fun rewriteoperand operand = " + rw_opnd + "(regmap, rs, rt, operand)" ],
how_to_rename registerkind,
arc::simple_error_handler fun_name
];
end;
# The generic:
#
str_body
=
[ raw::VERBATIM_CODE [ "package i = Instr",
"package c = i::C",
""
],
smj::error_handler architecture_description (\\ architecture_name = "Rewrite"),
ard::decl_of architecture_description "Rewrite",
mk_fun ("rewriteDef", "rewrite_operand_def", rkj::INT_REGISTER, DEF),
mk_fun ("rewriteUse", "rewrite_operand_use", rkj::INT_REGISTER, USE),
mk_fun ("frewriteDef", "frewrite_operand_def", rkj::FLOAT_REGISTER, DEF),
mk_fun ("frewriteUse", "frewrite_operand_use", rkj::FLOAT_REGISTER, USE)
];
ard::require architecture_description "Rewrite"
{ values => [ "rewriteOperandDef",
"rewriteOperandUse",
"frewriteOperandDef",
"frewriteOperandUse"
],
types => []
};
end;
end; # stipulate
}; # generic package adl_gen_rewrite
end; # stipulate