mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-23 13:23:47 +00:00
91560d2dd7
It used to be a special option that just set procs_per_c_function
to the special value of zero, but this behavior is inconsistent with
optimization_options taking the max of the old and new values of
integer options. This meant that --procs-per-c-function=5 -O6
would not put all procedures into one C function.
tools/make_optimization_options_db:
tools/make_optimization_options_end:
compiler/optimization_options.m:
As above: make --everything-in-one-c-function a bool option,
named use_just_one_c_func for brevity.
compiler/options.m:
Move the code handling --everything-in-one-c-function next to the
other optimization options.
compiler/mercury_compile_llds_back_end.m:
When deciding which procedures should be put into which C functions,
use the logic: if use_just_one_c_func, then put all procs into the
same C function, otherwise, put them into one or more C functions
with up to procs_per_c_function procedures per function.
This is now the *only* place in the compiler that looks at
procs_per_c_function; everywhere else looks at use_just_one_c_func.
compiler/code_util.m:
Replace a maybe pair type that used to store the value of
procs_per_c_function with a bespoke type storing use_just_one_c_func,
which documents its meaning.
compiler/code_info.m:
Replace a bool type with a bespoke type, again documenting
its meaning.
compiler/call_gen.m:
compiler/closure_gen.m:
compiler/middle_rec.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/rtti_out.m:
Conform to the changes above.
compiler/llds.m:
Fix blank lines.
767 lines
26 KiB
Mathematica
767 lines
26 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2012 The 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.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: middle_rec.m.
|
|
% Main authors: zs, conway.
|
|
%
|
|
% Code generation - do middle recursion optimization.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module ll_backend.middle_rec.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module ll_backend.code_info.
|
|
:- import_module ll_backend.code_loc_dep.
|
|
:- import_module ll_backend.llds.
|
|
|
|
:- pred match_and_generate(hlds_goal::in, llds_code::out,
|
|
code_info::in, code_info::out, code_loc_dep::in, code_loc_dep::out)
|
|
is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module backend_libs.
|
|
:- import_module backend_libs.builtin_ops.
|
|
:- import_module hlds.code_model.
|
|
:- import_module hlds.goal_form.
|
|
:- import_module hlds.hlds_llds.
|
|
:- import_module ll_backend.code_gen.
|
|
:- import_module ll_backend.code_util.
|
|
:- import_module ll_backend.opt_util.
|
|
:- import_module ll_backend.proc_gen.
|
|
:- import_module ll_backend.unify_gen_test.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
match_and_generate(Goal, Instrs, !CI, !CLD) :-
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
GoalExpr = switch(Var, cannot_fail, [Case1, Case2]),
|
|
Case1 = case(ConsId1, [], Goal1),
|
|
Case2 = case(ConsId2, [], Goal2),
|
|
( if
|
|
contains_only_builtins(Goal1) = yes,
|
|
contains_simple_recursive_call(Goal2, !.CI)
|
|
then
|
|
middle_rec_generate_switch(Var, ConsId1, Goal1, Goal2,
|
|
GoalInfo, Instrs, !CI, !CLD)
|
|
else if
|
|
contains_only_builtins(Goal2) = yes,
|
|
contains_simple_recursive_call(Goal1, !.CI)
|
|
then
|
|
middle_rec_generate_switch(Var, ConsId2, Goal2, Goal1,
|
|
GoalInfo, Instrs, !CI, !CLD)
|
|
else
|
|
fail
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% contains_simple_recursive_call(G, CI, Last, ContainsTakeAddr)
|
|
% succeeds if G is a conjunction of goals, exactly one of which is a
|
|
% recursive call (CI says what the current procedure is), there are no
|
|
% other goals that cause control to leave this procedure, and there are
|
|
% no unifications that take the addresses of fields.
|
|
%
|
|
:- pred contains_simple_recursive_call(hlds_goal::in, code_info::in)
|
|
is semidet.
|
|
|
|
contains_simple_recursive_call(hlds_goal(GoalExpr, _), CodeInfo) :-
|
|
GoalExpr = conj(plain_conj, Goals),
|
|
contains_simple_recursive_call_conj(Goals, CodeInfo).
|
|
|
|
:- pred contains_simple_recursive_call_conj(list(hlds_goal)::in, code_info::in)
|
|
is semidet.
|
|
|
|
contains_simple_recursive_call_conj([Goal | Goals], CodeInfo) :-
|
|
Goal = hlds_goal(GoalExpr, _),
|
|
OnlyBuiltinsGoalExpr = contains_only_builtins_expr(GoalExpr),
|
|
(
|
|
OnlyBuiltinsGoalExpr = yes,
|
|
contains_simple_recursive_call_conj(Goals, CodeInfo)
|
|
;
|
|
OnlyBuiltinsGoalExpr = no,
|
|
is_recursive_call(GoalExpr, CodeInfo),
|
|
contains_only_builtins_list(Goals) = yes
|
|
).
|
|
|
|
:- pred is_recursive_call(hlds_goal_expr::in, code_info::in) is semidet.
|
|
|
|
is_recursive_call(Goal, CodeInfo) :-
|
|
Goal = plain_call(CallPredId, CallProcId, _, BuiltinState, _, _),
|
|
BuiltinState = not_builtin,
|
|
get_pred_id(CodeInfo, PredId),
|
|
PredId = CallPredId,
|
|
get_proc_id(CodeInfo, ProcId),
|
|
ProcId = CallProcId.
|
|
|
|
% contains_only_builtins(G) returns `yes' if G is a leaf procedure,
|
|
% i.e. control does not leave G to call another procedure, even
|
|
% if that procedure is a complicated unification. It also does not contain
|
|
% unifications that take the addresses of fields.
|
|
%
|
|
:- func contains_only_builtins(hlds_goal) = bool.
|
|
|
|
contains_only_builtins(hlds_goal(GoalExpr, _)) =
|
|
contains_only_builtins_expr(GoalExpr).
|
|
|
|
:- func contains_only_builtins_expr(hlds_goal_expr) = bool.
|
|
|
|
contains_only_builtins_expr(GoalExpr) = OnlyBuiltins :-
|
|
(
|
|
GoalExpr = conj(ConjType, Goals),
|
|
(
|
|
ConjType = plain_conj,
|
|
OnlyBuiltins = contains_only_builtins_list(Goals)
|
|
;
|
|
ConjType = parallel_conj,
|
|
OnlyBuiltins = no
|
|
)
|
|
;
|
|
GoalExpr = disj(Goals),
|
|
OnlyBuiltins = contains_only_builtins_list(Goals)
|
|
;
|
|
GoalExpr = switch(_Var, _CanFail, Cases),
|
|
OnlyBuiltins = contains_only_builtins_cases(Cases)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
OnlyBuiltins = contains_only_builtins(SubGoal)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
OnlyBuiltins = yes
|
|
else
|
|
OnlyBuiltins = contains_only_builtins(SubGoal)
|
|
)
|
|
;
|
|
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
|
|
( if
|
|
contains_only_builtins(Cond) = yes,
|
|
contains_only_builtins(Then) = yes,
|
|
contains_only_builtins(Else) = yes
|
|
then
|
|
OnlyBuiltins = yes
|
|
else
|
|
OnlyBuiltins = no
|
|
)
|
|
;
|
|
GoalExpr = plain_call(_, _, _, BuiltinState, _, _),
|
|
(
|
|
BuiltinState = inline_builtin,
|
|
OnlyBuiltins = yes
|
|
;
|
|
BuiltinState = not_builtin,
|
|
OnlyBuiltins = no
|
|
)
|
|
;
|
|
GoalExpr = unify(_, _, _, Uni, _),
|
|
% Complicated unifies are _non_builtin_
|
|
(
|
|
Uni = assign(_, _),
|
|
OnlyBuiltins = yes
|
|
;
|
|
Uni = simple_test(_, _),
|
|
OnlyBuiltins = yes
|
|
;
|
|
Uni = construct(_, _, _, _, _, _, SubInfo),
|
|
(
|
|
SubInfo = no_construct_sub_info,
|
|
OnlyBuiltins = yes
|
|
;
|
|
SubInfo = construct_sub_info(TakeAddressFields, _),
|
|
(
|
|
TakeAddressFields = no,
|
|
OnlyBuiltins = yes
|
|
;
|
|
TakeAddressFields = yes(_),
|
|
OnlyBuiltins = no
|
|
)
|
|
)
|
|
;
|
|
Uni = deconstruct(_, _, _, _, _, _),
|
|
OnlyBuiltins = yes
|
|
;
|
|
Uni = complicated_unify(_, _, _),
|
|
OnlyBuiltins = no
|
|
)
|
|
;
|
|
( GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
),
|
|
OnlyBuiltins = no
|
|
;
|
|
GoalExpr = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
).
|
|
|
|
:- func contains_only_builtins_cases(list(case)) = bool.
|
|
|
|
contains_only_builtins_cases([]) = yes.
|
|
contains_only_builtins_cases([case(_, _, Goal) | Cases]) = OnlyBuiltins :-
|
|
OnlyBuiltinsGoal = contains_only_builtins(Goal),
|
|
(
|
|
OnlyBuiltinsGoal = yes,
|
|
OnlyBuiltins = contains_only_builtins_cases(Cases)
|
|
;
|
|
OnlyBuiltinsGoal = no,
|
|
OnlyBuiltins = no
|
|
).
|
|
|
|
:- func contains_only_builtins_list(list(hlds_goal)) = bool.
|
|
|
|
contains_only_builtins_list([]) = yes.
|
|
contains_only_builtins_list([Goal | Goals]) = OnlyBuiltins :-
|
|
OnlyBuiltinsGoal = contains_only_builtins(Goal),
|
|
(
|
|
OnlyBuiltinsGoal = yes,
|
|
OnlyBuiltins = contains_only_builtins_list(Goals)
|
|
;
|
|
OnlyBuiltinsGoal = no,
|
|
OnlyBuiltins = no
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred middle_rec_generate_switch(prog_var::in, cons_id::in,
|
|
hlds_goal::in, hlds_goal::in, hlds_goal_info::in, llds_code::out,
|
|
code_info::in, code_info::out, code_loc_dep::in, code_loc_dep::out)
|
|
is semidet.
|
|
|
|
middle_rec_generate_switch(Var, BaseConsId, Base, Recursive, SwitchGoalInfo,
|
|
Code, !CI, !CLD) :-
|
|
get_stack_slots(!.CI, StackSlots),
|
|
get_varset(!.CI, VarSet),
|
|
SlotsComment = explain_stack_slots(StackSlots, VarSet),
|
|
get_module_info(!.CI, ModuleInfo),
|
|
get_pred_id(!.CI, PredId),
|
|
get_proc_id(!.CI, ProcId),
|
|
EntryLabel = make_local_entry_label(ModuleInfo, PredId, ProcId,
|
|
for_from_everywhere),
|
|
|
|
pre_goal_update(SwitchGoalInfo, has_subgoals, !CLD),
|
|
produce_variable(Var, VarCode, VarRval, !CLD),
|
|
VarName = variable_name(!.CI, Var),
|
|
VarType = variable_type(!.CI, Var),
|
|
CheaperTagTest = lookup_cheaper_tag_test(!.CI, VarType),
|
|
generate_test_var_has_cons_id(VarRval, VarName, BaseConsId,
|
|
CheaperTagTest, branch_on_success, BaseLabel, TestCode, !CI),
|
|
EntryTestInstrs = cord.list(VarCode ++ TestCode),
|
|
|
|
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
|
|
remember_position(!.CLD, BranchStart),
|
|
generate_goal(model_det, Base, BaseGoalCode, !CI, !CLD),
|
|
generate_branch_end(StoreMap, no, MaybeEnd1, BaseSaveCode, !.CLD),
|
|
reset_to_position(BranchStart, !.CI, !:CLD),
|
|
generate_goal(model_det, Recursive, RecGoalCode, !CI, !CLD),
|
|
generate_branch_end(StoreMap, MaybeEnd1, MaybeEnd, RecSaveCode, !.CLD),
|
|
|
|
after_all_branches(StoreMap, MaybeEnd, !.CI, !:CLD),
|
|
post_goal_update(SwitchGoalInfo, !.CI, !CLD),
|
|
|
|
ArgModes = get_arginfo(!.CI),
|
|
HeadVars = get_headvars(!.CI),
|
|
assoc_list.from_corresponding_lists(HeadVars, ArgModes, Args),
|
|
setup_return(Args, LiveArgs, EpilogCode, !CLD),
|
|
|
|
BaseCode = BaseGoalCode ++ BaseSaveCode ++ EpilogCode,
|
|
RecCode = RecGoalCode ++ RecSaveCode ++ EpilogCode,
|
|
LiveValCode = singleton(
|
|
llds_instr(livevals(LiveArgs), "")
|
|
),
|
|
|
|
BaseInstrs = cord.list(BaseCode),
|
|
RecInstrs = cord.list(RecCode),
|
|
|
|
% In the code we generate, the base instruction sequence is executed
|
|
% in situations where this procedure has no stack frame. If this
|
|
% sequence refers to the stack frame, it will be to some other procedure's
|
|
% variables, which is obviously incorrect.
|
|
opt_util.block_refers_to_stack(BaseInstrs) = no,
|
|
|
|
AvoidInstrs = BaseInstrs ++ RecInstrs,
|
|
find_unused_register(AvoidInstrs, AuxReg),
|
|
|
|
split_rec_code(RecInstrs, BeforeInstrs0, AfterInstrs),
|
|
add_counter_to_livevals(BeforeInstrs0, AuxReg, BeforeInstrs),
|
|
|
|
get_next_label(Loop1Label, !CI),
|
|
get_next_label(Loop2Label, !CI),
|
|
get_total_stackslot_count(!.CI, FrameSize0),
|
|
FrameSize = round_det_stack_frame_size(!.CI, FrameSize0),
|
|
|
|
generate_downloop_test(EntryTestInstrs, Loop1Label, Loop1Test),
|
|
|
|
( if FrameSize = 0 then
|
|
MaybeIncrSp = empty,
|
|
MaybeDecrSp = empty,
|
|
InitAuxReg = singleton(
|
|
llds_instr(assign(AuxReg, const(llconst_int(0))),
|
|
"initialize counter register")
|
|
),
|
|
IncrAuxReg = singleton(
|
|
llds_instr(
|
|
assign(AuxReg,
|
|
binop(int_add(int_type_int), lval(AuxReg),
|
|
const(llconst_int(1)))),
|
|
"increment loop counter")
|
|
),
|
|
DecrAuxReg = singleton(
|
|
llds_instr(
|
|
assign(AuxReg,
|
|
binop(int_sub(int_type_int), lval(AuxReg),
|
|
const(llconst_int(1)))),
|
|
"decrement loop counter")
|
|
),
|
|
TestAuxReg = singleton(
|
|
llds_instr(
|
|
if_val(binop(
|
|
int_gt(int_type_int), lval(AuxReg), const(llconst_int(0))),
|
|
code_label(Loop2Label)),
|
|
"test on upward loop")
|
|
)
|
|
else
|
|
PushMsg = proc_gen.push_msg(ModuleInfo, PredId, ProcId),
|
|
MaybeIncrSp = singleton(
|
|
llds_instr(incr_sp(FrameSize, PushMsg, stack_incr_nonleaf), "")
|
|
),
|
|
MaybeDecrSp = singleton(
|
|
llds_instr(decr_sp(FrameSize), "")
|
|
),
|
|
InitAuxReg = singleton(
|
|
llds_instr(assign(AuxReg, lval(sp)), "initialize counter register")
|
|
),
|
|
IncrAuxReg = empty,
|
|
DecrAuxReg = empty,
|
|
TestAuxReg = singleton(
|
|
llds_instr(if_val(binop(
|
|
int_gt(int_type_int), lval(sp), lval(AuxReg)),
|
|
code_label(Loop2Label)),
|
|
"test on upward loop")
|
|
)
|
|
),
|
|
|
|
% Even though the recursive call is followed by some goals in the HLDS,
|
|
% these goals may generate no LLDS code, so it is in fact possible for
|
|
% AfterInstrs to be empty. There is no point in testing BeforeInstrs
|
|
% for empty, since if it is, the code is an infinite loop anyway.
|
|
|
|
(
|
|
AfterInstrs = [],
|
|
Code =
|
|
from_list([
|
|
llds_instr(label(EntryLabel), "Procedure entry point"),
|
|
llds_instr(comment(SlotsComment), "")
|
|
]) ++
|
|
from_list(EntryTestInstrs) ++
|
|
singleton(
|
|
llds_instr(label(Loop1Label), "start of the down loop")
|
|
) ++
|
|
from_list(BeforeInstrs) ++
|
|
from_list(Loop1Test) ++
|
|
singleton(
|
|
llds_instr(label(BaseLabel), "start of base case")
|
|
) ++
|
|
from_list(BaseInstrs) ++
|
|
LiveValCode ++
|
|
singleton(
|
|
llds_instr(goto(code_succip), "exit from base case")
|
|
)
|
|
;
|
|
AfterInstrs = [_ | _],
|
|
% The instruction list we are constructing has two copies of BaseList.
|
|
% If this list of instructions defines any labels, we must either not
|
|
% apply this version of the optimization, or we must consistently
|
|
% substitute the labels (which will be referred to only from within the
|
|
% BaseList instructions themselves). We choose the former course.
|
|
find_labels(BaseInstrs, BaseLabels),
|
|
BaseLabels = [],
|
|
Code =
|
|
from_list([
|
|
llds_instr(label(EntryLabel), "Procedure entry point"),
|
|
llds_instr(comment(SlotsComment), "")
|
|
]) ++
|
|
from_list(EntryTestInstrs) ++
|
|
InitAuxReg ++
|
|
singleton(
|
|
llds_instr(label(Loop1Label), "start of the down loop")
|
|
) ++
|
|
MaybeIncrSp ++
|
|
IncrAuxReg ++
|
|
from_list(BeforeInstrs) ++
|
|
from_list(Loop1Test) ++
|
|
from_list(BaseInstrs) ++
|
|
singleton(
|
|
llds_instr(label(Loop2Label), "")
|
|
) ++
|
|
from_list(AfterInstrs) ++
|
|
MaybeDecrSp ++
|
|
DecrAuxReg ++
|
|
TestAuxReg ++
|
|
LiveValCode ++
|
|
from_list([
|
|
llds_instr(goto(code_succip), "exit from recursive case"),
|
|
llds_instr(label(BaseLabel), "start of base case")
|
|
]) ++
|
|
from_list(BaseInstrs) ++
|
|
LiveValCode ++
|
|
singleton(
|
|
llds_instr(goto(code_succip), "exit from base case")
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred generate_downloop_test(list(instruction)::in, label::in,
|
|
list(instruction)::out) is det.
|
|
|
|
generate_downloop_test([], _, _) :-
|
|
unexpected($pred, "empty list").
|
|
generate_downloop_test([Instr0 | Instrs0], Target, Instrs) :-
|
|
( if Instr0 = llds_instr(if_val(Test, _OldTarget), _Comment) then
|
|
(
|
|
Instrs0 = []
|
|
;
|
|
Instrs0 = [_ | _],
|
|
unexpected($pred, "if_val followed by other instructions")
|
|
),
|
|
code_util.neg_rval(Test, NewTest),
|
|
Instrs = [
|
|
llds_instr(if_val(NewTest, code_label(Target)),
|
|
"test on downward loop")
|
|
]
|
|
else
|
|
generate_downloop_test(Instrs0, Target, Instrs1),
|
|
Instrs = [Instr0 | Instrs1]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred split_rec_code(list(instruction)::in,
|
|
list(instruction)::out, list(instruction)::out) is det.
|
|
|
|
split_rec_code([], _, _) :-
|
|
unexpected($pred, "did not find call").
|
|
split_rec_code([Instr0 | Instrs1], Before, After) :-
|
|
( if Instr0 = llds_instr(llcall(_, _, _, _, _, _), _) then
|
|
( if
|
|
opt_util.skip_comments(Instrs1, Instrs2),
|
|
Instrs2 = [Instr2 | Instrs3],
|
|
Instr2 = llds_instr(label(_), _)
|
|
then
|
|
Before = [],
|
|
After = Instrs3
|
|
else
|
|
unexpected($pred, "call not followed by label")
|
|
)
|
|
else
|
|
split_rec_code(Instrs1, Before1, After),
|
|
Before = [Instr0 | Before1]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred add_counter_to_livevals(list(instruction)::in, lval::in,
|
|
list(instruction)::out) is det.
|
|
|
|
add_counter_to_livevals([], _Lval, []).
|
|
add_counter_to_livevals([Instr0 | Instrs0], Lval, [Instr | Instrs]) :-
|
|
( if Instr0 = llds_instr(livevals(Lives0), Comment) then
|
|
set.insert(Lval, Lives0, Lives),
|
|
Instr = llds_instr(livevals(Lives), Comment)
|
|
else
|
|
Instr = Instr0
|
|
),
|
|
add_counter_to_livevals(Instrs0, Lval, Instrs).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred find_unused_register(list(instruction)::in, lval::out)
|
|
is det.
|
|
|
|
find_unused_register(Instrs, UnusedReg) :-
|
|
set.init(Used0),
|
|
find_used_registers(Instrs, Used0, Used1),
|
|
set.to_sorted_list(Used1, UsedList),
|
|
find_unused_register_acc(UsedList, 1, UnusedReg).
|
|
|
|
:- pred find_unused_register_acc(list(int)::in, int::in, lval::out) is det.
|
|
|
|
find_unused_register_acc([], N, reg(reg_r, N)).
|
|
find_unused_register_acc([H | T], N, Reg) :-
|
|
( if N < H then
|
|
Reg = reg(reg_r, N)
|
|
else
|
|
N1 = N + 1,
|
|
find_unused_register_acc(T, N1, Reg)
|
|
).
|
|
|
|
:- pred find_used_registers(list(instruction)::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers([], !Used).
|
|
find_used_registers([llds_instr(Uinstr, _) | Instrs], !Used) :-
|
|
find_used_registers_instr(Uinstr, !Used),
|
|
find_used_registers(Instrs, !Used).
|
|
|
|
:- pred find_used_registers_instr(instr::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_instr(Uinstr, !Used) :-
|
|
(
|
|
( Uinstr = comment(_)
|
|
; Uinstr = llcall(_, _, _, _, _, _)
|
|
; Uinstr = mkframe(_, _)
|
|
; Uinstr = label(_)
|
|
; Uinstr = goto(_)
|
|
; Uinstr = arbitrary_c_code(_, _, _)
|
|
; Uinstr = push_region_frame(_Id, _EmbeddedStackFrame)
|
|
; Uinstr = use_and_maybe_pop_region_frame(_UseOp, _EmbeddedStackFrame)
|
|
; Uinstr = discard_ticket
|
|
; Uinstr = prune_ticket
|
|
; Uinstr = incr_sp(_, _, _)
|
|
; Uinstr = decr_sp(_)
|
|
; Uinstr = decr_sp_and_return(_)
|
|
)
|
|
;
|
|
Uinstr = livevals(LvalSet),
|
|
set.to_sorted_list(LvalSet, LvalList),
|
|
find_used_registers_lvals(LvalList, !Used)
|
|
;
|
|
Uinstr = block(_, _, Instrs),
|
|
find_used_registers(Instrs, !Used)
|
|
;
|
|
( Uinstr = assign(Lval, Rval)
|
|
; Uinstr = keep_assign(Lval, Rval)
|
|
),
|
|
find_used_registers_lval(Lval, !Used),
|
|
find_used_registers_rval(Rval, !Used)
|
|
;
|
|
Uinstr = incr_hp(Lval, _, _, Rval, _, _, MaybeRegionRval, MaybeReuse),
|
|
find_used_registers_lval(Lval, !Used),
|
|
find_used_registers_rval(Rval, !Used),
|
|
(
|
|
MaybeRegionRval = yes(RegionRval),
|
|
find_used_registers_rval(RegionRval, !Used)
|
|
;
|
|
MaybeRegionRval = no
|
|
),
|
|
(
|
|
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval),
|
|
find_used_registers_rval(ReuseRval, !Used),
|
|
(
|
|
MaybeFlagLval = yes(FlagLval),
|
|
find_used_registers_lval(FlagLval, !Used)
|
|
;
|
|
MaybeFlagLval = no
|
|
)
|
|
;
|
|
MaybeReuse = no_llds_reuse
|
|
)
|
|
;
|
|
Uinstr = region_fill_frame(_FillOp, _EmbeddedStackFrame,
|
|
IdRval, NumLval, AddrLval),
|
|
find_used_registers_rval(IdRval, !Used),
|
|
find_used_registers_lval(NumLval, !Used),
|
|
find_used_registers_lval(AddrLval, !Used)
|
|
;
|
|
Uinstr = region_set_fixed_slot(_SetOp, _EmbeddedStackFrame, ValueRval),
|
|
find_used_registers_rval(ValueRval, !Used)
|
|
;
|
|
Uinstr = foreign_proc_code(_, Components, _, _, _, _, _, _, _, _),
|
|
find_used_registers_components(Components, !Used)
|
|
;
|
|
( Uinstr = computed_goto(Rval, _)
|
|
; Uinstr = if_val(Rval, _)
|
|
; Uinstr = restore_hp(Rval)
|
|
; Uinstr = free_heap(Rval)
|
|
; Uinstr = reset_ticket(Rval, _Rsn)
|
|
; Uinstr = prune_tickets_to(Rval)
|
|
),
|
|
find_used_registers_rval(Rval, !Used)
|
|
;
|
|
( Uinstr = save_maxfr(Lval)
|
|
; Uinstr = restore_maxfr(Lval)
|
|
; Uinstr = mark_hp(Lval)
|
|
; Uinstr = store_ticket(Lval)
|
|
; Uinstr = mark_ticket_stack(Lval)
|
|
; Uinstr = init_sync_term(Lval, _, _)
|
|
; Uinstr = fork_new_child(Lval, _)
|
|
; Uinstr = join_and_continue(Lval, _)
|
|
),
|
|
find_used_registers_lval(Lval, !Used)
|
|
;
|
|
Uinstr = lc_create_loop_control(_, LCLval),
|
|
find_used_registers_lval(LCLval, !Used)
|
|
;
|
|
Uinstr = lc_wait_free_slot(LCRval, LCSLval, _),
|
|
find_used_registers_rval(LCRval, !Used),
|
|
find_used_registers_lval(LCSLval, !Used)
|
|
;
|
|
Uinstr = lc_spawn_off(LCRval, LCSRval, _),
|
|
find_used_registers_rval(LCRval, !Used),
|
|
find_used_registers_rval(LCSRval, !Used)
|
|
;
|
|
Uinstr = lc_join_and_terminate(LCRval, LCSRval),
|
|
find_used_registers_rval(LCRval, !Used),
|
|
find_used_registers_rval(LCSRval, !Used)
|
|
).
|
|
|
|
:- pred find_used_registers_components(
|
|
list(foreign_proc_component)::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_components([], !Used).
|
|
find_used_registers_components([Comp | Comps], !Used) :-
|
|
find_used_registers_component(Comp, !Used),
|
|
find_used_registers_components(Comps, !Used).
|
|
|
|
:- pred find_used_registers_component(foreign_proc_component::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_component(foreign_proc_inputs(In), !Used) :-
|
|
insert_foreign_proc_input_registers(In, !Used).
|
|
find_used_registers_component(foreign_proc_outputs(Out), !Used) :-
|
|
insert_foreign_proc_output_registers(Out, !Used).
|
|
find_used_registers_component(foreign_proc_user_code(_, _, _), !Used).
|
|
find_used_registers_component(foreign_proc_raw_code(_, _, _, _), !Used).
|
|
find_used_registers_component(foreign_proc_fail_to(_), !Used).
|
|
find_used_registers_component(foreign_proc_alloc_id(_), !Used).
|
|
find_used_registers_component(foreign_proc_noop, !Used).
|
|
|
|
:- pred find_used_registers_lvals(list(lval)::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_lvals([], !Used).
|
|
find_used_registers_lvals([Lval | Lvals], !Used) :-
|
|
find_used_registers_lval(Lval, !Used),
|
|
find_used_registers_lvals(Lvals, !Used).
|
|
|
|
:- pred find_used_registers_lval(lval::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_lval(Lval, !Used) :-
|
|
( if Lval = reg(reg_r, N) then
|
|
copy(N, N1),
|
|
set.insert(N1, !Used)
|
|
else if Lval = field(_, Rval, FieldNum) then
|
|
find_used_registers_rval(Rval, !Used),
|
|
find_used_registers_rval(FieldNum, !Used)
|
|
else if Lval = lvar(_) then
|
|
unexpected($pred, "lvar")
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred find_used_registers_rval(rval::in, set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_rval(Rval, !Used) :-
|
|
(
|
|
Rval = lval(Lval),
|
|
find_used_registers_lval(Lval, !Used)
|
|
;
|
|
Rval = var(_),
|
|
unexpected($pred, "var")
|
|
;
|
|
Rval = mkword_hole(_)
|
|
;
|
|
Rval = const(_)
|
|
;
|
|
( Rval = mkword(_, SubRval)
|
|
; Rval = cast(_, SubRval)
|
|
; Rval = unop(_, SubRval)
|
|
),
|
|
find_used_registers_rval(SubRval, !Used)
|
|
;
|
|
Rval = binop(_, SubRvalA, SubRvalB),
|
|
find_used_registers_rval(SubRvalA, !Used),
|
|
find_used_registers_rval(SubRvalB, !Used)
|
|
;
|
|
Rval = mem_addr(MemRef),
|
|
find_used_registers_mem_ref(MemRef, !Used)
|
|
).
|
|
|
|
:- pred find_used_registers_mem_ref(mem_ref::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
find_used_registers_mem_ref(stackvar_ref(Rval), !Used) :-
|
|
find_used_registers_rval(Rval, !Used).
|
|
find_used_registers_mem_ref(framevar_ref(Rval), !Used) :-
|
|
find_used_registers_rval(Rval, !Used).
|
|
find_used_registers_mem_ref(heap_ref(Rval1, _, Rval2), !Used) :-
|
|
find_used_registers_rval(Rval1, !Used),
|
|
find_used_registers_rval(Rval2, !Used).
|
|
|
|
:- pred insert_foreign_proc_input_registers(list(foreign_proc_input)::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
insert_foreign_proc_input_registers([], !Used).
|
|
insert_foreign_proc_input_registers([Input | Inputs], !Used) :-
|
|
Input = foreign_proc_input(_, _, _, _, Rval, _, _),
|
|
find_used_registers_rval(Rval, !Used),
|
|
insert_foreign_proc_input_registers(Inputs, !Used).
|
|
|
|
:- pred insert_foreign_proc_output_registers(list(foreign_proc_output)::in,
|
|
set(int)::in, set(int)::out) is det.
|
|
|
|
insert_foreign_proc_output_registers([], !Used).
|
|
insert_foreign_proc_output_registers([Output | Outputs], !Used) :-
|
|
Output = foreign_proc_output(Lval, _, _, _, _, _, _),
|
|
find_used_registers_lval(Lval, !Used),
|
|
insert_foreign_proc_output_registers(Outputs, !Used).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Find all the labels defined in an instruction sequence.
|
|
%
|
|
:- pred find_labels(list(instruction)::in, list(label)::out) is det.
|
|
|
|
find_labels(Instrs, Labels) :-
|
|
find_labels_acc(Instrs, [], Labels).
|
|
|
|
:- pred find_labels_acc(list(instruction)::in,
|
|
list(label)::in, list(label)::out) is det.
|
|
|
|
find_labels_acc([], !Labels).
|
|
find_labels_acc([Instr | Instrs], !Labels) :-
|
|
Instr = llds_instr(Uinstr, _),
|
|
( if Uinstr = label(Label) then
|
|
!:Labels = [Label | !.Labels]
|
|
else if Uinstr = block(_, _, Block) then
|
|
find_labels_acc(Block, !Labels)
|
|
else
|
|
true
|
|
),
|
|
find_labels_acc(Instrs, !Labels).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module ll_backend.middle_rec.
|
|
%---------------------------------------------------------------------------%
|
|
|