mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
446 lines
16 KiB
Mathematica
446 lines
16 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2007, 2009-2011 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: dupproc.m.
|
|
% Author: zs.
|
|
%
|
|
% The job of this module is to eliminate duplicate procedure bodies. These
|
|
% can arise when a predicate has several modes that differ only in details that
|
|
% don't matter for code generation, such as in/out vs di/uo, or (in some cases)
|
|
% in/out, vs any/any.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module ll_backend.dupproc.
|
|
:- interface.
|
|
|
|
:- import_module ll_backend.llds.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred eliminate_duplicate_procs(assoc_list(proc_label, c_procedure)::in,
|
|
list(c_procedure)::out,
|
|
map(proc_label, proc_label)::in, map(proc_label, proc_label)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module ll_backend.opt_util.
|
|
|
|
:- import_module int.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
eliminate_duplicate_procs(IdProcs, Procs, !DupProcMap) :-
|
|
(
|
|
IdProcs = [],
|
|
Procs = []
|
|
;
|
|
IdProcs = [_Id - Proc],
|
|
Procs = [Proc]
|
|
;
|
|
IdProcs = [Id1 - Proc1 | IdProcsTail],
|
|
IdProcsTail = [_ | _],
|
|
apply_dup_proc_map_in_proc(Proc1, StdProc1, !.DupProcMap),
|
|
eliminate_dup_procs([Id1 - StdProc1], IdProcsTail, FinalIdProcsTail,
|
|
!DupProcMap),
|
|
assoc_list.values(FinalIdProcsTail, FinalProcsTail),
|
|
Procs = [Proc1 | FinalProcsTail]
|
|
).
|
|
|
|
:- pred eliminate_dup_procs(assoc_list(proc_label, c_procedure)::in,
|
|
assoc_list(proc_label, c_procedure)::in,
|
|
assoc_list(proc_label, c_procedure)::out,
|
|
map(proc_label, proc_label)::in, map(proc_label, proc_label)::out) is det.
|
|
|
|
eliminate_dup_procs(_ModelStdProcs, [], [], !DupProcMap).
|
|
eliminate_dup_procs(ModelStdProcs0, [Id - Proc0 | IdProcs0],
|
|
[Id - Proc | IdProcs], !DupProcMap) :-
|
|
( if
|
|
Proc0 ^ cproc_may_alter_rtti = may_alter_rtti,
|
|
find_matching_model_proc(ModelStdProcs0, Id, Proc0, !.DupProcMap,
|
|
MatchingId),
|
|
maybe_redirect_proc(Proc0, MatchingId, MaybeProc),
|
|
MaybeProc = yes(ProcPrime)
|
|
then
|
|
Proc = ProcPrime,
|
|
map.det_insert(Id, MatchingId, !DupProcMap),
|
|
ModelStdProcs = ModelStdProcs0
|
|
else
|
|
Proc = Proc0,
|
|
apply_dup_proc_map_in_proc(Proc0, StdProc0, !.DupProcMap),
|
|
% Since the number of procedures per predicate is tiny,
|
|
% the quadratic behavior here is not a problem.
|
|
list.append(ModelStdProcs0, [Id - StdProc0], ModelStdProcs)
|
|
),
|
|
eliminate_dup_procs(ModelStdProcs, IdProcs0, IdProcs, !DupProcMap).
|
|
|
|
:- pred find_matching_model_proc(assoc_list(proc_label, c_procedure)::in,
|
|
proc_label::in, c_procedure::in, map(proc_label, proc_label)::in,
|
|
proc_label::out) is semidet.
|
|
|
|
find_matching_model_proc([ModelId - ModelStdProc | ModelIdProcs], Id, Proc,
|
|
DupProcMap, MatchingId) :-
|
|
map.det_insert(Id, ModelId, DupProcMap, AugDupProcMap),
|
|
apply_dup_proc_map_in_proc(Proc, StdProc, AugDupProcMap),
|
|
StdInstrs = StdProc ^ cproc_code,
|
|
ModelStdInstrs = ModelStdProc ^ cproc_code,
|
|
( if StdInstrs = ModelStdInstrs then
|
|
MatchingId = ModelId
|
|
else
|
|
find_matching_model_proc(ModelIdProcs, Id, Proc, DupProcMap,
|
|
MatchingId)
|
|
).
|
|
|
|
% If the body of the matching procedures is significant enough,
|
|
% redirect the current procedure body to jump to the start of the
|
|
% model procedure's body instead. On the other hand, if the body
|
|
% is just a few instructions with no jumps, then this redirection
|
|
% jump would be a greater time cost than the space cost of duplicating
|
|
% the procedure body, so in that case we avoid the transformation
|
|
% by not returning the new body.
|
|
%
|
|
:- pred maybe_redirect_proc(c_procedure::in, proc_label::in,
|
|
maybe(c_procedure)::out) is det.
|
|
|
|
maybe_redirect_proc(Proc0, TargetProcLabel, MaybeProc) :-
|
|
Instrs0 = Proc0 ^ cproc_code,
|
|
get_prologue(Instrs0, LabelInstr, _Comments, LaterInstrs),
|
|
TargetLabel = entry_label(entry_label_local, TargetProcLabel),
|
|
Redirect = llds_instr(goto(code_label(TargetLabel)),
|
|
"Redirect to procedure with identical body"),
|
|
list.filter(disallowed_instr, LaterInstrs, DisallowedInstrs),
|
|
list.length(LaterInstrs, NumLaterInstrs),
|
|
( if
|
|
DisallowedInstrs = [],
|
|
% The threshold here is a guess. I don't think the precise value
|
|
% has much effect, so I don't think it is worth making it configurable.
|
|
NumLaterInstrs < 6
|
|
then
|
|
MaybeProc = no
|
|
else
|
|
Instrs = [LabelInstr, Redirect],
|
|
Proc = Proc0 ^ cproc_code := Instrs,
|
|
MaybeProc = yes(Proc)
|
|
).
|
|
|
|
:- pred disallowed_instr(instruction::in) is semidet.
|
|
|
|
disallowed_instr(llds_instr(Instr, _)) :-
|
|
(
|
|
Instr = if_val(_, _)
|
|
;
|
|
Instr = llcall(_, _, _, _, _, _)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred apply_dup_proc_map_in_proc(c_procedure::in, c_procedure::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_proc(CProc, StdCProc, DupProcMap) :-
|
|
Instrs = CProc ^ cproc_code,
|
|
apply_dup_proc_map_in_instrs(Instrs, StdInstrs, DupProcMap),
|
|
StdCProc = CProc ^ cproc_code := StdInstrs.
|
|
|
|
:- pred apply_dup_proc_map_in_instrs(
|
|
list(instruction)::in, list(instruction)::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_instrs([], [], _).
|
|
apply_dup_proc_map_in_instrs([llds_instr(Instr, _) | Instrs],
|
|
[llds_instr(StdInstr, "") | StdInstrs], DupProcMap) :-
|
|
apply_dup_proc_map_in_instr(Instr, StdInstr, DupProcMap),
|
|
apply_dup_proc_map_in_instrs(Instrs, StdInstrs, DupProcMap).
|
|
|
|
:- pred apply_dup_proc_map_in_instr(instr::in, instr::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_instr(Instr, StdInstr, DupProcMap) :-
|
|
(
|
|
Instr = block(NumIntTemps, NumFloatTemps, Instrs),
|
|
apply_dup_proc_map_in_instrs(Instrs, StdInstrs, DupProcMap),
|
|
StdInstr = block(NumIntTemps, NumFloatTemps, StdInstrs)
|
|
;
|
|
Instr = assign(Lval, Rval),
|
|
apply_dup_proc_map_in_rval(Rval, StdRval, DupProcMap),
|
|
StdInstr = assign(Lval, StdRval)
|
|
;
|
|
Instr = keep_assign(Lval, Rval),
|
|
apply_dup_proc_map_in_rval(Rval, StdRval, DupProcMap),
|
|
StdInstr = keep_assign(Lval, StdRval)
|
|
;
|
|
Instr = llcall(Target, Cont, LiveInfo, Context, GoalPath, Model),
|
|
apply_dup_proc_map_in_code_addr(Target, StdTarget, DupProcMap),
|
|
apply_dup_proc_map_in_code_addr(Cont, StdCont, DupProcMap),
|
|
StdInstr = llcall(StdTarget, StdCont, LiveInfo, Context, GoalPath,
|
|
Model)
|
|
;
|
|
Instr = mkframe(FrameInfo, MaybeCodeAddr),
|
|
(
|
|
FrameInfo = temp_frame(_),
|
|
StdFrameInfo = FrameInfo
|
|
;
|
|
FrameInfo = ordinary_frame(_, NumSlots),
|
|
StdFrameInfo = ordinary_frame("", NumSlots)
|
|
),
|
|
apply_dup_proc_map_in_maybe_code_addr(MaybeCodeAddr, MaybeStdCodeAddr,
|
|
DupProcMap),
|
|
StdInstr = mkframe(StdFrameInfo, MaybeStdCodeAddr)
|
|
;
|
|
Instr = label(Label),
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap),
|
|
StdInstr = label(StdLabel)
|
|
;
|
|
Instr = goto(Target),
|
|
apply_dup_proc_map_in_code_addr(Target, StdTarget, DupProcMap),
|
|
StdInstr = goto(StdTarget)
|
|
;
|
|
Instr = computed_goto(Rval, Targets),
|
|
apply_dup_proc_map_in_maybe_labels(Targets, StdTargets, DupProcMap),
|
|
StdInstr = computed_goto(Rval, StdTargets)
|
|
;
|
|
Instr = if_val(Rval, Target),
|
|
apply_dup_proc_map_in_rval(Rval, StdRval, DupProcMap),
|
|
apply_dup_proc_map_in_code_addr(Target, StdTarget, DupProcMap),
|
|
StdInstr = if_val(StdRval, StdTarget)
|
|
;
|
|
Instr = incr_sp(NumSlots, _, Kind),
|
|
StdInstr = incr_sp(NumSlots, "", Kind)
|
|
;
|
|
Instr = fork_new_child(Lval, Child),
|
|
apply_dup_proc_map_in_label(Child, StdChild, DupProcMap),
|
|
StdInstr = fork_new_child(Lval, StdChild)
|
|
;
|
|
Instr = join_and_continue(Lval, Label),
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap),
|
|
StdInstr = join_and_continue(Lval, StdLabel)
|
|
;
|
|
% The labels occurring in foreign_proc_code instructions
|
|
% cannot be substituted.
|
|
Instr = foreign_proc_code(_, _, _, _, _, _, _, _, _, _),
|
|
StdInstr = Instr
|
|
;
|
|
Instr = lc_wait_free_slot(Rval, Lval, Label),
|
|
apply_dup_proc_map_in_rval(Rval, StdRval, DupProcMap),
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap),
|
|
StdInstr = lc_wait_free_slot(StdRval, Lval, StdLabel)
|
|
;
|
|
Instr = lc_spawn_off(LCRval, LCSRval, Label),
|
|
apply_dup_proc_map_in_rval(LCRval, StdLCRval, DupProcMap),
|
|
apply_dup_proc_map_in_rval(LCSRval, StdLCSRval, DupProcMap),
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap),
|
|
StdInstr = lc_spawn_off(StdLCRval, StdLCSRval, StdLabel)
|
|
;
|
|
Instr = lc_join_and_terminate(LCRval, LCSRval),
|
|
apply_dup_proc_map_in_rval(LCRval, StdLCRval, DupProcMap),
|
|
apply_dup_proc_map_in_rval(LCSRval, StdLCSRval, DupProcMap),
|
|
StdInstr = lc_join_and_terminate(StdLCRval, StdLCSRval)
|
|
;
|
|
% These instructions have no labels inside them, or anything else
|
|
% that can be standardized.
|
|
( Instr = comment(_)
|
|
; Instr = livevals(_)
|
|
; Instr = arbitrary_c_code(_, _, _)
|
|
; Instr = save_maxfr(_)
|
|
; Instr = restore_maxfr(_)
|
|
; Instr = incr_hp(_, _, _, _, _, _, _, _)
|
|
; Instr = mark_hp(_)
|
|
; Instr = restore_hp(_)
|
|
; Instr = free_heap(_)
|
|
; Instr = push_region_frame(_, _)
|
|
; Instr = region_fill_frame(_, _, _, _, _)
|
|
; Instr = region_set_fixed_slot(_, _, _)
|
|
; Instr = use_and_maybe_pop_region_frame(_, _)
|
|
; Instr = store_ticket(_)
|
|
; Instr = reset_ticket(_, _)
|
|
; Instr = discard_ticket
|
|
; Instr = prune_ticket
|
|
; Instr = mark_ticket_stack(_)
|
|
; Instr = prune_tickets_to(_)
|
|
; Instr = decr_sp(_)
|
|
; Instr = decr_sp_and_return(_)
|
|
; Instr = init_sync_term(_, _, _)
|
|
; Instr = lc_create_loop_control(_, _)
|
|
),
|
|
StdInstr = Instr
|
|
).
|
|
|
|
% Compute the standard form of a proc_label.
|
|
%
|
|
:- pred apply_dup_proc_map_in_proc_label(proc_label::in, proc_label::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_proc_label(ProcLabel, StdProcLabel, DupProcMap) :-
|
|
( if map.search(DupProcMap, ProcLabel, FoundProcLabel) then
|
|
StdProcLabel = FoundProcLabel
|
|
else
|
|
StdProcLabel = ProcLabel
|
|
).
|
|
|
|
% Compute the standard form of a label.
|
|
%
|
|
:- pred apply_dup_proc_map_in_label(label::in, label::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap) :-
|
|
(
|
|
Label = internal_label(Num, ProcLabel),
|
|
apply_dup_proc_map_in_proc_label(ProcLabel, StdProcLabel, DupProcMap),
|
|
StdLabel = internal_label(Num, StdProcLabel)
|
|
;
|
|
Label = entry_label(Type, ProcLabel),
|
|
apply_dup_proc_map_in_proc_label(ProcLabel, StdProcLabel, DupProcMap),
|
|
StdLabel = entry_label(Type, StdProcLabel)
|
|
).
|
|
|
|
% Compute the standard form of a list(label).
|
|
%
|
|
:- pred apply_dup_proc_map_in_maybe_labels(list(maybe(label))::in,
|
|
list(maybe(label))::out, map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_maybe_labels([], [], _DupProcMap).
|
|
apply_dup_proc_map_in_maybe_labels([MaybeLabel | MaybeLabels],
|
|
[StdMaybeLabel | StdMaybeLabels], DupProcMap) :-
|
|
(
|
|
MaybeLabel = yes(Label),
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap),
|
|
StdMaybeLabel = yes(StdLabel)
|
|
;
|
|
MaybeLabel = no,
|
|
StdMaybeLabel = no
|
|
),
|
|
apply_dup_proc_map_in_maybe_labels(MaybeLabels, StdMaybeLabels,
|
|
DupProcMap).
|
|
|
|
% Compute the standard form of a code_addr.
|
|
%
|
|
:- pred apply_dup_proc_map_in_code_addr(code_addr::in, code_addr::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_code_addr(CodeAddr, StdCodeAddr, DupProcMap) :-
|
|
(
|
|
CodeAddr = code_label(Label),
|
|
apply_dup_proc_map_in_label(Label, StdLabel, DupProcMap),
|
|
StdCodeAddr = code_label(StdLabel)
|
|
;
|
|
CodeAddr = code_imported_proc(ProcLabel),
|
|
apply_dup_proc_map_in_proc_label(ProcLabel, StdProcLabel, DupProcMap),
|
|
StdCodeAddr = code_imported_proc(StdProcLabel)
|
|
;
|
|
( CodeAddr = code_succip
|
|
; CodeAddr = do_succeed(_)
|
|
; CodeAddr = do_redo
|
|
; CodeAddr = do_fail
|
|
; CodeAddr = do_trace_redo_fail_shallow
|
|
; CodeAddr = do_trace_redo_fail_deep
|
|
; CodeAddr = do_call_closure(_)
|
|
; CodeAddr = do_call_class_method(_)
|
|
; CodeAddr = do_not_reached
|
|
),
|
|
StdCodeAddr = CodeAddr
|
|
).
|
|
|
|
% Compute the standard form of a maybe(code_addr).
|
|
%
|
|
:- pred apply_dup_proc_map_in_maybe_code_addr(maybe(code_addr)::in,
|
|
maybe(code_addr)::out, map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_maybe_code_addr(MaybeCodeAddr, MaybeStdCodeAddr,
|
|
DupProcMap) :-
|
|
(
|
|
MaybeCodeAddr = no,
|
|
MaybeStdCodeAddr = no
|
|
;
|
|
MaybeCodeAddr = yes(CodeAddr),
|
|
apply_dup_proc_map_in_code_addr(CodeAddr, StdCodeAddr, DupProcMap),
|
|
MaybeStdCodeAddr = yes(StdCodeAddr)
|
|
).
|
|
|
|
% Compute the standard form of an rval.
|
|
%
|
|
:- pred apply_dup_proc_map_in_rval(rval::in, rval::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_rval(Rval, StdRval, DupProcMap) :-
|
|
(
|
|
( Rval = lval(_)
|
|
; Rval = mkword(_, _)
|
|
; Rval = mkword_hole(_)
|
|
; Rval = mem_addr(_)
|
|
),
|
|
StdRval = Rval
|
|
;
|
|
Rval = var(_),
|
|
unexpected($pred, "var")
|
|
;
|
|
Rval = const(Const),
|
|
apply_dup_proc_map_in_rval_const(Const, StdConst, DupProcMap),
|
|
StdRval = const(StdConst)
|
|
;
|
|
Rval = cast(Type, RvalL),
|
|
apply_dup_proc_map_in_rval(RvalL, StdRvalL, DupProcMap),
|
|
StdRval = cast(Type, StdRvalL)
|
|
;
|
|
Rval = unop(Unop, RvalL),
|
|
apply_dup_proc_map_in_rval(RvalL, StdRvalL, DupProcMap),
|
|
StdRval = unop(Unop, StdRvalL)
|
|
;
|
|
Rval = binop(Binop, RvalL, RvalR),
|
|
apply_dup_proc_map_in_rval(RvalL, StdRvalL, DupProcMap),
|
|
apply_dup_proc_map_in_rval(RvalR, StdRvalR, DupProcMap),
|
|
StdRval = binop(Binop, StdRvalL, StdRvalR)
|
|
).
|
|
|
|
% Compute the standard form of an rval constant.
|
|
%
|
|
:- pred apply_dup_proc_map_in_rval_const(rval_const::in, rval_const::out,
|
|
map(proc_label, proc_label)::in) is det.
|
|
|
|
apply_dup_proc_map_in_rval_const(Const, StdConst, DupProcMap) :-
|
|
(
|
|
( Const = llconst_true
|
|
; Const = llconst_false
|
|
; Const = llconst_int(_)
|
|
; Const = llconst_uint(_)
|
|
; Const = llconst_int8(_)
|
|
; Const = llconst_uint8(_)
|
|
; Const = llconst_int16(_)
|
|
; Const = llconst_uint16(_)
|
|
; Const = llconst_int32(_)
|
|
; Const = llconst_uint32(_)
|
|
; Const = llconst_int64(_)
|
|
; Const = llconst_uint64(_)
|
|
; Const = llconst_foreign(_, _)
|
|
; Const = llconst_float(_)
|
|
; Const = llconst_string(_)
|
|
; Const = llconst_multi_string(_)
|
|
; Const = llconst_data_addr(_, _)
|
|
),
|
|
StdConst = Const
|
|
;
|
|
Const = llconst_code_addr(CodeAddr),
|
|
apply_dup_proc_map_in_code_addr(CodeAddr, StdCodeAddr, DupProcMap),
|
|
StdConst = llconst_code_addr(StdCodeAddr)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module ll_backend.dupproc.
|
|
%-----------------------------------------------------------------------------%
|