%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1995-2007, 2009-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: dupelim.m. % Author: zs. % % This module eliminate some duplicate code sequences. % % Our algorithm has the following stages. % % 1. Divide the code of the procedure into basic blocks. % % 2. For each block, compute a standard form, which is its most general % generalization. % % 3. Find out which sets of blocks have the same standard form. % % 4. For each set of blocks with the same standard form, find out % which blocks are not fallen into and can thus be eliminated, % and choose which blocks will be eliminated. % % 5. For each set of blocks with the same standard form, compute % their most specific common generalization (which must exist), % and substitute this code for the code of the copy of the block % that step 4 has decided to keep. % % 6. Convert the (possibly reduced) list of basic blocks back to a % list of instructions and substitute all references to the labels % starting eliminated blocks to refer to their noneliminated version. % % Generalizing an rval, lval or instruction involves replacing field references % with known tags with field references with unknown tags. Generalizing a block % involves generalizing its constituent instructions, removing comments, and % possibly adding a goto at the end to represent falling through to the next % label. In all other ways the original and the generalized version will be % identical. % %-----------------------------------------------------------------------------% :- module ll_backend.dupelim. :- interface. :- import_module ll_backend.llds. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module counter. :- import_module list. %-----------------------------------------------------------------------------% :- pred dupelim_main(proc_label::in, counter::in, counter::out, list(instruction)::in, list(instruction)::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module ll_backend.basic_block. :- import_module ll_backend.opt_util. :- import_module bool. :- import_module int. :- import_module map. :- import_module maybe. :- import_module require. :- import_module set. %-----------------------------------------------------------------------------% % A std_map maps a list of standardized instructions to the list % of labels whose basic blocks have that standardized form. % :- type std_map == map(list(instr), list(label)). % cluster(Exemplar, OtherLabels) means that references to labels % in OtherLabels can be replaced with references to Exemplar % once its block has been replaced with the most specific % generalization of the blocks started by Exemplar and OtherLabels. % OtherLabels must be nonempty. % :- type cluster ---> cluster(label, list(label)). dupelim_main(ProcLabel, !C, Instrs0, Instrs) :- create_basic_blocks(Instrs0, Comments, ProcLabel, !C, _NewLabels, LabelSeq0, BlockMap0), map.init(StdMap0), set.init(Fixed0), dupelim_build_maps(LabelSeq0, BlockMap0, StdMap0, StdMap, Fixed0, Fixed), map.values(StdMap, StdList), find_clusters(StdList, Fixed, [], Clusters), ( Clusters = [], % We don't want to introduce any incidental changes % if we cannot eliminate any blocks. Instrs = Instrs0 ; Clusters = [_ | _], map.init(ReplMap0), process_clusters(Clusters, LabelSeq0, LabelSeq, BlockMap0, BlockMap, ReplMap0, ReplMap), flatten_basic_blocks(LabelSeq, BlockMap, Instrs1, _), opt_util.replace_labels_instruction_list(Instrs1, Instrs2, ReplMap, yes, no), Instrs = Comments ++ Instrs2 ). %-----------------------------------------------------------------------------% % dupelim_build_maps builds up a map mapping standardized instruction % sequences to the label(s) that start basic blocks with that standardized % form, and a set showing which labels are fallen into. % :- pred dupelim_build_maps(list(label)::in, block_map::in, std_map::in, std_map::out, set(label)::in, set(label)::out) is det. dupelim_build_maps([], _, !StdMap, !Fixed). dupelim_build_maps([Label | Labels], BlockMap, !StdMap, !Fixed) :- map.lookup(BlockMap, Label, BlockInfo), BlockInfo = block_info(_, _, Instrs, NumInstrs, _, _, MaybeFallThrough), ( if NumInstrs < std_block_size_limit then standardize_instr_block(Instrs, MaybeFallThrough, StdInstrs), map.search_insert(StdInstrs, [Label], MaybeOldCluster, !StdMap), ( MaybeOldCluster = no ; MaybeOldCluster = yes(OldCluster), map.det_update(StdInstrs, [Label | OldCluster], !StdMap) ) else true ), ( MaybeFallThrough = yes(FallIntoLabel), set.insert(FallIntoLabel, !Fixed) ; MaybeFallThrough = no ), list.foldl(add_pragma_pref_labels, Instrs, !Fixed), dupelim_build_maps(Labels, BlockMap, !StdMap, !Fixed). % Don't try to standardize blocks that have more instructions than this. % They are extremely unlikely to be duplicate blocks, so the work would % be almost certainly wasted. % :- func std_block_size_limit = int. std_block_size_limit = 10. :- pred add_pragma_pref_labels(instruction::in, set(label)::in, set(label)::out) is det. add_pragma_pref_labels(Instr, !FoldFixed) :- Instr = llds_instr(Uinstr, _), ( if Uinstr = foreign_proc_code(_, _, _, MaybeFixedLabel, MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, MaybeDefLabel, _, _) then ( MaybeFixedLabel = yes(FixedLabel), set.insert(FixedLabel, !FoldFixed) ; MaybeFixedLabel = no ), ( MaybeLayoutLabel = yes(LayoutLabel), set.insert(LayoutLabel, !FoldFixed) ; MaybeLayoutLabel = no ), ( MaybeOnlyLayoutLabel = yes(OnlyLayoutLabel), set.insert(OnlyLayoutLabel, !FoldFixed) ; MaybeOnlyLayoutLabel = no ), ( MaybeDefLabel = yes(DefLabel), set.insert(DefLabel, !FoldFixed) ; MaybeDefLabel = no ) else true ). % For each set of labels that start basic blocks with identical standard % forms, find_clusters finds out whether we can eliminate some of those % blocks; if yes, it decides which blocks can be eliminated and which % other block should stand in their place. % % If two or more blocks have the same standardized form, it may be possible % to eliminate all but one of the blocks. However, blocks that can be % fallen into cannot be eliminated. (Actually, they could, but only by % inserting a goto, and full jumpopt would then undo the elimination of % the block.) Similarly, blocks whose starting label is referred to by C % code cannot be eliminated. (Actually, they could, but only by doing % surgery on C code strings, which is not a good idea.) % :- pred find_clusters(list(list(label))::in, set(label)::in, list(cluster)::in, list(cluster)::out) is det. find_clusters([], _, !Clusters). find_clusters([Labels | LabelsList], Fixed, !Clusters) :- ( if Labels = [_, _ | _], % The rest of the condition is relatively expensive, so don't do it % if there aren't at least two labels whose blocks have the same % standardized form. IsFallenInto = (pred(Label::in) is semidet :- set.member(Label, Fixed) ), list.filter(IsFallenInto, Labels, FixedLabels, NonFixedLabels), NonFixedLabels = [FirstNonFixed | OtherNonFixed] then ( FixedLabels = [ChosenLabel | _], Cluster = cluster(ChosenLabel, NonFixedLabels) ; FixedLabels = [], Cluster = cluster(FirstNonFixed, OtherNonFixed) ), !:Clusters = [Cluster | !.Clusters] else true ), find_clusters(LabelsList, Fixed, !Clusters). %-----------------------------------------------------------------------------% % For each cluster, a set of blocks in which all but one are to be % eliminated favor of the remaining one, find their most specific common % generalization (which must exist), and substitute this code for the code % of the copy of the block that is to be kept. Remove the eliminated labels % from the label sequence and map them to their replacements. % :- pred process_clusters(list(cluster)::in, list(label)::in, list(label)::out, block_map::in, block_map::out, map(label, label)::in, map(label, label)::out) is det. process_clusters([], !LabelSeq, !BlockMap, !ReplMap). process_clusters([Cluster | Clusters], !LabelSeq, !BlockMap, !ReplMap) :- Cluster = cluster(Exemplar, ElimLabels), map.lookup(!.BlockMap, Exemplar, ExemplarInfo0), ExemplarInfo0 = block_info(ExLabel, ExLabelInstr, ExInstrs0, ExNumInstrs, ExFallInto, ExSideLabels, ExMaybeFallThrough), expect(unify(Exemplar, ExLabel), $pred, "exemplar label mismatch"), process_elim_labels(ElimLabels, ExInstrs0, !LabelSeq, !.BlockMap, Exemplar, !ReplMap, UnifiedInstrs, ExMaybeFallThrough, UnifiedMaybeFallThrough), ExemplarInfo = block_info(ExLabel, ExLabelInstr, UnifiedInstrs, ExNumInstrs, ExFallInto, ExSideLabels, UnifiedMaybeFallThrough), map.det_update(Exemplar, ExemplarInfo, !BlockMap), process_clusters(Clusters, !LabelSeq, !BlockMap, !ReplMap). % Given the current form of a basic block (instructions and fallthrough), % compute its most specific generalization with the basic blocks headed % by the given labels, whose basic blocks are to be eliminated. % % On the same traversal of the list of to-be-eliminated labels, remove each % such label from the sequence of labels whose basic blocks will make up % the final code of the procedure, and add the mapping of the eliminated % label to the replacement (exemplar) label to the set of substitutions % that will need to be done. % :- pred process_elim_labels(list(label)::in, list(instruction)::in, list(label)::in, list(label)::out, block_map::in, label::in, map(label, label)::in, map(label, label)::out, list(instruction)::out, maybe(label)::in, maybe(label)::out) is det. process_elim_labels([], Instrs, !LabelSeq, _, _, !ReplMap, Instrs, !MaybeFallThrough). process_elim_labels([ElimLabel | ElimLabels], Instrs0, !LabelSeq, BlockMap, Exemplar, !ReplMap, Instrs, !MaybeFallThrough) :- map.lookup(BlockMap, ElimLabel, ElimLabelInfo), ElimLabelInfo = block_info(ElimLabel2, _, ElimInstrs, _NumElimInstrs, _, _, ElimMaybeFallThrough), expect(unify(ElimLabel, ElimLabel2), $pred, "elim label mismatch"), ( if most_specific_block(Instrs0, !.MaybeFallThrough, ElimInstrs, ElimMaybeFallThrough, Instrs1, !:MaybeFallThrough) then list.delete_all(!.LabelSeq, ElimLabel, !:LabelSeq), map.det_insert(ElimLabel, Exemplar, !ReplMap), process_elim_labels(ElimLabels, Instrs1, !LabelSeq, BlockMap, Exemplar, !ReplMap, Instrs, !MaybeFallThrough) else unexpected($pred, "blocks with same standard form don't antiunify") ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % The code of this section is concerned with computing the standard % form (most general generalization) of a sequence of instructions. % % If a block can fall through, we add a goto to the following label % at the end. This way, it will match with other blocks that have % identical (standardized) content except for an explicit goto to our % fallthrough label. % :- pred standardize_instr_block(list(instruction)::in, maybe(label)::in, list(instr)::out) is det. standardize_instr_block(Instrs0, MaybeFallThrough, Uinstrs) :- standardize_instrs(Instrs0, Uinstrs1), ( MaybeFallThrough = yes(Label), Goto = goto(code_label(Label)), Uinstrs = Uinstrs1 ++ [Goto] ; MaybeFallThrough = no, Uinstrs = Uinstrs1 ). % Compute the standard form of a sequence of instructions. % :- pred standardize_instrs(list(instruction)::in, list(instr)::out) is det. standardize_instrs([], []). standardize_instrs([llds_instr(Instr, _) | Instrs], StdInstrs) :- standardize_instrs(Instrs, StdInstrs1), standardize_instr(Instr, StdInstr), ( if StdInstr = comment(_) then StdInstrs = StdInstrs1 else StdInstrs = [StdInstr | StdInstrs1] ). % Compute the standard form of an instruction. % :- pred standardize_instr(instr::in, instr::out) is det. standardize_instr(Instr0, Instr) :- ( Instr0 = assign(Lval0, Rval0), standardize_lval(Lval0, Lval), standardize_rval(Rval0, Rval), Instr = assign(Lval, Rval) ; Instr0 = keep_assign(Lval0, Rval0), standardize_lval(Lval0, Lval), standardize_rval(Rval0, Rval), Instr = keep_assign(Lval, Rval) ; Instr0 = if_val(Rval0, CodeAddr), standardize_rval(Rval0, Rval), Instr = if_val(Rval, CodeAddr) ; Instr0 = save_maxfr(Lval0), standardize_lval(Lval0, Lval), Instr = save_maxfr(Lval) ; Instr0 = restore_maxfr(Lval0), standardize_lval(Lval0, Lval), Instr = restore_maxfr(Lval) ; Instr0 = incr_hp(Lval0, MaybeTag, MaybeOffset, Rval0, Msg, MayUseAtomic, MaybeRegionRval0, MaybeReuse0), standardize_lval(Lval0, Lval), standardize_rval(Rval0, Rval), ( MaybeRegionRval0 = yes(RegionRval0), standardize_rval(RegionRval0, RegionRval), MaybeRegionRval = yes(RegionRval) ; MaybeRegionRval0 = no, MaybeRegionRval = MaybeRegionRval0 ), ( MaybeReuse0 = llds_reuse(ReuseRval0, MaybeFlagLval0), standardize_rval(ReuseRval0, ReuseRval), ( MaybeFlagLval0 = yes(FlagLval0), standardize_lval(FlagLval0, FlagLval), MaybeFlagLval = yes(FlagLval) ; MaybeFlagLval0 = no, MaybeFlagLval = no ), MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval) ; MaybeReuse0 = no_llds_reuse, MaybeReuse = no_llds_reuse ), Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Msg, MayUseAtomic, MaybeRegionRval, MaybeReuse) ; Instr0 = mark_hp(Lval0), standardize_lval(Lval0, Lval), Instr = mark_hp(Lval) ; Instr0 = restore_hp(Rval0), standardize_rval(Rval0, Rval), Instr = restore_hp(Rval) ; Instr0 = region_fill_frame(FillOp, EmbeddedStackFrame, IdRval0, NumLval0, AddrLval0), standardize_rval(IdRval0, IdRval), standardize_lval(NumLval0, NumLval), standardize_lval(AddrLval0, AddrLval), Instr = region_fill_frame(FillOp, EmbeddedStackFrame, IdRval, NumLval, AddrLval) ; Instr0 = region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRval0), standardize_rval(ValueRval0, ValueRval), Instr = region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRval) ; Instr0 = free_heap(Rval0), standardize_rval(Rval0, Rval), Instr = free_heap(Rval) ; Instr0 = store_ticket(Lval0), standardize_lval(Lval0, Lval), Instr = store_ticket(Lval) ; Instr0 = reset_ticket(Rval0, Reason), standardize_rval(Rval0, Rval), Instr = reset_ticket(Rval, Reason) ; Instr0 = mark_ticket_stack(Lval0), standardize_lval(Lval0, Lval), Instr = mark_ticket_stack(Lval) ; Instr0 = prune_tickets_to(Rval0), standardize_rval(Rval0, Rval), Instr = prune_tickets_to(Rval) ; Instr0 = init_sync_term(Lval0, N, ConjId), standardize_lval(Lval0, Lval), Instr = init_sync_term(Lval, N, ConjId) ; Instr0 = join_and_continue(Lval0, Label), standardize_lval(Lval0, Lval), Instr = join_and_continue(Lval, Label) ; Instr0 = lc_create_loop_control(NumSlots, Lval0), standardize_lval(Lval0, Lval), Instr = lc_create_loop_control(NumSlots, Lval) ; Instr0 = lc_wait_free_slot(Rval0, Lval0, Label), standardize_rval(Rval0, Rval), standardize_lval(Lval0, Lval), Instr = lc_wait_free_slot(Rval, Lval, Label) ; Instr0 = lc_spawn_off(LCRval0, LCSRval0, Label), standardize_rval(LCRval0, LCRval), standardize_rval(LCSRval0, LCSRval), Instr = lc_spawn_off(LCRval, LCSRval, Label) ; Instr0 = lc_join_and_terminate(LCRval0, LCSRval0), standardize_rval(LCRval0, LCRval), standardize_rval(LCSRval0, LCSRval), Instr = lc_join_and_terminate(LCRval, LCSRval) ; ( Instr0 = comment(_) ; Instr0 = livevals(_) ; Instr0 = block(_, _, _) ; Instr0 = llcall(_, _, _, _, _, _) ; Instr0 = mkframe(_, _) ; Instr0 = label(_) ; Instr0 = goto(_) ; Instr0 = computed_goto(_, _) ; Instr0 = arbitrary_c_code(_, _, _) ; Instr0 = push_region_frame(_, _) ; Instr0 = use_and_maybe_pop_region_frame(_, _) ; Instr0 = discard_ticket ; Instr0 = prune_ticket ; Instr0 = incr_sp(_, _, _) ; Instr0 = decr_sp(_) ; Instr0 = decr_sp_and_return(_) ; Instr0 = fork_new_child(_, _) ; Instr0 = foreign_proc_code(_, _, _, _, _, _, _, _, _, _) ), Instr = Instr0 ). % Compute the standard form of an lval. % :- pred standardize_lval(lval::in, lval::out) is det. standardize_lval(Lval0, Lval) :- ( ( Lval0 = reg(_, _) ; Lval0 = succip ; Lval0 = maxfr ; Lval0 = curfr ; Lval0 = hp ; Lval0 = sp ; Lval0 = parent_sp ; Lval0 = temp(_, _) ; Lval0 = stackvar(_) ; Lval0 = parent_stackvar(_) ; Lval0 = framevar(_) ; Lval0 = double_stackvar(_, _) ; Lval0 = succip_slot(_) ; Lval0 = redoip_slot(_) ; Lval0 = succfr_slot(_) ; Lval0 = redofr_slot(_) ; Lval0 = prevfr_slot(_) ; Lval0 = mem_ref(_) ; Lval0 = global_var_ref(_) ), Lval = Lval0 ; Lval0 = field(_, Addr, FieldNum), Lval = field(no, Addr, FieldNum) ; Lval0 = lvar(_), unexpected($pred, "lvar") ). % Compute the standard form of an rval. % :- pred standardize_rval(rval::in, rval::out) is det. standardize_rval(Rval0, Rval) :- ( Rval0 = lval(Lval0), standardize_lval(Lval0, Lval), Rval = lval(Lval) ; ( Rval0 = mkword(_, _) ; Rval0 = mkword_hole(_) ; Rval0 = const(_) ; Rval0 = mem_addr(_) ), Rval = Rval0 ; Rval0 = cast(Type, Rval0L), standardize_rval(Rval0L, RvalL), Rval = cast(Type, RvalL) ; Rval0 = unop(Unop, Rval0L), standardize_rval(Rval0L, RvalL), Rval = unop(Unop, RvalL) ; Rval0 = binop(Binop, Rval0L, Rval0R), standardize_rval(Rval0L, RvalL), standardize_rval(Rval0R, RvalR), Rval = binop(Binop, RvalL, RvalR) ; Rval0 = var(_), unexpected($pred, "var") ). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % This predicate computes the most specific code sequence that % generalizes both input sequences. % % If a block can fall through, we add a goto to the following label % at the end. This way, it will match with other blocks that have % identical (standardized) content except for an explicit goto to our % fallthrough label. % :- pred standardize_block(list(instruction)::in, maybe(label)::in, list(instruction)::out) is det. standardize_block(Instrs, MaybeFallThrough, StdInstrs) :- ( MaybeFallThrough = yes(Label), ( if list.last(Instrs, LastInstr), LastInstr = llds_instr(goto(code_label(Label)), _) then StdInstrs = Instrs else Goto = llds_instr(goto(code_label(Label)), ""), StdInstrs = Instrs ++ [Goto] ) ; MaybeFallThrough = no, StdInstrs = Instrs ). :- pred most_specific_block(list(instruction)::in, maybe(label)::in, list(instruction)::in, maybe(label)::in, list(instruction)::out, maybe(label)::out) is semidet. most_specific_block(Instrs1, MaybeFallThrough1, Instrs2, MaybeFallThrough2, Instrs, MaybeFallThrough) :- standardize_block(Instrs1, MaybeFallThrough1, StdInstrs1), standardize_block(Instrs2, MaybeFallThrough2, StdInstrs2), most_specific_instrs(StdInstrs1, StdInstrs2, Instrs), % A basic block cannot be empty after standardization, since % standardization adds a goto to basic blocks that previously % had no executable instructions. While most_specific_instrs % can delete comments from its input instruction sequences, % it cannot delete executable instructions. list.det_last(Instrs, LastInstr), ( if LastInstr = llds_instr(goto(code_label(Label)), _) then MaybeFallThrough = yes(Label) else MaybeFallThrough = no ). :- pred most_specific_instrs(list(instruction)::in, list(instruction)::in, list(instruction)::out) is semidet. most_specific_instrs(InstrsA, InstrsB, Instrs) :- ( if InstrsA = [InstrA | TailA], InstrsB = [InstrB | TailB] then InstrA = llds_instr(UinstrA, CommentA), InstrB = llds_instr(UinstrB, CommentB), ( if most_specific_instr(UinstrA, UinstrB, yes(Uinstr)) then ( if CommentA = CommentB then Comment = CommentA else Comment = "unified intruction" ), Instr = llds_instr(Uinstr, Comment), most_specific_instrs(TailA, TailB, Tail), Instrs = [Instr | Tail] else if UinstrA = comment(_) then most_specific_instrs(TailA, InstrsB, Instrs) else if UinstrB = comment(_) then most_specific_instrs(InstrsA, TailB, Instrs) else fail ) else if InstrsA = [], InstrsB = [] then Instrs = [] else if InstrsA = [InstrA | TailA], InstrA = llds_instr(comment(_), _) then most_specific_instrs(TailA, InstrsB, Instrs) else if InstrsB = [InstrB | TailB], InstrB = llds_instr(comment(_), _) then most_specific_instrs(InstrsA, TailB, Instrs) else fail ). % This predicate computes the most specific instruction that % generalizes both input instructions. % :- pred most_specific_instr(instr::in, instr::in, maybe(instr)::out) is det. most_specific_instr(InstrA, InstrB, MaybeInstr) :- ( InstrA = assign(LvalA, RvalA), ( if InstrB = assign(LvalB, RvalB), most_specific_lval(LvalA, LvalB, Lval), most_specific_rval(RvalA, RvalB, Rval) then MaybeInstr = yes(assign(Lval, Rval)) else MaybeInstr = no ) ; InstrA = keep_assign(LvalA, RvalA), ( if InstrB = keep_assign(LvalB, RvalB), most_specific_lval(LvalA, LvalB, Lval), most_specific_rval(RvalA, RvalB, Rval) then MaybeInstr = yes(keep_assign(Lval, Rval)) else MaybeInstr = no ) ; InstrA = if_val(RvalA, CodeAddrA), ( if InstrB = if_val(RvalB, CodeAddrB), most_specific_rval(RvalA, RvalB, Rval), CodeAddrA = CodeAddrB then MaybeInstr = yes(if_val(Rval, CodeAddrA)) else MaybeInstr = no ) ; InstrA = incr_hp(LvalA, MaybeTag, MaybeOffset, RvalA, Msg, MayUseAtomic, MaybeRegionRvalA, MaybeReuseA), ( if InstrB = incr_hp(LvalB, MaybeTag, MaybeOffset, RvalB, Msg, MayUseAtomic, MaybeRegionRvalB, MaybeReuseB), most_specific_lval(LvalA, LvalB, Lval), most_specific_rval(RvalA, RvalB, Rval), ( MaybeRegionRvalA = yes(RegionRvalA), MaybeRegionRvalB = yes(RegionRvalB), most_specific_rval(RegionRvalA, RegionRvalB, RegionRval), MaybeRegionRval = yes(RegionRval) ; MaybeRegionRvalA = no, MaybeRegionRvalB = no, MaybeRegionRval = no ), ( MaybeReuseA = llds_reuse(ReuseRvalA, MaybeFlagLvalA), MaybeReuseB = llds_reuse(ReuseRvalB, MaybeFlagLvalB), most_specific_rval(ReuseRvalA, ReuseRvalB, ReuseRval), ( MaybeFlagLvalA = yes(FlagLvalA), MaybeFlagLvalB = yes(FlagLvalB), most_specific_lval(FlagLvalA, FlagLvalB, FlagLval), MaybeFlagLval = yes(FlagLval) ; MaybeFlagLvalA = no, MaybeFlagLvalB = no, MaybeFlagLval = no ), MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval) ; MaybeReuseA = no_llds_reuse, MaybeReuseB = no_llds_reuse, MaybeReuse = no_llds_reuse ) then MaybeInstr = yes(incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Msg, MayUseAtomic, MaybeRegionRval, MaybeReuse)) else MaybeInstr = no ) ; InstrA = mark_hp(LvalA), ( if InstrB = mark_hp(LvalB), most_specific_lval(LvalA, LvalB, Lval) then MaybeInstr = yes(mark_hp(Lval)) else MaybeInstr = no ) ; InstrA = restore_hp(RvalA), ( if InstrB = restore_hp(RvalB), most_specific_rval(RvalA, RvalB, Rval) then MaybeInstr = yes(restore_hp(Rval)) else MaybeInstr = no ) ; InstrA = free_heap(RvalA), ( if InstrB = free_heap(RvalB), most_specific_rval(RvalA, RvalB, Rval) then MaybeInstr = yes(free_heap(Rval)) else MaybeInstr = no ) ; InstrA = push_region_frame(StackId, EmbeddedStackFrame), ( if InstrB = push_region_frame(StackId, EmbeddedStackFrame) then MaybeInstr = yes(push_region_frame(StackId, EmbeddedStackFrame)) else MaybeInstr = no ) ; InstrA = region_fill_frame(FillOp, EmbeddedStackFrame, IdRvalA, NumLvalA, AddrLvalA), ( if InstrB = region_fill_frame(FillOp, EmbeddedStackFrame, IdRvalB, NumLvalB, AddrLvalB), most_specific_rval(IdRvalA, IdRvalB, IdRval), most_specific_lval(NumLvalA, NumLvalB, NumLval), most_specific_lval(AddrLvalA, AddrLvalB, AddrLval) then MaybeInstr = yes(region_fill_frame(FillOp, EmbeddedStackFrame, IdRval, NumLval, AddrLval)) else MaybeInstr = no ) ; InstrA = region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRvalA), ( if InstrB = region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRvalB), most_specific_rval(ValueRvalA, ValueRvalB, ValueRval) then MaybeInstr = yes(region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRval)) else MaybeInstr = no ) ; InstrA = use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame), ( if InstrB = use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame) then MaybeInstr = yes(use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame)) else MaybeInstr = no ) ; InstrA = store_ticket(LvalA), ( if InstrB = store_ticket(LvalB), most_specific_lval(LvalA, LvalB, Lval) then MaybeInstr = yes(store_ticket(Lval)) else MaybeInstr = no ) ; InstrA = reset_ticket(RvalA, Reason), ( if InstrB = reset_ticket(RvalB, Reason), most_specific_rval(RvalA, RvalB, Rval) then MaybeInstr = yes(reset_ticket(Rval, Reason)) else MaybeInstr = no ) ; InstrA = mark_ticket_stack(LvalA), ( if InstrB = mark_ticket_stack(LvalB), most_specific_lval(LvalA, LvalB, Lval) then MaybeInstr = yes(mark_ticket_stack(Lval)) else MaybeInstr = no ) ; InstrA = prune_tickets_to(RvalA), ( if InstrB = prune_tickets_to(RvalB), most_specific_rval(RvalA, RvalB, Rval) then MaybeInstr = yes(prune_tickets_to(Rval)) else MaybeInstr = no ) ; InstrA = lc_create_loop_control(NumSlots, LvalA), ( if InstrB = lc_create_loop_control(NumSlots, LvalB), most_specific_lval(LvalA, LvalB, Lval) then MaybeInstr = yes(lc_create_loop_control(NumSlots, Lval)) else MaybeInstr = no ) ; InstrA = lc_wait_free_slot(RvalA, LvalA, Label), ( if InstrB = lc_wait_free_slot(RvalB, LvalB, Label), most_specific_rval(RvalA, RvalB, Rval), most_specific_lval(LvalA, LvalB, Lval) then MaybeInstr = yes(lc_wait_free_slot(Rval, Lval, Label)) else MaybeInstr = no ) ; InstrA = lc_spawn_off(LCRvalA, LCSRvalA, Label), ( if InstrB = lc_spawn_off(LCRvalB, LCSRvalB, Label), most_specific_rval(LCRvalA, LCRvalB, LCRval), most_specific_rval(LCSRvalA, LCSRvalB, LCSRval) then MaybeInstr = yes(lc_spawn_off(LCRval, LCSRval, Label)) else MaybeInstr = no ) ; InstrA = lc_join_and_terminate(LCRvalA, LCSRvalA), ( if InstrB = lc_join_and_terminate(LCRvalB, LCSRvalB), most_specific_rval(LCRvalA, LCRvalB, LCRval), most_specific_rval(LCSRvalA, LCSRvalB, LCSRval) then MaybeInstr = yes(lc_join_and_terminate(LCRval, LCSRval)) else MaybeInstr = no ) ; ( InstrA = livevals(_) ; InstrA = block(_, _, _) ; InstrA = llcall(_, _, _, _, _, _) ; InstrA = mkframe(_, _) ; InstrA = label(_) ; InstrA = goto(_) ; InstrA = computed_goto(_, _) ; InstrA = arbitrary_c_code(_, _, _) ; InstrA = save_maxfr(_) ; InstrA = restore_maxfr(_) ; InstrA = discard_ticket ; InstrA = prune_ticket ; InstrA = incr_sp(_, _, _) ; InstrA = decr_sp(_) ; InstrA = decr_sp_and_return(_) ; InstrA = foreign_proc_code(_, _, _, _, _, _, _, _, _, _) ; InstrA = fork_new_child(_, _) ; InstrA = init_sync_term(_, _, _) ; InstrA = join_and_continue(_, _) ), ( if InstrA = InstrB then MaybeInstr = yes(InstrA) else MaybeInstr = no ) ; InstrA = comment(_), MaybeInstr = no ). % This predicate computes the most specific lval that % generalizes both input lvals. % :- pred most_specific_lval(lval::in, lval::in, lval::out) is semidet. most_specific_lval(LvalA, LvalB, Lval) :- ( ( LvalA = reg(_, _) ; LvalA = succip ; LvalA = maxfr ; LvalA = curfr ; LvalA = hp ; LvalA = sp ; LvalA = parent_sp ; LvalA = temp(_, _) ; LvalA = stackvar(_) ; LvalA = parent_stackvar(_) ; LvalA = framevar(_) ; LvalA = double_stackvar(_, _) ; LvalA = succip_slot(_) ; LvalA = redoip_slot(_) ; LvalA = redofr_slot(_) ; LvalA = succfr_slot(_) ; LvalA = prevfr_slot(_) ; LvalA = mem_ref(_) ; LvalA = global_var_ref(_) ), LvalA = LvalB, Lval = LvalA ; LvalA = field(MaybeTagA, Addr, FieldNum), LvalB = field(MaybeTagB, Addr, FieldNum), ( if MaybeTagA = MaybeTagB then MaybeTag = MaybeTagA else MaybeTag = no ), Lval = field(MaybeTag, Addr, FieldNum) ; LvalA = lvar(_), unexpected($pred, "lvar") ). % This predicate computes the most specific rval that % generalizes both input rvals. % :- pred most_specific_rval(rval::in, rval::in, rval::out) is semidet. most_specific_rval(RvalA, RvalB, Rval) :- require_complete_switch [RvalA] ( RvalA = lval(LvalA), RvalB = lval(LvalB), most_specific_lval(LvalA, LvalB, Lval), Rval = lval(Lval) ; RvalA = var(_), unexpected($pred, "var") ; ( RvalA = mkword(_, _) ; RvalA = mkword_hole(_) ; RvalA = const(_) ; RvalA = mem_addr(_) ), RvalB = RvalA, Rval = RvalA ; RvalA = cast(Type, RvalAL), RvalB = cast(Type, RvalBL), most_specific_rval(RvalAL, RvalBL, RvalL), Rval = cast(Type, RvalL) ; RvalA = unop(Unop, RvalAL), RvalB = unop(Unop, RvalBL), most_specific_rval(RvalAL, RvalBL, RvalL), Rval = unop(Unop, RvalL) ; RvalA = binop(Binnop, RvalAL, RvalAR), RvalB = binop(Binnop, RvalBL, RvalBR), most_specific_rval(RvalAL, RvalBL, RvalL), most_specific_rval(RvalAR, RvalBR, RvalR), Rval = binop(Binnop, RvalL, RvalR) ). %-----------------------------------------------------------------------------% :- end_module ll_backend.dupelim. %-----------------------------------------------------------------------------%