[m-rev.] for review: implicit_parallelism and distance_granularity (new modules)
Jerome Tannier
jerome.tannier at student.fundp.ac.be
Tue Nov 28 10:31:07 AEDT 2006
Estimated hours taken: 60
Branches: main
Two new modules for review : implicit_parallelism (already submitted) and
distance_granularity. I have corrected a few mistakes since implicit_parallelism was
submitted the first time.
compiler/dep_par_conj.m:
Moved find_shared_variables in the interface (needed for implicit_parallelism.m).
compiler/distance_granularity.m:
New module which controls the granularity using the distance metric.
compiler/hlds_pred.m:
Add a predicate to set the arity of a predicate (needed for distance_granularity).
compiler/implicit_parallelism.m:
New module which reads the profiling feedback file and decides where
parallelism should be introduced.
compiler/mercury_compile.m:
Add the calls to apply implicit parallelism and to control granularity using
distance metric.
compiler/options:
Add implicit-parallelism, feedback-file and distance-granularity options.
compiler/pred_table.m:
Add a predicate to get the next pred_id available (needed for
distance_granularity).
compiler/transform_hlds.m:
Add transform_paralellism and distance_granularity in the imported modules.
deep_profiler/dump.m:
Add "all" option to dump everything out of the Deep.data file.
deep_profiler/mdprof_feedback.m:
Rename distribution to measure.
Add handling of dump_stages and dump_options.
Correct the way the list of CSS is built (elems were put in the wrong order).
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.13
diff -u -r1.13 dep_par_conj.m
--- compiler/dep_par_conj.m 20 Oct 2006 02:06:29 -0000 1.13
+++ compiler/dep_par_conj.m 22 Nov 2006 01:30:02 -0000
@@ -64,15 +64,23 @@
:- module transform_hlds.dep_par_conj.
:- interface.
+:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
+:- import_module hlds.instmap.
+:- import_module parse_tree.prog_data.
:- import_module io.
+:- import_module set.
%-----------------------------------------------------------------------------%
:- pred dependent_par_conj(module_info::in, module_info::out, io::di, io::uo)
is det.
+ %Used by transform_hlds.implicit_parallelism.
+:- func find_shared_variables(module_info, instmap, hlds_goals)
+ = set(prog_var).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -82,16 +90,13 @@
:- import_module check_hlds.mode_util.
:- import_module check_hlds.purity.
:- import_module hlds.goal_util.
-:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
-:- import_module hlds.instmap.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
:- import_module transform_hlds.dependency_graph.
@@ -103,7 +108,6 @@
:- import_module map.
:- import_module maybe.
:- import_module pair.
-:- import_module set.
:- import_module std_util.
:- import_module string.
:- import_module svmap.
@@ -678,9 +682,6 @@
% XXX this code is probably too complicated. I think Thomas already had a
% more elegant way to find the shared variables somewhere, using multisets.
%
-:- func find_shared_variables(module_info, instmap, hlds_goals)
- = set(prog_var).
-
find_shared_variables(ModuleInfo, InstMap, Goals) = SharedVars :-
list.map2(get_nonlocals_and_instmaps, Goals, Nonlocals, InstMapDeltas),
find_shared_variables_2(ModuleInfo, 0, Nonlocals, InstMap, InstMapDeltas,
Index: compiler/distance_granularity.m
===================================================================
RCS file: compiler/distance_granularity.m
diff -N compiler/distance_granularity.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/distance_granularity.m 27 Nov 2006 23:20:13 -0000
@@ -0,0 +1,825 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 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: distance_granularity.m.
+% Author: tannier.
+%
+% This module control the granularity at compile time using the distance metric.
+% For more information, see Distance: a New Metric for Controlling Granularity
+% for Parallel Execution available on http://citeseer.ist.psu.edu/21443.html .
+%
+% Example of the transformation:
+%
+% Original version of fibonacci:
+%
+% :- pred fibonacci(int::in, int::out) is det.
+%
+% fibonacci(!I) :-
+% ( !.I = 0 ->
+% !:I = 0
+% ;
+% ( !.I = 1 ->
+% !:I = 1
+% ;
+% ( !.I > 1 ->
+% J = !.I - 1,
+% K = !.I - 2,
+% (
+% fibonacci(J, Jout)
+% %
+% fibonacci(K, Kout)
+% ),
+% !:I = Jout + Kout
+% ;
+% error("fibonacci: wrong value")
+% )
+% )
+% ).
+%
+% Cloned version of fibonacci (we assume that the distance which was given
+% during compilation is 10):
+%
+% :- pred fibonacci(int::in, int::out, int::in) is det.
+%
+% fibonacci(!I, Distance) :-
+% ( !.I = 0 ->
+% !:I = 0
+% ;
+% ( !.I = 1 ->
+% !:I = 1
+% ;
+% ( !.I > 1 ->
+% J = !.I - 1,
+% K = !.I - 2,
+% ( Distance = 0 ->
+% (
+% fibonacci(J, Jout, 10)
+% &
+% fibonacci(K, Kout, 10)
+% )
+% ;
+% fibonacci(J, Jout, Distance - 1),
+% fibonacci(K, Kout, Distance - 1)
+% ),
+% !:I = Jout + Kout
+% ;
+% error("fibonacci: wrong value")
+% )
+% )
+% ).
+%
+% Once the cloned version of the recursive procedure is created, we update the
+% recursive calls of the original procedure to the cloned procedure. This way,
+% the granularity control is transparent.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.distance_granularity.
+:- interface.
+
+:- import_module hlds.hlds_module.
+
+%-----------------------------------------------------------------------------%
+
+:- pred control_distance_granularity(module_info::in, module_info::out,
+ int::in) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.pred_table.
+:- import_module hlds.quantification.
+:- import_module hlds.instmap.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_mode.
+:- import_module parse_tree.prog_type.
+:- import_module term.
+:- import_module transform_hlds.implicit_parallelism.
+
+:- import_module bool.
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module pair.
+:- import_module map.
+:- import_module maybe.
+:- import_module require.
+:- import_module string.
+:- import_module set.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+control_distance_granularity(!ModuleInfo, Distance) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ control_preds(PredIds, Distance, !ModuleInfo).
+
+ % Control the granularity of a list of predicates.
+ %
+:- pred control_preds(list(pred_id)::in, int::in,
+ module_info::in, module_info::out) is det.
+
+control_preds([], _Distance, !ModuleInfo).
+control_preds([PredId | PredIdList], Distance, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_non_imported_procids(PredInfo),
+
+ % We need to know the pred_id of the cloned predicate before we clone it.
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
+ get_next_pred_id(PredicateTable, NewPredId),
+
+ control_procs(PredId, ProcIds, Distance, NewPredId, PredInfo,
+ PredInfoClone0, no, Cloned, !ModuleInfo),
+ ( Cloned = yes ->
+ % Add the granularity prefix to the cloned predicate name.
+ Name = pred_info_name(PredInfoClone0),
+ pred_info_set_name(granularity_prefix ++ Name, PredInfoClone0,
+ PredInfoClone1),
+
+ % The arity and the argument types of the cloned procedure must be
+ % modified.
+ Arity = pred_info_orig_arity(PredInfoClone1),
+ pred_info_set_orig_arity(Arity + 1, PredInfoClone1, PredInfoClone2),
+ pred_info_get_arg_types(PredInfoClone2, ListMerType0),
+ list.append(ListMerType0, [int_type], ListMerType),
+ pred_info_get_typevarset(PredInfoClone2, Tvarset),
+ pred_info_get_exist_quant_tvars(PredInfoClone2, ExistqTvars),
+ pred_info_set_arg_types(Tvarset, ExistqTvars, ListMerType,
+ PredInfoClone2, PredInfoClone),
+
+ % Add the cloned predicate to the predicate table.
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
+ predicate_table_insert(PredInfoClone, _, PredicateTable0,
+ PredicateTable1),
+ module_info_set_predicate_table(PredicateTable1, !ModuleInfo),
+
+ update_original_predicate_procs(PredId, ProcIds, Distance, NewPredId,
+ PredInfo, PredInfoUpdated, !ModuleInfo),
+ module_info_set_pred_info(PredId, PredInfoUpdated, !ModuleInfo)
+ ;
+ % The predicate hasn't been cloned.
+ true
+ ),
+ control_preds(PredIdList, Distance, !ModuleInfo).
+
+ % Control the granularity of a list of procedures.
+ %
+:- pred control_procs(pred_id::in, list(proc_id)::in, int::in, pred_id::in,
+ pred_info::in, pred_info::out, bool::in, bool::out,
+ module_info::in, module_info::out) is det.
+
+control_procs(_PredId, [], _Distance, _PredIdNew, !PredInfo, !Cloned,
+ !ModuleInfo).
+control_procs(PredId, [ProcId | ProcIds], Distance, PredIdNew, !PredInfo,
+ !Cloned, !ModuleInfo) :-
+ module_info_proc_info(!.ModuleInfo, proc(PredId, ProcId), ProcInfo0),
+ proc_info_get_goal(ProcInfo0, Body),
+ control_goal(Body, BodyClone, PredId, ProcId, PredIdNew, ProcInfo0,
+ ProcInfo1, !ModuleInfo, Distance, no, no, GranularityVar, _),
+ ( GranularityVar = yes(_) ->
+ % The granularity variable has been created while the procedure was
+ % processed. That means that the predicate must be cloned.
+ !:Cloned = yes,
+ proc_info_set_goal(BodyClone, ProcInfo1, ProcInfo2),
+ requantify_proc(ProcInfo2, ProcInfo3),
+ RecomputeAtomic = no,
+ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
+ ProcInfo, !ModuleInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo),
+
+ control_procs(PredId, ProcIds, Distance, PredIdNew, !PredInfo, !Cloned,
+ !ModuleInfo)
+ ;
+ control_procs(PredId, ProcIds, Distance, PredIdNew, !PredInfo, !Cloned,
+ !ModuleInfo)
+ ).
+
+ % Control the granularity of a goal.
+ %
+:- pred control_goal(hlds_goal::in, hlds_goal::out, pred_id::in, proc_id::in,
+ pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in, bool::in,
+ maybe(prog_var)::in, maybe(prog_var)::out, bool::out) is det.
+
+control_goal(!HLDSGoal, PredId, ProcId, PredIdNew, !ProcInfo, !ModuleInfo,
+ Distance, IsInParallelConj, !GranularityVar,
+ IsRecursiveCallInParallelConj) :-
+ !.HLDSGoal = HLDSGoalExpr0 - HLDSGoalInfo0,
+ (
+ HLDSGoalExpr0 = unify(_, _, _, _, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = plain_call(CallPredId, CallProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName0),
+ ( IsInParallelConj = yes, CallPredId = PredId, CallProcId = ProcId
+ ->
+ ( !.GranularityVar = yes(_GranularityVar) ->
+ % The variable Granularity has already been added to ProcInfo.
+ true
+ ;
+ % Add the variable Granularity to ProcInfo.
+ proc_info_create_var_from_type(int_type, no,
+ GranularityVar, !ProcInfo),
+ !:GranularityVar = yes(GranularityVar),
+
+ % Check if the int module is imported.
+ ( visible_module(unqualified("int"), !.ModuleInfo) ->
+ true
+ ;
+ % The int module is not imported. Let's add it to the
+ % list of modules imported in the interface.
+ module_add_imported_module_specifiers(status_imported(
+ import_locn_interface), [unqualified("int")] ,
+ !ModuleInfo)
+ ),
+
+ % Add the int variable to the head variables of the procedure
+ % and adapt the mode.
+ proc_info_get_argmodes(!.ProcInfo, ListMerMode0),
+ list.append(ListMerMode0, [in_mode], ListMerMode),
+ proc_info_set_argmodes(ListMerMode, !ProcInfo),
+ proc_info_get_headvars(!.ProcInfo, HeadVars0),
+ list.append(HeadVars0, [GranularityVar], HeadVars),
+ proc_info_set_headvars(HeadVars, !ProcInfo)
+ ),
+
+ % Change the pred_id and the sym_name. We'll deal with the arguments
+ % later as they are not identical for the then and the else part of
+ % the if_then_else goal introduced by the transformation.
+ update_pred_name(granularity_prefix, CallSymName0, CallSymName),
+ HLDSGoalExpr = plain_call(PredIdNew, CallProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo0,
+ IsRecursiveCallInParallelConj = yes
+ ;
+ IsRecursiveCallInParallelConj = no
+ )
+ ;
+ HLDSGoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = generic_call(_, _, _, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = conj(Type, Goals0),
+ (
+ Type = plain_conj,
+ control_conj(Goals0, [], Goals, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance, no, !GranularityVar, no, _),
+ HLDSGoalExpr = conj(plain_conj, Goals),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo0
+ ;
+ Type = parallel_conj,
+ control_conj(Goals0, [], Goals, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance, yes, !GranularityVar, no,
+ ContainRecursiveCalls),
+ ( ContainRecursiveCalls = yes ->
+ % Create the if_then_else goal.
+ proc_info_create_var_from_type(int_type, no, Var, !ProcInfo),
+ make_int_const_construction(Var, 0, UnifyGoal),
+ ( !.GranularityVar = yes(GranularityVar) ->
+ % Create the if.
+ make_simple_test(GranularityVar, Var,
+ umc_implicit("distance_granularity"), [], Test),
+ create_conj(UnifyGoal, Test, plain_conj ,If),
+
+ % Create the then.
+ Then0 = conj(parallel_conj, Goals) - HLDSGoalInfo0,
+ update_then(Then0, Then, GranularityVar, PredIdNew, ProcId,
+ Distance, !ModuleInfo, !ProcInfo),
+
+ % Create the else.
+ Else0 = conj(plain_conj, Goals) - HLDSGoalInfo0,
+ update_else(Else0, Else, GranularityVar, PredIdNew, ProcId,
+ !ModuleInfo, !ProcInfo),
+
+ % The non locals of HLDSGoalInfo need to be updated for
+ % the variable controlling the granularity in the test.
+ goal_info_get_nonlocals(HLDSGoalInfo0, NonLocals0),
+ set.insert(NonLocals0, GranularityVar, NonLocals),
+ goal_info_set_nonlocals(NonLocals, HLDSGoalInfo0,
+ HLDSGoalInfo),
+ !:HLDSGoal = if_then_else([], If, Then, Else) -
+ HLDSGoalInfo
+ ;
+ % The conjunction contains recursive calls so the
+ % granularity variable must have been created.
+ error("control_goal: GranularityVar wrong value")
+ )
+ ;
+ true
+ )
+ ),
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = disj(HLDSGoals0),
+ control_disj(HLDSGoals0, [], HLDSGoals, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance, !GranularityVar),
+ HLDSGoalExpr = disj(HLDSGoals),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo0,
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = switch(Var, CanFail, Cases0),
+ control_switch(Cases0, [], Cases, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, !GranularityVar),
+ HLDSGoalExpr = switch(Var, CanFail, Cases),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo0,
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = negation(HLDSGoal0),
+ control_goal(HLDSGoal0, HLDSGoal, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, IsInParallelConj, !GranularityVar,
+ IsRecursiveCallInParallelConj),
+ HLDSGoalExpr = negation(HLDSGoal),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo0
+ ;
+ HLDSGoalExpr0 = scope(_, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = if_then_else(Vars, If0, Then0, Else0),
+ control_goal(If0, If, PredId, ProcId, PredIdNew, !ProcInfo, !ModuleInfo,
+ Distance, no, !GranularityVar, _),
+ control_goal(Then0, Then, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, no, !GranularityVar, _),
+ control_goal(Else0, Else, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, no, !GranularityVar, _),
+ HLDSGoalExpr = if_then_else(Vars, If, Then, Else),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo0,
+ IsRecursiveCallInParallelConj = no
+ ;
+ HLDSGoalExpr0 = shorthand(_),
+ IsRecursiveCallInParallelConj = no
+ ).
+
+ % Control the granularity of a conjunction.
+ %
+:- pred control_conj(hlds_goals::in, hlds_goals::in, hlds_goals::out,
+ pred_id::in, proc_id::in, pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in, bool::in,
+ maybe(prog_var)::in, maybe(prog_var)::out, bool::in, bool::out) is det.
+
+control_conj([], !GoalsAcc, _PredId, _ProcId, _PredIdNew, !ProcInfo,
+ !ModuleInfo, _Distance, _IsInParallelConj, !GranularityVar,
+ !HasRecursiveCallsInParallelConj).
+control_conj([Goal0 | Goals], !GoalsAcc, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, IsInParallelConj, !GranularityVar,
+ !HasRecursiveCallsInParallelConj) :-
+ control_goal(Goal0, Goal, PredId, ProcId, PredIdNew, !ProcInfo, !ModuleInfo,
+ Distance, IsInParallelConj, !GranularityVar, IsRecursiveCall),
+ list.append(!.GoalsAcc, [Goal], !:GoalsAcc),
+ ( IsRecursiveCall = yes ->
+ % The goal we just processed is a recursive call in a parallel
+ % conjunction. Therefore, the conjunction contains recursive calls.
+ !:HasRecursiveCallsInParallelConj = yes
+ ;
+ !:HasRecursiveCallsInParallelConj = !.HasRecursiveCallsInParallelConj
+ ),
+ control_conj(Goals, !GoalsAcc, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, IsInParallelConj, !GranularityVar,
+ !HasRecursiveCallsInParallelConj).
+
+ % Update the then part of the new if_then_else goal.
+ %
+:- pred update_then(hlds_goal::in, hlds_goal::out, prog_var::in, pred_id::in,
+ proc_id::in, int::in, module_info::in, module_info::out,
+ proc_info::in, proc_info::out) is det.
+
+update_then(!Goal, GranularityVar, PredId, ProcId, Distance, !ModuleInfo,
+ !ProcInfo) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ update_then2(GoalExpr0, GoalExpr, 1, _, GranularityVar, PredId, ProcId,
+ Distance, !ModuleInfo, !ProcInfo),
+ Goal0 = GoalExpr - GoalInfo,
+ recompute_conj_info(Goal0, !:Goal).
+
+:- pred update_then2(hlds_goal_expr::in, hlds_goal_expr::out,
+ int::in, int::out, prog_var::in, pred_id::in, proc_id::in, int::in,
+ module_info::in, module_info::out, proc_info::in, proc_info::out) is det.
+
+update_then2(!GoalExpr, !IndexInConj, GranularityVar, PredId, ProcId,
+ Distance, !ModuleInfo, !ProcInfo) :-
+ ( !.GoalExpr = conj(parallel_conj, Goals0) ->
+ list.length(Goals0, Length),
+ ( !.IndexInConj > Length ->
+ true
+ ;
+ list.index1_det(Goals0, !.IndexInConj, Goal0),
+ Goal0 = GoalExpr0 - GoalInfo0,
+ ( GoalExpr0 = plain_call(CallPredId, CallProcId, CallArgs0,
+ CallBuiltin, CallUnifyContext, CallSymName)
+ ->
+ ( CallPredId = PredId, CallProcId = ProcId ->
+ % Create int variable containing value Distance.
+ proc_info_create_var_from_type(int_type, no,
+ Var, !ProcInfo),
+ make_int_const_construction(Var, Distance, UnifyGoal),
+
+ % Use that variable as the last argument of the call.
+ list.append(CallArgs0, [Var], CallArgs),
+ GoalExpr = plain_call(CallPredId, CallProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName),
+
+ % Var has instmap bound(Distance).
+ goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+ MerInst = bound(shared, [bound_functor(int_const(Distance),
+ [])]),
+ instmap_delta_insert(Var, MerInst, InstMapDelta0,
+ InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0,
+ GoalInfo),
+
+ Goal = GoalExpr - GoalInfo,
+
+ create_conj(UnifyGoal, Goal, plain_conj, PlainConj),
+
+ % Replace the call by the newly created conjunction.
+ list.replace_nth_det(Goals0, !.IndexInConj, PlainConj,
+ Goals),
+ !:GoalExpr = conj(parallel_conj, Goals)
+ ;
+ % Not a recursive call.
+ true
+ ),
+ !:IndexInConj = !.IndexInConj + 1
+ ;
+ !:IndexInConj = !.IndexInConj + 1
+ ),
+ update_then2(!GoalExpr, !IndexInConj, GranularityVar, PredId,
+ ProcId, Distance, !ModuleInfo, !ProcInfo)
+ )
+ ;
+ error("update_then2: not a parallel conjunction")
+ ).
+
+ % Recompute the info of a conjunction.
+ %
+:- pred recompute_conj_info(hlds_goal::in, hlds_goal::out) is det.
+
+recompute_conj_info(!Conj) :-
+ ( !.Conj = conj(Type, Goals) - ConjInfo0 ->
+ goal_list_nonlocals(Goals, NonLocals),
+ goal_list_instmap_delta(Goals, InstMapDelta),
+ goal_list_determinism(Goals, Detism),
+ goal_list_purity(Goals, Purity),
+ goal_info_set_nonlocals(NonLocals, ConjInfo0, ConjInfo1),
+ goal_info_set_instmap_delta(InstMapDelta, ConjInfo1, ConjInfo2),
+ goal_info_set_determinism(Detism, ConjInfo2, ConjInfo3),
+ goal_info_set_purity(Purity, ConjInfo3, ConjInfo),
+ !:Conj = conj(Type, Goals) - ConjInfo
+ ;
+ error("recompute_conj_info: not a conjunction")
+ ).
+
+ % Update the else part of the new if_then_else goal.
+ %
+:- pred update_else(hlds_goal::in, hlds_goal::out, prog_var::in, pred_id::in,
+ proc_id::in, module_info::in, module_info::out,
+ proc_info::in, proc_info::out) is det.
+
+update_else(!Goal, GranularityVar, PredId, ProcId, !ModuleInfo, !ProcInfo) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ update_else2(GoalExpr0, GoalExpr, 1, _, GranularityVar, PredId, ProcId,
+ !ModuleInfo, !ProcInfo),
+ Goal0 = GoalExpr - GoalInfo,
+ recompute_conj_info(Goal0, !:Goal).
+
+:- pred update_else2(hlds_goal_expr::in, hlds_goal_expr::out,
+ int::in, int::out, prog_var::in, pred_id::in, proc_id::in,
+ module_info::in, module_info::out, proc_info::in, proc_info::out) is det.
+
+update_else2(!GoalExpr, !IndexInConj, GranularityVar, PredId, ProcId,
+ !ModuleInfo, !ProcInfo) :-
+ ( !.GoalExpr = conj(plain_conj, Goals0) ->
+ list.length(Goals0, Length),
+ ( !.IndexInConj > Length ->
+ true
+ ;
+ list.index1_det(Goals0, !.IndexInConj, Goal0),
+ Goal0 = GoalExpr0 - GoalInfo0,
+ ( GoalExpr0 = plain_call(CallPredId, CallProcId, CallArgs0,
+ CallBuiltin, CallUnifyContext, CallSymName)
+ ->
+ ( CallPredId = PredId, CallProcId = ProcId ->
+ % Create an int variable containing the value 1.
+ proc_info_create_var_from_type(int_type, no,
+ Var, !ProcInfo),
+ make_int_const_construction(Var, 1, UnifyGoal),
+
+ % Create int variable which will contain the result of the
+ % decrementation.
+ proc_info_create_var_from_type(int_type, no,
+ VarResult, !ProcInfo),
+
+ % Decrement GranularityVar before the call.
+ lookup_builtin_pred_proc_id(!.ModuleInfo,
+ unqualified("int"), "minus", function, 2, only_mode,
+ MinusPredId, MinusProcId),
+ MinusCallArgs = [GranularityVar, Var, VarResult],
+ MinusCallBuiltin = inline_builtin,
+ MinusCallSymName = qualified(unqualified("int"),"-"),
+ Rhs = rhs_functor(cons(MinusCallSymName, 2) , no,
+ [GranularityVar, Var]),
+ MinusCallUnifyContext = yes(call_unify_context(VarResult,
+ Rhs, unify_context(
+ umc_implicit("distance_granularity"), []))),
+ DecrementGoalExpr = plain_call(MinusPredId, MinusProcId,
+ MinusCallArgs, MinusCallBuiltin, MinusCallUnifyContext,
+ MinusCallSymName),
+ set.list_to_set([GranularityVar, Var, VarResult],
+ NonLocals),
+ VarResultDelta = VarResult - ground(unique, none),
+ VarDelta = Var - bound(shared, [bound_functor(int_const(1),
+ [])]),
+ instmap_delta_from_assoc_list([VarDelta, VarResultDelta],
+ InstMapDeltaDecrement),
+ Detism = detism_det,
+ Purity = purity_pure,
+ % Take the context of the first goal of the conjunction.
+ list.index1_det(Goals0, 1, FirstGoal),
+ FirstGoal = _ - FirstGoalInfo,
+ goal_info_get_context(FirstGoalInfo, Context),
+ goal_info_init(NonLocals, InstMapDeltaDecrement, Detism,
+ Purity, Context, DecrementGoalInfo),
+ DecrementGoal = DecrementGoalExpr - DecrementGoalInfo,
+
+ % Use the decremented value of GranularityVar as the last
+ % argument of the call.
+ list.append(CallArgs0, [VarResult], CallArgs),
+ GoalExpr = plain_call(CallPredId, CallProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName),
+ goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+ MerInst = ground(shared, none),
+ instmap_delta_insert(Var, MerInst, InstMapDelta0,
+ InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0,
+ GoalInfo),
+ Goal = GoalExpr - GoalInfo,
+ list.replace_nth_det(Goals0, !.IndexInConj, Goal, Goals1),
+
+ % Append the goals in the right order.
+ list.det_split_list(!.IndexInConj - 1, Goals1, StartGoals,
+ EndGoals),
+ list.append(StartGoals, [UnifyGoal], GoalsAppend0),
+ list.append(GoalsAppend0, [DecrementGoal],
+ GoalsAppend1),
+ list.append(GoalsAppend1, EndGoals, Goals),
+ !:GoalExpr = conj(plain_conj, Goals)
+ ;
+ % Not a recursive call.
+ true
+ ),
+ !:IndexInConj = !.IndexInConj + 3
+ ;
+ !:IndexInConj = !.IndexInConj + 1
+ ),
+ update_else2(!GoalExpr, !IndexInConj, GranularityVar, PredId,
+ ProcId, !ModuleInfo, !ProcInfo)
+ )
+ ;
+ error("update_else2: not a parallel conjunction")
+ ).
+
+ % Control the granularity of a disjunction.
+ %
+:- pred control_disj(list(hlds_goal)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, pred_id::in, proc_id::in,
+ pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in,
+ maybe(prog_var)::in, maybe(prog_var)::out) is det.
+
+control_disj([], !HLDSGoalsAcc, _PredId, _ProcId, _PredIdNew, !ProcInfo,
+ !ModuleInfo, _Distance, !GranularityVar).
+control_disj([HLDSGoal0 | HLDSGoals], !HLDSGoalsAcc, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance, !GranularityVar) :-
+ control_goal(HLDSGoal0, HLDSGoal, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, no, !GranularityVar, _),
+ list.append( !.HLDSGoalsAcc, [HLDSGoal], !:HLDSGoalsAcc),
+ control_disj(HLDSGoals, !HLDSGoalsAcc, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, !GranularityVar).
+
+ % Control the granularity of a switch.
+ %
+:- pred control_switch(
+ list(case)::in, list(case)::in, list(case)::out, pred_id::in,
+ proc_id::in, pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in,
+ maybe(prog_var)::in, maybe(prog_var)::out) is det.
+
+control_switch([], !CasesAcc, _PredId, _ProcId, _PredIdNew, !ProcInfo,
+ !ModuleInfo, _Distance, !GranularityVar).
+control_switch([Case | Cases], !CasesAcc, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance, !GranularityVar) :-
+ Case = case(Functor, Goal0),
+ control_goal(Goal0, Goal, PredId, ProcId, PredIdNew, !ProcInfo, !ModuleInfo,
+ Distance, no, !GranularityVar, _),
+ !:CasesAcc = [case(Functor, Goal) | !.CasesAcc],
+ control_switch(Cases, !CasesAcc, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance, !GranularityVar).
+
+%-----------------------------------------------------------------------------%
+
+ % Update the recursive calls in a list of procedures so that the pred_id
+ % called is the one of the cloned procedure.
+ %
+:- pred update_original_predicate_procs(pred_id::in, list(proc_id)::in, int::in,
+ pred_id::in, pred_info::in, pred_info::out,
+ module_info::in, module_info::out) is det.
+
+update_original_predicate_procs(_PredId, [], _Distance, _PredIdNew, !PredInfo,
+ !ModuleInfo).
+update_original_predicate_procs(PredId, [ProcId | ProcIds], Distance, PredIdNew,
+ !PredInfo, !ModuleInfo) :-
+ module_info_proc_info(!.ModuleInfo, proc(PredId, ProcId), ProcInfo0),
+ proc_info_get_goal(ProcInfo0, Body0),
+ update_original_predicate_goal(Body0, Body, PredId, ProcId, PredIdNew,
+ ProcInfo0, ProcInfo1, !ModuleInfo, Distance),
+ proc_info_set_goal(Body, ProcInfo1, ProcInfo2),
+ requantify_proc(ProcInfo2, ProcInfo3),
+ RecomputeAtomic = no,
+ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
+ ProcInfo, !ModuleInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo),
+ update_original_predicate_procs(PredId, ProcIds, Distance, PredIdNew,
+ !PredInfo, !ModuleInfo).
+
+ % Update the recursive calls of a goal so that the pred_id called is the one
+ % of the cloned procedure.
+ %
+:- pred update_original_predicate_goal(hlds_goal::in, hlds_goal::out,
+ pred_id::in, proc_id::in, pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in) is det.
+
+update_original_predicate_goal(!HLDSGoal, PredId, ProcId, PredIdNew, !ProcInfo,
+ !ModuleInfo, Distance) :-
+ !.HLDSGoal = HLDSGoalExpr0 - HLDSGoalInfo,
+ (
+ HLDSGoalExpr0 = unify(_, _, _, _, _)
+ ;
+ HLDSGoalExpr0 = plain_call(CallPredId, CallProcId, CallArgs0,
+ CallBuiltin, CallUnifyContext, CallSymName0),
+ ( CallPredId = PredId, CallProcId = ProcId ->
+ % Create the int variable which will be used as the last argument of
+ % the call.
+ proc_info_create_var_from_type(int_type, no,
+ Var, !ProcInfo),
+ make_int_const_construction(Var, Distance, UnifyGoal),
+ list.append(CallArgs0, [Var], CallArgs),
+
+ % Update the pred_id to the pred_id of the cloned pred.
+ update_pred_name(granularity_prefix, CallSymName0, CallSymName),
+ CallExpr = plain_call(PredIdNew, CallProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName),
+
+ % The nonlocals and the instmap_delta
+ goal_info_get_nonlocals(HLDSGoalInfo, NonLocals0),
+ set.insert(NonLocals0, Var, NonLocals),
+ goal_info_set_nonlocals(NonLocals, HLDSGoalInfo,
+ CallInfo1),
+ goal_info_get_instmap_delta(HLDSGoalInfo, InstMapDelta0),
+ MerInst = ground(shared, none),
+ instmap_delta_insert(Var, MerInst, InstMapDelta0,
+ InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, CallInfo1,
+ CallInfo),
+ Call = CallExpr - CallInfo,
+
+ % That might unflatten the parent conjunction. We deal with that
+ % after the conjunction has been processed.
+ create_conj(UnifyGoal, Call, plain_conj, !:HLDSGoal)
+ ;
+ true
+ )
+ ;
+ HLDSGoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ HLDSGoalExpr0 = generic_call(_, _, _, _)
+ ;
+ HLDSGoalExpr0 = conj(Type, Goals0),
+ update_original_predicate_goals(Goals0, [], Goals1, PredId,
+ ProcId, PredIdNew, !ProcInfo, !ModuleInfo, Distance),
+
+ % No need to flatten parallel conjunctions.
+ ( Type = plain_conj ->
+ flatten_conj(Goals1, Goals)
+ ;
+ Goals = Goals1
+ ),
+ HLDSGoalExpr = conj(Type, Goals),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo
+ ;
+ HLDSGoalExpr0 = disj(HLDSGoals0),
+ update_original_predicate_goals(HLDSGoals0, [], HLDSGoals, PredId,
+ ProcId, PredIdNew, !ProcInfo, !ModuleInfo, Distance),
+ HLDSGoalExpr = disj(HLDSGoals),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo
+ ;
+ HLDSGoalExpr0 = switch(Var, CanFail, Cases0),
+ update_original_predicate_switch(Cases0, [], Cases, PredId, ProcId,
+ PredIdNew, !ProcInfo, !ModuleInfo, Distance),
+ HLDSGoalExpr = switch(Var, CanFail, Cases),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo
+ ;
+ HLDSGoalExpr0 = negation(HLDSGoal0),
+ update_original_predicate_goal(HLDSGoal0, HLDSGoal, PredId, ProcId,
+ PredIdNew, !ProcInfo, !ModuleInfo, Distance),
+ HLDSGoalExpr = negation(HLDSGoal),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo
+ ;
+ HLDSGoalExpr0 = scope(_, _)
+ ;
+ HLDSGoalExpr0 = if_then_else(Vars, If0, Then0, Else0),
+ update_original_predicate_goal(If0, If, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance),
+ update_original_predicate_goal(Then0, Then, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance),
+ update_original_predicate_goal(Else0, Else, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance),
+ HLDSGoalExpr = if_then_else(Vars, If, Then, Else),
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo
+ ;
+ HLDSGoalExpr0 = shorthand(_)
+ ).
+
+ % Update the recursive calls of a list of goals so that the pred_id called
+ % is the one of the cloned procedure.
+ %
+:- pred update_original_predicate_goals(list(hlds_goal)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, pred_id::in, proc_id::in,
+ pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in) is det.
+
+update_original_predicate_goals([], !HLDSGoalsAcc, _PredId, _ProcId, _PredIdNew,
+ !ProcInfo, !ModuleInfo, _Distance).
+update_original_predicate_goals([HLDSGoal0 | HLDSGoals], !HLDSGoalsAcc, PredId,
+ ProcId, PredIdNew, !ProcInfo, !ModuleInfo, Distance) :-
+ update_original_predicate_goal(HLDSGoal0, HLDSGoal, PredId, ProcId,
+ PredIdNew, !ProcInfo, !ModuleInfo, Distance),
+ list.append(!.HLDSGoalsAcc, [HLDSGoal], !:HLDSGoalsAcc),
+ update_original_predicate_goals(HLDSGoals, !HLDSGoalsAcc, PredId, ProcId,
+ PredIdNew, !ProcInfo, !ModuleInfo, Distance).
+
+ % Update the recursive calls of a switch so that the pred_id called is the
+ % one of the cloned procedure.
+ %
+:- pred update_original_predicate_switch(
+ list(case)::in, list(case)::in, list(case)::out, pred_id::in,
+ proc_id::in, pred_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in) is det.
+
+update_original_predicate_switch([], !CasesAcc, _PredId, _ProcId, _PredIdNew,
+ !ProcInfo, !ModuleInfo, _Distance).
+update_original_predicate_switch([Case | Cases], !CasesAcc, PredId, ProcId,
+ PredIdNew, !ProcInfo, !ModuleInfo, Distance) :-
+ Case = case(Functor, Goal0),
+ update_original_predicate_goal(Goal0, Goal, PredId, ProcId, PredIdNew,
+ !ProcInfo, !ModuleInfo, Distance),
+ !:CasesAcc = [ case(Functor, Goal) | !.CasesAcc ],
+ update_original_predicate_switch(Cases, !CasesAcc, PredId, ProcId,
+ PredIdNew, !ProcInfo, !ModuleInfo, Distance).
+
+ % Flatten a list of goals of a conjunction.
+ %
+:- pred flatten_conj(hlds_goals::in, hlds_goals::out) is det.
+
+flatten_conj([], []).
+flatten_conj([Goal | Goals0], Goals) :-
+ flatten_conj(Goals0, Goals1),
+ ( Goal = conj(plain_conj, SubGoals) - _ ->
+ list.append(SubGoals, Goals1, Goals)
+ ;
+ Goals = [Goal | Goals1]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Modify the name of a predicate by appending a prefix to it.
+ %
+:- pred update_pred_name(string::in, sym_name::in, sym_name::out) is det.
+
+update_pred_name(Prefix, !SymName) :-
+ ( !.SymName = qualified(unqualified(ModuleName), PredName0) ->
+ PredName = Prefix ++ PredName0,
+ !:SymName = qualified(unqualified(ModuleName), PredName)
+ ;
+ error("update_pred_name: not a predicate name")
+ ).
+
+:-func granularity_prefix = string.
+
+granularity_prefix = "distance_granularity_".
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds.distance_granularity.
+%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.212
diff -u -r1.212 hlds_pred.m
--- compiler/hlds_pred.m 1 Oct 2006 06:05:02 -0000 1.212
+++ compiler/hlds_pred.m 23 Nov 2006 03:21:09 -0000
@@ -604,6 +604,8 @@
:- pred pred_info_set_name(string::in,
pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_orig_arity(arity::in,
+ pred_info::in, pred_info::out) is det.
:- pred pred_info_set_origin(pred_origin::in,
pred_info::in, pred_info::out) is det.
:- pred pred_info_set_import_status(import_status::in,
@@ -1193,6 +1195,7 @@
pred_info_get_procedures(PI, PI ^ procedures).
pred_info_set_name(X, PI, PI ^ name := X).
+pred_info_set_orig_arity(X, PI, PI ^ orig_arity := X).
pred_info_set_origin(X, PI, PI ^ pred_origin := X).
pred_info_set_import_status(X, PI, PI ^ import_status := X).
pred_info_set_goal_type(X, PI, PI ^ goal_type := X).
Index: compiler/implicit_parallelism.m
===================================================================
RCS file: compiler/implicit_parallelism.m
diff -N compiler/implicit_parallelism.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/implicit_parallelism.m 24 Nov 2006 01:16:44 -0000
@@ -0,0 +1,935 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 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.
+%-----------------------------------------------------------------------------%
+%
+% Author: tannier.
+%
+% This module reads the profiling feedback file generated by the mdprof_feedback
+% module and decides where parallelism should be used (implicit parallelism).
+%
+%TODO - Once a call which has to be parallelized is found, search forward AND
+% backward for the closet goal to be parallelized/parallel conjunction and
+% determine which side is the best (on the basis of the number of shared
+% variables).
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.implicit_parallelism.
+:- interface.
+
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_module.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred apply_implicit_parallelism_transformation(module_info::in,
+ module_info::out, string::in, io::di, io::uo) is det.
+
+ % Create a conjunction.
+ %
+:- pred create_conj(hlds_goal::in, hlds_goal::in, conj_type::in,
+ hlds_goal::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.inst_match.
+:- import_module check_hlds.mode_util.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.instmap.
+:- import_module hlds.quantification.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.dep_par_conj.
+
+:- import_module bool.
+:- import_module char.
+:- import_module counter.
+:- import_module int.
+:- import_module list.
+:- import_module maybe.
+:- import_module pair.
+:- import_module require.
+:- import_module set.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+ % Represent a call site static which has to be parallelized.
+ %
+:- type css_to_be_parallelized
+ ---> css_to_be_parallelized(
+ caller :: string,
+ slot_number :: int,
+ kind :: string,
+ callee :: string
+ ).
+
+%-----------------------------------------------------------------------------%
+
+apply_implicit_parallelism_transformation(!ModuleInfo, FeedbackFile, !IO) :-
+ parse_feedback_file(FeedbackFile, MaybeCSSListToBeParallelized, !IO),
+ (
+ MaybeCSSListToBeParallelized = error(Err),
+ io.stderr_stream(Stderr, !IO),
+ io.write_string(Stderr, Err ++ "\n", !IO)
+ ;
+ MaybeCSSListToBeParallelized = ok(CSSListToBeParallelized),
+ module_info_predids(!.ModuleInfo, PredIds),
+ process_preds_for_implicit_parallelism(PredIds,
+ CSSListToBeParallelized, !ModuleInfo)
+ ).
+
+ % Process predicates for implicit parallelism.
+ %
+:- pred process_preds_for_implicit_parallelism(list(pred_id)::in,
+ list(css_to_be_parallelized)::in, module_info::in, module_info::out)
+ is det.
+
+process_preds_for_implicit_parallelism([], _CSSListToBeParallelized,
+ !ModuleInfo).
+process_preds_for_implicit_parallelism([PredId | PredIdList],
+ CSSListToBeParallelized, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_non_imported_procids(PredInfo),
+ process_procs_for_implicit_parallelism(PredId, ProcIds,
+ CSSListToBeParallelized, !ModuleInfo),
+ process_preds_for_implicit_parallelism(PredIdList,
+ CSSListToBeParallelized, !ModuleInfo).
+
+ % Process procedures for implicit parallelism.
+ %
+:- pred process_procs_for_implicit_parallelism(pred_id::in,
+ list(proc_id)::in, list(css_to_be_parallelized)::in,
+ module_info::in, module_info::out) is det.
+
+process_procs_for_implicit_parallelism(_PredId, [],
+ _CSSListToBeParallelized, !ModuleInfo).
+process_procs_for_implicit_parallelism(PredId, [ProcId | ProcIds],
+ CSSListToBeParallelized, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo0, ProcInfo0),
+ % Initialize the counter for the slot number.
+ Counter = counter.init(0),
+ pred_proc_id_to_raw_id(PredInfo0, ProcId, CallerRawId),
+ get_callees_feedback(CallerRawId, CSSListToBeParallelized, [],
+ CalleesList),
+ list.length(CalleesList, CalleesListLength),
+ ( CalleesListLength = 0 ->
+ % No calls to be parallelized in this procedure.
+ process_procs_for_implicit_parallelism(PredId, ProcIds,
+ CSSListToBeParallelized, !ModuleInfo)
+ ;
+ proc_info_get_goal(ProcInfo0, Body0),
+ process_goal_for_implicit_parallelism(Body0, Body, ProcInfo0,
+ !ModuleInfo, no, _, 0, _, CalleesList, _, Counter, _),
+ proc_info_set_goal(Body, ProcInfo0, ProcInfo1),
+ pred_info_get_markers(PredInfo0, Markers0),
+ add_marker(marker_may_have_parallel_conj, Markers0, Markers),
+ pred_info_set_markers(Markers, PredInfo0, PredInfo1),
+ requantify_proc(ProcInfo1, ProcInfo2),
+ RecomputeAtomic = no,
+ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo2, ProcInfo,
+ !ModuleInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, PredInfo1, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
+ process_procs_for_implicit_parallelism(PredId, ProcIds,
+ CSSListToBeParallelized, !ModuleInfo)
+ ).
+
+ % By using the feedback file, build a list of css_to_be_parallelized whose
+ % caller is equal to the first parameter.
+ %
+:- pred get_callees_feedback(string::in, list(css_to_be_parallelized)::in,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out) is det.
+
+get_callees_feedback(_Caller, [], !ResultAcc).
+get_callees_feedback(Caller, [CSSToBeParallelized | CSSListToBeParallelized],
+ !ResultAcc) :-
+ CSSToBeParallelized = css_to_be_parallelized(CSSCaller, _, _, _),
+ ( Caller = CSSCaller ->
+ !:ResultAcc = [ CSSToBeParallelized | !.ResultAcc ],
+ get_callees_feedback(Caller, CSSListToBeParallelized, !ResultAcc)
+ ;
+ get_callees_feedback(Caller, CSSListToBeParallelized, !ResultAcc)
+ ).
+
+ % Process a goal for implicit parallelism.
+ % MaybeConj is the conjunction which contains HLDSGoal.
+ %
+:- pred process_goal_for_implicit_parallelism(hlds_goal::in, hlds_goal::out,
+ proc_info::in, module_info::in, module_info::out,
+ maybe(hlds_goal_expr)::in, maybe(hlds_goal_expr)::out, int ::in, int::out,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out,
+ counter::in, counter::out) is det.
+
+process_goal_for_implicit_parallelism(!HLDSGoal, ProcInfo, !ModuleInfo,
+ !MaybeConj, !IndexInConj, !CalleeListToBeParallelized, !Counter) :-
+ !.HLDSGoal = HLDSGoalExpr0 - HLDSGoalInfo,
+ (
+ HLDSGoalExpr0 = unify(_, _, _, _, _),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ HLDSGoalExpr0 = plain_call(_, _, _, _, _, _),
+ process_call_for_implicit_parallelism(!.HLDSGoal, ProcInfo, !ModuleInfo,
+ !IndexInConj, !MaybeConj, !CalleeListToBeParallelized, !Counter)
+ % We deal with the index in the conjunction in
+ % process_call_for_implicit_parallelism.
+ ;
+ HLDSGoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
+ process_call_for_implicit_parallelism(!.HLDSGoal, ProcInfo, !ModuleInfo,
+ !IndexInConj, !MaybeConj, !CalleeListToBeParallelized, !Counter)
+ ;
+ HLDSGoalExpr0 = generic_call(Details, _, _, _),
+ (
+ Details = higher_order(_, _, _, _),
+ process_call_for_implicit_parallelism(!.HLDSGoal, ProcInfo,
+ !ModuleInfo, !IndexInConj, !MaybeConj,
+ !CalleeListToBeParallelized, !Counter)
+ ;
+ Details = class_method(_, _, _, _),
+ process_call_for_implicit_parallelism(!.HLDSGoal, ProcInfo,
+ !ModuleInfo, !IndexInConj, !MaybeConj,
+ !CalleeListToBeParallelized, !Counter)
+ ;
+ Details = event_call(_),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ Details = cast(_),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ )
+ ;
+ % No distinction is made between plain conjunctions and parallel
+ % conjunctions. We have to process the parallel conjunction for the
+ % slot number.
+ HLDSGoalExpr0 = conj(_, _),
+ process_conj_for_implicit_parallelism(HLDSGoalExpr0, HLDSGoalExpr, 1,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter),
+ % A plain conjunction will never be contained in an other plain
+ % conjunction. As for parallel conjunctions, they wont
+ % be modified. Therefore, incrementing the index suffices (no need to
+ % call update_conj_and_index).
+ !:HLDSGoal = HLDSGoalExpr - HLDSGoalInfo,
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ HLDSGoalExpr0 = disj(HLDSGoals0),
+ process_disj_for_implicit_parallelism(HLDSGoals0, [], HLDSGoals,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter),
+ GoalProcessed = disj(HLDSGoals) - HLDSGoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ % If we are not in a conjunction, then we need to return the modified
+ % value of HLDSGoal. In we are in a conjunction, that information is not
+ % read (see process_conj_for_implicit_parallelism).
+ !:HLDSGoal = GoalProcessed
+ ;
+ HLDSGoalExpr0 = switch(Var, CanFail, Cases0),
+ process_switch_cases_for_implicit_parallelism(Cases0, [], Cases,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter),
+ GoalProcessed = switch(Var, CanFail, Cases) - HLDSGoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:HLDSGoal = GoalProcessed
+ ;
+ HLDSGoalExpr0 = negation(HLDSGoal0),
+ process_goal_for_implicit_parallelism(HLDSGoal0, HLDSGoal, ProcInfo,
+ !ModuleInfo, !MaybeConj, !IndexInConj, !CalleeListToBeParallelized,
+ !Counter),
+ GoalProcessed = negation(HLDSGoal) - HLDSGoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:HLDSGoal = GoalProcessed
+ ;
+ HLDSGoalExpr0 = scope(_, _),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ HLDSGoalExpr0 = if_then_else(Vars, If0, Then0, Else0),
+ % 0 is the default value when we are not in a conjunction (in this case
+ % an if then else).
+ process_goal_for_implicit_parallelism(If0, If, ProcInfo, !ModuleInfo,
+ no, _, 0, _, !CalleeListToBeParallelized, !Counter),
+ process_goal_for_implicit_parallelism(Then0, Then, ProcInfo, !ModuleInfo
+ , no, _, 0, _, !CalleeListToBeParallelized, !Counter),
+ process_goal_for_implicit_parallelism(Else0, Else, ProcInfo, !ModuleInfo
+ , no, _, 0, _, !CalleeListToBeParallelized, !Counter),
+ GoalProcessed = if_then_else(Vars, If, Then, Else) - HLDSGoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:HLDSGoal = GoalProcessed
+ ;
+ HLDSGoalExpr0 = shorthand(_),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ).
+
+ % Increment the index if we are in a conjunction.
+ %
+:- pred increment_index_if_in_conj(maybe(hlds_goal_expr)::in, int::in, int::out)
+ is det.
+
+increment_index_if_in_conj(MaybeConj, !IndexInConj) :-
+ (
+ MaybeConj = yes(_),
+ !:IndexInConj = !.IndexInConj + 1
+ ;
+ MaybeConj = no
+ ).
+
+ % Process a call for implicit parallelism.
+ %
+:- pred process_call_for_implicit_parallelism(hlds_goal::in, proc_info::in,
+ module_info::in, module_info::out, int::in, int::out,
+ maybe(hlds_goal_expr)::in, maybe(hlds_goal_expr)::out,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out,
+ counter::in, counter::out) is det.
+
+process_call_for_implicit_parallelism(Call, ProcInfo, !ModuleInfo, !IndexInConj
+ , !MaybeConj, !CalleeListToBeParallelized, !Counter) :-
+ counter.allocate(SlotNumber, !Counter),
+ get_call_kind_and_callee(!.ModuleInfo, Call, Kind, CalleeRawId),
+ ( !.MaybeConj = yes(Conj0), Conj0 = conj(plain_conj, ConjGoals0)
+ ->
+ (is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
+ !.CalleeListToBeParallelized, [], !:CalleeListToBeParallelized)
+ ->
+ ( build_goals_surrounded_by_calls_to_be_parallelized(ConjGoals0,
+ !.ModuleInfo, [Call], Goals, !.IndexInConj + 1, End, !Counter,
+ !CalleeListToBeParallelized)
+ ->
+ parallelize_calls(Goals, !.IndexInConj, End, Conj0, Conj,
+ ProcInfo, !ModuleInfo),
+ !:IndexInConj = End,
+ !:MaybeConj = yes(Conj)
+ ;
+ % The next call is not in the feedback file or we've hit a
+ % plain conjunction/disjunction/switch/if then else.
+ !:IndexInConj = !.IndexInConj + 1
+ )
+ ;
+ % Not to be parallelized.
+ !:IndexInConj = !.IndexInConj + 1
+ )
+ ;
+ % Call is not in a conjunction or the call is already in a parallel
+ % conjunction.
+ true
+ ).
+
+ % Give the raw id (the same as in the deep profiler) of a callee contained
+ % in a call.
+ %
+:- pred get_call_kind_and_callee(module_info::in, hlds_goal::in, string::out,
+ string::out) is det.
+
+get_call_kind_and_callee(ModuleInfo, Call, Kind, CalleeRawId) :-
+ GoalExpr = fst(Call),
+ ( GoalExpr = plain_call(PredId, ProcId, _, _, _, _)
+ ->
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, _),
+ pred_proc_id_to_raw_id(PredInfo, ProcId, CalleeRawId),
+ Kind = "normal_call"
+ ;
+ ( GoalExpr = call_foreign_proc(_, PredId, ProcId, _, _, _, _)
+ ->
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, _),
+ pred_proc_id_to_raw_id(PredInfo, ProcId, CalleeRawId),
+ Kind = "special_call"
+ ;
+ ( GoalExpr = generic_call(Details, _, _, _)
+ ->
+ (
+ Details = higher_order(_, _, _, _),
+ CalleeRawId = "",
+ Kind = "higher_order_call"
+ ;
+ Details = class_method(_, _, _, _),
+ CalleeRawId = "",
+ Kind = "method_call"
+ ;
+ Details = event_call(_),
+ error("get_call_kind_and_callee:: the call is an event" ++
+ " call")
+ ;
+ Details = cast(_),
+ error("get_call_kind_and_callee: the call is a cast")
+ )
+ ;
+ error("get_call_kind_and_callee: not a call")
+ )
+ )
+ ).
+
+ % Convert a pred_info and a proc_id to the raw procedure id (the same used
+ % in the deep profiler).
+ %
+:- pred pred_proc_id_to_raw_id(pred_info::in, proc_id::in, string::out) is det.
+
+pred_proc_id_to_raw_id(PredInfo, ProcId, RawId) :-
+ Module = pred_info_module(PredInfo),
+ Name = pred_info_name(PredInfo),
+ OrigArity = pred_info_orig_arity(PredInfo),
+ IsPredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ ModuleString = sym_name_to_string(Module),
+ ProcIdInt = proc_id_to_int(ProcId),
+ RawId = string.append_list([ModuleString, ".", Name, "/",
+ string.int_to_string(OrigArity),
+ ( IsPredOrFunc = function -> "+1" ; ""), "-",
+ string.from_int(ProcIdInt)]).
+
+ % Succeed if the caller, slot number and callee correspond to a
+ % css_to_be_parallelized in the list given as a parameter.
+ % Fail otherwise.
+ %
+:- pred is_in_css_list_to_be_parallelized(string::in, int::in, string::in,
+ list(css_to_be_parallelized)::in,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out)
+ is semidet.
+
+is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
+ CSSListToBeParallelized, !ResultAcc) :-
+ (
+ CSSListToBeParallelized = [],
+ fail
+ ;
+ CSSListToBeParallelized = [ CSSToBeParallelized |
+ CSSListToBeParallelized0],
+ CSSToBeParallelized = css_to_be_parallelized(_, CSSSlotNumber, CSSKind,
+ CSSCallee),
+ % =< because there is not a one to one correspondance with the source
+ % code. New calls might have been added by the previous stages of the
+ % compiler.
+ ( CSSSlotNumber =< SlotNumber, CSSKind = Kind, CSSCallee = CalleeRawId
+ ->
+ list.append(!.ResultAcc, CSSListToBeParallelized0, !:ResultAcc)
+ ;
+ list.append(!.ResultAcc, [CSSToBeParallelized], !:ResultAcc),
+ is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
+ CSSListToBeParallelized0, !ResultAcc)
+ )
+ ).
+
+ % Build a list of goals surrounded by two calls which are in the feedback
+ % file or by a call which is in the feedback file and a parallel
+ % conjunction.
+ %
+ % Succeed if we can build that list of goals.
+ % Fail otherwise.
+ %
+:- pred build_goals_surrounded_by_calls_to_be_parallelized(list(hlds_goal)::in,
+ module_info::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ int::in, int::out, counter::in, counter::out,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out)
+ is semidet.
+
+build_goals_surrounded_by_calls_to_be_parallelized(ConjGoals, ModuleInfo,
+ !ResultAcc, !Index, !Counter, !CalleeListToBeParallelized) :-
+ list.length(ConjGoals, Length),
+ ( !.Index > Length
+ ->
+ fail
+ ;
+ list.index1_det(ConjGoals, !.Index, Goal),
+ GoalExpr = fst(Goal),
+ ( ( GoalExpr = disj(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = conj(plain_conj, _)
+ ) ->
+ fail
+ ;
+ ( is_a_conjunct(Goal, parallel_conj) ->
+ list.append(!.ResultAcc, [Goal], !:ResultAcc)
+ ;
+ ( is_a_call(Goal)
+ ->
+ counter.allocate(SlotNumber, !Counter),
+ get_call_kind_and_callee(ModuleInfo, Goal, Kind,
+ CalleeRawId),
+ ( is_in_css_list_to_be_parallelized(Kind, SlotNumber,
+ CalleeRawId, !.CalleeListToBeParallelized, [],
+ !:CalleeListToBeParallelized)
+ ->
+ list.append(!.ResultAcc, [Goal], !:ResultAcc)
+ ;
+ list.append(!.ResultAcc, [Goal], !:ResultAcc),
+ !:Index = !.Index + 1,
+ build_goals_surrounded_by_calls_to_be_parallelized(
+ ConjGoals, ModuleInfo, !ResultAcc, !Index, !Counter,
+ !CalleeListToBeParallelized)
+ )
+ ;
+ list.append(!.ResultAcc, [Goal], !:ResultAcc),
+ !:Index = !.Index + 1,
+ build_goals_surrounded_by_calls_to_be_parallelized(
+ ConjGoals, ModuleInfo, !ResultAcc, !Index, !Counter,
+ !CalleeListToBeParallelized)
+ )
+ )
+ )
+ ).
+
+ % Succeed if the Goal is a conjunction.
+ % Fail otherwise.
+ %
+:- pred is_a_conjunct(hlds_goal::in, conj_type::out) is semidet.
+
+is_a_conjunct(Goal, Type) :-
+ GoalExpr = fst(Goal),
+ GoalExpr = conj(Type, _).
+
+ % Succeed if Goal is a call or a call inside a negation.
+ % Fail otherwise.
+ %
+:- pred is_a_call(hlds_goal::in) is semidet.
+
+is_a_call(Goal) :-
+ GoalExpr = fst(Goal),
+ (
+ GoalExpr = plain_call(_, _, _, _, _, _)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalExpr = generic_call(Details, _, _, _),
+ (
+ Details = class_method(_, _, _, _)
+ ;
+ Details = higher_order(_, _, _, _)
+ )
+ ;
+ GoalExpr = negation(GoalNeg),
+ GoalNegExpr = fst(GoalNeg),
+ (
+ GoalNegExpr = plain_call(_, _, _, _, _, _)
+ ;
+ GoalNegExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalNegExpr = generic_call(Details, _, _, _),
+ (
+ Details = class_method(_, _, _, _)
+ ;
+ Details = higher_order(_, _, _, _)
+ )
+ )
+ ).
+
+ % Parallelize two calls/a call and a parallel conjunction which might have
+ % goals between them. If these have no dependencies with the first call then
+ % we move them before the first call and parallelize the two calls/call and
+ % parallel conjunction.
+ %
+ % Goals is contained in Conj.
+ %
+:- pred parallelize_calls(list(hlds_goal)::in, int::in, int::in,
+ hlds_goal_expr::in, hlds_goal_expr::out, proc_info::in,
+ module_info::in, module_info::out) is det.
+
+parallelize_calls(Goals, Start, End, !Conj, ProcInfo, !ModuleInfo) :-
+ ( !.Conj = conj(plain_conj, ConjGoals0) ->
+ ( ConjGoals0 = [FirstGoal, LastGoal] ->
+ ( is_worth_parallelizing(FirstGoal, LastGoal, ProcInfo,
+ !.ModuleInfo)
+ ->
+ ( is_a_conjunct(LastGoal, parallel_conj) ->
+ % The parallel conjunction has to remain flatened.
+ add_call_to_parallel_conjunction(FirstGoal, LastGoal,
+ ParallelGoal),
+ !:Conj = fst(ParallelGoal)
+ ;
+ !:Conj = conj(parallel_conj, ConjGoals0)
+ )
+ ;
+ % Not worth parallelizing.
+ true
+ )
+ ;
+ % There are more than two goals in the conjunction.
+ list.length(Goals, Length),
+ list.index1_det(Goals, 1, FirstGoal),
+ list.index1_det(Goals, Length, LastGoal),
+ ( is_worth_parallelizing(FirstGoal, LastGoal, ProcInfo,
+ !.ModuleInfo)
+ ->
+ GoalsInBetweenAndLast = list.det_tail(Goals),
+ list.delete_all(GoalsInBetweenAndLast, LastGoal,
+ GoalsInBetween),
+ % Check the dependencies of GoalsInBetween with FirstGoal.
+ list.filter(goal_depends_on_goal(FirstGoal),
+ GoalsInBetween, GoalsFiltered),
+ ( list.is_empty(GoalsFiltered) ->
+ ( is_a_conjunct(LastGoal, parallel_conj) ->
+ add_call_to_parallel_conjunction(FirstGoal, LastGoal,
+ ParallelGoal)
+ ;
+ create_conj(FirstGoal, LastGoal, parallel_conj,
+ ParallelGoal)
+ ),
+ ( Start = 1 ->
+ GoalsFront = []
+ ;
+ list.det_split_list(Start - 1, ConjGoals0,
+ GoalsFront, _)
+ ),
+ list.length(ConjGoals0, ConjLength),
+ ( End = ConjLength ->
+ GoalsBack = []
+ ;
+ list.det_split_list(End, ConjGoals0, _,
+ GoalsBack)
+ ),
+ list.append(GoalsFront, GoalsInBetween,
+ GoalsFrontWithBetween),
+ list.append(GoalsFrontWithBetween, [ParallelGoal],
+ GoalsWithoutBack),
+ list.append(GoalsWithoutBack, GoalsBack, ConjGoals),
+ !:Conj = conj(plain_conj, ConjGoals)
+ ;
+ % The goals between the two calls/call and parallel
+ % conjunction can't be moved before the first call.
+ true
+ )
+ ;
+ % Not worth parallelizing.
+ true
+ )
+ )
+ ;
+ error("parallelize_calls: not in a plain conjunct ")
+ ).
+
+ % Two calls are worth parallelizing if the number of shared variables is
+ % smaller than the number of argument variables of at least one of the two
+ % calls.
+ %
+ % A call and a parallel conjunction are worth parallelizing if the number of
+ % shared variables is smaller than the number of argument variables of the
+ % call.
+ %
+ % Succeed if it is worth parallelizing the two goals.
+ % Fail otherwise.
+ %
+ %
+:- pred is_worth_parallelizing(hlds_goal::in, hlds_goal::in, proc_info::in,
+ module_info::in) is semidet.
+
+is_worth_parallelizing(GoalA, GoalB, ProcInfo, ModuleInfo) :-
+ proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap),
+ SharedVars = find_shared_variables(ModuleInfo, InstMap, [GoalA, GoalB]),
+ set.to_sorted_list(SharedVars, SharedVarsList),
+ list.length(SharedVarsList, NbSharedVars),
+ ( NbSharedVars = 0 ->
+ % No shared vars between the goals.
+ true
+ ;
+ ( is_a_conjunct(GoalB, parallel_conj) ->
+ get_number_args(GoalA, NbArgsA),
+ NbSharedVars < NbArgsA
+ ;
+ ( get_number_args(GoalA, NbArgsA), get_number_args(GoalB, NbArgsB)
+ ->
+ ( ( NbSharedVars < NbArgsA, NbSharedVars < NbArgsB
+ ; NbSharedVars = NbArgsA, NbSharedVars < NbArgsB
+ ; NbSharedVars < NbArgsA, NbSharedVars = NbArgsB
+ )
+ ->
+ true
+ ;
+ fail
+ )
+ ;
+ error("is_worth_parallelizing: GoalA and/or GoalB are/is" ++
+ " not a call")
+ )
+ )
+ ).
+
+ % Give the number of argument variables of a call.
+ %
+:- pred get_number_args(hlds_goal::in, int::out) is semidet.
+
+get_number_args(Call, NbArgs) :-
+ CallExpr = fst(Call),
+ (
+ CallExpr = plain_call(_, _, Args, _, _, _),
+ list.length(Args, NbArgs)
+ ;
+ CallExpr = generic_call(Details, Args, _, _),
+ (
+ Details = higher_order(_, _, _, _),
+ list.length(Args, NbArgs)
+ ;
+ Details = class_method(_, _, _, _),
+ list.length(Args, NbArgs)
+ )
+ ;
+ CallExpr = call_foreign_proc(_, _, _, Args, _, _, _),
+ list.length(Args, NbArgs)
+ ).
+
+ % Add a call to an existing parallel conjunction.
+ %
+:- pred add_call_to_parallel_conjunction(hlds_goal::in, hlds_goal::in,
+ hlds_goal::out) is det.
+
+add_call_to_parallel_conjunction(Call, ParallelGoal0, ParallelGoal) :-
+ ParallelGoalExpr0 = fst(ParallelGoal0),
+ ParallelGoalInfo0 = snd(ParallelGoal0),
+ ( ParallelGoalExpr0 = conj(parallel_conj, GoalList0) ->
+ GoalList = [Call | GoalList0],
+ goal_list_nonlocals(GoalList, NonLocals),
+ goal_list_instmap_delta(GoalList, InstMapDelta),
+ goal_list_determinism(GoalList, Detism),
+ goal_list_purity(GoalList, Purity),
+ goal_info_set_nonlocals(NonLocals, ParallelGoalInfo0,
+ ParallelGoalInfo1),
+ goal_info_set_instmap_delta(InstMapDelta, ParallelGoalInfo1,
+ ParallelGoalInfo2),
+ goal_info_set_determinism(Detism, ParallelGoalInfo2, ParallelGoalInfo3),
+ goal_info_set_purity(Purity, ParallelGoalInfo3, ParallelGoalInfo),
+ ParallelGoalExpr = conj(parallel_conj, GoalList),
+ ParallelGoal = ParallelGoalExpr - ParallelGoalInfo
+ ;
+ error("add_call_to_parallel_conjunction: ParallelGoal0 is not a " ++
+ "parallel conjunction")
+ ).
+
+create_conj(GoalA, GoalB, Type, ConjGoal) :-
+ GoalsInConj = [GoalA, GoalB],
+ ConjGoalExpr = conj(Type, GoalsInConj),
+ goal_list_nonlocals(GoalsInConj, NonLocals),
+ goal_list_instmap_delta(GoalsInConj, InstMapDelta),
+ goal_list_determinism(GoalsInConj, Detism),
+ goal_list_purity(GoalsInConj, Purity),
+ GoalAInfo = snd(GoalA),
+ goal_info_get_context(GoalAInfo, Context),
+ goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
+ ConjGoalInfo),
+ ConjGoal = ConjGoalExpr - ConjGoalInfo.
+
+ % Succeed if the first goal depends on the second one.
+ % Fail otherwise.
+ %
+:- pred goal_depends_on_goal(hlds_goal::in, hlds_goal::in) is semidet.
+
+goal_depends_on_goal(_ - GoalInfo1, _ - GoalInfo2) :-
+ goal_info_get_instmap_delta(GoalInfo1, InstmapDelta1),
+ instmap_delta_changed_vars(InstmapDelta1, ChangedVars1),
+ goal_info_get_nonlocals(GoalInfo2, NonLocals2),
+ set.intersect(ChangedVars1, NonLocals2, Intersection),
+ \+ set.empty(Intersection).
+
+ % Process a conjunction for implicit parallelism.
+ %
+:- pred process_conj_for_implicit_parallelism(
+ hlds_goal_expr::in, hlds_goal_expr::out, int::in,
+ proc_info::in, module_info::in, module_info::out,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out,
+ counter::in, counter::out) is det.
+
+process_conj_for_implicit_parallelism(!HLDSGoalExpr, IndexInConj, ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !Counter) :-
+ ( !.HLDSGoalExpr = conj(_, HLDSGoalsConj) ->
+ list.length(HLDSGoalsConj, Length),
+ ( IndexInConj > Length ->
+ true
+ ;
+ MaybeConj0 = yes(!.HLDSGoalExpr),
+ list.index1_det(HLDSGoalsConj, IndexInConj, HLDSGoalInConj),
+ % We are not interested in the return value of HLDSGoalInConj, only
+ % MaybeConj matters.
+ process_goal_for_implicit_parallelism(HLDSGoalInConj, _, ProcInfo,
+ !ModuleInfo, MaybeConj0, MaybeConj, IndexInConj, IndexInConj0,
+ !CalleeListToBeParallelized, !Counter),
+ ( MaybeConj = yes(HLDSGoalExprProcessed) ->
+ !:HLDSGoalExpr = HLDSGoalExprProcessed
+ ;
+ error("process_conj_for_implicit_parallelism: wrong maybe" ++
+ " value")
+ ),
+ process_conj_for_implicit_parallelism(!HLDSGoalExpr, IndexInConj0,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter)
+ )
+ ;
+ error("process_conj_for_implicit_parallelism: not a conjunct")
+ ).
+
+ % Process a disjunction for implicit parallelism.
+ %
+:- pred process_disj_for_implicit_parallelism(
+ list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ proc_info::in, module_info::in, module_info::out,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out,
+ counter::in, counter::out) is det.
+
+process_disj_for_implicit_parallelism([], !HLDSGoalsAcc, _ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !Counter).
+process_disj_for_implicit_parallelism([HLDSGoal0 | HLDSGoals], !HLDSGoalsAcc,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter) :-
+ process_goal_for_implicit_parallelism(HLDSGoal0, HLDSGoal, ProcInfo,
+ !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !Counter),
+ list.append(!.HLDSGoalsAcc, [HLDSGoal], !:HLDSGoalsAcc),
+ process_disj_for_implicit_parallelism(HLDSGoals, !HLDSGoalsAcc, ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !Counter).
+
+ % If we are in a conjunction, update it by replacing the goal at index by
+ % Goal and increment the index.
+ %
+:- pred update_conj_and_index(
+ maybe(hlds_goal_expr)::in, maybe(hlds_goal_expr)::out,
+ hlds_goal::in, int::in, int::out) is det.
+
+update_conj_and_index(!MaybeConj, Goal, !IndexInConj) :-
+ ( !.MaybeConj = yes(conj(Type, Goals0)) ->
+ list.replace_nth_det(Goals0, !.IndexInConj, Goal, Goals),
+ !:IndexInConj = !.IndexInConj + 1,
+ !:MaybeConj = yes(conj(Type, Goals))
+ ;
+ true
+ ).
+
+ % Process a switch for implicit parallelism.
+ %
+:- pred process_switch_cases_for_implicit_parallelism(
+ list(case)::in, list(case)::in, list(case)::out, proc_info::in,
+ module_info::in, module_info::out,
+ list(css_to_be_parallelized)::in, list(css_to_be_parallelized)::out,
+ counter::in, counter::out) is det.
+
+process_switch_cases_for_implicit_parallelism([], !CasesAcc, _ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !Counter).
+process_switch_cases_for_implicit_parallelism([Case0 | Cases], !CasesAcc,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter) :-
+ Case0 = case(Functor, Goal0),
+ process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
+ !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !Counter),
+ list.append(!.CasesAcc, [ case(Functor, Goal) ], !:CasesAcc),
+ process_switch_cases_for_implicit_parallelism(Cases, !CasesAcc,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !Counter).
+
+%-----------------------------------------------------------------------------%
+
+ % Parse the feedback file (header and body).
+ %
+:- pred parse_feedback_file(string::in,
+ maybe_error(list(css_to_be_parallelized))::out, io::di, io::uo) is det.
+
+parse_feedback_file(InputFile, MaybeCSSListToBeParallelized, !IO) :-
+ io.open_input(InputFile, Result, !IO),
+ (
+ Result = io.error(ErrInput),
+ MaybeCSSListToBeParallelized = error(io.error_message(ErrInput))
+ ;
+ Result = ok(InStrm),
+ io.read_file_as_string(InStrm, MaybeFileAsString, !IO),
+ (
+ MaybeFileAsString = ok(FileAsString),
+ LineList = string.words_separator(is_carriage_return,
+ FileAsString),
+ process_header(LineList, MaybeBodyFileAsListString, !IO),
+ (
+ MaybeBodyFileAsListString = error(ErrProcessHeader),
+ MaybeCSSListToBeParallelized = error(ErrProcessHeader)
+ ;
+ MaybeBodyFileAsListString = ok(BodyFileAsListString),
+ process_body(BodyFileAsListString,
+ MaybeCSSListToBeParallelized0),
+ (
+ MaybeCSSListToBeParallelized0 =
+ ok(CSSListToBeParallelized),
+ MaybeCSSListToBeParallelized = ok(CSSListToBeParallelized)
+ ;
+ MaybeCSSListToBeParallelized0 = error(Err),
+ MaybeCSSListToBeParallelized = error(Err)
+ )
+ )
+ ;
+ MaybeFileAsString = error(_, ErrReadFileAsString),
+ MaybeCSSListToBeParallelized =
+ error(io.error_message(ErrReadFileAsString))
+ ),
+ io.close_input(InStrm, !IO)
+ ).
+
+:- pred is_carriage_return(char::in) is semidet.
+
+is_carriage_return(Char) :- Char = '\n'.
+
+ % Process the header of the feedback file.
+ %
+:- pred process_header(list(string)::in, maybe_error(list(string))::out,
+ io::di, io::uo) is det.
+
+process_header(FileAsListString, MaybeFileAsListStringWithoutHeader, !IO) :-
+ ( list.index0(FileAsListString, 0, Type) ->
+ ( Type = "Profiling feedback file" ->
+ (list.index0(FileAsListString, 1, Version) ->
+ ( Version = "Version = 1.0" ->
+ list.det_split_list(4, FileAsListString, _,
+ FileAsListStringWithoutHeader),
+ MaybeFileAsListStringWithoutHeader =
+ ok(FileAsListStringWithoutHeader)
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Profiling" ++
+ " feedback file version incorrect")
+ )
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Not a profiling"
+ ++ " feedback file")
+ )
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Not a profiling" ++
+ " feedback file")
+ )
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Not a profiling feedback"
+ ++ " file")
+ ).
+
+ % Process the body of the feedback file.
+ %
+:- pred process_body(list(string)::in,
+ maybe_error(list(css_to_be_parallelized))::out) is det.
+
+process_body(CoreFileAsListString, MaybeCSSListToBeParallelized) :-
+ ( process_body2(CoreFileAsListString, [], CSSListToBeParallelized) ->
+ MaybeCSSListToBeParallelized = ok(CSSListToBeParallelized)
+ ;
+ MaybeCSSListToBeParallelized = error("Profiling feedback file has been"
+ ++ " tampered with")
+ ).
+
+:- pred process_body2(list(string)::in, list(css_to_be_parallelized)::in,
+ list(css_to_be_parallelized)::out) is semidet.
+
+process_body2([], !CSSListToBeParallelizedAcc).
+process_body2([Line | Lines], !CSSListToBeParallelizedAcc) :-
+ Words = string.words_separator(is_whitespace, Line),
+ list.index0_det(Words, 0, Caller),
+ ( Caller = "Mercury" ->
+ process_body2(Lines, !CSSListToBeParallelizedAcc)
+ ;
+ list.index0_det(Words, 1, SlotNumber),
+ string.to_int(SlotNumber, IntSlotNumber),
+ list.index0_det(Words, 2, Kind),
+ ( Kind = "normal_call" ->
+ list.index0_det(Words, 3, Callee),
+ CSStoBeParallelized = css_to_be_parallelized(Caller, IntSlotNumber,
+ Kind, Callee)
+ ;
+ CSStoBeParallelized = css_to_be_parallelized(Caller, IntSlotNumber,
+ Kind, "")
+ ),
+ !:CSSListToBeParallelizedAcc = [ CSStoBeParallelized |
+ !.CSSListToBeParallelizedAcc ],
+ process_body2(Lines, !CSSListToBeParallelizedAcc)
+ ).
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds.implicit_parallelism.
+%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.414
diff -u -r1.414 mercury_compile.m
--- compiler/mercury_compile.m 3 Nov 2006 08:31:09 -0000 1.414
+++ compiler/mercury_compile.m 27 Nov 2006 05:13:50 -0000
@@ -78,6 +78,7 @@
:- import_module transform_hlds.trailing_analysis.
:- import_module transform_hlds.tabling_analysis.
:- import_module transform_hlds.higher_order.
+:- import_module transform_hlds.implicit_parallelism.
:- import_module transform_hlds.accumulator.
:- import_module transform_hlds.tupling.
:- import_module transform_hlds.untupling.
@@ -89,6 +90,7 @@
:- import_module transform_hlds.unused_args.
:- import_module transform_hlds.unneeded_code.
:- import_module transform_hlds.lco.
+:- import_module transform_hlds.distance_granularity.
:- import_module transform_hlds.ctgc.
:- import_module transform_hlds.ctgc.structure_reuse.
:- import_module transform_hlds.ctgc.structure_reuse.analysis.
@@ -2414,7 +2416,7 @@
module_info_get_globals(!.HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
-
+
maybe_read_experimental_complexity_file(!HLDS, !IO),
tabling(Verbose, Stats, !HLDS, !IO),
@@ -2523,9 +2525,15 @@
maybe_structure_reuse_analysis(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 195, "structure_reuse", !DumpInfo, !IO),
+ maybe_implicit_parallelism(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 199, "implicit_parallelism", !DumpInfo, !IO),
+
maybe_control_granularity(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 200, "granularity", !DumpInfo, !IO),
+ maybe_control_distance_granularity(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 201, "distance_granularity", !DumpInfo, !IO),
+
maybe_dependent_par_conj(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 205, "dependent_par_conj", !DumpInfo, !IO),
@@ -3830,6 +3838,55 @@
Sharing = no
).
+:- pred maybe_implicit_parallelism(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+maybe_implicit_parallelism(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, parallel, Parallel),
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ globals.lookup_bool_option(Globals, implicit_parallelism,
+ ImplicitParallelism),
+ globals.lookup_string_option(Globals, feedback_file,
+ FeedbackFile),
+ ( FeedbackFile = "" ->
+ % No feedback file has been specified.
+ true
+ ;
+ (
+ % If this is false, no implicit parallelism is to be introduced.
+ Parallel = yes,
+
+ % If this is false, then the user hasn't asked for implicit
+ % parallelism.
+ ImplicitParallelism = yes,
+
+ % Our mechanism for implicit parallelism only works for the low
+ % level backend.
+ HighLevelCode = no
+ ->
+ globals.get_target(Globals, Target),
+ (
+ Target = target_c,
+ maybe_write_string(Verbose, "% Applying implicit parallelism...\n"
+ , !IO),
+ maybe_flush_output(Verbose, !IO),
+ apply_implicit_parallelism_transformation(!HLDS,
+ FeedbackFile, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ ( Target = target_il
+ ; Target = target_java
+ ; Target = target_asm
+ )
+ % Leave the HLDS alone. We cannot implement parallelism.
+ )
+ ;
+ true
+ )
+ ).
+
:- pred maybe_control_granularity(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3872,6 +3929,49 @@
true
).
+:- pred maybe_control_distance_granularity(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+maybe_control_distance_granularity(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, parallel, Parallel),
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ globals.lookup_int_option(Globals, distance_granularity, Distance),
+ module_info_get_contains_par_conj(!.HLDS, ContainsParConj),
+ (
+ % If either of these is false, there is no parallelism to control.
+ Parallel = yes,
+ ContainsParConj = yes,
+
+ % Our mechanism for granularity control only works for the low level
+ % backend.
+ HighLevelCode = no,
+
+ % Distance must be greater than 0 to apply the distance granularity
+ % transformation.
+ Distance > 0
+ ->
+ globals.get_target(Globals, Target),
+ (
+ Target = target_c,
+ maybe_write_string(Verbose,
+ "% Distance granularity transformation...\n", !IO),
+ maybe_flush_output(Verbose, !IO),
+ control_distance_granularity(!HLDS, Distance),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ ( Target = target_il
+ ; Target = target_java
+ ; Target = target_asm
+ )
+ % Leave the HLDS alone. We cannot implement parallelism,
+ % so there is not point in controlling its granularity.
+ )
+ ;
+ true
+ ).
+
:- pred maybe_dependent_par_conj(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.536
diff -u -r1.536 options.m
--- compiler/options.m 3 Nov 2006 08:31:10 -0000 1.536
+++ compiler/options.m 27 Nov 2006 02:15:43 -0000
@@ -547,7 +547,9 @@
; tuple_costs_ratio
; tuple_min_args
; control_granularity
+ ; distance_granularity
; parallelism_target
+ ; implicit_parallelism
% Stuff for the CTGC system (structure sharing / structure reuse).
; structure_sharing_analysis
@@ -789,7 +791,7 @@
% recent when no other test can easily be constructed in
% configure.in.
- ; experiment.
+ ; experiment
% This option is provided for use by implementors who want to
% compare a new way of doing something with the old way. The idea
% is that the code that switches between the two ways should
@@ -802,6 +804,7 @@
% option to control their code, but adding an option requires
% recompiling most of the modules in the compiler. Having this
% option permanently here should reduce the need for that.
+ ; feedback_file.
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
@@ -1295,7 +1298,9 @@
tuple_costs_ratio - int(100),
tuple_min_args - int(4),
control_granularity - bool(no),
+ distance_granularity - int(0),
parallelism_target - int(4),
+ implicit_parallelism - bool(no),
% HLDS -> LLDS
smart_indexing - bool(no),
@@ -1533,7 +1538,8 @@
fullarch - string(""),
local_module_id - accumulating([]),
compiler_sufficiently_recent - bool(no),
- experiment - string("")
+ experiment - string(""),
+ feedback_file - string("")
]).
% please keep this in alphabetic order
@@ -2046,7 +2052,9 @@
long_option("tuple-costs-ratio", tuple_costs_ratio).
long_option("tuple-min-args", tuple_min_args).
long_option("control-granularity", control_granularity).
+long_option("distance-granularity", distance_granularity).
long_option("parallelism-target", parallelism_target).
+long_option("implicit-parallelism", implicit_parallelism).
% CTGC related options.
long_option("structure-sharing", structure_sharing_analysis).
@@ -2307,6 +2315,7 @@
long_option("no-noncompact-ho-call-2004-01-15", compiler_sufficiently_recent).
long_option("trace-io-builtins-2006-08-14", compiler_sufficiently_recent).
long_option("experiment", experiment).
+long_option("feedback-file", feedback_file).
%-----------------------------------------------------------------------------%
@@ -4215,7 +4224,12 @@
"\thandle, which is specified using --parallelism-target.",
"--parallelism-target N",
"\tSpecified the number of CPUs of the target machine, for use by",
- "\tthe --control-granularity option."
+ "\tthe --control-granularity option.",
+ "--distance-granularity <value>",
+ "\tControl the granularity using the specified distance value",
+ "--implicit-parallelism",
+ "\tApply implicit parallelism if a profiling feedback file is",
+ "\tspecified using the feedback-file option."
]).
:- pred options_help_hlds_llds_optimization(io::di, io::uo) is det.
@@ -4711,12 +4725,15 @@
"\tcompile several modules without the overhead of process",
"\tcreation for each one.)",
"--version",
- "\tDisplay the compiler version."
+ "\tDisplay the compiler version.",
% The `--fullarch' option is reserved for
% use by the `Mercury.config' file.
% The `--local-module-id' option is used by `mmc --make'.
+ "--feedback-file",
+ "\tUse the specified feedback file which may currently only",
+ "\tprocessed for implicit parallelism."
]).
:- pred write_tabbed_lines(list(string)::in, io::di, io::uo) is det.
Index: compiler/pred_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pred_table.m,v
retrieving revision 1.5
diff -u -r1.5 pred_table.m
--- compiler/pred_table.m 2 Oct 2006 05:21:20 -0000 1.5
+++ compiler/pred_table.m 23 Nov 2006 04:42:28 -0000
@@ -301,6 +301,8 @@
string::in, pred_or_func::in, arity::in, mode_no::in,
pred_id::out, proc_id::out) is det.
+:-pred get_next_pred_id(predicate_table::in, pred_id::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -1171,6 +1173,9 @@
)
).
+get_next_pred_id(PredTable, NextPredId) :-
+ NextPredId = PredTable ^ next_pred_id.
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.25
diff -u -r1.25 transform_hlds.m
--- compiler/transform_hlds.m 3 Nov 2006 08:31:12 -0000 1.25
+++ compiler/transform_hlds.m 26 Nov 2006 23:31:01 -0000
@@ -83,8 +83,10 @@
:- include_module size_prof.
:- include_module tupling.
:- include_module untupling.
+:- include_module distance_granularity.
:- include_module granularity.
:- include_module dep_par_conj.
+:- include_module implicit_parallelism.
:- include_module mmc_analysis.
Index: deep_profiler/dump.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/dump.m,v
retrieving revision 1.8
diff -u -r1.8 dump.m
--- deep_profiler/dump.m 12 Oct 2006 06:30:21 -0000 1.8
+++ deep_profiler/dump.m 22 Nov 2006 01:30:02 -0000
@@ -742,6 +742,7 @@
should_dump(DumpOptions, What) :-
( list.member(What, DumpOptions)
+ ; list.member("all", DumpOptions)
; DumpOptions = []
).
Index: deep_profiler/mdprof_feedback.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/mdprof_feedback.m,v
retrieving revision 1.1
diff -u -r1.1 mdprof_feedback.m
--- deep_profiler/mdprof_feedback.m 19 Oct 2006 06:20:20 -0000 1.1
+++ deep_profiler/mdprof_feedback.m 22 Nov 2006 01:30:02 -0000
@@ -64,17 +64,22 @@
write_help_message(ProgName, !IO)
;
( Args = [Input, Output] ->
- lookup_string_option(Options, distribution, Distribution),
- ( construct_distribution(Distribution, DistributionType) ->
+ lookup_string_option(Options, measure, Measure),
+ ( construct_measure(Measure, MeasureType) ->
lookup_int_option(Options, threshold, Threshold),
lookup_bool_option(Options, verbose, Verbose),
- read_deep_file(Input, Verbose, MaybeProfile, !IO),
+ lookup_accumulating_option(Options, dump_stages,
+ DumpStages),
+ lookup_accumulating_option(Options, dump_options,
+ DumpOptions),
+ read_deep_file(Input, Verbose, DumpStages, DumpOptions,
+ MaybeProfile, !IO),
(
MaybeProfile = ok(Deep),
compute_css_list_above_threshold(0, Deep, Threshold,
- DistributionType, [], CSSListAboveThreshold),
+ MeasureType, [], CSSListAboveThreshold),
generate_feedback_file(CSSListAboveThreshold, Deep,
- DistributionType, Threshold, Output, !IO)
+ MeasureType, Threshold, Output, !IO)
;
MaybeProfile = error(Error),
io.stderr_stream(Stderr, !IO),
@@ -111,7 +116,7 @@
io.format("--verbose Generate progress messages.\n", []),
io.format("--threshold <value>\n", []),
io.format(" Set the threshold to <value>.\n",[]),
- io.format("--distrib average|median\n",[]),
+ io.format("--measure average|median\n",[]),
io.format(" average : Write to <output> the call sites\n",[]),
io.format(" static whose call sites dynamic's average\n",[]),
io.format(" call sequence counts exceed the given\n",[]),
@@ -135,10 +140,11 @@
% Read a deep profiling data file.
%
-:- pred read_deep_file(string::in, bool::in, maybe_error(deep)::out,
- io::di, io::uo) is det.
+:- pred read_deep_file(string::in, bool::in,
+ list(string)::in, list(string)::in,
+ maybe_error(deep)::out, io::di, io::uo) is det.
-read_deep_file(Input, Verbose, MaybeProfile, !IO) :-
+read_deep_file(Input, Verbose, DumpStages, DumpOptions, MaybeProfile, !IO) :-
server_name(Machine, !IO),
(
Verbose = yes,
@@ -148,17 +154,17 @@
Verbose = no,
MaybeOutput = no
),
- read_and_startup(Machine, [Input], no, MaybeOutput, [], [], MaybeProfile,
- !IO).
+ read_and_startup(Machine, [Input], no, MaybeOutput,
+ DumpStages, DumpOptions, MaybeProfile, !IO).
% Determine those CSSs whose CSDs' average/median call sequence counts
% exceed the given threshold.
%
:- pred compute_css_list_above_threshold(int::in, deep::in, int::in,
- distribution_type::in, list(call_site_static)::in,
+ measure_type::in, list(call_site_static)::in,
list(call_site_static)::out) is det.
-compute_css_list_above_threshold(Index, Deep, Threshold, Distribution,
+compute_css_list_above_threshold(Index, Deep, Threshold, Measure,
!CSSAcc) :-
array.size(Deep ^ call_site_statics, Size),
( Index = Size ->
@@ -173,13 +179,13 @@
Callseqs = 0
;
(
- Distribution = average,
+ Measure = average,
list.foldr(sum_callseqs_csd_ptr(Deep), CSDList,
0, SumCallseqs),
% NOTE: we have checked that NumCSD is not zero above.
Callseqs = SumCallseqs // NumCSD
;
- Distribution = median,
+ Measure = median,
list.sort(compare_csd_ptr(Deep), CSDList, CSDListSorted),
IndexMedian = NumCSD // 2,
list.index0_det(CSDListSorted, IndexMedian, MedianPtr),
@@ -188,12 +194,12 @@
),
( Callseqs >= Threshold ->
CSS = array.lookup(Deep ^ call_site_statics, Index),
- !:CSSAcc = [ CSS | !.CSSAcc ],
+ list.append(!.CSSAcc, [CSS], !:CSSAcc),
compute_css_list_above_threshold(Index + 1, Deep, Threshold,
- Distribution, !CSSAcc)
+ Measure, !CSSAcc)
;
compute_css_list_above_threshold(Index + 1, Deep, Threshold,
- Distribution, !CSSAcc)
+ Measure, !CSSAcc)
)
).
@@ -223,9 +229,9 @@
% threshold.
%
:- pred generate_feedback_file(list(call_site_static)::in, deep::in,
- distribution_type::in, int::in, string::in, io::di, io::uo) is det.
+ measure_type::in, int::in, string::in, io::di, io::uo) is det.
-generate_feedback_file(CSSList, Deep, Distribution, Threshold, Output, !IO) :-
+generate_feedback_file(CSSList, Deep, Measure, Threshold, Output, !IO) :-
io.open_output(Output, Result, !IO),
(
Result = io.error(Err),
@@ -236,11 +242,11 @@
io.write_string(Stream, "Profiling feedback file\n", !IO),
io.write_string(Stream, "Version = 1.0\n", !IO),
(
- Distribution = average,
- io.write_string(Stream, "Distribution = average\n", !IO)
+ Measure = average,
+ io.write_string(Stream, "Measure = average\n", !IO)
;
- Distribution = median,
- io.write_string(Stream, "Distribution = median\n", !IO)
+ Measure = median,
+ io.write_string(Stream, "Measure = median\n", !IO)
),
io.format(Stream, "Threshold = %i\n", [i(Threshold)], !IO),
write_css_list(CSSList, Deep, Stream, !IO),
@@ -290,9 +296,11 @@
; help
; verbose
; version
- ; distribution.
+ ; measure
+ ; dump_stages
+ ; dump_options.
-:- type distribution_type
+:- type measure_type
---> average
; median.
@@ -304,7 +312,9 @@
short('t', threshold).
short('h', help).
short('v', version).
-short('d', distribution).
+short('m', measure).
+short('d', dump_stages).
+short('D', dump_options).
:- pred long(string::in, option::out) is semidet.
@@ -313,8 +323,9 @@
long("help", help).
long("verbose", verbose).
long("version", version).
-long("distrib", distribution).
-long("distribution", distribution).
+long("measure", measure).
+long("dump-stages", dump_stages).
+long("dump-options", dump_options).
:- pred defaults(option::out, option_data::out) is multi.
@@ -322,12 +333,14 @@
defaults(help, bool(no)).
defaults(verbose, bool(no)).
defaults(version, bool(no)).
-defaults(distribution, string("average")).
+defaults(measure, string("average")).
+defaults(dump_stages, accumulating([])).
+defaults(dump_options, accumulating([])).
-:- pred construct_distribution(string::in, distribution_type::out) is semidet.
+:- pred construct_measure(string::in, measure_type::out) is semidet.
-construct_distribution("average", average).
-construct_distribution("median", median).
+construct_measure("average", average).
+construct_measure("median", median).
%-----------------------------------------------------------------------------%
:- end_module mdprof_feedback.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list