mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 06:47:17 +00:00
54bb1c4a67
Estimated hours taken: 3 code_gen, pragma_c_code: Move the code that generates code for pragma_c_codes to a new module. llds: Change the representation of reg and temp lvals, in order to create the concept of a "register type" and to reduce memory requirements. Also add a comment indicating a possible future extension dealing with model_non pragma_c_codes. code_exprn, code_info: Add the ability to request registers of a given type, or a specific register, when acquiring registers. bytecode, bytecode_gen, call_gen, dupelim, exprn_aux, follow_vars, frameopt, garbage_out, jumpopt, llds_out, middle_rec, opt_debug, opt_util, store_alloc, string_switch, tag_switch, unify_gen, vn_block, vn_cost, vn_filter, vn_flush, vn_order, vn_temploc, vn_type, vn_util, vn_verify: Small changes to accommodate the new register representation. hlds_goal: Add a comment indicating a possible future extension dealing with model_non pragma_c_codes. inlining: Add a comment indicating a how to deal with a possible future extension dealing with model_non pragma_c_codes.
683 lines
22 KiB
Mathematica
683 lines
22 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1995 University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%------------------------------------------------------------------------------%
|
|
|
|
:- module exprn_aux.
|
|
|
|
:- interface.
|
|
|
|
:- import_module llds, options.
|
|
:- import_module list, std_util, bool, assoc_list.
|
|
|
|
:- type exprn_opts
|
|
---> nlg_asm_sgt_ubf(
|
|
bool, % --use-non-local-gotos
|
|
bool, % --use-asm-labels
|
|
bool, % --static-ground-terms
|
|
bool % --unboxed-float
|
|
).
|
|
|
|
:- pred exprn_aux__init_exprn_opts(option_table, exprn_opts).
|
|
:- mode exprn_aux__init_exprn_opts(in, out) is det.
|
|
|
|
% Determine whether an rval_const can be used as the initializer
|
|
% of a C static constant.
|
|
:- pred exprn_aux__const_is_constant(rval_const, exprn_opts, bool).
|
|
:- mode exprn_aux__const_is_constant(in, in, out) is det.
|
|
|
|
% exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst)
|
|
% figures out whether an imported label address is a constant.
|
|
% This depends on how we treat labels.
|
|
|
|
:- pred exprn_aux__imported_is_constant(bool, bool, bool).
|
|
:- mode exprn_aux__imported_is_constant(in, in, out) is det.
|
|
|
|
:- pred exprn_aux__rval_contains_lval(rval, lval).
|
|
:- mode exprn_aux__rval_contains_lval(in, in) is semidet.
|
|
|
|
:- pred exprn_aux__rval_contains_rval(rval, rval).
|
|
:- mode exprn_aux__rval_contains_rval(in, in) is semidet.
|
|
:- mode exprn_aux__rval_contains_rval(in, out) is multidet.
|
|
|
|
:- pred exprn_aux__args_contain_rval(list(maybe(rval)), rval).
|
|
:- mode exprn_aux__args_contain_rval(in, in) is semidet.
|
|
:- mode exprn_aux__args_contain_rval(in, out) is nondet.
|
|
|
|
:- pred exprn_aux__substitute_lval_in_rval(lval, lval, rval, rval).
|
|
:- mode exprn_aux__substitute_lval_in_rval(in, in, in, out) is det.
|
|
|
|
:- pred exprn_aux__substitute_rval_in_rval(rval, rval, rval, rval).
|
|
:- mode exprn_aux__substitute_rval_in_rval(in, in, in, out) is det.
|
|
|
|
:- pred exprn_aux__substitute_vars_in_rval(assoc_list(var, rval), rval, rval).
|
|
:- mode exprn_aux__substitute_vars_in_rval(in, in, out) is det.
|
|
|
|
:- pred exprn_aux__substitute_rvals_in_rval(assoc_list(rval, rval), rval, rval).
|
|
:- mode exprn_aux__substitute_rvals_in_rval(in, in, out) is det.
|
|
|
|
:- pred exprn_aux__vars_in_lval(lval, list(var)).
|
|
:- mode exprn_aux__vars_in_lval(in, out) is det.
|
|
|
|
:- pred exprn_aux__vars_in_rval(rval, list(var)).
|
|
:- mode exprn_aux__vars_in_rval(in, out) is det.
|
|
|
|
:- pred exprn_aux__simplify_rval(rval, rval).
|
|
:- mode exprn_aux__simplify_rval(in, out) is det.
|
|
|
|
% the following predicates take an lval/rval (list)
|
|
% and return a list of the code and data addresses that it references.
|
|
|
|
:- pred exprn_aux__rval_list_addrs(list(rval),
|
|
list(code_addr), list(data_addr)).
|
|
:- mode exprn_aux__rval_list_addrs(in, out, out) is det.
|
|
|
|
:- pred exprn_aux__lval_list_addrs(list(lval),
|
|
list(code_addr), list(data_addr)).
|
|
:- mode exprn_aux__lval_list_addrs(in, out, out) is det.
|
|
|
|
:- pred exprn_aux__rval_addrs(rval, list(code_addr), list(data_addr)).
|
|
:- mode exprn_aux__rval_addrs(in, out, out) is det.
|
|
|
|
:- pred exprn_aux__lval_addrs(lval, list(code_addr), list(data_addr)).
|
|
:- mode exprn_aux__lval_addrs(in, out, out) is det.
|
|
|
|
:- pred exprn_aux__maybe_rval_list_addrs(list(maybe(rval)),
|
|
list(code_addr), list(data_addr)).
|
|
:- mode exprn_aux__maybe_rval_list_addrs(in, out, out) is det.
|
|
|
|
%------------------------------------------------------------------------------%
|
|
%------------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module int, require, getopt, options.
|
|
|
|
exprn_aux__init_exprn_opts(Options, ExprnOpts) :-
|
|
getopt__lookup_bool_option(Options, gcc_non_local_gotos, NLG),
|
|
getopt__lookup_bool_option(Options, asm_labels, ASM),
|
|
getopt__lookup_bool_option(Options, static_ground_terms, SGT),
|
|
getopt__lookup_bool_option(Options, unboxed_float, UBF),
|
|
ExprnOpts = nlg_asm_sgt_ubf(NLG, ASM, SGT, UBF).
|
|
|
|
% Determine whether a const (well, what _we_ consider to be a const)
|
|
% is constant as far as the C compiler is concerned -- specifically,
|
|
% determine whether it can be used as the initializer of a C static
|
|
% constant.
|
|
|
|
exprn_aux__const_is_constant(true, _, yes).
|
|
exprn_aux__const_is_constant(false, _, yes).
|
|
exprn_aux__const_is_constant(int_const(_), _, yes).
|
|
exprn_aux__const_is_constant(float_const(_), ExprnOpts, IsConst) :-
|
|
ExprnOpts = nlg_asm_sgt_ubf(_NLG, _ASM, StaticGroundTerms,
|
|
UnboxedFloat),
|
|
( UnboxedFloat = yes ->
|
|
%
|
|
% If we're using unboxed (single-precision) floats,
|
|
% floating point values are always constants
|
|
%
|
|
IsConst = yes
|
|
;
|
|
%
|
|
% If we're using boxed floats, then we can generate a static
|
|
% constant variable to hold a float constant, and gcc
|
|
% doesn't mind us converting from its address to word
|
|
% in a static initializer. However, we only do this if
|
|
% --static-ground-terms is enabled.
|
|
%
|
|
IsConst = StaticGroundTerms
|
|
).
|
|
exprn_aux__const_is_constant(string_const(_), _, yes).
|
|
exprn_aux__const_is_constant(code_addr_const(CodeAddr), ExprnOpts, IsConst) :-
|
|
exprn_aux__addr_is_constant(CodeAddr, ExprnOpts, IsConst).
|
|
exprn_aux__const_is_constant(data_addr_const(_), _, yes).
|
|
|
|
:- pred exprn_aux__addr_is_constant(code_addr, exprn_opts, bool).
|
|
:- mode exprn_aux__addr_is_constant(in, in, out) is det.
|
|
|
|
exprn_aux__addr_is_constant(label(Label), ExprnOpts, IsConst) :-
|
|
ExprnOpts = nlg_asm_sgt_ubf(NonLocalGotos, AsmLabels, _SGT, _UBF),
|
|
exprn_aux__label_is_constant(Label, NonLocalGotos, AsmLabels, IsConst).
|
|
exprn_aux__addr_is_constant(imported(_), ExprnOpts, IsConst) :-
|
|
ExprnOpts = nlg_asm_sgt_ubf(NonLocalGotos, AsmLabels, _SGT, _UBF),
|
|
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
|
|
exprn_aux__addr_is_constant(succip, _, no).
|
|
exprn_aux__addr_is_constant(do_succeed(_), _, no).
|
|
exprn_aux__addr_is_constant(do_redo, _, no).
|
|
exprn_aux__addr_is_constant(do_fail, _, no).
|
|
exprn_aux__addr_is_constant(do_det_closure, _, no).
|
|
exprn_aux__addr_is_constant(do_semidet_closure, _, no).
|
|
exprn_aux__addr_is_constant(do_nondet_closure, _, no).
|
|
|
|
:- pred exprn_aux__label_is_constant(label, bool, bool, bool).
|
|
:- mode exprn_aux__label_is_constant(in, in, in, out) is det.
|
|
|
|
exprn_aux__label_is_constant(exported(_), NonLocalGotos, AsmLabels, IsConst) :-
|
|
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
|
|
exprn_aux__label_is_constant(local(_), NonLocalGotos, AsmLabels, IsConst) :-
|
|
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
|
|
exprn_aux__label_is_constant(c_local(_), _NonLocalGotos, _AsmLabels, yes).
|
|
exprn_aux__label_is_constant(local(_, _), _NonLocalGotos, _AsmLabels, yes).
|
|
|
|
% The logic of this function and how it is used in globals.m to
|
|
% select the default type_info method must agree with the code in
|
|
% runtime/typeinfo.h.
|
|
|
|
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst) :-
|
|
(
|
|
NonLocalGotos = yes,
|
|
AsmLabels = no
|
|
->
|
|
%
|
|
% with non-local gotos but no asm labels, jumps to code
|
|
% addresses in different c_modules must be done via global
|
|
% variables; the value of these global variables is not
|
|
% constant (i.e. not computable at load time), since they
|
|
% can't be initialized until we call init_modules().
|
|
%
|
|
IsConst = no
|
|
;
|
|
IsConst = yes
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
exprn_aux__rval_contains_lval(lval(Lval0), Lval) :-
|
|
exprn_aux__lval_contains_lval(Lval0, Lval).
|
|
exprn_aux__rval_contains_lval(create(_, Rvals, _, _), Lval) :-
|
|
exprn_aux__args_contain_lval(Rvals, Lval).
|
|
exprn_aux__rval_contains_lval(mkword(_, Rval), Lval) :-
|
|
exprn_aux__rval_contains_lval(Rval, Lval).
|
|
exprn_aux__rval_contains_lval(unop(_, Rval), Lval) :-
|
|
exprn_aux__rval_contains_lval(Rval, Lval).
|
|
exprn_aux__rval_contains_lval(binop(_, Rval0, Rval1), Lval) :-
|
|
(
|
|
exprn_aux__rval_contains_lval(Rval0, Lval)
|
|
;
|
|
exprn_aux__rval_contains_lval(Rval1, Lval)
|
|
).
|
|
|
|
:- pred exprn_aux__lval_contains_lval(lval, lval).
|
|
:- mode exprn_aux__lval_contains_lval(in, in) is semidet.
|
|
|
|
exprn_aux__lval_contains_lval(Lval0, Lval) :-
|
|
(
|
|
Lval0 = Lval
|
|
->
|
|
true
|
|
;
|
|
Lval0 = field(_, Rval0, Rval1)
|
|
->
|
|
(
|
|
exprn_aux__rval_contains_lval(Rval0, Lval)
|
|
;
|
|
exprn_aux__rval_contains_lval(Rval1, Lval)
|
|
)
|
|
;
|
|
Lval0 = lvar(_Var)
|
|
->
|
|
error("exprn_aux__lval_contains_lval: var! I can't tell")
|
|
;
|
|
fail
|
|
).
|
|
|
|
:- pred exprn_aux__args_contain_lval(list(maybe(rval)), lval).
|
|
:- mode exprn_aux__args_contain_lval(in, in) is semidet.
|
|
|
|
exprn_aux__args_contain_lval([M | Ms], Lval) :-
|
|
(
|
|
M = yes(Rval),
|
|
exprn_aux__rval_contains_lval(Rval, Lval)
|
|
->
|
|
true
|
|
;
|
|
exprn_aux__args_contain_lval(Ms, Lval)
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
exprn_aux__rval_contains_rval(Rval0, Rval) :-
|
|
(
|
|
Rval0 = Rval
|
|
;
|
|
(
|
|
Rval0 = lval(Lval),
|
|
exprn_aux__lval_contains_rval(Lval, Rval)
|
|
;
|
|
Rval0 = create(_, Rvals, _, _),
|
|
exprn_aux__args_contain_rval(Rvals, Rval)
|
|
;
|
|
Rval0 = mkword(_, Rval1),
|
|
exprn_aux__rval_contains_rval(Rval1, Rval)
|
|
;
|
|
Rval0 = unop(_, Rval1),
|
|
exprn_aux__rval_contains_rval(Rval1, Rval)
|
|
;
|
|
Rval0 = binop(_, Rval1, Rval2),
|
|
(
|
|
exprn_aux__rval_contains_rval(Rval1, Rval)
|
|
;
|
|
exprn_aux__rval_contains_rval(Rval2, Rval)
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred exprn_aux__lval_contains_rval(lval, rval).
|
|
:- mode exprn_aux__lval_contains_rval(in, in) is semidet.
|
|
:- mode exprn_aux__lval_contains_rval(in, out) is nondet.
|
|
|
|
exprn_aux__lval_contains_rval(field(_, Rval0, Rval1), Rval) :-
|
|
(
|
|
exprn_aux__rval_contains_rval(Rval0, Rval)
|
|
;
|
|
exprn_aux__rval_contains_rval(Rval1, Rval)
|
|
).
|
|
|
|
exprn_aux__args_contain_rval([M | Ms], Rval) :-
|
|
(
|
|
M = yes(Rval0),
|
|
exprn_aux__rval_contains_rval(Rval0, Rval)
|
|
;
|
|
exprn_aux__args_contain_rval(Ms, Rval)
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
exprn_aux__vars_in_rval(lval(Lval), Vars) :-
|
|
exprn_aux__vars_in_lval(Lval, Vars).
|
|
exprn_aux__vars_in_rval(var(Var), [Var]).
|
|
exprn_aux__vars_in_rval(create(_, Rvals, _, _), Vars) :-
|
|
exprn_aux__vars_in_args(Rvals, Vars).
|
|
exprn_aux__vars_in_rval(mkword(_, Rval), Vars) :-
|
|
exprn_aux__vars_in_rval(Rval, Vars).
|
|
exprn_aux__vars_in_rval(const(_Conts), []).
|
|
exprn_aux__vars_in_rval(unop(_, Rval), Vars) :-
|
|
exprn_aux__vars_in_rval(Rval, Vars).
|
|
exprn_aux__vars_in_rval(binop(_, Rval0, Rval1), Vars) :-
|
|
exprn_aux__vars_in_rval(Rval0, Vars0),
|
|
exprn_aux__vars_in_rval(Rval1, Vars1),
|
|
list__append(Vars0, Vars1, Vars).
|
|
|
|
exprn_aux__vars_in_lval(Lval, Vars) :-
|
|
(
|
|
Lval = lvar(Var)
|
|
->
|
|
Vars = [Var]
|
|
;
|
|
Lval = field(_, Rval0, Rval1)
|
|
->
|
|
exprn_aux__vars_in_rval(Rval0, Vars0),
|
|
exprn_aux__vars_in_rval(Rval1, Vars1),
|
|
list__append(Vars0, Vars1, Vars)
|
|
;
|
|
Vars = []
|
|
).
|
|
|
|
:- pred exprn_aux__vars_in_args(list(maybe(rval)), list(var)).
|
|
:- mode exprn_aux__vars_in_args(in, out) is det.
|
|
|
|
exprn_aux__vars_in_args([], []).
|
|
exprn_aux__vars_in_args([M | Ms], Vars) :-
|
|
exprn_aux__vars_in_args(Ms, Vars0),
|
|
(
|
|
M = yes(Rval)
|
|
->
|
|
exprn_aux__vars_in_rval(Rval, Vars1),
|
|
list__append(Vars1, Vars0, Vars)
|
|
;
|
|
Vars = Vars0
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval0, Rval) :-
|
|
(
|
|
Rval0 = lval(Lval0),
|
|
exprn_aux__substitute_lval_in_lval(OldLval, NewLval,
|
|
Lval0, Lval),
|
|
Rval = lval(Lval)
|
|
;
|
|
Rval0 = var(_Var),
|
|
Rval = Rval0
|
|
;
|
|
Rval0 = create(Tag, Rvals0, Unique, Num),
|
|
exprn_aux__substitute_lval_in_args(OldLval, NewLval,
|
|
Rvals0, Rvals),
|
|
Rval = create(Tag, Rvals, Unique, Num)
|
|
;
|
|
Rval0 = mkword(Tag, Rval1),
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval1,
|
|
Rval2),
|
|
Rval = mkword(Tag, Rval2)
|
|
;
|
|
Rval0 = const(_Const),
|
|
Rval = Rval0
|
|
;
|
|
Rval0 = unop(Unop, Rval1),
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval1,
|
|
Rval2),
|
|
Rval = unop(Unop, Rval2)
|
|
;
|
|
Rval0 = binop(Binop, Rval1, Rval2),
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval1,
|
|
Rval3),
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval2,
|
|
Rval4),
|
|
Rval = binop(Binop, Rval3, Rval4)
|
|
).
|
|
|
|
:- pred exprn_aux__substitute_lval_in_lval(lval, lval, lval, lval).
|
|
:- mode exprn_aux__substitute_lval_in_lval(in, in, in, out) is det.
|
|
|
|
exprn_aux__substitute_lval_in_lval(OldLval, NewLval, Lval0, Lval) :-
|
|
(
|
|
Lval0 = OldLval
|
|
->
|
|
Lval = NewLval
|
|
;
|
|
Lval0 = field(Tag, Rval0, Rval1)
|
|
->
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval0,
|
|
Rval2),
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval1,
|
|
Rval3),
|
|
Lval = field(Tag, Rval2, Rval3)
|
|
;
|
|
Lval = Lval0
|
|
).
|
|
|
|
:- pred exprn_aux__substitute_lval_in_args(lval, lval,
|
|
list(maybe(rval)), list(maybe(rval))).
|
|
:- mode exprn_aux__substitute_lval_in_args(in, in, in, out) is det.
|
|
|
|
exprn_aux__substitute_lval_in_args(_OldLval, _NewLval, [], []).
|
|
exprn_aux__substitute_lval_in_args(OldLval, NewLval, [M0 | Ms0], [M | Ms]) :-
|
|
(
|
|
M0 = yes(Rval0)
|
|
->
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval0,
|
|
Rval),
|
|
M = yes(Rval)
|
|
;
|
|
M = M0
|
|
),
|
|
exprn_aux__substitute_lval_in_args(OldLval, NewLval, Ms0, Ms).
|
|
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval) :-
|
|
(
|
|
Rval0 = OldRval
|
|
->
|
|
Rval = NewRval
|
|
;
|
|
(
|
|
Rval0 = lval(Lval0),
|
|
exprn_aux__substitute_rval_in_lval(OldRval, NewRval,
|
|
Lval0, Lval),
|
|
Rval = lval(Lval)
|
|
;
|
|
Rval0 = var(_),
|
|
Rval = Rval0
|
|
;
|
|
Rval0 = create(Tag, Rvals0, Unique, Num),
|
|
exprn_aux__substitute_rval_in_args(OldRval, NewRval,
|
|
Rvals0, Rvals),
|
|
Rval = create(Tag, Rvals, Unique, Num)
|
|
;
|
|
Rval0 = mkword(Tag, Rval1),
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
|
|
Rval1, Rval2),
|
|
Rval = mkword(Tag, Rval2)
|
|
;
|
|
Rval0 = const(_Const),
|
|
Rval = Rval0
|
|
;
|
|
Rval0 = unop(Unop, Rval1),
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
|
|
Rval1, Rval2),
|
|
Rval = unop(Unop, Rval2)
|
|
;
|
|
Rval0 = binop(Binop, Rval1, Rval2),
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
|
|
Rval1, Rval3),
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
|
|
Rval2, Rval4),
|
|
Rval = binop(Binop, Rval3, Rval4)
|
|
)
|
|
).
|
|
|
|
:- pred exprn_aux__substitute_rval_in_lval(rval, rval, lval, lval).
|
|
:- mode exprn_aux__substitute_rval_in_lval(in, in, in, out) is det.
|
|
|
|
exprn_aux__substitute_rval_in_lval(OldRval, NewRval, Lval0, Lval) :-
|
|
(
|
|
Lval0 = field(Tag, Rval0, Rval1)
|
|
->
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0,
|
|
Rval2),
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval1,
|
|
Rval3),
|
|
Lval = field(Tag, Rval2, Rval3)
|
|
;
|
|
Lval = Lval0
|
|
).
|
|
|
|
:- pred exprn_aux__substitute_rval_in_args(rval, rval,
|
|
list(maybe(rval)), list(maybe(rval))).
|
|
:- mode exprn_aux__substitute_rval_in_args(in, in, in, out) is det.
|
|
|
|
exprn_aux__substitute_rval_in_args(_OldRval, _NewRval, [], []).
|
|
exprn_aux__substitute_rval_in_args(OldRval, NewRval, [M0 | Ms0], [M | Ms]) :-
|
|
(
|
|
M0 = yes(Rval0)
|
|
->
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0,
|
|
Rval),
|
|
M = yes(Rval)
|
|
;
|
|
M = M0
|
|
),
|
|
exprn_aux__substitute_rval_in_args(OldRval, NewRval, Ms0, Ms).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
exprn_aux__substitute_vars_in_rval([], Rval, Rval).
|
|
exprn_aux__substitute_vars_in_rval([Var - Sub | Rest], Rval0, Rval) :-
|
|
exprn_aux__substitute_rval_in_rval(var(Var), Sub, Rval0, Rval1),
|
|
exprn_aux__substitute_vars_in_rval(Rest, Rval1, Rval).
|
|
|
|
% When we substitute a one set of rvals for another, we face the problem
|
|
% that the substitution may not be idempotent. We finesse this problem by
|
|
% substituting unique new rvals for the original rvals, and then substituting
|
|
% the replacement rvals for these unique rvals. We guarantee the uniqueness
|
|
% of these rvals by using framevars with negative numbers for them.
|
|
|
|
exprn_aux__substitute_rvals_in_rval(RvalPairs, Rval0, Rval) :-
|
|
exprn_aux__substitute_rvals_in_rval_1(RvalPairs, 0,
|
|
RvalUniqPairs, UniqRvalPairs),
|
|
exprn_aux__substitute_rvals_in_rval_2(RvalUniqPairs, Rval0, Rval1),
|
|
exprn_aux__substitute_rvals_in_rval_2(UniqRvalPairs, Rval1, Rval).
|
|
|
|
:- pred exprn_aux__substitute_rvals_in_rval_1(assoc_list(rval, rval), int,
|
|
assoc_list(rval, rval), assoc_list(rval, rval)).
|
|
:- mode exprn_aux__substitute_rvals_in_rval_1(in, in, out, out) is det.
|
|
|
|
exprn_aux__substitute_rvals_in_rval_1([], _, [], []).
|
|
exprn_aux__substitute_rvals_in_rval_1([Rval1 - Rval2 | RvalPairList], N0,
|
|
[Rval1 - Uniq | RvalUniqList], [Uniq - Rval2 | UniqRvalList]) :-
|
|
N1 is N0 - 1,
|
|
Uniq = lval(framevar(N1)),
|
|
exprn_aux__substitute_rvals_in_rval_1(RvalPairList, N1,
|
|
RvalUniqList, UniqRvalList).
|
|
|
|
:- pred exprn_aux__substitute_rvals_in_rval_2(assoc_list(rval, rval),
|
|
rval, rval).
|
|
:- mode exprn_aux__substitute_rvals_in_rval_2(in, in, out) is det.
|
|
|
|
exprn_aux__substitute_rvals_in_rval_2([], Rval, Rval).
|
|
exprn_aux__substitute_rvals_in_rval_2([Left - Right | Rest], Rval0, Rval2) :-
|
|
exprn_aux__substitute_rval_in_rval(Left, Right, Rval0, Rval1),
|
|
exprn_aux__substitute_rvals_in_rval_2(Rest, Rval1, Rval2).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
exprn_aux__simplify_rval(Rval0, Rval) :-
|
|
(
|
|
exprn_aux__simplify_rval_2(Rval0, Rval1)
|
|
->
|
|
exprn_aux__simplify_rval(Rval1, Rval)
|
|
;
|
|
Rval = Rval0
|
|
).
|
|
|
|
:- pred exprn_aux__simplify_rval_2(rval, rval).
|
|
:- mode exprn_aux__simplify_rval_2(in, out) is semidet.
|
|
|
|
exprn_aux__simplify_rval_2(Rval0, Rval) :-
|
|
(
|
|
Rval0 = lval(field(Tag, create(Tag, Args, _, _), Field)),
|
|
Field = const(int_const(FieldNum))
|
|
->
|
|
list__index0_det(Args, FieldNum, yes(Rval))
|
|
;
|
|
Rval0 = lval(field(Tag, Rval1, Num)),
|
|
exprn_aux__simplify_rval_2(Rval1, Rval2)
|
|
->
|
|
Rval = lval(field(Tag, Rval2, Num))
|
|
;
|
|
Rval0 = create(Tag, Args0, Unique, CNum),
|
|
exprn_aux__simplify_args(Args0, Args),
|
|
Args \= Args0
|
|
->
|
|
Rval = create(Tag, Args, Unique, CNum)
|
|
;
|
|
Rval0 = unop(UOp, Rval1),
|
|
exprn_aux__simplify_rval_2(Rval1, Rval2)
|
|
->
|
|
Rval = unop(UOp, Rval2)
|
|
;
|
|
Rval0 = binop(BOp, Rval1, Rval2),
|
|
exprn_aux__simplify_rval_2(Rval1, Rval3)
|
|
->
|
|
Rval = binop(BOp, Rval3, Rval2)
|
|
;
|
|
Rval0 = binop(BOp, Rval1, Rval2),
|
|
exprn_aux__simplify_rval_2(Rval2, Rval3)
|
|
->
|
|
Rval = binop(BOp, Rval1, Rval3)
|
|
;
|
|
fail
|
|
).
|
|
|
|
:- pred exprn_aux__simplify_args(list(maybe(rval)), list(maybe(rval))).
|
|
:- mode exprn_aux__simplify_args(in, out) is det.
|
|
|
|
exprn_aux__simplify_args([], []).
|
|
exprn_aux__simplify_args([MR0 | Ms0], [MR | Ms]) :-
|
|
exprn_aux__simplify_args(Ms0, Ms),
|
|
(
|
|
MR0 = yes(Rval0),
|
|
exprn_aux__simplify_rval_2(Rval0, Rval)
|
|
->
|
|
MR = yes(Rval)
|
|
;
|
|
MR = MR0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% give an rval, return a list of the code and data addresses
|
|
% that are referenced by that rval
|
|
|
|
exprn_aux__rval_addrs(lval(Lval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__lval_addrs(Lval, CodeAddrs, DataAddrs).
|
|
exprn_aux__rval_addrs(var(_), [], []).
|
|
exprn_aux__rval_addrs(create(_, MaybeRvals, _, _), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__maybe_rval_list_addrs(MaybeRvals, CodeAddrs, DataAddrs).
|
|
exprn_aux__rval_addrs(mkword(_Tag, Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__rval_addrs(const(Const), CodeAddrs, DataAddrs) :-
|
|
( Const = code_addr_const(CodeAddress) ->
|
|
CodeAddrs = [CodeAddress],
|
|
DataAddrs = []
|
|
; Const = data_addr_const(DataAddress) ->
|
|
CodeAddrs = [],
|
|
DataAddrs = [DataAddress]
|
|
;
|
|
CodeAddrs = [],
|
|
DataAddrs = []
|
|
).
|
|
exprn_aux__rval_addrs(unop(_Op, Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__rval_addrs(binop(_BinOp, Rval1, Rval2), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval1, CodeAddrs1, DataAddrs1),
|
|
exprn_aux__rval_addrs(Rval2, CodeAddrs2, DataAddrs2),
|
|
list__append(CodeAddrs1, CodeAddrs2, CodeAddrs),
|
|
list__append(DataAddrs1, DataAddrs2, DataAddrs).
|
|
|
|
% give an lval, return a list of the code and data addresses
|
|
% that are referenced by that lval
|
|
|
|
exprn_aux__lval_addrs(reg(_, _), [], []).
|
|
exprn_aux__lval_addrs(stackvar(_Int), [], []).
|
|
exprn_aux__lval_addrs(framevar(_Int), [], []).
|
|
exprn_aux__lval_addrs(succip, [], []).
|
|
exprn_aux__lval_addrs(maxfr, [], []).
|
|
exprn_aux__lval_addrs(curfr, [], []).
|
|
exprn_aux__lval_addrs(prevfr(Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__lval_addrs(succfr(Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__lval_addrs(redoip(Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__lval_addrs(succip(Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__lval_addrs(hp, [], []).
|
|
exprn_aux__lval_addrs(sp, [], []).
|
|
exprn_aux__lval_addrs(field(_Tag, Rval1, Rval2), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval1, CodeAddrs1, DataAddrs1),
|
|
exprn_aux__rval_addrs(Rval2, CodeAddrs2, DataAddrs2),
|
|
list__append(CodeAddrs1, CodeAddrs2, CodeAddrs),
|
|
list__append(DataAddrs1, DataAddrs2, DataAddrs).
|
|
exprn_aux__lval_addrs(lvar(_Var), [], []).
|
|
exprn_aux__lval_addrs(temp(_, _), [], []).
|
|
|
|
% give a list of rvals, return a list of the code and data addresses
|
|
% that are referenced by those rvals
|
|
|
|
exprn_aux__rval_list_addrs([], [], []).
|
|
exprn_aux__rval_list_addrs([Rval | Rvals], CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs0, DataAddrs0),
|
|
exprn_aux__rval_list_addrs(Rvals, CodeAddrs1, DataAddrs1),
|
|
list__append(CodeAddrs0, CodeAddrs1, CodeAddrs),
|
|
list__append(DataAddrs0, DataAddrs1, DataAddrs).
|
|
|
|
% give a list of lvals, return a list of the code and data addresses
|
|
% that are referenced by those lvals
|
|
|
|
exprn_aux__lval_list_addrs([], [], []).
|
|
exprn_aux__lval_list_addrs([Lval | Lvals], CodeAddrs, DataAddrs) :-
|
|
exprn_aux__lval_addrs(Lval, CodeAddrs0, DataAddrs0),
|
|
exprn_aux__lval_list_addrs(Lvals, CodeAddrs1, DataAddrs1),
|
|
list__append(CodeAddrs0, CodeAddrs1, CodeAddrs),
|
|
list__append(DataAddrs0, DataAddrs1, DataAddrs).
|
|
|
|
% give a list of maybe(rval), return a list of the code and data
|
|
% addresses that are reference by that list
|
|
|
|
exprn_aux__maybe_rval_list_addrs([], [], []).
|
|
exprn_aux__maybe_rval_list_addrs([MaybeRval | MaybeRvals],
|
|
CodeAddrs, DataAddrs) :-
|
|
( MaybeRval = yes(Rval) ->
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs0, DataAddrs0),
|
|
exprn_aux__maybe_rval_list_addrs(MaybeRvals,
|
|
CodeAddrs1, DataAddrs1),
|
|
list__append(CodeAddrs0, CodeAddrs1, CodeAddrs),
|
|
list__append(DataAddrs0, DataAddrs1, DataAddrs)
|
|
;
|
|
exprn_aux__maybe_rval_list_addrs(MaybeRvals,
|
|
CodeAddrs, DataAddrs)
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
%------------------------------------------------------------------------------%
|