%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2001-2002, 2004-2008, 2010-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: canonical.m. % Authors: conway, zs. % % This module contains code for recursively merging sets of ProcDynamic and % CallSiteDynamic nodes. % %---------------------------------------------------------------------------% :- module canonical. :- interface. :- import_module profile. :- pred canonicalize_cliques(initial_deep::in, initial_deep::out) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module array_util. :- import_module callgraph. :- import_module measurements. :- import_module array. :- import_module bool. :- import_module int. :- import_module io. :- import_module list. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. %---------------------------------------------------------------------------% :- type merge_info ---> merge_info( merge_clique_members :: array(list(proc_dynamic_ptr)), merge_clique_index :: array(clique_ptr) ). :- type redirect ---> redirect( csd_redirect :: array(call_site_dynamic_ptr), % index: call_site_dynamic_ptr pd_redirect :: array(proc_dynamic_ptr) % index: proc_dynamic_ptr ). canonicalize_cliques(!InitDeep) :- MaxCSDs = array.max(!.InitDeep ^ init_call_site_dynamics), MaxPDs = array.max(!.InitDeep ^ init_proc_dynamics), NumCSDs = MaxCSDs + 1, NumPDs = MaxPDs + 1, find_cliques(!.InitDeep, CliqueList), make_clique_indexes(NumPDs, CliqueList, Cliques, CliqueIndex), MergeInfo = merge_info(Cliques, CliqueIndex), CSDRedirect0 = array.init(NumCSDs, call_site_dynamic_ptr(0)), PDRedirect0 = array.init(NumPDs, proc_dynamic_ptr(0)), Redirect0 = redirect(CSDRedirect0, PDRedirect0), merge_cliques(CliqueList, MergeInfo, !InitDeep, Redirect0, Redirect1), compact_dynamics(Redirect1, NumCSDs, NumPDs, !InitDeep). :- pred merge_cliques(list(list(proc_dynamic_ptr))::in, merge_info::in, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_cliques([], _, !InitDeep, !Redirect). merge_cliques([Clique | Cliques], MergeInfo, !InitDeep, !Redirect) :- merge_clique(Clique, MergeInfo, !InitDeep, !Redirect), merge_cliques(Cliques, MergeInfo, !InitDeep, !Redirect). :- pred merge_clique(list(proc_dynamic_ptr)::in, merge_info::in, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_clique(CliquePDs0, MergeInfo, !InitDeep, !Redirect) :- ( CliquePDs0 = [] ; CliquePDs0 = [_] ; CliquePDs0 = [_, _ | _], map.init(ProcMap0), list.foldl(cluster_pds_by_ps(!.InitDeep), CliquePDs0, ProcMap0, ProcMap1), map.values(ProcMap1, PDsList1), list.filter(two_or_more, PDsList1, ToMergePDsList1), ( ToMergePDsList1 = [_ | _], complete_clique(!.InitDeep, !.Redirect, ProcMap1, ProcMap, Clique), map.values(ProcMap, PDsList), list.filter(two_or_more, PDsList, ToMergePDsList), list.foldl2(merge_proc_dynamics_ignore_chosen(MergeInfo, Clique), ToMergePDsList, !InitDeep, !Redirect) ; ToMergePDsList1 = [] ) ). :- pred insert_pds(list(T)::in, set(T)::in, set(T)::out) is det. insert_pds(List, !Set) :- set.insert_list(List, !Set). % find set of proc_statics in the CliquePDs % for all (first order) calls in CliquePDs, if call is to a procedure % that CliquePDs contains a call to, add its PD to the set % :- pred complete_clique(initial_deep::in, redirect::in, map(proc_static_ptr, list(proc_dynamic_ptr))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::out, set(proc_dynamic_ptr)::out) is det. complete_clique(InitDeep, Redirect, !ProcMap, Clique) :- map.values(!.ProcMap, PDsList0), list.foldl(insert_pds, PDsList0, set.init, Clique0), complete_clique_pass(InitDeep, Redirect, Clique0, !ProcMap, no, AddedPD), ( AddedPD = yes, disable_warning [suspicious_recursion] ( complete_clique(InitDeep, Redirect, !ProcMap, Clique) ) ; AddedPD = no, Clique = Clique0 ). :- pred complete_clique_pass(initial_deep::in, redirect::in, set(proc_dynamic_ptr)::in, map(proc_static_ptr, list(proc_dynamic_ptr))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::out, bool::in, bool::out) is det. complete_clique_pass(InitDeep, _Redirect, Clique, !ProcMap, !AddedPD) :- map.to_assoc_list(!.ProcMap, PSPDs0), list.foldl2(complete_clique_ps(InitDeep, Clique), PSPDs0, !ProcMap, !AddedPD). :- pred complete_clique_ps(initial_deep::in, set(proc_dynamic_ptr)::in, pair(proc_static_ptr, list(proc_dynamic_ptr))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::out, bool::in, bool::out) is det. complete_clique_ps(InitDeep, Clique, PSPtr - PDPtrs, !ProcMap, !AddedPD) :- ( if PDPtrs = [_, _ | _] then lookup_proc_statics(InitDeep ^ init_proc_statics, PSPtr, PS), list.map(lookup_pd_site(InitDeep), PDPtrs, PDSites), complete_clique_slots(array.max(PS ^ ps_sites), InitDeep, Clique, PS ^ ps_sites, PDSites, !ProcMap, !AddedPD) else true ). :- pred lookup_pd_site(initial_deep::in, proc_dynamic_ptr::in, array(call_site_array_slot)::out) is det. lookup_pd_site(InitDeep, PDPtr, Sites) :- lookup_proc_dynamics(InitDeep ^ init_proc_dynamics, PDPtr, PD), Sites = PD ^ pd_sites. :- pred complete_clique_slots(int::in, initial_deep::in, set(proc_dynamic_ptr)::in, array(call_site_static_ptr)::in, list(array(call_site_array_slot))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::out, bool::in, bool::out) is det. complete_clique_slots(SlotNum, InitDeep, Clique, PSSites, PDSites, !ProcMap, !AddedPD) :- ( if SlotNum >= 0 then array.lookup(PSSites, SlotNum, CSSPtr), lookup_call_site_statics(InitDeep ^ init_call_site_statics, CSSPtr, CSS), ( if CSS ^ css_kind = normal_call_and_callee(_, _) then lookup_normal_sites(PDSites, SlotNum, CSDPtrs) else lookup_multi_sites(PDSites, SlotNum, CSDPtrLists), list.condense(CSDPtrLists, CSDPtrs) ), list.filter(valid_call_site_dynamic_ptr_raw( InitDeep ^ init_call_site_dynamics), CSDPtrs, ValidCSDPtrs), list.map(extract_csdptr_callee(InitDeep), ValidCSDPtrs, CalleePDPtrs), CalleePDPtrSet = set.list_to_set(CalleePDPtrs), set.intersect(CalleePDPtrSet, Clique, Common), ( if set.is_empty(Common) then true else set.difference(CalleePDPtrSet, Clique, NewMembers), ( if set.is_empty(NewMembers) then !:AddedPD = no else set.to_sorted_list(NewMembers, NewMemberList), list.foldl(cluster_pds_by_ps(InitDeep), NewMemberList, !ProcMap), !:AddedPD = yes ) ), complete_clique_slots(SlotNum - 1, InitDeep, Clique, PSSites, PDSites, !ProcMap, !AddedPD) else true ). :- pred merge_proc_dynamics_ignore_chosen(merge_info::in, set(proc_dynamic_ptr)::in, list(proc_dynamic_ptr)::in, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_proc_dynamics_ignore_chosen(MergeInfo, Clique, CandidatePDPtrs, !InitDeep, !Redirect) :- merge_proc_dynamics(MergeInfo, Clique, CandidatePDPtrs, _ChosenPDPtr, !InitDeep, !Redirect). :- pred merge_proc_dynamics(merge_info::in, set(proc_dynamic_ptr)::in, list(proc_dynamic_ptr)::in, proc_dynamic_ptr::out, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_proc_dynamics(MergeInfo, Clique, CandidatePDPtrs, ChosenPDPtr, !InitDeep, !Redirect) :- ProcDynamics0 = !.InitDeep ^ init_proc_dynamics, list.filter(valid_proc_dynamic_ptr_raw(ProcDynamics0), CandidatePDPtrs, ValidPDPtrs, InvalidPDPtrs), require(unify(InvalidPDPtrs, []), "merge_proc_dynamics: invalid pdptrs"), ( ValidPDPtrs = [PrimePDPtr | RestPDPtrs], record_pd_redirect(RestPDPtrs, PrimePDPtr, !Redirect), lookup_proc_dynamics(ProcDynamics0, PrimePDPtr, PrimePD0), list.map(lookup_proc_dynamics(ProcDynamics0), RestPDPtrs, RestPDs), list.map(extract_pd_sites, RestPDs, RestSites), PrimeSites0 = PrimePD0 ^ pd_sites, array.max(PrimeSites0, MaxSiteNum), merge_proc_dynamic_slots(MergeInfo, MaxSiteNum, Clique, PrimePDPtr, u(PrimeSites0), RestSites, PrimeSites, !InitDeep, !Redirect), PrimePD = PrimePD0 ^ pd_sites := PrimeSites, ProcDynamics1 = !.InitDeep ^ init_proc_dynamics, update_proc_dynamics(PrimePDPtr, PrimePD, u(ProcDynamics1), ProcDynamics), !InitDeep ^ init_proc_dynamics := ProcDynamics, ChosenPDPtr = PrimePDPtr ; ValidPDPtrs = [], % This could happen when merging the callees of CSDs representing % special calls, but only before we added callcode to the % unify/compare routines of builtin types. % ChosenPDPtr = proc_dynamic_ptr(0), unexpected($pred, "no valid pdptrs") ). :- pred merge_proc_dynamic_slots(merge_info::in, int::in, set(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, array(call_site_array_slot)::array_di, list(array(call_site_array_slot))::in, array(call_site_array_slot)::array_uo, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_proc_dynamic_slots(MergeInfo, SlotNum, Clique, PrimePDPtr, !.PrimeSiteArray, RestSiteArrays, !:PrimeSiteArray, !InitDeep, !Redirect) :- ( if SlotNum >= 0 then array.lookup(!.PrimeSiteArray, SlotNum, PrimeSite0), ( PrimeSite0 = slot_normal(PrimeCSDPtr0), merge_proc_dynamic_normal_slot(MergeInfo, SlotNum, Clique, PrimePDPtr, PrimeCSDPtr0, RestSiteArrays, PrimeCSDPtr, !InitDeep, !Redirect), array.set(SlotNum, slot_normal(PrimeCSDPtr), !PrimeSiteArray) ; PrimeSite0 = slot_multi(IsZeroed, PrimeCSDPtrArray0), array.to_list(PrimeCSDPtrArray0, PrimeCSDPtrList0), merge_proc_dynamic_multi_slot(MergeInfo, SlotNum, Clique, PrimePDPtr, PrimeCSDPtrList0, RestSiteArrays, PrimeCSDPtrList, !InitDeep, !Redirect), PrimeCSDPtrArray = array(PrimeCSDPtrList), array.set(SlotNum, slot_multi(IsZeroed, PrimeCSDPtrArray), !PrimeSiteArray) ), merge_proc_dynamic_slots(MergeInfo, SlotNum - 1, Clique, PrimePDPtr, !.PrimeSiteArray, RestSiteArrays, !:PrimeSiteArray, !InitDeep, !Redirect) else true ). :- pred merge_proc_dynamic_normal_slot(merge_info::in, int::in, set(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, call_site_dynamic_ptr::in, list(array(call_site_array_slot))::in, call_site_dynamic_ptr::out, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_proc_dynamic_normal_slot(MergeInfo, SlotNum, Clique, PrimePDPtr, PrimeCSDPtr0, RestSiteArrays, PrimeCSDPtr, !InitDeep, !Redirect) :- lookup_normal_sites(RestSiteArrays, SlotNum, RestCSDPtrs), merge_call_site_dynamics(MergeInfo, Clique, PrimePDPtr, [PrimeCSDPtr0 | RestCSDPtrs], PrimeCSDPtr, !InitDeep, !Redirect). :- pred accumulate_csd_owns(call_site_dynamic::in, own_prof_info::in, own_prof_info::out) is det. accumulate_csd_owns(CSD, Own0, Own) :- Own = add_own_to_own(Own0, CSD ^ csd_own_prof). :- pred callee_in_clique(initial_deep::in, set(proc_dynamic_ptr)::in, call_site_dynamic_ptr::in) is semidet. callee_in_clique(InitDeep, Clique, CSDPtr) :- lookup_call_site_dynamics(InitDeep ^ init_call_site_dynamics, CSDPtr, CSD), CalleePDPtr = CSD ^ csd_callee, set.member(CalleePDPtr, Clique). :- pred merge_proc_dynamic_multi_slot(merge_info::in, int::in, set(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, list(call_site_dynamic_ptr)::in, list(array(call_site_array_slot))::in, list(call_site_dynamic_ptr)::out, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_proc_dynamic_multi_slot(MergeInfo, SlotNum, Clique, ParentPDPtr, PrimeCSDPtrs0, RestSiteArrays, PrimeCSDPtrs, !InitDeep, !Redirect) :- lookup_multi_sites(RestSiteArrays, SlotNum, RestCSDPtrLists), list.condense([PrimeCSDPtrs0 | RestCSDPtrLists], AllCSDPtrs), map.init(ProcMap0), list.foldl(cluster_csds_by_ps(!.InitDeep), AllCSDPtrs, ProcMap0, ProcMap), map.values(ProcMap, CSDPtrsClusters), list.foldl3(merge_multi_slot_cluster(MergeInfo, ParentPDPtr, Clique), CSDPtrsClusters, [], PrimeCSDPtrs, !InitDeep, !Redirect). :- pred merge_multi_slot_cluster(merge_info::in, proc_dynamic_ptr::in, set(proc_dynamic_ptr)::in, list(call_site_dynamic_ptr)::in, list(call_site_dynamic_ptr)::in, list(call_site_dynamic_ptr)::out, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_multi_slot_cluster(MergeInfo, ParentPDPtr, Clique, ClusterCSDPtrs, PrimeCSDPtrs0, PrimeCSDPtrs, InitDeep0, InitDeep, Redirect0, Redirect) :- merge_call_site_dynamics(MergeInfo, Clique, ParentPDPtr, ClusterCSDPtrs, PrimeCSDPtr, InitDeep0, InitDeep, Redirect0, Redirect), PrimeCSDPtrs = [PrimeCSDPtr | PrimeCSDPtrs0]. :- pred merge_call_site_dynamics(merge_info::in, set(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, list(call_site_dynamic_ptr)::in, call_site_dynamic_ptr::out, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_call_site_dynamics(MergeInfo, Clique, ParentPDPtr, CandidateCSDPtrs, ChosenCSDPtr, !InitDeep, !Redirect) :- CallSiteDynamics0 = !.InitDeep ^ init_call_site_dynamics, list.filter(valid_call_site_dynamic_ptr_raw(CallSiteDynamics0), CandidateCSDPtrs, ValidCSDPtrs), ( ValidCSDPtrs = [], % This signifies that there is no call here. ChosenCSDPtr = call_site_dynamic_ptr(0) ; ValidCSDPtrs = [FirstCSDPtr | LaterCSDPtrs], lookup_call_site_dynamics(CallSiteDynamics0, FirstCSDPtr, FirstCSD0), FirstCSD = FirstCSD0 ^ csd_caller := ParentPDPtr, update_call_site_dynamics(FirstCSDPtr, FirstCSD, u(CallSiteDynamics0), CallSiteDynamics), !InitDeep ^ init_call_site_dynamics := CallSiteDynamics, ( LaterCSDPtrs = [] ; LaterCSDPtrs = [_ | _], merge_call_site_dynamics_2(MergeInfo, Clique, FirstCSDPtr, LaterCSDPtrs, !InitDeep, !Redirect) ), ChosenCSDPtr = FirstCSDPtr ). :- pred merge_call_site_dynamics_2(merge_info::in, set(proc_dynamic_ptr)::in, call_site_dynamic_ptr::in, list(call_site_dynamic_ptr)::in, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_call_site_dynamics_2(MergeInfo, Clique, PrimeCSDPtr, RestCSDPtrs, InitDeep0, InitDeep, Redirect0, Redirect) :- % We must check whether PrimeCSDPtr and RestCSDPtrs are in Clique % *before* we update the proc_dynamics array in InitDeep0, which is % destructive updated to create InitDeep1. list.filter(callee_in_clique(InitDeep0, Clique), RestCSDPtrs, InClique, NotInClique), % XXX design error: should take union of cliques % i.e. if call is within clique in *any* caller, it should be within % clique in the final configuration ( if callee_in_clique(InitDeep0, Clique, PrimeCSDPtr) then require(unify(NotInClique, []), "merge_proc_dynamic_normal_slot: prime in clique, " ++ "others not in clique"), MergeChildren = no else require(unify(InClique, []), "merge_proc_dynamic_normal_slot: prime not in clique, " ++ "others in clique"), MergeChildren = yes ), record_csd_redirect(RestCSDPtrs, PrimeCSDPtr, Redirect0, Redirect1), CallSiteDynamics0 = InitDeep0 ^ init_call_site_dynamics, lookup_call_site_dynamics(CallSiteDynamics0, PrimeCSDPtr, PrimeCSD0), list.map(lookup_call_site_dynamics(CallSiteDynamics0), RestCSDPtrs, RestCSDs), PrimeOwn0 = PrimeCSD0 ^ csd_own_prof, list.foldl(accumulate_csd_owns, RestCSDs, PrimeOwn0, PrimeOwn1), PrimeCSD1 = PrimeCSD0 ^ csd_own_prof := PrimeOwn1, update_call_site_dynamics(PrimeCSDPtr, PrimeCSD1, u(CallSiteDynamics0), CallSiteDynamics1), InitDeep1 = InitDeep0 ^ init_call_site_dynamics := CallSiteDynamics1, ( MergeChildren = no, InitDeep = InitDeep1, Redirect = Redirect1 ; MergeChildren = yes, merge_call_site_dynamics_descendants(MergeInfo, PrimeCSDPtr, RestCSDPtrs, ChosenPDPtr, InitDeep1, InitDeep2, Redirect1, Redirect), % We must ensure that PrimeCSDPtr ^ csd_callee is updated to reflect % the chosen merged ProcDynamic. CallSiteDynamics2 = InitDeep2 ^ init_call_site_dynamics, lookup_call_site_dynamics(CallSiteDynamics2, PrimeCSDPtr, PrimeCSD2), PrimeCSD = PrimeCSD2 ^ csd_callee := ChosenPDPtr, update_call_site_dynamics(PrimeCSDPtr, PrimeCSD, u(CallSiteDynamics2), CallSiteDynamics), InitDeep = InitDeep2 ^ init_call_site_dynamics := CallSiteDynamics ). :- pred merge_call_site_dynamics_descendants(merge_info::in, call_site_dynamic_ptr::in, list(call_site_dynamic_ptr)::in, proc_dynamic_ptr::out, initial_deep::in, initial_deep::out, redirect::in, redirect::out) is det. merge_call_site_dynamics_descendants(MergeInfo, PrimeCSDPtr, RestCSDPtrs, ChosenPDPtr, !InitDeep, !Redirect) :- CallSiteDynamics = !.InitDeep ^ init_call_site_dynamics, lookup_call_site_dynamics(CallSiteDynamics, PrimeCSDPtr, PrimeCSD), extract_csd_callee(PrimeCSD, PrimeCSDCallee), list.map(lookup_call_site_dynamics(CallSiteDynamics), RestCSDPtrs, RestCSDs), list.map(extract_csd_callee, RestCSDs, RestCSDCallees), PDPtrs = [PrimeCSDCallee | RestCSDCallees], list.foldl(union_cliques(MergeInfo), PDPtrs, set.init, CliqueUnion), merge_proc_dynamics(MergeInfo, CliqueUnion, PDPtrs, ChosenPDPtr, !InitDeep, !Redirect). :- pred union_cliques(merge_info::in, proc_dynamic_ptr::in, set(proc_dynamic_ptr)::in, set(proc_dynamic_ptr)::out) is det. union_cliques(MergeInfo, PDPtr, !CliqueUnion) :- ( if PDPtr = proc_dynamic_ptr(0) then % This can happen with calls to the unify/compare preds of builtin % types. true else lookup_clique_index(MergeInfo ^ merge_clique_index, PDPtr, CliquePtr), lookup_clique_members(MergeInfo ^ merge_clique_members, CliquePtr, Members), set.insert_list(Members, !CliqueUnion) ). :- pred lookup_normal_sites(list(array(call_site_array_slot))::in, int::in, list(call_site_dynamic_ptr)::out) is det. lookup_normal_sites([], _, []). lookup_normal_sites([RestArray | RestArrays], SlotNum, [CSDPtr | CSDPtrs]) :- array.lookup(RestArray, SlotNum, Slot), ( Slot = slot_normal(CSDPtr) ; Slot = slot_multi(_, _), unexpected($pred, "found slot_multi") ), lookup_normal_sites(RestArrays, SlotNum, CSDPtrs). :- pred lookup_multi_sites(list(array(call_site_array_slot))::in, int::in, list(list(call_site_dynamic_ptr))::out) is det. lookup_multi_sites([], _, []). lookup_multi_sites([RestArray | RestArrays], SlotNum, [CSDList | CSDLists]) :- array.lookup(RestArray, SlotNum, Slot), ( Slot = slot_normal(_), unexpected($pred, "found normal") ; Slot = slot_multi(_, CSDArray), array.to_list(CSDArray, CSDList) ), lookup_multi_sites(RestArrays, SlotNum, CSDLists). :- pred record_pd_redirect(list(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, redirect::in, redirect::out) is det. record_pd_redirect(RestPDPtrs, PrimePDPtr, !Redirect) :- trace [compiletime(flag("pd_redirect")), io(!IO)] ( io.output_stream(OutputStream, !IO), io.write_string(OutputStream, "pd redirect: ", !IO), io.print(OutputStream, RestPDPtrs, !IO), io.write_string(OutputStream, " -> ", !IO), io.print(OutputStream, PrimePDPtr, !IO), io.nl(OutputStream, !IO) ), lookup_pd_redirect(!.Redirect ^ pd_redirect, PrimePDPtr, OldRedirect), ( if OldRedirect = proc_dynamic_ptr(0) then record_pd_redirect_2(RestPDPtrs, PrimePDPtr, !Redirect) else unexpected($pred, "prime is redirected") ). :- pred record_pd_redirect_2(list(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, redirect::in, redirect::out) is det. record_pd_redirect_2([], _, !Redirect). record_pd_redirect_2([RestPDPtr | RestPDPtrs], PrimePDPtr, !Redirect) :- ProcRedirect0 = !.Redirect ^ pd_redirect, lookup_pd_redirect(ProcRedirect0, RestPDPtr, OldRedirect), ( if OldRedirect = proc_dynamic_ptr(0) then set_pd_redirect(u(ProcRedirect0), RestPDPtr, PrimePDPtr, ProcRedirect) else unexpected($pred, "already redirected") ), !Redirect ^ pd_redirect := ProcRedirect, record_pd_redirect_2(RestPDPtrs, PrimePDPtr, !Redirect). :- pred record_csd_redirect(list(call_site_dynamic_ptr)::in, call_site_dynamic_ptr::in, redirect::in, redirect::out) is det. record_csd_redirect(RestCSDPtrs, PrimeCSDPtr, !Redirect) :- trace [compiletime(flag("csd_redirect")), io(!IO)] ( io.output_stream(OutputStream, !IO), io.write_string(OutputStream, "csd redirect: ", !IO), io.print(OutputStream, RestCSDPtrs, !IO), io.write_string(OutputStream, " -> ", !IO), io.print(OutputStream, PrimeCSDPtr, !IO), io.nl(OutputStream, !IO) ), lookup_csd_redirect(!.Redirect ^ csd_redirect, PrimeCSDPtr, OldRedirect), ( if OldRedirect = call_site_dynamic_ptr(0) then record_csd_redirect_2(RestCSDPtrs, PrimeCSDPtr, !Redirect) else unexpected($pred, "prime is redirected") ). :- pred record_csd_redirect_2(list(call_site_dynamic_ptr)::in, call_site_dynamic_ptr::in, redirect::in, redirect::out) is det. record_csd_redirect_2([], _, !Redirect). record_csd_redirect_2([RestCSDPtr | RestCSDPtrs], PrimeCSDPtr, !Redirect) :- CallSiteRedirect0 = !.Redirect ^ csd_redirect, lookup_csd_redirect(CallSiteRedirect0, RestCSDPtr, OldRedirect), ( if OldRedirect = call_site_dynamic_ptr(0) then set_csd_redirect(u(CallSiteRedirect0), RestCSDPtr, PrimeCSDPtr, CallSiteRedirect) else unexpected($pred, "already redirected") ), !Redirect ^ csd_redirect := CallSiteRedirect, record_csd_redirect_2(RestCSDPtrs, PrimeCSDPtr, !Redirect). :- pred two_or_more(list(proc_dynamic_ptr)::in) is semidet. two_or_more([_, _ | _]). :- pred cluster_pds_by_ps(initial_deep::in, proc_dynamic_ptr::in, map(proc_static_ptr, list(proc_dynamic_ptr))::in, map(proc_static_ptr, list(proc_dynamic_ptr))::out) is det. cluster_pds_by_ps(InitDeep, PDPtr, !ProcMap) :- ProcDynamics = InitDeep ^ init_proc_dynamics, ( if valid_proc_dynamic_ptr_raw(ProcDynamics, PDPtr) then lookup_proc_dynamics(ProcDynamics, PDPtr, PD), PSPtr = PD ^ pd_proc_static, ( if map.search(!.ProcMap, PSPtr, PDPtrs0) then map.det_update(PSPtr, [PDPtr | PDPtrs0], !ProcMap) else map.det_insert(PSPtr, [PDPtr], !ProcMap) ) else true ). :- pred cluster_csds_by_ps(initial_deep::in, call_site_dynamic_ptr::in, map(proc_static_ptr, list(call_site_dynamic_ptr))::in, map(proc_static_ptr, list(call_site_dynamic_ptr))::out) is det. cluster_csds_by_ps(InitDeep, CSDPtr, !ProcMap) :- CallSiteDynamics = InitDeep ^ init_call_site_dynamics, ( if valid_call_site_dynamic_ptr_raw(CallSiteDynamics, CSDPtr) then lookup_call_site_dynamics(CallSiteDynamics, CSDPtr, CSD), PDPtr = CSD ^ csd_callee, ProcDynamics = InitDeep ^ init_proc_dynamics, ( if valid_proc_dynamic_ptr_raw(ProcDynamics, PDPtr) then lookup_proc_dynamics(ProcDynamics, PDPtr, PD), PSPtr = PD ^ pd_proc_static else PSPtr = proc_static_ptr(0) ), ( if map.search(!.ProcMap, PSPtr, CSDPtrs0) then map.det_update(PSPtr, [CSDPtr | CSDPtrs0], !ProcMap) else map.det_insert(PSPtr, [CSDPtr], !ProcMap) ) else true ). :- pred lookup_pd_redirect(array(proc_dynamic_ptr)::in, proc_dynamic_ptr::in, proc_dynamic_ptr::out) is det. lookup_pd_redirect(ProcRedirect0, PDPtr, OldRedirect) :- PDPtr = proc_dynamic_ptr(PDI), array.lookup(ProcRedirect0, PDI, OldRedirect). :- pred set_pd_redirect(array(proc_dynamic_ptr)::array_di, proc_dynamic_ptr::in, proc_dynamic_ptr::in, array(proc_dynamic_ptr)::array_uo) is det. set_pd_redirect(ProcRedirect0, PDPtr, NewRedirect, ProcRedirect) :- PDPtr = proc_dynamic_ptr(PDI), array.set(PDI, NewRedirect, ProcRedirect0, ProcRedirect). :- pred lookup_csd_redirect(array(call_site_dynamic_ptr)::in, call_site_dynamic_ptr::in, call_site_dynamic_ptr::out) is det. lookup_csd_redirect(CallSiteRedirect0, CSDPtr, OldRedirect) :- CSDPtr = call_site_dynamic_ptr(CSDI), array.lookup(CallSiteRedirect0, CSDI, OldRedirect). :- pred set_csd_redirect(array(call_site_dynamic_ptr)::array_di, call_site_dynamic_ptr::in, call_site_dynamic_ptr::in, array(call_site_dynamic_ptr)::array_uo) is det. set_csd_redirect(CallSiteRedirect0, CSDPtr, NewRedirect, CallSiteRedirect) :- CSDPtr = call_site_dynamic_ptr(CSDI), array.set(CSDI, NewRedirect, CallSiteRedirect0, CallSiteRedirect). %---------------------------------------------------------------------------% :- pred deref_call_site_dynamic(redirect::in, call_site_dynamic_ptr::in, call_site_dynamic_ptr::out) is det. deref_call_site_dynamic(Redirect, !CSDPtr) :- lookup_csd_redirect(Redirect ^ csd_redirect, !.CSDPtr, RedirectCSDPtr), RedirectCSDPtr = call_site_dynamic_ptr(RedirectCSDI), ( if RedirectCSDI > 0 then deref_call_site_dynamic(Redirect, RedirectCSDPtr, !:CSDPtr) else true ). :- pred deref_proc_dynamic(redirect::in, proc_dynamic_ptr::in, proc_dynamic_ptr::out) is det. deref_proc_dynamic(Redirect, !PDPtr) :- lookup_pd_redirect(Redirect ^ pd_redirect, !.PDPtr, RedirectPDPtr), RedirectPDPtr = proc_dynamic_ptr(RedirectPDI), ( if RedirectPDI > 0 then deref_proc_dynamic(Redirect, RedirectPDPtr, !:PDPtr) else true ). %---------------------------------------------------------------------------% :- pred compact_dynamics(redirect::in, int::in, int::in, initial_deep::in, initial_deep::out) is det. compact_dynamics(Redirect0, MaxCSD0, MaxPD0, !InitDeep) :- Redirect0 = redirect(CSDredirect0, PDredirect0), !.InitDeep = initial_deep(Stats, Root0, CSDs0, PDs0, CSSs, PSs), compact_csd_redirect(1, 1, MaxCSD0, NumCSD, u(CSDredirect0), CSDredirect), compact_pd_redirect(1, 1, MaxPD0, NumPD, u(PDredirect0), PDredirect), Redirect = redirect(CSDredirect, PDredirect), array_map_from_1(subst_in_call_site_dynamic(Redirect), u(CSDs0), CSDs1), array_map_from_1(subst_in_proc_dynamic(Redirect), u(PDs0), PDs1), array.shrink(NumCSD, CSDs1, CSDs), array.shrink(NumPD, PDs1, PDs), lookup_pd_redirect(PDredirect, Root0, Root), !:InitDeep = initial_deep(Stats, Root, CSDs, PDs, CSSs, PSs). :- pred compact_csd_redirect(int::in, int::in, int::in, int::out, array(call_site_dynamic_ptr)::array_di, array(call_site_dynamic_ptr)::array_uo) is det. compact_csd_redirect(CurOld, CurNew, MaxOld, NumNew, !CSDredirect) :- ( if CurOld > MaxOld then NumNew = CurNew else array.lookup(!.CSDredirect, CurOld, Redirect0), ( if Redirect0 = call_site_dynamic_ptr(0) then array.set(CurOld, call_site_dynamic_ptr(CurNew), !CSDredirect), compact_csd_redirect(CurOld + 1, CurNew + 1, MaxOld, NumNew, !CSDredirect) else % Since this CSD is being redirected, its slot is available for % another (non-redirected) CSD. compact_csd_redirect(CurOld + 1, CurNew, MaxOld, NumNew, !CSDredirect) ) ). :- pred compact_pd_redirect(int::in, int::in, int::in, int::out, array(proc_dynamic_ptr)::array_di, array(proc_dynamic_ptr)::array_uo) is det. compact_pd_redirect(CurOld, CurNew, MaxOld, NumNew, !PDredirect) :- ( if CurOld > MaxOld then NumNew = CurNew else array.lookup(!.PDredirect, CurOld, Redirect0), ( if Redirect0 = proc_dynamic_ptr(0) then array.set(CurOld, proc_dynamic_ptr(CurNew), !PDredirect), compact_pd_redirect(CurOld + 1, CurNew + 1, MaxOld, NumNew, !PDredirect) else % Since this PD is being redirected, its slot is % available for another (non-redirected) PD. compact_pd_redirect(CurOld + 1, CurNew, MaxOld, NumNew, !PDredirect) ) ). :- pred subst_in_call_site_dynamic(redirect::in, call_site_dynamic::in, call_site_dynamic::out) is det. subst_in_call_site_dynamic(Redirect, !CSD) :- !.CSD = call_site_dynamic(Caller0, Callee0, Own), lookup_pd_redirect(Redirect ^ pd_redirect, Caller0, Caller), lookup_pd_redirect(Redirect ^ pd_redirect, Callee0, Callee), !:CSD = call_site_dynamic(Caller, Callee, Own). :- pred subst_in_proc_dynamic(redirect::in, proc_dynamic::in, proc_dynamic::out) is det. subst_in_proc_dynamic(Redirect, !PD) :- !.PD = proc_dynamic(PDPtr, Slots0, MaybeCPs), array.map(subst_in_slot(Redirect), u(Slots0), Slots), !:PD = proc_dynamic(PDPtr, Slots, MaybeCPs). :- pred subst_in_slot(redirect::in, call_site_array_slot::in, call_site_array_slot::out) is det. subst_in_slot(Redirect, slot_normal(CSDPtr0), slot_normal(CSDPtr)) :- lookup_csd_redirect(Redirect ^ csd_redirect, CSDPtr0, CSDPtr). subst_in_slot(Redirect, slot_multi(IsZeroed, CSDPtrs0), slot_multi(IsZeroed, CSDPtrs)) :- array.map(lookup_csd_redirect(Redirect ^ csd_redirect), u(CSDPtrs0), CSDPtrs). %---------------------------------------------------------------------------% :- pred merge_profiles(list(initial_deep)::in, maybe_error(initial_deep)::out) is det. merge_profiles(InitDeeps, MaybeMergedInitDeep) :- ( InitDeeps = [FirstInitDeep | LaterInitDeeps], ( if all_compatible(FirstInitDeep, LaterInitDeeps) then do_merge_profiles(FirstInitDeep, LaterInitDeeps, MergedInitDeep), MaybeMergedInitDeep = ok(MergedInitDeep) else MaybeMergedInitDeep = error("profiles are not from the same executable") ) ; InitDeeps = [], MaybeMergedInitDeep = error("merge_profiles: empty list of profiles") ). :- pred all_compatible(initial_deep::in, list(initial_deep)::in) is semidet. all_compatible(BaseInitDeep, OtherInitDeeps) :- extract_max_css(BaseInitDeep, BaseMaxCSS), extract_max_ps(BaseInitDeep, BaseMaxPS), extract_ticks_per_sec(BaseInitDeep, BaseTicksPerSec), list.map(extract_max_css, OtherInitDeeps, OtherMaxCSSs), list.map(extract_max_ps, OtherInitDeeps, OtherMaxPSs), list.map(extract_ticks_per_sec, OtherInitDeeps, OtherTicksPerSec), all_true(unify(BaseMaxCSS), OtherMaxCSSs), all_true(unify(BaseMaxPS), OtherMaxPSs), all_true(unify(BaseTicksPerSec), OtherTicksPerSec), extract_init_call_site_statics(BaseInitDeep, BaseCallSiteStatics), extract_init_proc_statics(BaseInitDeep, BaseProcStatics), list.map(extract_init_call_site_statics, OtherInitDeeps, OtherCallSiteStatics), list.map(extract_init_proc_statics, OtherInitDeeps, OtherProcStatics), array_match_elements(1, BaseMaxCSS, BaseCallSiteStatics, OtherCallSiteStatics), array_match_elements(1, BaseMaxPS, BaseProcStatics, OtherProcStatics). :- pred do_merge_profiles(initial_deep::in, list(initial_deep)::in, initial_deep::out) is det. do_merge_profiles(BaseInitDeep, OtherInitDeeps, MergedInitDeep) :- extract_max_csd(BaseInitDeep, BaseMaxCSD), extract_max_pd(BaseInitDeep, BaseMaxPD), list.map(extract_max_csd, OtherInitDeeps, OtherMaxCSDs), list.map(extract_max_pd, OtherInitDeeps, OtherMaxPDs), list.foldl(int_add, OtherMaxCSDs, BaseMaxCSD, ConcatMaxCSD), list.foldl(int_add, OtherMaxPDs, BaseMaxPD, ConcatMaxPD), extract_init_call_site_dynamics(BaseInitDeep, BaseCallSiteDynamics), extract_init_proc_dynamics(BaseInitDeep, BaseProcDynamics), array.lookup(BaseCallSiteDynamics, 0, DummyCSD), array.lookup(BaseProcDynamics, 0, DummyPD), array.init(ConcatMaxCSD + 1, DummyCSD, ConcatCallSiteDynamics0), array.init(ConcatMaxPD + 1, DummyPD, ConcatProcDynamics0), AllInitDeeps = [BaseInitDeep | OtherInitDeeps], concatenate_profiles(AllInitDeeps, 0, 0, ConcatCallSiteDynamics0, ConcatCallSiteDynamics, ConcatProcDynamics0, ConcatProcDynamics), extract_max_css(BaseInitDeep, BaseMaxCSS), extract_max_ps(BaseInitDeep, BaseMaxPS), extract_ticks_per_sec(BaseInitDeep, BaseTicksPerSec), list.map(extract_instrument_quanta, AllInitDeeps, InstrumentQuantas), list.map(extract_user_quanta, AllInitDeeps, UserQuantas), list.foldl(int_add, InstrumentQuantas, 0, InstrumentQuanta), list.foldl(int_add, UserQuantas, 0, UserQuanta), extract_num_callseqs(BaseInitDeep, BaseNumCallSeqs), list.map(extract_num_callseqs, OtherInitDeeps, OtherNumCallSeqs), list.foldl(int_add, OtherNumCallSeqs, BaseNumCallSeqs, ConcatNumCallSeqs), % The program names are not checked. The new profile is named after the % base profile. BaseProgramName = BaseInitDeep ^ init_profile_stats ^ prs_program_name, % With the exception of the canonical flags, we get the flags from % the base profile also. BaseFlags = BaseInitDeep ^ init_profile_stats ^ prs_deep_flags, ConcatFlags = BaseFlags ^ df_canonical_flag := is_canonical, ConcatProfileStats = profile_stats(BaseProgramName, ConcatMaxCSD, BaseMaxCSS, ConcatMaxPD, BaseMaxPS, ConcatNumCallSeqs, BaseTicksPerSec, InstrumentQuanta, UserQuanta, ConcatFlags), % The root part is a temporary lie. MergedInitDeep = initial_deep(ConcatProfileStats, BaseInitDeep ^ init_root, ConcatCallSiteDynamics, ConcatProcDynamics, BaseInitDeep ^ init_call_site_statics, BaseInitDeep ^ init_proc_statics). % list.map(extract_init_root, AllInitDeeps, Roots), % merge clique of roots, replacing root with chosen pd :- pred concatenate_profiles(list(initial_deep)::in, int::in, int::in, call_site_dynamics::array_di, call_site_dynamics::array_uo, proc_dynamics::array_di, proc_dynamics::array_uo) is det. concatenate_profiles([], _PrevMaxCSD, _PrevMaxPD, !ConcatCallSiteDynamics, !ConcatProcDynamics). concatenate_profiles([InitDeep | InitDeeps], PrevMaxCSD, PrevMaxPD, !ConcatCallSiteDynamics, !ConcatProcDynamics) :- concatenate_profile(InitDeep, PrevMaxCSD, PrevMaxPD, NextMaxCSD, NextMaxPD, !ConcatCallSiteDynamics, !ConcatProcDynamics), concatenate_profiles(InitDeeps, NextMaxCSD, NextMaxPD, !ConcatCallSiteDynamics, !ConcatProcDynamics). :- pred concatenate_profile(initial_deep::in, int::in, int::in, int::out, int::out, call_site_dynamics::array_di, call_site_dynamics::array_uo, proc_dynamics::array_di, proc_dynamics::array_uo) is det. concatenate_profile(InitDeep, PrevMaxCSD, PrevMaxPD, NextMaxCSD, NextMaxPD, !ConcatCallSiteDynamics, !ConcatProcDynamics) :- extract_max_csd(InitDeep, MaxCSD), extract_max_pd(InitDeep, MaxPD), NextMaxCSD = PrevMaxCSD + MaxCSD, NextMaxPD = PrevMaxPD + MaxPD, concatenate_profile_csds(1, MaxCSD, PrevMaxCSD, PrevMaxPD, InitDeep ^ init_call_site_dynamics, !ConcatCallSiteDynamics), concatenate_profile_pds(1, MaxPD, PrevMaxCSD, PrevMaxPD, InitDeep ^ init_proc_dynamics, !ConcatProcDynamics). :- pred concatenate_profile_csds(int::in, int::in, int::in, int::in, call_site_dynamics::in, call_site_dynamics::array_di, call_site_dynamics::array_uo) is det. concatenate_profile_csds(Cur, Max, PrevMaxCSD, PrevMaxPD, CallSiteDynamics, !ConcatCallSiteDynamics) :- ( if Cur =< Max then array.lookup(CallSiteDynamics, Cur, CSD0), CSD0 = call_site_dynamic(CallerPDPtr0, CalleePDPtr0, Own), concat_proc_dynamic_ptr(PrevMaxPD, CallerPDPtr0, CallerPDPtr), concat_proc_dynamic_ptr(PrevMaxPD, CalleePDPtr0, CalleePDPtr), CSD = call_site_dynamic(CallerPDPtr, CalleePDPtr, Own), array.set(PrevMaxCSD + Cur, CSD, !ConcatCallSiteDynamics), concatenate_profile_csds(Cur + 1, Max, PrevMaxCSD, PrevMaxPD, CallSiteDynamics, !ConcatCallSiteDynamics) else true ). :- pred concatenate_profile_pds(int::in, int::in, int::in, int::in, proc_dynamics::in, proc_dynamics::array_di, proc_dynamics::array_uo) is det. concatenate_profile_pds(Cur, Max, PrevMaxCSD, PrevMaxPD, ProcDynamics, !ConcatProcDynamics) :- ( if Cur =< Max then array.lookup(ProcDynamics, Cur, PD0), PD0 = proc_dynamic(PSPtr, Sites0, MaybeCPs), array.max(Sites0, MaxSite), concatenate_profile_slots(0, MaxSite, PrevMaxCSD, PrevMaxPD, u(Sites0), Sites), PD = proc_dynamic(PSPtr, Sites, MaybeCPs), array.set(PrevMaxPD + Cur, PD, !ConcatProcDynamics), concatenate_profile_pds(Cur + 1, Max, PrevMaxCSD, PrevMaxPD, ProcDynamics, !ConcatProcDynamics) else true ). :- pred concatenate_profile_slots(int::in, int::in, int::in, int::in, array(call_site_array_slot)::array_di, array(call_site_array_slot)::array_uo) is det. concatenate_profile_slots(Cur, Max, PrevMaxCSD, PrevMaxPD, !Sites) :- ( if Cur =< Max then array.lookup(!.Sites, Cur, Slot0), ( Slot0 = slot_normal(CSDPtr0), concat_call_site_dynamic_ptr(PrevMaxCSD, CSDPtr0, CSDPtr), Slot = slot_normal(CSDPtr) ; Slot0 = slot_multi(IsZeroed, CSDPtrs0), array_map_from_0(concat_call_site_dynamic_ptr(PrevMaxCSD), u(CSDPtrs0), CSDPtrs), Slot = slot_multi(IsZeroed, CSDPtrs) ), array.set(Cur, Slot, !Sites), concatenate_profile_slots(Cur + 1, Max, PrevMaxCSD, PrevMaxPD, !Sites) else true ). :- pred concat_call_site_dynamic_ptr(int::in, call_site_dynamic_ptr::in, call_site_dynamic_ptr::out) is det. concat_call_site_dynamic_ptr(PrevMaxCSD, !CSDPtr) :- !.CSDPtr = call_site_dynamic_ptr(CSDI0), ( if CSDI0 = 0 then true else !:CSDPtr = call_site_dynamic_ptr(CSDI0 + PrevMaxCSD) ). :- pred concat_proc_dynamic_ptr(int::in, proc_dynamic_ptr::in, proc_dynamic_ptr::out) is det. concat_proc_dynamic_ptr(PrevMaxPD, !PDPtr) :- !.PDPtr = proc_dynamic_ptr(PDI0), ( if PDI0 = 0 then true else !:PDPtr = proc_dynamic_ptr(PDI0 + PrevMaxPD) ). %---------------------------------------------------------------------------% % array_match_elements(Min, Max, BaseArray, OtherArrays): % % Succeeds iff all the elements of all the OtherArrays are equal to the % corresponding element of BaseArray. % :- pred array_match_elements(int::in, int::in, array(T)::in, list(array(T))::in) is semidet. array_match_elements(N, Max, BaseArray, OtherArrays) :- ( if N =< Max then array.lookup(BaseArray, N, BaseElement), match_element(BaseElement, N, OtherArrays), array_match_elements(N + 1, Max, BaseArray, OtherArrays) else true ). % match_element(TestElement, Index, Arrays): % % Succeeds iff the elements of all the Arrays at index Index % are equal to TestElement. % :- pred match_element(T::in, int::in, list(array(T))::in) is semidet. match_element(_, _, []). match_element(TestElement, Index, [Array | Arrays]) :- array.lookup(Array, Index, Element), Element = TestElement, match_element(Element, Index, Arrays). :- pred int_add(int::in, int::in, int::out) is det. int_add(A, B, C) :- C = A + B. %---------------------------------------------------------------------------% :- end_module canonical. %---------------------------------------------------------------------------%