## make-sourcecode-for-machcode-xxx-package.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-gen-instr.sml
#
# Generate the <architecture>Instr api and generic.
# This package contains the definition of the instruction set.
#
# This currently generates
#
# src/lib/compiler/back/low/intel32/code/machcode-intel32.codemade.api# src/lib/compiler/back/low/intel32/code/machcode-intel32-g.codemade.pkg#
# src/lib/compiler/back/low/pwrpc32/code/machcode-pwrpc32.codemade.api# src/lib/compiler/back/low/pwrpc32/code/machcode-pwrpc32-g.codemade.pkg#
# src/lib/compiler/back/low/sparc32/code/machcode-sparc32.codemade.api# src/lib/compiler/back/low/sparc32/code/machcode-sparc32-g.codemade.pkg#
# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "We can only see a short distance ahead, but
### we can see plenty there that needs to be done."
###
### -- Alan Turing
stipulate
package ard = architecture_description; # architecture_description is from src/lib/compiler/back/low/tools/arch/architecture-description.pkgherein
api Make_Sourcecode_For_Machcode_Xxx_Package {
#
make_sourcecode_for_machcode_xxx_package
:
ard::Architecture_Description -> Void;
};
end;
stipulate
package ard = architecture_description; # architecture_description is from src/lib/compiler/back/low/tools/arch/architecture-description.pkg package smj = sourcecode_making_junk; # sourcecode_making_junk is from src/lib/compiler/back/low/tools/arch/sourcecode-making-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.pkg package spp = simple_prettyprinter; # simple_prettyprinter is from src/lib/prettyprint/simple/simple-prettyprinter.pkg #
++ = spp::CONS; infix my ++ ;
alpha = spp::ALPHABETIC;
iblock = spp::INDENTED_BLOCK;
indent = spp::INDENT;
nl = spp::NEWLINE;
punct = spp::PUNCTUATION;
herein
# We are run-time invoked in:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages-g.pkg # We are compile-time invoked in:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.pkg package make_sourcecode_for_machcode_xxx_package
: Make_Sourcecode_For_Machcode_Xxx_Package # Make_Sourcecode_For_Machcode_Xxx_Package is from src/lib/compiler/back/low/tools/arch/make-sourcecode-for-machcode-xxx-package.pkg {
to_lower = string::map char::to_lower;
machine_op_sumtype
=
raw::VERBATIM_CODE
[
"Machine_Op",
" = LIVE { regs: rgk::Codetemplists, spilled: rgk::Codetemplists }",
" | DEAD { regs: rgk::Codetemplists, spilled: rgk::Codetemplists }",
" #",
" | COPY { kind:\t\trkj::Registerkind,",
" size_in_bits:\tInt,",
" dst:\t\tList( rkj::Codetemp_Info ),",
" src:\t\tList( rkj::Codetemp_Info ),",
" tmp:\t\tNull_Or( Effective_Address )\t\t\t# NULL if |dst| == |src| == 1",
" }",
" #",
" | NOTE { op:\t\tMachine_Op,",
" note:\t\tnt::Note",
" }",
" #",
" | BASE_OP Base_Op",
" ;",
""
];
fun make_sourcecode_for_machcode_xxx_package architecture_description
=
{
smj::write_sourcecode_file
{
architecture_description,
created_by_package => "src/lib/compiler/back/low/tools/arch/make-sourcecode-for-machcode-xxx-package.pkg",
#
subdir => "code", # Relative to file containing architecture description.
make_filename => \\ architecture_name = sprintf "machcode-%s.codemade.api" architecture_name, # architecture_name can be "pwrpc32" | "sparc32" | "intel32".
code => [ api_code ]
};
smj::write_sourcecode_file
{
architecture_description,
created_by_package => "src/lib/compiler/back/low/tools/arch/make-sourcecode-for-machcode-xxx-package.pkg",
#
subdir => "code", # Relative to file containing architecture description.
make_filename => \\ architecture_name = sprintf "machcode-%s-g.codemade.pkg" architecture_name, # architecture_name can be "pwrpc32" | "sparc32" | "intel32".
code => [ pkg_code ]
};
}
where
arch = ard::architecture_name_of architecture_description;
archl = string::to_lower arch;
archm = string::to_mixed arch;
archu = string::to_upper arch;
# Name of the package/api:
#
# pkg_name = smj::make_package_name architecture_description "Instr";
api_name = smj::make_api_name architecture_description "Machcode";
# The sumtype that defines the instruction set:
#
base_ops = ard::base_ops_of architecture_description;
base_ops_sumtype = raw::SUMTYPE_DECL ([ rsj::sumtypefun ("Base_Op", [], base_ops)], []);
args_for_generic = ["tcf: Treecode_Form"]; # Arguments to the instruction generic.
# The shorthand functions:
#
machine_op_type = raw::IDTY (raw::IDENT([], "Machine_Op"));
short_hand_api
=
map \\ raw::CONSTRUCTOR { name, type => NULL, ... } => raw::VALUE_API_DECL ([to_lower name], machine_op_type);
raw::CONSTRUCTOR { name, type => THE type, ... } => raw::VALUE_API_DECL ([to_lower name], raw::FUNTY (type, machine_op_type));
end
base_ops;
short_hand_funs
=
raw::SEQ_DECL
(map \\ raw::CONSTRUCTOR { name, type=>NULL, ... }
=>
raw::VAL_DECL
[ raw::NAMED_VARIABLE
( raw::IDPAT (to_lower name),
raw::APPLY_EXPRESSION
( raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT([], "BASE_OP"), NULL), # NULL because this constructor carries no value.
raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT([], name), NULL)
)
)
];
raw::CONSTRUCTOR { name, type=>THE _, ... }
=>
raw::VAL_DECL
[ raw::NAMED_VARIABLE
( raw::IDPAT (to_lower name),
raw::APPLY_EXPRESSION
( rsj::id "o",
raw::TUPLE_IN_EXPRESSION
[ raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT([], "BASE_OP"), NULL), # NULL because this constructor carries no value.
raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT([], name), NULL)
]
)
)
];
end
base_ops
);
# The api:
#
api_body
=
[ raw::VERBATIM_CODE
[ "#",
(sprintf "package rgk: Registerkinds_%s;\t\t\t\t\t# Registerkinds_%s\tis from src/lib/compiler/back/low/%s/code/registerkinds-%s.pkg" archm archm archl archl),
"package tcf: Treecode_Form;\t\t\t\t\t\t# Treecode_Form\t\t\tis from src/lib/compiler/back/low/treecode/treecode-form.api",
"package lac: Late_Constant;\t\t\t\t\t\t# Late_Constant\t\t\tis from src/lib/compiler/back/low/code/late-constant.api",
"package rgn: Ramregion;\t\t\t\t\t\t# Ramregion\t\t\tis from src/lib/compiler/back/low/code/ramregion.api",
"",
"sharing lac == tcf::lac;\t\t\t\t\t\t# \"lac\" == \"late_constant\".",
"sharing rgn == tcf::rgn;\t\t\t\t\t\t# \"rgn\" == \"region\".",
""
],
ard::decl_of architecture_description "Instruction", # Types from "Instruction" structure in the .adl file.
# For intel32 this is types Operand, Addressing_Mode, ... Fsize, Isize:
base_ops_sumtype, # Base_Op type from the 'base_op' declaration in the .adl file.
machine_op_sumtype # 'Machine_Op' sumtype, handcoded as VERBATIM_CODE above.
]
@
short_hand_api;
# The generic:
#
pkg_body
=
[ raw::VERBATIM_CODE
[
(sprintf "\t\t\t\t\t\t\t\t\t# Machcode_%s\t\tis from src/lib/compiler/back/low/%s/code/machcode-%s.api" archm archl archl),
"# Export to client packages:",
"#",
"package tcf = tcf;",
"package rgn = tcf::rgn;\t\t\t\t\t\t# \"rgn\" == \"region\".",
"package lac = tcf::lac;\t\t\t\t\t\t# \"lac\" == \"late_constant\".",
(sprintf "package rgk = registerkinds_%s;\t\t\t\t\t# registerkinds_%s\t\tis from src/lib/compiler/back/low/%s/code/registerkinds-%s.pkg" archl archl archl archl),
"",
""
],
ard::decl_of architecture_description "Instruction", # Types from "Instruction" structure in the .adl file.
# For intel32 this is types Operand, Addressing_Mode, ... Fsize, Isize:
base_ops_sumtype, # Base_Op type from the 'base_op" declaration in the .adl file.
machine_op_sumtype, # 'Machine_Op' sumtype, handcoded as VERBATIM_CODE above.
short_hand_funs
];
api_code
=
spp::CAT [
alpha (sprintf "# This api specifies an abstract view of the %s instruction set." archu), nl,
alpha "#", nl,
alpha "# The idea is that the Base_Op sumtype defines", nl,
alpha (sprintf "# one constructor for each %s machine instruction." archu), nl,
alpha "#", nl,
alpha "# Machcode allows us to do tasks like instruction selection and peephole optimization", nl,
alpha "# (not currently implemented) without yet worrying about the details of the actual", nl,
alpha "# target-architecture binary encoding of instructions.", nl,
alpha "#", nl,
alpha "# This file is a concrete instantiation of the general Machcode_Form api defined in:", nl,
alpha "#", nl,
alpha "# src/lib/compiler/back/low/code/machcode-form.api", nl,
alpha "#", nl,
alpha (sprintf "# At runtime our %s machcode representation of the program being compiled is produced by" archu), nl,
alpha "# ", nl,
alpha (sprintf "# src/lib/compiler/back/low/%s/treecode/translate-treecode-to-machcode-%s-g.pkg" archl archl), nl,
alpha "#", nl,
alpha "# Later, absolute executable binary machine code is produced by", nl,
alpha "#", nl,
alpha if (archl == "intel32")
"# src/lib/compiler/back/low/intel32/translate-machcode-to-execode-intel32-g.pkg";
else
sprintf "# src/lib/compiler/back/low/%s/emit/translate-machcode-to-execode-%s-g.codemade.pkg" archl archl;
fi, nl,
alpha "#", nl,
alpha "# For display purposes, human-readable target-architecture assembly code is be produced", nl,
alpha "# from the machcode representation by", nl,
alpha "#", nl,
alpha (sprintf "# src/lib/compiler/back/low/%s/emit/translate-machcode-to-asmcode-%s-g.codemade.pkg" archl archl), nl,
alpha "#", nl,
alpha "# This modules is mechanically generated from our architecture-description file by", nl,
alpha "#", nl,
alpha "# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-translate-machcode-to-asmcode-xxx-g-package.pkg", nl,
alpha "#", nl,
alpha "# This api is implemented in:", nl,
alpha "#", nl,
alpha (sprintf "# src/lib/compiler/back/low/%s/code/machcode-%s-g.codemade.pkg" archl archl), nl,
alpha "", nl,
alpha "stipulate", nl,
iblock(indent++alpha "package lbl = codelabel;\t\t\t\t\t\t\t# codelabel\t\t\tis from src/lib/compiler/back/low/code/codelabel.pkg"), nl,
iblock(indent++alpha "package nt = note;\t\t\t\t\t\t\t# note\t\t\t\tis from src/lib/src/note.pkg"), nl,
iblock(indent++alpha "package rkj = registerkinds_junk;\t\t\t\t\t\t# registerkinds_junk\t\tis from src/lib/compiler/back/low/code/registerkinds-junk.pkg"), nl,
alpha "herein", nl, nl,
iblock (indent ++ smj::make_api architecture_description "Machcode" (map rst::strip_marks api_body)),
alpha "end;", nl, nl
];
pkg_code
=
spp::CAT [
punct "# We are invoked from:", nl,
punct "#", nl,
punct (sprintf "# src/lib/compiler/back/low/main/%s/backend-lowhalf-%s%s.pkg" archl archl (archl == "intel32" ?? "-g" :: "")), nl,
nl,
alpha "stipulate", nl,
iblock(indent++alpha "package lbl = codelabel;\t\t\t\t\t\t\t# codelabel\t\t\tis from src/lib/compiler/back/low/code/codelabel.pkg"), nl,
iblock(indent++alpha "package nt = note;\t\t\t\t\t\t\t# note\t\t\t\tis from src/lib/src/note.pkg"), nl,
iblock(indent++alpha "package rkj = registerkinds_junk;\t\t\t\t\t\t# registerkinds_junk\t\tis from src/lib/compiler/back/low/code/registerkinds-junk.pkg"), nl,
alpha "herein", nl,
alpha "\t\t\t\t\t\t\t\t\t\t# Treecode_Form\t\t\tis from src/lib/compiler/back/low/treecode/treecode-form.api", nl, nl,
iblock (indent ++ smj::make_generic
architecture_description
(\\ architecture_name = sprintf "machcode_%s_g" architecture_name)
args_for_generic
smj::WEAK_SEAL
api_name
(map rst::strip_marks pkg_body)
),
alpha "end;", nl, nl
];
ard::require architecture_description "Instruction"
{
types => ["Effective_Address", "Operand", "Addressing_Mode"],
values => []
};
end;
}; # generic package adl_gen_instr_g
end; # stipulate