## make-sourcecode-for-registerkinds-xxx-package.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-gen-cells.sml
#
# Generate the _registerkinds_<architecturename> package,
# where <architecturename> is currently one of "intel32"/"pwrpc32"/"sparc32"
#
# This package contains information about the
# architecture's register sets.
#
# This currently generates
#
# src/lib/compiler/back/low/intel32/code/registerkinds-intel32.codemade.pkg# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "Mathematics is the music of reason."
###
### -- James Joseph Sylvester
stipulate
package ard = architecture_description; # architecture_description is from src/lib/compiler/back/low/tools/arch/architecture-description.pkgherein
api Make_Sourcecode_For_Registerkinds_Xxx_Package {
#
make_sourcecode_for_registerkinds_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 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 rrs = adl_rewrite_raw_syntax_parsetree; # adl_rewrite_raw_syntax_parsetree is from src/lib/compiler/back/low/tools/adl-syntax/adl-rewrite-raw-syntax-parsetree.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 rsp = adl_raw_syntax_predicates; # adl_raw_syntax_predicates is from src/lib/compiler/back/low/tools/arch/adl-raw-syntax-predicates.pkg package smj = sourcecode_making_junk; # sourcecode_making_junk is from src/lib/compiler/back/low/tools/arch/sourcecode-making-junk.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;
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_registerkinds_xxx_package
: Make_Sourcecode_For_Registerkinds_Xxx_Package
{
sz_ty = raw::IDTY (raw::IDENT(["rkj"], "Register_Size_In_Bits"));
register_id_ty = raw::IDTY (raw::IDENT(["rkj"], "Interkind_Register_Id"));
reg2string_fun_type = raw::FUNTY (register_id_ty, rsj::string_type);
sizedreg2string_fun_type = raw::FUNTY (raw::TUPLETY [register_id_ty, sz_ty], rsj::string_type);
fun make_sourcecode_for_registerkinds_xxx_package
#
(architecture_description: ard::Architecture_Description)
=
{ architecture_name = ard::architecture_name_of architecture_description; # "intel32"/"sparc32"/"pwrpc32"
archl = string::to_lower architecture_name;
archm = string::to_mixed architecture_name;
# Name of the package and api:
#
pkg_name = string::to_lower ("registerkinds_" + architecture_name); # "registerkinds_intel32" or such.
api_name = string::to_mixed pkg_name; # "Registerkinds_Intel32" or such.
# All register kinds:
#
registerkinds = ard::registersets_of architecture_description;
codetemp_id_if_above
=
process (registerkinds, 0)
where
fun process (raw::REGISTER_SET { from, to, count, ... } ! ds, r)
=>
{ count = case count THE c => c;
NULL => 0;
esac;
from := r;
to := r + count - 1;
process (ds, r+count);
};
process ([], r)
=>
r;
end;
end;
# All register kind names:
#
registerkind_names
=
map (\\ raw::REGISTER_SET r = r.name)
registerkinds;
all_registerkind_names = registerkind_names;
# Registerkinds that has to be put into the registerset
# registersets = ard::registersets_of architecture_description;
# registersets' = ard::registersets_Aliases architecture_description;
# registerset_names = map (\\ raw::REGISTER_SET { id, ... } => id) registersets;
client_defined_registerkinds
=
list::filter
(\\ raw::REGISTER_SET r = not (rsp::is_predefined_registerkind r.name))
registerkinds;
special_registers = ard::special_registers_of architecture_description;
# xxx_to_string functions -- gp_to_string, fp_to_string, cc_to_string, eflags_to_string, fflags_to_string, mem_to_string ...
#
reg2string_funs_in_api = raw::VALUE_API_DECL (map (\\ k = string::to_lower ( k + "_to_string")) registerkind_names, reg2string_fun_type);
sizedreg2string_funs_in_api = raw::VALUE_API_DECL (map (\\ k = string::to_lower ("sized_" + k + "_to_string")) registerkind_names, sizedreg2string_fun_type);
sizedreg2string_funs_in_pkg
=
{ fun shift (from, to) e
=
if (*from == 0)
#
e;
else
rsj::let_fn
( [ rsj::my_fn
( "r",
raw::IF_EXPRESSION
( rsj::app ("<=", raw::TUPLE_IN_EXPRESSION [rsj::id "r", rsj::integer_constant_in_expression *to]),
rsj::app ("-", raw::TUPLE_IN_EXPRESSION [rsj::id "r", rsj::integer_constant_in_expression *from]),
rsj::id "r"
)
)
],
e
);
fi;
raw::FUN_DECL
(
map (\\ raw::REGISTER_SET { name, from, to, print, ... }
=
raw::FUN
( string::to_lower ("sized_" + name + "_to_string"),
[ raw::CLAUSE ( [raw::TUPLEPAT [raw::IDPAT "register_number", raw::IDPAT "register_size_in_bits"] ],
NULL,
(raw::APPLY_EXPRESSION (print, raw::TUPLE_IN_EXPRESSION [rsj::id "register_number", rsj::id "register_size_in_bits"]))
)
]
)
)
registerkinds
);
};
reg2string_funs_in_pkg
=
raw::SEQ_DECL (map (\\ raw::REGISTER_SET { name, from, to, print, bits, ... }
=
rsj::fun_fn
( string::to_lower (name + "_to_string"),
raw::IDPAT "register_number",
rsj::app
( string::to_lower ("sized_" + name + "_to_string"),
raw::TUPLE_IN_EXPRESSION [ rsj::id "register_number", rsj::integer_constant_in_expression bits ]
)
)
)
registerkinds
);
# Architecture-specific registerkinds:
#
architecture_specific_registerkinds_in_api
=
raw::VALUE_API_DECL
(
map (\\ raw::REGISTER_SET r = string::to_lower r.name + "_kind") client_defined_registerkinds,
#
raw::IDTY (raw::IDENT (["rkj"], "Registerkind"))
);
# Make something like: eflags_kind = rkj::make_registerkind { name=>"EFLAGS", nickname=>"eflags" };
#
fun create_registerkind (raw::REGISTER_SET { name, nickname, ... } )
=
raw::VAL_DECL
[ raw::NAMED_VARIABLE
(
raw::IDPAT ((string::to_lower name) + "_kind"),
#
raw::APPLY_EXPRESSION
(
raw::ID_IN_EXPRESSION (raw::IDENT (["rkj"], "make_registerkind")),
#
raw::RECORD_IN_EXPRESSION [ ("name", rsj::string_constant_in_expression name),
("nickname", rsj::string_constant_in_expression nickname)
]
)
)
];
architecture_specific_registerkinds_in_pkg
=
raw::SEQ_DECL
(
raw::VERBATIM_CODE [ "" ]
!
(map create_registerkind client_defined_registerkinds)
);
null = raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT ([], "NULL"), NULL);
new_counter = raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT([], "REF"), THE (rsj::integer_constant_in_expression 0));
non_aliased_registerkinds # All register kinds declared without a 'aliasing' clause,
= # which at this point means those with NULL 'alias' fields.
list::filter
#
\\ raw::REGISTER_SET { alias=>NULL, ... } => TRUE;
raw::REGISTER_SET _ => FALSE;
end
#
registerkinds;
fun kind_name k
=
if (rsp::is_predefined_registerkind k) raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT (["rkj"], k), NULL); # One of rkj::INT_REGISTER, rkj::FLOAT_REGISTER, rkj::FLAGS_REGISTER, rkj::RAM_BYTE, rkj::CONTROL_DEPENDENCY
else rsj::id' [ ] (string::to_lower (k + "_kind")); # On intel32 one of eflags_kind, fflags_kind registerset_kind.
fi;
# Generate info record for a registerkind:
#
fun make_descriptor (raw::REGISTER_SET { from, to, name, nickname, defaults, ... } )
=
raw::VAL_DECL [ raw::NAMED_VARIABLE (raw::IDPAT ("info_for_kind_" + string::to_lower name), expression) ]
where
always_zero_register
=
list::fold_backward
#
\\ ((r, raw::LITERAL_IN_EXPRESSION (raw::INT_LIT 0)), _) => raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT ([], "THE"), THE (rsj::integer_constant_in_expression r));
(_, d) => d;
end
null
defaults;
count = int::max (*to - *from + 1, 0);
hardware_registers = raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT ([], "REF"), THE (rsj::id' ["rkj"] "zero_length_rw_vector"));
# Generate an expression which will unparse as something like:
#
# rkj::REGISTERKIND_INFO
# { min_register_id=>0, max_register_id=>31, kind=>rkj::INT_REGISTER,
# always_zero_register=>NULL, to_string=>int_register_to_string, sized_to_string=>sized_int_register_to_string,
# codetemps_made_count=>REF 0, global_codetemps_created_so_far=>REF 0, hardware_registers=>REF rkj::zero_length_rw_vector
# };
expression
=
raw::CONSTRUCTOR_IN_EXPRESSION
( raw::IDENT (["rkj"], "REGISTERKIND_INFO"),
#
THE (
raw::RECORD_IN_EXPRESSION
[
("min_register_id", rsj::integer_constant_in_expression *from),
("max_register_id", rsj::integer_constant_in_expression *to),
("kind", kind_name name),
("always_zero_register", always_zero_register),
("to_string", rsj::id (string::to_lower( name + "_to_string"))),
("sized_to_string", rsj::id (string::to_lower("sized_" + name + "_to_string"))),
("codetemps_made_count", new_counter),
("global_codetemps_created_so_far", new_counter), # This is a (quiescent) bug -- the counter should be shared by all REGISTERKIND_INFO records -- see comment in src/lib/compiler/back/low/code/registerkinds-junk.api ("hardware_registers", hardware_registers)
]
)
);
end;
# Here we're producing something that
# will unparse like one of:
#
# (rkj::FLAGS_REGISTER, info_for_kind_int_register),
# (eflags_kind, info_for_kind_eflags),
#
fun make_kind_info (raw::REGISTER_SET { alias=>NULL, name, ... } ) => raw::TUPLE_IN_EXPRESSION [ kind_name name, rsj::id (string::to_lower ("info_for_kind_" + name)) ];
make_kind_info (raw::REGISTER_SET { alias=>THE x, name, ... } ) => raw::TUPLE_IN_EXPRESSION [ kind_name name, rsj::id (string::to_lower ("info_for_kind_" + x )) ];
end;
# Create registerkinds_junk:
#
apply_registers_common
=
raw::PACKAGE_DECL
( "my_registerkinds", [], NULL,
raw::APPSEXP
( raw::IDSEXP (raw::IDENT ([], "registerkinds_g")),
raw::DECLSEXP (
[ raw::VERBATIM_CODE [ "\t\t\t\t\t\t\t# registerkinds_g\tis from src/lib/compiler/back/low/code/registerkinds-g.pkg",
"#",
"exception NO_SUCH_PHYSICAL_REGISTER = NO_SUCH_PHYSICAL_REGISTER_" + string::to_upper architecture_name + ";",
"",
"codetemp_id_if_above = 256;",
"",
"# The 'hardware_registers' values below are dummies -- the actual",
"# vectors get built and installed by the below call to",
"#",
"# registerkinds_g ()",
"#",
""
]
]
@
(map make_descriptor non_aliased_registerkinds)
@
[ raw::VERBATIM_CODE [ "",
"# The order here is not irrelevant.",
"# We do a lot of linear searches over this list",
"# -- see info_for() in src/lib/compiler/back/low/code/registerkinds-g.pkg",
"# Probably 90% of the searchs are for INT_REGISTER info,",
"# and likely 90% of the remaining searches are for FLOAT_REGISTER info,",
"# so we put those first:",
"#"
],
# Here we generate something that
# will unparse about like so:
#
# registerkind_infos
# =
# [ (rkj::INT_REGISTER, info_for_kind_int_register),
# (rkj::FLOAT_REGISTER, info_for_kind_float_register),
# (rkj::FLAGS_REGISTER, info_for_kind_int_register),
# (eflags_kind, info_for_kind_eflags),
# (fflags_kind, info_for_kind_fflags),
# (rkj::RAM_BYTE, info_for_kind_ram_byte),
# (rkj::CONTROL_DEPENDENCY, info_for_kind_control_dependency),
# (registerset_kind, info_for_kind_registerset)
# ];
#
#
rsj::my_fn
( "registerkind_infos",
raw::LIST_IN_EXPRESSION (map make_kind_info registerkinds, NULL)
)
]
)
)
);
# Architecture-specific special register names:
/*
architecture_specific_special_registers_in_api
=
map \\ raw::SPECIAL_REGISTER (id, NULL, _) => raw::VALUE_API_DECL ([id], REGISTERty);
raw::SPECIAL_REGISTER (id, THE _, _) => raw::VALUE_API_DECL ([id], raw::FUNTY (int_type, REGISTERty));
end
special_registers;
*/
# stackptr_r, asm_tmp_r, and fasm_tmp_r are in the common Registers
# interface, so we do not include them in the architecture-specific interface
# as well -- or we would have a duplicate specification error.
#
architecture_specific_special_registers_in_api
=
locs special_registers
where
fun locs (raw::SPECIAL_REGISTER("stackptr_r", _, _) ! rest) => locs rest;
locs (raw::SPECIAL_REGISTER("asm_tmp_r", _, _) ! rest) => locs rest;
locs (raw::SPECIAL_REGISTER("fasm_tmp", _, _) ! rest) => locs rest;
locs (raw::SPECIAL_REGISTER (id, NULL, _) ! rest) => raw::VALUE_API_DECL ([id], rsj::register_type) ! locs rest;
locs (raw::SPECIAL_REGISTER (id, THE _, _) ! rest) => raw::VALUE_API_DECL ([id], raw::FUNTY (rsj::int_type, rsj::register_type)) ! locs rest;
locs [] => [];
end;
end;
reg_funs_in_pkg # reg_int_register | reg_float_register | reg_flags_register | reg_ram_byte | reg_control_dependency | reg_eflags | reg_fflags |reg_registerset (latter three on intel32).
=
raw::SEQ_DECL
(map (\\ raw::REGISTER_SET { name, ... }
=
raw::VAL_DECL
[
raw::NAMED_VARIABLE
( raw::IDPAT (string::to_lower ("get_ith_" + name)),
rsj::app ( "get_ith_hardware_register_of_kind",
if (rsp::is_predefined_registerkind name)
#
raw::CONSTRUCTOR_IN_EXPRESSION (raw::IDENT([], name), NULL); # INT_REGISTER | FLOAT_REGISTER | FLAGS_REGISTER | RAM_BYTE | CONTROL_DEPENDENCY
else
rsj::id (string::to_lower (name + "_kind")); # eflags_kind | fflags_kind | registerset_kind (on intel32).
fi
)
)
]
)
registerkinds
);
special_registers_in_pkg
=
{ fun make_location e
=
{ fun rewrite_expression_node _ (raw::REGISTER_IN_EXPRESSION (id, e, _))
=>
{ (ard::find_registerset_by_name architecture_description id) -> raw::REGISTER_SET { name, ... }; # 'name' is INT_REGISTER | FLOAT_REGISTER | ... | EFLAGS | FFLAGS | REGISTERSET (on intel32)
#
rsj::app (string::to_lower ("get_ith_" + name), e);
};
rewrite_expression_node _ e => e;
end;
fns.rewrite_expression_parsetree e
where
fns = rrs::make_raw_syntax_parsetree_rewriters [ rrs::REWRITE_EXPRESSION_NODE rewrite_expression_node ];
end;
};
map \\ raw::SPECIAL_REGISTER (id, NULL, e) => rsj::my_fn (id, make_location e);
raw::SPECIAL_REGISTER (id, THE p, e) => rsj::my_fn (id, raw::FN_IN_EXPRESSION [raw::CLAUSE ([p], NULL, make_location e)]);
end
special_registers;
};
fun set k
=
rsj::id ("set" + k);
# Body of api:
#
api_body
=
[ raw::VERBATIM_CODE ["#"],
raw::VERBATIM_CODE ["include api Registerkinds;\t\t\t\t\t\t# Registerkinds\tis from src/lib/compiler/back/low/code/registerkinds.api"],
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE ["# Architecture-specific register kinds:"],
raw::VERBATIM_CODE ["#"],
architecture_specific_registerkinds_in_api,
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE ["# Functions to generate asmcode string names for registers."],
raw::VERBATIM_CODE ["# The first five are for the standard cross-platform registersets,"],
raw::VERBATIM_CODE ["# the remainder are architecture-specific:"],
raw::VERBATIM_CODE ["#"],
reg2string_funs_in_api,
raw::VERBATIM_CODE ["#"],
sizedreg2string_funs_in_api,
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE ["# Architecture-specific special registers:"],
raw::VERBATIM_CODE ["#"],
raw::SEQ_DECL architecture_specific_special_registers_in_api
];
# Body of package:
#
pkg_body
=
[ raw::VERBATIM_CODE
[ sprintf "\t\t\t\t\t\t\t\t# Registerkinds_%s\tis from src/lib/compiler/back/low/%s/code/registerkinds-%s.codemade.pkg" archm archl archl,
"#",
"exception " + string::to_upper ("NO_SUCH_PHYSICAL_REGISTER_" + architecture_name) + ";",
"",
"fun error msg = err::error(\"" + ("NO_SUCH_PHYSICAL_REGISTER_" + string::to_upper architecture_name) + "\", msg);",
"",
"include package registerkinds_junk;\t\t\t\t\t# registerkinds_junk\t\tis from src/lib/compiler/back/low/code/registerkinds-junk.pkg",
""
],
sizedreg2string_funs_in_pkg,
reg2string_funs_in_pkg,
architecture_specific_registerkinds_in_pkg,
raw::VERBATIM_CODE [""],
apply_registers_common,
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE [ "include package my_registerkinds;" ],
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE ["# NB: package cls (== registerset) is a subpackage of registerkinds_junk, which was 'included' above."],
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE [
"",
"# Here get_ith_int_register(i) (e.g.) will return essentially",
"#",
"# INT_REGISTER.REGISTERKIND_INFO.hardware_registers[i]",
"#",
"# -- see 'get_ith_hardware_register_of_kind' definition in src/lib/compiler/back/low/code/registerkinds-g.pkg",
"#"
],
reg_funs_in_pkg,
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE ["# Special registers:"],
raw::VERBATIM_CODE ["#"],
raw::SEQ_DECL special_registers_in_pkg, # On intel32 this will be "eax = get_ith_int_register 0;" etc for ecx, edx, ebx, esp, ebp, esi, edi.
raw::VERBATIM_CODE [""],
raw::VERBATIM_CODE ["# If you define a package registerkinds in your"],
raw::VERBATIM_CODE ["#"],
raw::VERBATIM_CODE [ sprintf "# %s.architecture-description" archl ],
raw::VERBATIM_CODE ["#"],
raw::VERBATIM_CODE ["# file its contents should appear at this point. This is an escape"],
raw::VERBATIM_CODE ["# to let you include any extra code required by your architecture."],
raw::VERBATIM_CODE ["# Currently this space is empty on all supported architectures."],
raw::VERBATIM_CODE ["#"],
ard::decl_of architecture_description "registerkinds" # On intel32 this produces nothing -- perhaps I've broken it. 2011-05-08 CrT
# The only things which appear to be missing are the (unused) assembly-temp declarations
#
# stackptr_r = get_ith_int_register 4;
# asm_tmp_r = get_ith_int_register 0;
# fasm_tmp = get_ith_float_register 0;
#
# In the root SML code the "registerkinds" string is "Cells", which also appears to
# reference nothing. My guess is that this is intended as an escape which lets the
# author of the (e.g.) intel32.architecture-description file dump arbitrary code into the generated
#
# registerkinds-intel32.codemade.pkg
#
# file by including a package 'registerkinds' within the intel32.architecture-description file. -- 2011-05-08 CrT
];
api_code
=
spp::CAT
[
alpha "stipulate", nl,
iblock (indent ++ alpha "package rkj = registerkinds_junk;\t\t\t\t\t# registerkinds_junk\tis from src/lib/compiler/back/low/code/registerkinds-junk.pkg"), nl,
alpha "herein", nl, nl,
iblock (indent ++ smj::make_api architecture_description "registerkinds" api_body),
alpha "end;", nl, nl
];
pkg_code
=
spp::CAT
[
alpha "stipulate", nl,
iblock (indent ++ alpha "package rkj = registerkinds_junk;\t\t\t\t\t# registerkinds_junk\tis from src/lib/compiler/back/low/code/registerkinds-junk.pkg"), nl,
iblock (indent ++ alpha "package err = lowhalf_error_message;\t\t\t\t# lowhalf_error_message\tis from src/lib/compiler/back/low/control/lowhalf-error-message.pkg"), nl,
alpha "herein", nl, nl,
iblock (indent ++ smj::make_package architecture_description "registerkinds" api_name pkg_body),
alpha "end;", nl, nl
];
# Create one of
#
# src/lib/compiler/back/low/pwrpc32/code/registerkinds-pwrpc32.codemade.pkg # src/lib/compiler/back/low/sparc32/code/registerkinds-sparc32.codemade.pkg # src/lib/compiler/back/low/intel32/code/registerkinds-intel32.codemade.pkg #
smj::write_sourcecode_file
{
architecture_description,
created_by_package => "src/lib/compiler/back/low/tools/arch/make-sourcecode-for-registerkinds-xxx-package.pkg",
#
subdir => "code", # Relative to file containing architecture description.
make_filename => \\ architecture_name = sprintf "registerkinds-%s.codemade.pkg" architecture_name, # architecture_name can be "pwrpc32"|"sparc32"|"intel32".
code => [ api_code, pkg_code ]
};
};
}; # package make_sourcecode_for_registerkinds_xxx_package
end; # stipulate