## adl-gen-ssaprops.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-gen-ssaprops.sml
#
# Generate the <architecture>SSAProps generic.
# This package extracts semantics and dependence
# information about the instruction set needed for SSA optimizations.
# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "Common sense is genius in homespun."
###
### -- Alfred North Whitehead
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 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 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 (only) 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_ssa_props (
# =================
#
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 tcf = rtl::tcf; # "tcf" == "treecode_form".
# package lct = arc::lct; # "lct" == "lowhalf_types".
#
nonfix my in ;
#
include package rsj;
include package err;
herein
# Insert copies
fun copy_funs has_impl
=
{ my (impl_init, impl_pattern, impl_copy)
=
if has_impl ("impl=REF NULL, ", "impl, ", "impl=impl, ");
else ("", "", "");
fi;
raw::VERBATIM_CODE [ "fun copies fps =",
"stipulate fun f ([], id, is, fd, fs) = (id, is, fd, fs)",
" | f( { dst, src } . fps, id, is, fd, fs) =",
" if rkj::codetemps_are_same_color (dst, src) then f (fps, id, is, fd, fs)",
" else case rkj::registerkind_of dst of",
" rkj::GP => f (fps, dst . id, src . is, fd, fs)",
" | rkj::FP => f (fps, id, is, dst . fd, src . fs)",
" | rkj::MEM => f (fps, id, is, fd, fs)",
" | rkj::CTRL => f (fps, id, is, fd, fs)",
" | kind => error(\"copies: \"$rkj::name_of_registerkind kind$",
" \" dst=\"$rkj::register_to_string dst$",
" \" src=\"$rkj::register_to_string src)",
" my (id, is, fd, fs) = f (fps,[],[],[],[])",
" icopy = case id of",
" [] => []",
" | [_] => [i::COPY { src=is, dst=id, " + impl_init + "tmp=NULL } ]",
" | _ => [i::COPY { src=is, dst=id, " + impl_init,
" tmp=THE (i::DIRECT (rkj::make_reg())) } ]",
" fcopy = case fd of",
" [] => []",
" | [_] => [i::FCOPY { src=fs, dst=fd, " + impl_init + "tmp=NULL } ]",
" | _ => [i::FCOPY { src=fs, dst=fd, " + impl_init,
" tmp=THE (i::FDIRECT (rkj::new_freg())) } ]",
"herein icopy @ fcopy end"
];
};
# Expressions building utilities
#
fun consexp (x, raw::LIST_IN_EXPRESSION (a, b)) => raw::LIST_IN_EXPRESSION (x ! a, b);
consexp (x, y) => raw::LIST_IN_EXPRESSION([x], THE y);
end;
nilexp = raw::LIST_IN_EXPRESSION ([], NULL);
fun conspat (x, raw::LISTPAT (a, b)) => raw::LISTPAT (x ! a, b);
conspat (x, y) => raw::LISTPAT ([x], THE y);
end;
nilpat = raw::LISTPAT ([], NULL);
fun gen compiled_rtls
=
smj::write_sourcecode_file
{
architecture_description,
created_by_package => "src/lib/compiler/back/low/tools/arch/adl-gen-ssaprops.pkg",
#
subdir => "static-single-assignment", # Relative to file containing architecture description.
make_filename => \\ architecture_name = sprintf "SSAProps-%s.pkg" architecture_name, # architecture_name can be "pwrpc32" | "sparc32" | "intel32".
code => [ smj::make_generic
architecture_description
(\\ architecture_name = sprintf "ssa_props_%s_g" architecture_name)
args
smj::STRONG_SEAL
sig_name
str_body
] # (map rst::simplify_declaration str_body)
}
where
architecture_description = arc::architecture_description_of compiled_rtls;
# Name of the package/api:
#
str_name = smj::make_package_name architecture_description "SSAProps";
sig_name = "LOWHALF_SSA_PROPERTIES";
make_query = arc::make_query compiled_rtls; # Query function.
fun in x = "in_" + x;
fun out x = "out_" + x;
# Function for extracting naming constraints from an RTL:
#
naming_constraints
=
make_query
{ name => "namingConstraints",
named_arguments => TRUE,
args => [ ["instruction", "src", "dst" ] ],
case_args => ["dst_list", "src_list"],
decls => decls,
body => body
}
where
fun body { instruction, rtl, const }
=
{ expression => raw::LIST_IN_EXPRESSION (c, NULL),
case_pats => [d, u]
}
where
fun ignore p
=
conspat (raw::WILDCARD_PATTERN, p);
fun cell (k, r)
=
const
(
raw::APPLY_EXPRESSION
( raw::APPLY_EXPRESSION
( raw::ID_IN_EXPRESSION (raw::IDENT (["C"], "Reg")),
raw::ID_IN_EXPRESSION (raw::IDENT (["C"], rkj::name_of_registerkind k))
),
integer_constant_in_expression (multiword_int::to_int r)
)
);
fun add_src (id, r, (d, u, c))
=
( d,
conspat (raw::IDPAT (in id), u),
rsj::app ("USE", raw::RECORD_IN_EXPRESSION [("var", rsj::id (in id)), ("color", r)]) ! c
);
fun add_dst (id, r, (d, u, c))
=
( conspat (raw::IDPAT (out id), d),
u,
rsj::app ("DEF", raw::RECORD_IN_EXPRESSION [("var", rsj::id (out id)), ("color", r)]) ! c
);
fun add_dst_src (id, (d, u, c))
=
( conspat (raw::IDPAT (out id), d),
conspat (raw::IDPAT (in id), u),
rsj::app ("SAME", raw::RECORD_IN_EXPRESSION [("x", rsj::id (out id)), ("y", rsj::id (in id))]) ! c
);
fun ignore_use (d, u, c)
=
(d, conspat (raw::WILDCARD_PATTERN, u), c);
fun ignore_def (d, u, c)
=
(conspat (raw::WILDCARD_PATTERN, d), u, c);
fun f (id, type, tcf::ATATAT(_, k, tcf::LITERAL r), rtl::IN _, x) => add_src (id, cell (k, r), x);
f (id, type, tcf::ATATAT(_, k, tcf::LITERAL r), rtl::OUT _, x) => add_dst (id, cell (k, r), x);
#
f (id, type, _, rtl::IO _, x) => add_dst_src (id, x);
f (id, type, _, rtl::IN _, x) => ignore_use x;
f (id, type, _, rtl::OUT _, x) => ignore_def x;
end;
fun g (id, type, x)
=
x;
my (d, u, c)
=
arc::forall_args
{ instruction, rtl, rtl_arg =>f, non_rtl_arg =>g }
(nilpat, nilpat, []);
end;
decls = [ arc::complex_error_handler "namingConstraints",
raw::VERBATIM_CODE [ "dst_list = dst and src_list = src" ]
];
end; # naming_constraints
# Function for rewriting the operands of a
# register transfer level expression ("rtl"):
#
substitute_operands
=
make_query
{ name => "substituteOperands",
named_arguments => TRUE,
args => [["const"],["instruction", "dst", "src"]],
case_args => ["dst_list", "src_list"],
decls => decls,
body => body
}
where
fun body { instruction, rtl, const }
=
{ expression, case_pats => [d, u] }
where
fun ignore p
=
conspat (raw::WILDCARD_PATTERN, p);
fun add (rtl::IN _, x, d, u) => (d, conspat (raw::IDPAT (in x), u));
add (rtl::OUT _, x, d, u) => (conspat (raw::IDPAT (out x), d), u);
add (rtl::IO _, x, d, u) => (conspat (raw::IDPAT (out x), d), ignore u);
end;
fun nochange (d, u)
=
( ignore d,
ignore u
);
fun f (id, type, tcf::ATATAT(_, k, tcf::LITERAL r), pos, (d, u)) => nochange (d, u);
f (id, type, expression, pos, (d, u)) => add (pos, id, d, u);
end;
fun g (id, type, (d, u))
=
( ignore d,
ignore u
);
fun arg (tcf::ATATAT (_, k, _), name)
=>
if (rkj::name_of_registerkind k == "REGISTERSET") NULL;
else THE (rsj::id name);
fi;
arg (tcf::ARG _, name)
=>
THE (rsj::app ("get_operand", rsj::id name));
arg _ => raise exception DIE "Bug: Unsupported case in gen/body/arg";
end;
fun f' (id, type, tcf::ATATAT(_, k, tcf::LITERAL r), pos ) => NULL;
f' (id, type, expression, rtl::IN _ ) => arg (expression, in id);
f' (id, type, expression, rtl::OUT _) => arg (expression, out id);
f' (id, type, expression, rtl::IO _ ) => arg (expression, out id);
end;
fun g' _ = NULL;
my (d, u)
=
arc::forall_args
{ instruction, rtl, rtl_arg=>f, non_rtl_arg=>g }
(nilpat, nilpat);
expression
=
arc::map_instr { instruction, rtl, rtl_arg=>f', non_rtl_arg=>g' };
end;
decls = [ arc::complex_error_handler "substituteOperands",
raw::VERBATIM_CODE [ "fun get_operand x = error \"get_operand\"",
"dst_list = dst and src_list = src"
]
];
end;
# Arguments to the instruction generic:
#
args =
[ "package instruction: " + smj::make_api_name architecture_description "INSTR",
"package region_props: REGION_PROPERTIES ",
"package gc_rtl_props: RTL_PROPERTIES where I = Instr",
"package machcode_universals: Machcode_Universals where I = Instr",
"package asm_emitter: Machcode_Codebuffer where I = Instr",
"package operand_table: OPERAND_TABLE where I = Instr",
" sharing RegionProps::Region = Instr::Region",
"my volatile: Instr::C.cell List",
"my pinnedDef: Instr::C.cell List",
"my pinnedUse: Instr::C.cell List",
"my globalDef: Instr::C.cell List",
"my globalUse: Instr::C.cell List"
];
# The generic:
#
str_body
=
[ raw::VERBATIM_CODE [ "package i = Instr",
"package c = i::C",
"package gc_rtl_props = RTLProps",
"package machcode_universals = machcode_universals",
"package rtl = RTLProps::RTL",
"package t = RTL::T",
"package ot = OperandTable",
"package rp = RegionProps",
"",
"enum const = enum ot::const",
"enum constraint =",
" DEF of { var: rkj::cell, color: rkj::cell }",
"| USE of { var: rkj::cell, color: rkj::cell }",
"| SAME of { x: rkj::cell, y: rkj::cell }",
""
],
smj::error_handler architecture_description (\\ architecture_name = "SSAProps"),
arc::complex_error_handler_def (),
raw::VERBATIM_CODE [ "",
"volatile = volatile",
"globalDef = globalDef",
"globalUse = globalUse",
"pinnedDef = pinnedDef",
"pinnedUse = pinnedUse",
"source = i::SOURCE {}",
"sink = i::SINK {}",
"phi = i::PHI {}",
""
],
naming_constraints,
substitute_operands,
copy_funs (ard::has_copy_impl architecture_description),
ard::decl_of architecture_description "SSA"
];
end;
end; # stipulate
}; # generic package adl_gen_ssa_props
end; # stipulate