[m-rev.] diff: clean up mprof
Julien Fischer
juliensf at cs.mu.OZ.AU
Wed Dec 1 15:23:27 AEDT 2004
Estimates hours taken: 5
Branches: main
Clean up most of the profiler and bring it into line
with out current coding standards. There are no changes
to any algorithms.
This reduce the size of the code and also (hopefully)
makes things a little easier to maintain.
XXX The profiler is currently broken on those machines
that compile with intermodule optimization, e.g jupiter.
XXX I haven't cleaned up the demangler much yet either.
profiler/call_graph.m:
profiler/generate_output.m:
profiler/globals.m:
profiler/output.m:
profiler/mercury_profile.m:
profiler/process_file.m:
profiler/output_prof_info.m:
profiler/prof_debug.m:
profiler/prof_info.m:
profiler/propagate.m:
profiler/read.m:
Bring these modules in line with our current
coding standards.
Replace existing code with code that uses
higher-order predicates, state variables and
functions where appropriate.
Replace `is' with `='.
profiler/demangler.m:
Replace `is' with `='.
Julien.
Index: call_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/call_graph.m,v
retrieving revision 1.8
diff -u -r1.8 call_graph.m
--- call_graph.m 4 Mar 1998 19:59:54 -0000 1.8
+++ call_graph.m 11 Nov 2004 12:10:59 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% call_graph.m
%
@@ -24,9 +21,8 @@
:- import_module relation, io, list, string.
-:- pred call_graph__main(list(string), relation(string), relation(string),
- io__state, io__state).
-:- mode call_graph__main(in, in, out, di, uo) is det.
+:- pred call_graph__main(list(string)::in,
+ relation(string)::in, relation(string)::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -37,87 +33,76 @@
:- import_module options, globals.
:- import_module require, bool, std_util.
+%-----------------------------------------------------------------------------%
-call_graph__main(Args, StaticCallGraph0, StaticCallGraph) -->
- globals__io_lookup_bool_option(dynamic_cg, Dynamic),
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
-
+call_graph__main(Args, !StaticCallGraph, !IO) :-
+ globals__io_lookup_bool_option(dynamic_cg, Dynamic, !IO),
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ %
% We can only build the static call graph if the *.prof files are
% available. NB The dynamic call graph is built as it is read in
% in process_addr_pair_file
- (
- { Dynamic = yes }
- ->
- { StaticCallGraph = StaticCallGraph0 }
+ %
+ ( Dynamic = yes ->
+ true
;
- build_static_call_graph(Args, StaticCallGraph0, VeryVerbose,
- StaticCallGraph)
+ build_static_call_graph(Args, VeryVerbose, !StaticCallGraph,
+ !IO)
).
-
-% build_static_call_graph:
-% Builds the static call graph located in the *.prof files.
-%
-:- pred build_static_call_graph(list(string), relation(string), bool,
- relation(string), io__state, io__state).
-:- mode build_static_call_graph(in, in, in, out, di, uo) is det.
-
-build_static_call_graph([], StaticCallGraph, _, StaticCallGraph) --> [].
-build_static_call_graph([File | Files], StaticCallGraph0, VeryVerbose,
- StaticCallGraph) -->
- maybe_write_string(VeryVerbose, "\n\tProcessing "),
- maybe_write_string(VeryVerbose, File),
- maybe_write_string(VeryVerbose, "..."),
- process_prof_file(File, StaticCallGraph0, StaticCallGraph1),
- maybe_write_string(VeryVerbose, " done"),
- build_static_call_graph(Files, StaticCallGraph1, VeryVerbose,
- StaticCallGraph).
-
+ % build_static_call_graph:
+ % Builds the static call graph located in the *.prof files.
+ %
+:- pred build_static_call_graph(list(string)::in, bool::in,
+ relation(string)::in, relation(string)::out, io::di, io::uo) is det.
+
+build_static_call_graph(Files, VeryVerbose, !StaticCallGraph, !IO) :-
+ list__foldl2(process_prof_file(VeryVerbose), Files, !StaticCallGraph,
+ !IO).
-% process_prof_file:
-% Puts all the Caller and Callee label pairs from File into the
-% static call graph relation.
-%
-:- pred process_prof_file(string, relation(string), relation(string),
- io__state, io__state).
-:- mode process_prof_file(in, in, out, di, uo) is det.
-
-process_prof_file(File, StaticCallGraph0, StaticCallGraph) -->
- io__see(File, Result),
+ % process_prof_file:
+ % Puts all the Caller and Callee label pairs from File into the
+ % static call graph relation.
+ %
+:- pred process_prof_file(bool::in, string::in,
+ relation(string)::in, relation(string)::out, io::di, io::uo) is det.
+
+process_prof_file(VeryVerbose, File, !StaticCallGraph, !IO) :-
+ maybe_write_string(VeryVerbose, "\n\tProcessing ", !IO),
+ maybe_write_string(VeryVerbose, File, !IO),
+ maybe_write_string(VeryVerbose, "...", !IO),
+ io__see(File, Result, !IO),
(
- { Result = ok },
- process_prof_file_2(StaticCallGraph0, StaticCallGraph),
- io__seen
+ Result = ok,
+ process_prof_file_2(!StaticCallGraph, !IO),
+ io__seen(!IO)
;
- { Result = error(Error) },
- { StaticCallGraph = StaticCallGraph0 },
-
- { io__error_message(Error, ErrorMsg) },
- io__stderr_stream(StdErr),
+ Result = error(Error),
+ io__error_message(Error, ErrorMsg),
+ io__stderr_stream(StdErr, !IO),
io__write_strings(StdErr, ["mprof: error opening file `",
- File, "': ", ErrorMsg, "\n"])
- ).
-
-:- pred process_prof_file_2(relation(string), relation(string),
- io__state, io__state).
-:- mode process_prof_file_2(in, out, di, uo) is det.
-
-process_prof_file_2(StaticCallGraph0, StaticCallGraph) -->
- maybe_read_label_name(MaybeLabelName),
- (
- { MaybeLabelName = yes(CallerLabel) },
- read_label_name(CalleeLabel),
- { relation__lookup_element(StaticCallGraph0, CallerLabel,
- CallerKey) },
- { relation__lookup_element(StaticCallGraph0, CalleeLabel,
- CalleeKey) },
- { relation__add(StaticCallGraph0, CallerKey, CalleeKey,
- StaticCallGraph1) },
- process_prof_file_2(StaticCallGraph1, StaticCallGraph)
+ File, "': ", ErrorMsg, "\n"], !IO)
+ ),
+ maybe_write_string(VeryVerbose, " done", !IO).
+
+:- pred process_prof_file_2(relation(string)::in, relation(string)::out,
+ io::di, io::uo) is det.
+
+process_prof_file_2(!StaticCallGraph, !IO) :-
+ maybe_read_label_name(MaybeLabelName, !IO),
+ ( MaybeLabelName = yes(CallerLabel) ->
+ read_label_name(CalleeLabel, !IO),
+ relation__lookup_element(!.StaticCallGraph, CallerLabel,
+ CallerKey),
+ relation__lookup_element(!.StaticCallGraph, CalleeLabel,
+ CalleeKey),
+ relation__add(!.StaticCallGraph, CallerKey, CalleeKey,
+ !:StaticCallGraph),
+ process_prof_file_2(!StaticCallGraph, !IO)
;
- { MaybeLabelName = no },
- { StaticCallGraph = StaticCallGraph0 }
+ true
).
-
+%-----------------------------------------------------------------------------%
+:- end_module call_graph.
%-----------------------------------------------------------------------------%
Index: demangle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/demangle.m,v
retrieving revision 1.17
diff -u -r1.17 demangle.m
--- demangle.m 2 Jan 2003 06:53:59 -0000 1.17
+++ demangle.m 15 Nov 2004 10:42:44 -0000
@@ -40,8 +40,7 @@
---> (lambda)
; deforestation
; accumulator
- ; type_spec(string)
- .
+ ; type_spec(string).
:- type data_category
---> common
@@ -364,13 +363,13 @@
m_remove_suffix("__ua")
->
{ UnusedArgs = yes(ModeNum0 - no) },
- { ModeNum is UA_ModeNum mod 10000 }
+ { ModeNum = UA_ModeNum mod 10000 }
;
remove_trailing_int(UA_ModeNum),
m_remove_suffix("__uab")
->
{ UnusedArgs = yes(ModeNum0 - yes) },
- { ModeNum is UA_ModeNum mod 10000 }
+ { ModeNum = UA_ModeNum mod 10000 }
;
{ UnusedArgs = no },
{ ModeNum = ModeNum0 }
@@ -706,7 +705,7 @@
remove_prefix("__"),
( { Num > 1 } ->
{ Sep = ", " },
- { Num1 is Num - 1 },
+ { Num1 = Num - 1 },
demangle_class_args(Num1, Rest)
;
{ Sep = "" },
@@ -838,7 +837,7 @@
->
string__left(String0, Index, Module),
string__length(String0, Len),
- Index2 is Index + 2,
+ Index2 = Index + 2,
string__substring(String0, Index2, Len, String1),
(
remove_maybe_module_prefix(yes(SubModule),
@@ -865,7 +864,7 @@
->
string__left(String0, Index, PredName),
string__length(String0, Len),
- Index2 is Index + 2,
+ Index2 = Index + 2,
string__substring(String0, Index2, Len, String),
MaybePredName = yes(PredName)
;
@@ -947,7 +946,7 @@
remove_trailing_int(Int) -->
remove_trailing_digit(Digit),
( remove_trailing_int(Rest) ->
- { Int is Rest * 10 + Digit }
+ { Int = Rest * 10 + Digit }
;
{ Int = Digit }
).
@@ -962,7 +961,7 @@
:- mode string_last_char(in, out, out) is semidet.
string_last_char(String0, Char, String) :-
string__length(String0, Len),
- Len1 is Len - 1,
+ Len1 = Len - 1,
string__index(String0, Len1, Char),
string__left(String0, Len1, String).
Index: generate_output.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/generate_output.m,v
retrieving revision 1.20
diff -u -r1.20 generate_output.m
--- generate_output.m 8 Jul 2004 05:56:37 -0000 1.20
+++ generate_output.m 15 Nov 2004 11:40:12 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% generate_output.m
%
@@ -19,208 +16,191 @@
:- module generate_output.
:- interface.
-:- import_module float, int, string, map, io, prof_info, output_prof_info.
-:- pred generate_output__main(prof, map(string, int), output,
- io__state, io__state).
-:- mode generate_output__main(in, out, out, di, uo) is det.
+:- import_module output_prof_info.
+:- import_module prof_info.
+
+:- import_module float, int, io, map, string.
-:- pred checked_float_divide(float::in, float::in, float::out) is det.
+%-----------------------------------------------------------------------------%
+
+:- pred generate_output__main(prof::in, map(string, int)::out, output::out,
+ io::di, io::uo) is det.
+
+:- func checked_float_divide(float, float) = float.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module globals, options.
+
+:- import_module globals.
+:- import_module options.
+
:- import_module bool, list, rbtree, relation.
-% :- import_module writeln.
+%-----------------------------------------------------------------------------%
% rbtrees are used because they allow duplicate values to be stored.
% This means that we can then convert to a sorted list of names which
% can be used to lookup the output_prof map when we actually output.
-:- type profiling --->
- profiling(
+:- type profiling
+ ---> profiling(
map(string, output_prof), % associate name with the
% output_prof structure.
rbtree(float, string), % associate call graph
% percentage with a name.
rbtree(flat_key, string) % as above except for flat
% profile.
- ).
+ ).
-:- type flat_key --->
- flat_key(
+:- type flat_key
+ ---> flat_key(
float, % per cent time in this predicate
int % number of calls to this predicate
- ).
+ ).
+%-----------------------------------------------------------------------------%
-generate_output__main(Prof, IndexMap, Output) -->
+generate_output__main(Prof, IndexMap, Output, !IO) :-
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+
% Get intitial values of use.
- { prof_get_entire(Prof, _, _, IntTotalCounts, _, ProfNodeMap, _) },
- { _TotalCounts = float__float(IntTotalCounts) },
-
- { map__values(ProfNodeMap, ProfNodeList) },
-
- { profiling_init(OutputProf0) },
-
- globals__io_lookup_bool_option(very_verbose, VV),
- process_prof_node_list(ProfNodeList, Prof, VV, OutputProf0, OutputProf),
+ prof_get_entire(Prof, _, _, _IntTotalCounts, _, ProfNodeMap, _),
+ ProfNodeList = map__values(ProfNodeMap),
+ OutputProf0 = profiling_init,
+ process_prof_node_list(ProfNodeList, Prof, VeryVerbose,
+ OutputProf0, OutputProf, !IO),
- { OutputProf = profiling(InfoMap, CallTree, FlatTree) },
-
- { rbtree__values(CallTree, CallList0) },
- { rbtree__values(FlatTree, FlatList0) },
-
- { assign_index_numbers(CallList0, IndexMap, CallList) },
- { list__reverse(FlatList0, FlatList) },
-
- { Output = output(InfoMap, CallList, FlatList) }.
-
-
-:- pred process_prof_node_list(list(prof_node), prof, bool,
- profiling, profiling, io__state, io__state).
-:- mode process_prof_node_list(in, in, in, in, out, di, uo) is det.
-
-process_prof_node_list([], _, _, OutputProf, OutputProf) --> [].
-process_prof_node_list([PN | PNs], Prof, VVerbose, OutputProf0, OutputProf) -->
- (
- { VVerbose = yes }
- ->
- { prof_node_get_pred_name(PN, LabelName) },
- io__write_string("\n\t% Processing "),
- io__write_string(LabelName)
+ OutputProf = profiling(InfoMap, CallTree, FlatTree),
+ CallList0 = rbtree__values(CallTree),
+ FlatList0 = rbtree__values(FlatTree),
+
+ assign_index_numbers(CallList0, IndexMap, CallList),
+ FlatList = list__reverse(FlatList0),
+ Output = output(InfoMap, CallList, FlatList).
+
+:- pred process_prof_node_list(list(prof_node)::in, prof::in, bool::in,
+ profiling::in, profiling::out, io::di, io::uo) is det.
+
+process_prof_node_list([], _, _, !OutputProf, !IO).
+process_prof_node_list([PN | PNs], Prof, VeryVerbose, !OutputProf, !IO) :-
+ ( VeryVerbose = yes ->
+ prof_node_get_pred_name(PN, LabelName),
+ io__write_string("\n\t% Processing " ++ LabelName, !IO)
;
- []
+ true
),
- { process_prof_node(PN, Prof, OutputProf0, OutputProf1) },
- process_prof_node_list(PNs, Prof, VVerbose, OutputProf1, OutputProf).
-
+ process_prof_node(PN, Prof, !OutputProf),
+ process_prof_node_list(PNs, Prof, VeryVerbose, !OutputProf, !IO).
-% process_prof_node:
-% This is the main function. It converts the prof_node structure to the
-% output_prof structure.
-%
-:- pred process_prof_node(prof_node, prof, profiling, profiling).
-:- mode process_prof_node(in, in, in, out) is det.
+ % process_prof_node:
+ % This is the main function. It converts the prof_node
+ % structure to the output_prof structure.
+ %
+:- pred process_prof_node(prof_node::in, prof::in,
+ profiling::in, profiling::out) is det.
-process_prof_node(ProfNode, Prof, OutputProf0, OutputProf) :-
+process_prof_node(ProfNode, Prof, !OutputProf) :-
prof_node_type(ProfNode, ProfNodeType),
- (
- ProfNodeType = cycle,
- OutputProf = OutputProf0
- % generate_output__cycle(ProfNode, Prof, OutputProf0,
- % OutputProf)
+ ( ProfNodeType = predicate ->
+ generate_output.single_predicate(ProfNode, Prof, !OutputProf)
;
- ProfNodeType = predicate,
- generate_output__single_predicate(ProfNode, Prof, OutputProf0,
- OutputProf)
+ true
+ % generate_output__cycle(ProfNode, Prof, OutputProf0,
+ % OutputProf)
).
+ % generate_output__cycle
+ % XXX
+ %
+:- pred generate_output__cycle(prof_node::in, prof::in,
+ profiling::in, profiling::out) is det.
-% generate_output__cycle
-% XXX
-%
-:- pred generate_output__cycle(prof_node, prof, profiling, profiling).
-:- mode generate_output__cycle(in, in, in, out) is det.
-
-generate_output__cycle(ProfNode, Prof, OutputProf0, OutputProf) :-
+generate_output__cycle(ProfNode, Prof, !OutputProf) :-
prof_get_entire(Prof, Scale, _Units, IntTotalCounts, _, _,
- _CycleMap),
+ _CycleMap),
TotalCounts = float__float(IntTotalCounts),
prof_node_get_entire_cycle(ProfNode, Name, CycleNum, Initial, Prop,
- _CycleMembers, TotalCalls, SelfCalls),
+ _CycleMembers, TotalCalls, SelfCalls),
- OutputProf0 = profiling(InfoMap0, CallTree0, FreeTree),
+ !.OutputProf = profiling(InfoMap0, CallTree0, FreeTree),
% Calculate proportion of time in current predicate and its
% descendents as a percentage.
%
InitialFloat = float__float(Initial),
- (
- TotalCounts = 0.0
- ->
+ ( TotalCounts = 0.0 ->
DescPercentage = 0.0
;
- DescPercentage is (InitialFloat + Prop) / TotalCounts * 100.0
+ DescPercentage = (InitialFloat + Prop) / TotalCounts * 100.0
),
% Calculate the self time spent in the current predicate.
% Calculate the descendant time, which is the time spent in the
% current predicate and its descendants
- SelfTime is InitialFloat * Scale,
- DescTime is (InitialFloat+Prop) * Scale,
-
- OutputProfNode = output_cycle_prof( Name, CycleNum, SelfTime,
- DescPercentage,
- DescTime, TotalCalls, SelfCalls,
- [], []
- ),
+ SelfTime = InitialFloat * Scale,
+ DescTime = (InitialFloat + Prop) * Scale,
+ OutputProfNode = output_cycle_prof(Name, CycleNum, SelfTime,
+ DescPercentage, DescTime, TotalCalls, SelfCalls,
+ [], []),
+
map__det_insert(InfoMap0, Name, OutputProfNode, InfoMap),
rbtree__insert_duplicate(CallTree0, DescPercentage,
- Name, CallTree),
+ Name, CallTree),
- OutputProf = profiling(InfoMap, CallTree, FreeTree).
+ !:OutputProf = profiling(InfoMap, CallTree, FreeTree).
-% generate_output__single_predicate:
-% Fills out the output_prof structure when pred is a single predicate.
-%
-:- pred generate_output__single_predicate(prof_node, prof, profiling,profiling).
-:- mode generate_output__single_predicate(in, in, in, out) is det.
+ % generate_output__single_predicate:
+ % Fills out the output_prof structure when pred is a single predicate.
+ %
+:- pred generate_output__single_predicate(prof_node::in, prof::in,
+ profiling::in, profiling::out) is det.
-generate_output__single_predicate(ProfNode, Prof, OutputProf0, OutputProf) :-
+generate_output__single_predicate(ProfNode, Prof, !OutputProf) :-
prof_get_entire(Prof, Scale, _Units, IntTotalCounts, _, _,
- CycleMap),
+ CycleMap),
TotalCounts = float__float(IntTotalCounts),
prof_node_get_entire_pred(ProfNode, LabelName, CycleNum, Initial, Prop,
- ParentList, ChildList, TotalCalls,
- SelfCalls, NameList),
+ ParentList, ChildList, TotalCalls, SelfCalls, NameList),
% Node only needs to be processed if it has a parent or a child.
- (
- ParentList = [],
- ChildList = []
- ->
- OutputProf = OutputProf0
+ ( ParentList = [], ChildList = [] ->
+ true
;
- OutputProf0 = profiling(InfoMap0, CallTree0, FlatTree0),
+ !.OutputProf = profiling(InfoMap0, CallTree0, FlatTree0),
- construct_name(NameList, Name0),
- string__append(LabelName, Name0, Name),
+ Name = LabelName ++ construct_name(NameList),
% Calculate proportion of time in current predicate and its
% descendents as a percentage.
% Calculate proportion of time in current predicate
% as a percentage.
InitialFloat = float__float(Initial),
- (
- TotalCounts = 0.0
- ->
+ ( TotalCounts = 0.0 ->
DescPercentage = 0.0,
FlatPercentage = 0.0
-
;
- DescPercentage is (InitialFloat + Prop) / TotalCounts
- * 100.0,
- FlatPercentage is InitialFloat / TotalCounts * 100.0
+ DescPercentage = (InitialFloat + Prop) / TotalCounts
+ * 100.0,
+ FlatPercentage = InitialFloat / TotalCounts * 100.0
),
% Calculate the self time spent in the current predicate.
% Calculate the descendant time, which is the time spent in the
% current predicate and its descendants
- SelfTime is InitialFloat * Scale,
- DescTime is (InitialFloat+Prop) * Scale,
+ SelfTime = InitialFloat * Scale,
+ DescTime = (InitialFloat+Prop) * Scale,
process_prof_node_parents(ParentList, SelfTime, DescTime,
- TotalCalls, CycleNum, CycleMap,
- OutputParentList, OutputCycleParentList),
+ TotalCalls, CycleNum, CycleMap,
+ OutputParentList, OutputCycleParentList),
process_prof_node_children(ChildList, CycleNum, CycleMap,
- Prof, OutputChildList, OutputCycleChildList),
+ Prof, OutputChildList, OutputCycleChildList),
OutputProfNode = output_prof( Name, CycleNum,
DescPercentage,
@@ -235,24 +215,23 @@
map__det_insert(InfoMap0, LabelName, OutputProfNode, InfoMap),
rbtree__insert_duplicate(CallTree0, DescPercentage,
- LabelName, CallTree),
- rbtree__insert_duplicate(FlatTree0, flat_key(FlatPercentage,
- TotalCalls),
- LabelName, FlatTree),
+ LabelName, CallTree),
+ rbtree__insert_duplicate(FlatTree0,
+ flat_key(FlatPercentage, TotalCalls),
+ LabelName, FlatTree),
- OutputProf = profiling(InfoMap, CallTree, FlatTree)
+ !:OutputProf = profiling(InfoMap, CallTree, FlatTree)
).
-% construct_name:
-% When more then one predicate maps to the same address. This predicate
-% will build a string of all the different names separated by 'or's.
-:- pred construct_name(list(string), string).
-:- mode construct_name(in, out) is det.
-
-construct_name([], "").
-construct_name([Name | Names], NameStr) :-
- construct_name(Names, NameStr0),
+ % construct_name:
+ % When more then one predicate maps to the same address. This predicate
+ % will build a string of all the different names separated by 'or's.
+:- func construct_name(list(string)) = string.
+
+construct_name([]) = "".
+construct_name([Name | Names]) = NameStr :-
+ NameStr0 = construct_name(Names),
string__append(" or ", Name, NameStr1),
string__append(NameStr1, NameStr0, NameStr).
@@ -292,10 +271,7 @@
(
ParentCycleNum = CycleNum
->
- % writeln("Throwing away parent "),
- % writeln(LabelName),
-
- TotalCalls1 is TotalCalls0 - Calls,
+ TotalCalls1 = TotalCalls0 - Calls,
remove_cycle_members(PNs, TotalCalls1, CycleNum,
CycleMap, TotalCalls, List, OC0),
Parent = parent(LabelName, CycleNum, 0.0, 0.0, Calls),
@@ -326,18 +302,17 @@
Output0, Output),
rbtree__values(Output, OutputParentList).
+:- pred process_prof_node_parents_3(list(pred_info)::in,
+ float::in, float::in, float::in, cycle_map::in,
+ rbtree(int, parent)::in, rbtree(int, parent)::out) is det.
-:- pred process_prof_node_parents_3(list(pred_info), float, float, float,
- cycle_map, rbtree(int, parent), rbtree(int, parent)).
-:- mode process_prof_node_parents_3(in, in, in, in, in, in, out) is det.
-
-process_prof_node_parents_3([], _, _, _, _, Output, Output).
+process_prof_node_parents_3([], _, _, _, _, !Output).
process_prof_node_parents_3([PN | PNs], SelfTime, DescTime, TotalCalls,
- CycleMap, Output0, Output) :-
+ CycleMap, !Output) :-
pred_info_get_entire(PN, LabelName, Calls),
(
- % if parent member of cycle
+ % if parent member of cycle
map__search(CycleMap, LabelName, ParentCycleNum0)
->
ParentCycleNum = ParentCycleNum0
@@ -345,22 +320,21 @@
ParentCycleNum = 0
),
- FloatCalls = float__float(Calls),
- checked_float_divide(FloatCalls, TotalCalls, Proportion),
+ Proportion = checked_float_divide(float(Calls), TotalCalls),
% Calculate the amount of the current predicate's self-time spent
% due to the parent.
% and the amount of the current predicate's descendant-time spent
% due to the parent.
- PropSelfTime is SelfTime * Proportion,
- PropDescTime is DescTime * Proportion,
+ PropSelfTime = SelfTime * Proportion,
+ PropDescTime = DescTime * Proportion,
Parent = parent(LabelName, ParentCycleNum, PropSelfTime,
- PropDescTime, Calls),
- rbtree__insert_duplicate(Output0, Calls, Parent, Output1),
+ PropDescTime, Calls),
+ rbtree__insert_duplicate(!.Output, Calls, Parent, !:Output),
process_prof_node_parents_3(PNs, SelfTime, DescTime, TotalCalls,
- CycleMap, Output1, Output).
+ CycleMap, !Output).
:- pred process_prof_node_children(list(pred_info), int, cycle_map,
@@ -376,17 +350,16 @@
process_prof_node_children_2(Children, Prof, Output0, Output),
rbtree__values(Output, OutputChildList).
-% remove_child_cycle_members
-% removes any members of the same cycle from the child listing
-% of a predicate and adds them to a new list
-%
-:- pred remove_child_cycle_members(list(pred_info), int, cycle_map,
- list(pred_info), list(child)).
-:- mode remove_child_cycle_members(in, in, in, out, out) is det.
+ % remove_child_cycle_members
+ % removes any members of the same cycle from the child listing
+ % of a predicate and adds them to a new list
+ %
+:- pred remove_child_cycle_members(list(pred_info)::in, int::in, cycle_map::in,
+ list(pred_info)::out, list(child)::out)is det.
remove_child_cycle_members([], _, _, [], []).
remove_child_cycle_members([PN | PNs], CycleNum, CycleMap, List,
- CycleChildList) :-
+ CycleChildList) :-
pred_info_get_entire(PN, LabelName, Calls),
(
map__search(CycleMap, LabelName, ChildCycleNum)
@@ -394,39 +367,32 @@
(
ChildCycleNum = CycleNum
->
- % writeln("Throwing away child "),
- % writeln(LabelName),
-
remove_child_cycle_members(PNs, CycleNum, CycleMap,
- List, OC0),
+ List, OC0),
Child = child(LabelName, CycleNum, 0.0, 0.0, Calls, 0),
CycleChildList = [ Child | OC0 ]
;
remove_child_cycle_members(PNs, CycleNum, CycleMap,
- List0, OC0),
+ List0, OC0),
CycleChildList = OC0,
List = [PN | List0]
)
;
remove_child_cycle_members(PNs, CycleNum, CycleMap, List0,
- CycleChildList),
+ CycleChildList),
List = [PN | List0]
).
-
-:- pred process_prof_node_children_2(list(pred_info), prof, rbtree(int, child),
- rbtree(int, child)).
-:- mode process_prof_node_children_2(in, in, in, out) is det.
+:- pred process_prof_node_children_2(list(pred_info)::in, prof::in,
+ rbtree(int, child)::in, rbtree(int, child)::out) is det.
-process_prof_node_children_2([], _, Output, Output).
-process_prof_node_children_2([PN | PNs], Prof, Output0, Output) :-
+process_prof_node_children_2([], _, !Output).
+process_prof_node_children_2([PN | PNs], Prof, !Output) :-
pred_info_get_entire(PN, LabelName, Calls),
prof_get_entire(Prof, Scale, _Units, _, AddrMap, ProfNodeMap,
- CycleMap),
+ CycleMap),
- (
- map__search(CycleMap, LabelName, CycleNum0)
- ->
+ ( map__search(CycleMap, LabelName, CycleNum0) ->
CycleNum = CycleNum0
;
CycleNum = 0
@@ -437,72 +403,57 @@
prof_node_get_propagated_counts(ProfNode, Prop),
prof_node_get_total_calls(ProfNode, TotalCalls),
- InitialFloat = float__float(Initial),
- CurrentCount is InitialFloat + Prop,
-
- FloatTotalCalls = float__float(TotalCalls),
- FloatCalls = float__float(Calls),
- checked_float_divide(FloatCalls, FloatTotalCalls, Proportion),
+ CurrentCount = float(Initial) + Prop,
+ Proportion = checked_float_divide(float(Calls), float(TotalCalls)),
% Calculate the self time spent in the current predicate.
- SelfTime is InitialFloat * Scale,
+ SelfTime = float(Initial) * Scale,
% Calculate the descendant time, which is the time spent in the
% current predicate and its descendants
- DescTime is CurrentCount * Scale,
+ DescTime = CurrentCount * Scale,
% Calculate the amount of the current predicate's self-time spent
% due to the parent.
% and the amount of the current predicate's descendant-time spent
% due to the parent.
- PropSelfTime is SelfTime * Proportion,
- PropDescTime is DescTime * Proportion,
+ PropSelfTime = SelfTime * Proportion,
+ PropDescTime = DescTime * Proportion,
Child = child(LabelName, CycleNum, PropSelfTime, PropDescTime, Calls,
- TotalCalls),
- rbtree__insert_duplicate(Output0, Calls, Child, Output1),
- process_prof_node_children_2(PNs, Prof, Output1, Output).
-
-
-
-% assign_index_numbers:
-% Reverses the output list so that the predicates which account for
-% most of the time come first and then assigns index numbers.
-%
-:- pred assign_index_numbers(list(string), map(string, int), list(string)).
-:- mode assign_index_numbers(in, out, out) is det.
+ TotalCalls),
+ rbtree__insert_duplicate(!.Output, Calls, Child, !:Output),
+ process_prof_node_children_2(PNs, Prof, !Output).
+
+ % assign_index_numbers:
+ % Reverses the output list so that the predicates which account for
+ % most of the time come first and then assigns index numbers.
+ %
+:- pred assign_index_numbers(list(string)::in, map(string, int)::out,
+ list(string)::out) is det.
assign_index_numbers(List0, IndexMap, List) :-
- map__init(IndexMap0),
list__reverse(List0, List),
+ assign_index_numbers_2(List, 1, map.init, IndexMap).
- assign_index_numbers_2(List, IndexMap0, 1, IndexMap).
-
-
-:- pred assign_index_numbers_2(list(string), map(string, int), int,
- map(string, int)).
-:- mode assign_index_numbers_2(in, in, in, out) is det.
+:- pred assign_index_numbers_2(list(string)::in, int::in,
+ map(string, int)::in, map(string, int)::out) is det.
-assign_index_numbers_2([], IndexMap, _, IndexMap).
-assign_index_numbers_2([X0|Xs0], IndexMap0, N0, IndexMap) :-
- map__det_insert(IndexMap0, X0, N0, IndexMap1),
- N is N0 + 1,
- assign_index_numbers_2(Xs0, IndexMap1, N, IndexMap).
+assign_index_numbers_2([], _, !IndexMap).
+assign_index_numbers_2([X0 | Xs0], N, !IndexMap) :-
+ map__det_insert(!.IndexMap, X0, N, !:IndexMap),
+ assign_index_numbers_2(Xs0, N + 1, !IndexMap).
+:- func profiling_init = profiling.
-:- pred profiling_init(profiling).
-:- mode profiling_init(out) is det.
-
-profiling_init(Profiling) :-
+profiling_init = Profiling :-
map__init(InfoMap),
rbtree__init(CallTree),
rbtree__init(FlatTree),
Profiling = profiling(InfoMap, CallTree, FlatTree).
-checked_float_divide(A, B, C) :-
- ( B = 0.0 ->
- C = 0.0
- ;
- C is A / B
- ).
+checked_float_divide(A, B) = ( B = 0.0 -> 0.0 ; A / B).
+%----------------------------------------------------------------------------%
+:- end_module generate_output.
+%----------------------------------------------------------------------------%
Index: globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/globals.m,v
retrieving revision 1.9
diff -u -r1.9 globals.m
--- globals.m 19 May 2004 01:56:39 -0000 1.9
+++ globals.m 30 Nov 2004 08:04:22 -0000
@@ -4,8 +4,6 @@
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-:- module globals.
-
% Main author: fjh.
% This module exports the `globals' type and associated access predicates.
@@ -15,6 +13,8 @@
%-----------------------------------------------------------------------------%
+:- module globals.
+
:- interface.
:- import_module bool, list, options, getopt, io.
@@ -87,7 +87,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module map, std_util, require.
+:- import_module map, std_util, string, require.
%-----------------------------------------------------------------------------%
@@ -149,62 +149,62 @@
( OptionData = accumulating(Accumulating) ->
Value = Accumulating
;
- error("globals__lookup_accumulating_option: invalid accumulating option")
+ error("globals__lookup_accumulating_option: " ++
+ "invalid accumulating option")
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-globals__io_init(Options) -->
- { globals__init(Options, Globals) },
- globals__io_set_globals(Globals).
-
-globals__io_get_globals(Globals) -->
- io__get_globals(UnivGlobals),
- {
- univ_to_type(UnivGlobals, Globals0)
- ->
+globals__io_init(Options, !IO) :-
+ globals__init(Options, Globals),
+ globals__io_set_globals(Globals, !IO).
+
+globals__io_get_globals(Globals, !IO) :-
+ io__get_globals(UnivGlobals, !IO),
+ ( univ_to_type(UnivGlobals, Globals0) ->
Globals = Globals0
;
- error("globals__io_get_globals: univ_to_type failed")
- }.
+ error("globals.io_get_globals: univ_to_type failed")
+ ).
-globals__io_set_globals(Globals0) -->
- { unsafe_promise_unique(Globals0, Globals) },
- { type_to_univ(Globals, UnivGlobals) },
- io__set_globals(UnivGlobals).
+globals__io_set_globals(Globals0, !IO) :-
+ unsafe_promise_unique(Globals0, Globals),
+ type_to_univ(Globals, UnivGlobals),
+ io__set_globals(UnivGlobals, !IO).
%-----------------------------------------------------------------------------%
-globals__io_lookup_option(Option, OptionData) -->
- globals__io_get_globals(Globals),
- { globals__get_options(Globals, OptionTable) },
- { map__lookup(OptionTable, Option, OptionData) }.
+globals__io_lookup_option(Option, OptionData, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__get_options(Globals, OptionTable),
+ map__lookup(OptionTable, Option, OptionData).
-globals__io_set_option(Option, OptionData) -->
- globals__io_get_globals(Globals0),
- { globals__get_options(Globals0, OptionTable0) },
- { map__set(OptionTable0, Option, OptionData, OptionTable) },
- { globals__set_options(Globals0, OptionTable, Globals) },
- globals__io_set_globals(Globals).
+globals__io_set_option(Option, OptionData, !IO) :-
+ globals__io_get_globals(Globals0, !IO),
+ globals__get_options(Globals0, OptionTable0),
+ map__set(OptionTable0, Option, OptionData, OptionTable),
+ globals__set_options(Globals0, OptionTable, Globals),
+ globals__io_set_globals(Globals, !IO).
%-----------------------------------------------------------------------------%
-globals__io_lookup_bool_option(Option, Value) -->
- globals__io_get_globals(Globals),
- { globals__lookup_bool_option(Globals, Option, Value) }.
+globals__io_lookup_bool_option(Option, Value, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__lookup_bool_option(Globals, Option, Value).
-globals__io_lookup_int_option(Option, Value) -->
- globals__io_get_globals(Globals),
- { globals__lookup_int_option(Globals, Option, Value) }.
+globals__io_lookup_int_option(Option, Value, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__lookup_int_option(Globals, Option, Value).
-globals__io_lookup_string_option(Option, Value) -->
- globals__io_get_globals(Globals),
- { globals__lookup_string_option(Globals, Option, Value) }.
+globals__io_lookup_string_option(Option, Value, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__lookup_string_option(Globals, Option, Value).
-globals__io_lookup_accumulating_option(Option, Value) -->
- globals__io_get_globals(Globals),
- { globals__lookup_accumulating_option(Globals, Option, Value) }.
+globals__io_lookup_accumulating_option(Option, Value, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__lookup_accumulating_option(Globals, Option, Value).
%-----------------------------------------------------------------------------%
+:- end_module globals.
%-----------------------------------------------------------------------------%
Index: mercury_profile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/mercury_profile.m,v
retrieving revision 1.26
diff -u -r1.26 mercury_profile.m
--- mercury_profile.m 21 Jan 2004 01:27:32 -0000 1.26
+++ mercury_profile.m 11 Nov 2004 09:15:53 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% Mercury profiler
% Main author: petdr.
@@ -29,8 +26,7 @@
:- import_module io.
-:- pred main(io__state, io__state).
-:- mode main(di, uo) is det.
+:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -44,150 +40,134 @@
%-----------------------------------------------------------------------------%
-
-main -->
- io__command_line_arguments(Args0),
- { OptionOps = option_ops(short_option, long_option, option_defaults,
- special_handler) },
- { getopt__process_options(OptionOps, Args0, Args, Result0) },
- postprocess_options(Result0, Args, Result),
- main_2(Result, Args).
-
-
-:- pred postprocess_options(maybe_option_table(option), list(string),
- maybe(string), io__state, io__state).
-:- mode postprocess_options(in, in, out, di, uo) is det.
-
-postprocess_options(error(ErrorMessage), _Args, yes(ErrorMessage)) --> [].
-postprocess_options(ok(OptionTable), Args, no) -->
- globals__io_init(OptionTable),
+main(!IO) :-
+ io__command_line_arguments(Args0, !IO),
+ OptionOps = option_ops(short_option, long_option, option_defaults,
+ special_handler),
+ getopt__process_options(OptionOps, Args0, Args, Result0),
+ postprocess_options(Result0, Args, Result, !IO),
+ main_2(Result, Args, !IO).
+
+:- pred postprocess_options(maybe_option_table(option)::in, list(string)::in,
+ maybe(string)::out, io::di, io::uo) is det.
+
+postprocess_options(error(ErrorMessage), _Args, yes(ErrorMessage), !IO).
+postprocess_options(ok(OptionTable), Args, no, !IO) :-
+ globals__io_init(OptionTable, !IO),
% --very-verbose implies --verbose
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- (
- { VeryVerbose = yes }
- ->
- globals__io_set_option(verbose, bool(yes))
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ globals__io_set_option(verbose, bool(yes), !IO)
;
- []
+ true
),
-
-
+ %
% Any empty list of arguments implies that we must build the call
% graph from the dynamic information.
- (
- { Args = [] }
- ->
- globals__io_set_option(dynamic_cg, bool(yes))
+ %
+ ( Args = [] ->
+ globals__io_set_option(dynamic_cg, bool(yes), !IO)
;
- []
+ true
).
-
- % Display error message and then usage message
-:- pred usage_error(string::in, io__state::di, io__state::uo) is det.
-usage_error(ErrorMessage) -->
- io__progname_base("mercury_profile", ProgName),
- io__stderr_stream(StdErr),
- io__write_string(StdErr, ProgName),
- io__write_string(StdErr, ": "),
- io__write_string(StdErr, ErrorMessage),
- io__write_string(StdErr, "\n"),
- io__set_exit_status(1),
- usage.
-
-
- % Display usage message
-:- pred usage(io__state::di, io__state::uo) is det.
-usage -->
- io__progname_base("mprof", ProgName),
- io__stderr_stream(StdErr),
- { library__version(Version) },
- io__write_strings(StdErr,
- ["Mercury Profiler, version ", Version, "\n"]),
- io__write_string(StdErr, "Copyright (C) 1995-2004 The University of Melbourne\n"),
- io__write_string(StdErr, "Usage: "),
- io__write_string(StdErr, ProgName),
- io__write_string(StdErr, " [<options>] [<files>]\n"),
- io__write_string(StdErr, "Use `"),
- io__write_string(StdErr, ProgName),
- io__write_string(StdErr, " --help' for more information.\n").
-
-:- pred long_usage(io__state::di, io__state::uo) is det.
-long_usage -->
- io__progname_base("mprof", ProgName),
- { library__version(Version) },
- io__write_strings(["Mercury Profiler, version ", Version, "\n"]),
- io__write_string("Copyright (C) 1995-2004 The University of Melbourne\n"),
- io__write_string("\n"),
- io__write_string("Usage: "),
- io__write_string(ProgName),
- io__write_string(" [<options>] [<files>]\n"),
- io__write_string("\n"),
- io__write_string("Description:\n"),
- io__write_string("\t`mprof' produces execution profiles for Mercury programs.\n"),
- io__write_string("\tIt outputs a flat profile and optionally also a hierarchical\n"),
- io__write_string("\t(call graph based) profile based on data collected during program\n"),
- io__write_string("\texecution.\n"),
- io__write_string("\n"),
- io__write_string("Arguments:\n"),
- io__write_string("\tIf no <files> are specified, then the `--use-dynamic' option\n"),
- io__write_string("\tis implied: the call graph will be built dynamically.\n"),
- io__write_string("\tOtherwise, the <files> specified should be the `.prof' file\n"),
- io__write_string("\tfor every module in the program. The `.prof' files, which are\n"),
- io__write_string("\tgenerated automatically by the Mercury compiler, contain the\n"),
- io__write_string("\tprogram's static call graph.\n"),
- io__write_string("\n"),
- io__write_string("Options:\n"),
- options_help.
-
-
-%-----------------------------------------------------------------------------%
-
-
-:- pred main_2(maybe(string), list(string), io__state, io__state).
-:- mode main_2(in, in, di, uo) is det.
-
-main_2(yes(ErrorMessage), _) -->
- usage_error(ErrorMessage).
-main_2(no, Args) -->
- io__stderr_stream(StdErr),
- io__set_output_stream(StdErr, StdOut),
- globals__io_lookup_bool_option(call_graph, CallGraphOpt),
- globals__io_lookup_bool_option(help, Help),
- (
- { Help = yes }
- ->
- long_usage
+ % Display error message and then usage message.
+ %
+:- pred usage_error(string::in, io::di, io::uo) is det.
+
+usage_error(ErrorMessage, !IO) :-
+ io__progname_base("mercury_profile", ProgName, !IO),
+ io__stderr_stream(StdErr, !IO),
+ io__write_strings(StdErr, [ProgName, ": ", ErrorMessage, "\n"], !IO),
+ io__set_exit_status(1, !IO),
+ usage(!IO).
+
+ % Display usage message.
+ %
+:- pred usage(io::di, io::uo) is det.
+
+usage(!IO) :-
+ io__progname_base("mprof", ProgName, !IO),
+ io__stderr_stream(StdErr, !IO),
+ library__version(Version),
+ io__write_strings(StdErr, [
+ "Mercury Profiler, version ", Version, "\n",
+ "Copyright (C) 1995-2004 The University of Melbourne\n",
+ "Usage: ", ProgName, " [<options>] [<files>]\n",
+ "Use `", ProgName, " --help' for more information.\n"
+ ], !IO).
+
+:- pred long_usage(io::di, io::uo) is det.
+
+long_usage(!IO) :-
+ io__progname_base("mprof", ProgName, !IO),
+ library__version(Version),
+ io__write_strings([
+ "Mercury Profiler, version ", Version, "\n",
+ "Copyright (C) 1995-2004 The University of Melbourne\n\n",
+ "Usage: ", ProgName, "[<options>] [<files>]\n",
+ "\n",
+ "Description:\n",
+ "\t`mprof' produces execution profiles for Mercury programs.\n",
+ "\tIt outputs a flat profile and optionally also a hierarchical\n",
+ "\t(call graph based) profile based on data collected during program\n",
+ "\texecution.\n",
+ "\n",
+ "Arguments:\n",
+ "\tIf no <files> are specified, then the `--use-dynamic' option\n",
+ "\tis implied: the call graph will be built dynamically.\n",
+ "\tOtherwise, the <files> specified should be the `.prof' file\n",
+ "\tfor every module in the program. The `.prof' files, which are\n",
+ "\tgenerated automatically by the Mercury compiler, contain the\n",
+ "\tprogram's static call graph.\n",
+ "\n",
+ "Options:\n"], !IO),
+ options_help(!IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred main_2(maybe(string)::in, list(string)::in, io::di, io::uo) is det.
+
+main_2(yes(ErrorMessage), _, !IO) :-
+ usage_error(ErrorMessage, !IO).
+main_2(no, Args, !IO) :-
+ io__stderr_stream(StdErr, !IO),
+ io__set_output_stream(StdErr, StdOut, !IO),
+ globals__io_lookup_bool_option(call_graph, CallGraphOpt, !IO),
+ globals__io_lookup_bool_option(help, Help, !IO),
+ ( Help = yes ->
+ long_usage(!IO)
;
- globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
- maybe_write_string(Verbose, "% Processing input files..."),
- process_file__main(Prof0, CallGraph0),
- maybe_write_string(Verbose, " done\n"),
+ maybe_write_string(Verbose, "% Processing input files...", !IO),
+ process_file__main(Prof0, CallGraph0, !IO),
+ maybe_write_string(Verbose, " done\n", !IO),
- (
- { CallGraphOpt = yes }
- ->
- maybe_write_string(Verbose, "% Building call graph..."),
- call_graph__main(Args, CallGraph0, CallGraph),
- maybe_write_string(Verbose, " done\n"),
-
- maybe_write_string(Verbose, "% Propagating counts..."),
- propagate__counts(CallGraph, Prof0, Prof),
- maybe_write_string(Verbose, " done\n")
+ ( CallGraphOpt = yes ->
+ maybe_write_string(Verbose, "% Building call graph...",
+ !IO),
+ call_graph__main(Args, CallGraph0, CallGraph, !IO),
+ maybe_write_string(Verbose, " done\n", !IO),
+
+ maybe_write_string(Verbose, "% Propagating counts...",
+ !IO),
+ propagate__counts(CallGraph, Prof0, Prof, !IO),
+ maybe_write_string(Verbose, " done\n", !IO)
;
- { Prof = Prof0 }
+ Prof = Prof0
),
- maybe_write_string(Verbose, "% Generating output..."),
- generate_output__main(Prof, IndexMap, OutputProf),
- maybe_write_string(Verbose, " done\n"),
-
- io__set_output_stream(StdOut, _),
- output__main(OutputProf, IndexMap),
- io__write_char('\n')
- ).
-
+ maybe_write_string(Verbose, "% Generating output...", !IO),
+ generate_output__main(Prof, IndexMap, OutputProf, !IO),
+ maybe_write_string(Verbose, " done\n", !IO),
+
+ io__set_output_stream(StdOut, _, !IO),
+ output__main(OutputProf, IndexMap, !IO),
+ io__nl(!IO)
+ ).
+%-----------------------------------------------------------------------------%
+:- end_module mercury_profile.
%-----------------------------------------------------------------------------%
Index: options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/options.m,v
retrieving revision 1.15
diff -u -r1.15 options.m
--- options.m 6 Feb 2001 07:11:45 -0000 1.15
+++ options.m 15 Nov 2004 05:50:33 -0000
@@ -36,7 +36,7 @@
% Miscellaneous Options
; help.
-:- type option_table == option_table(option).
+:- type option_table == option_table(option).
:- pred short_option(character::in, option::out) is semidet.
:- pred long_option(string::in, option::out) is semidet.
@@ -49,11 +49,11 @@
% A couple of misc utilities
-:- pred maybe_write_string(bool::input, string::input,
- io__state::di, io__state::uo) is det.
-:- pred maybe_flush_output(bool::in, io__state::di, io__state::uo) is det.
+:- pred maybe_write_string(bool::input, string::input, io::di, io::uo) is det.
+:- pred maybe_flush_output(bool::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
:- import_module std_util, map.
@@ -113,8 +113,7 @@
long_option("verbose", verbose).
long_option("very-verbose", very_verbose).
-special_handler(profile, string(WhatToProfile), OptionTable0, Result)
- :-
+special_handler(profile, string(WhatToProfile), OptionTable0, Result) :-
( valid_profile_option(WhatToProfile, CountFile) ->
map__set(OptionTable0, countfile, string(CountFile),
OptionTable),
@@ -133,6 +132,7 @@
OptionTable).
:- pred valid_profile_option(string::in, string::out) is semidet.
+
valid_profile_option("memory-words", "Prof.MemoryWords").
valid_profile_option("memory-cells", "Prof.MemoryCells").
valid_profile_option("time", "Prof.Counts").
@@ -173,7 +173,6 @@
io__write_string("\t\tName of the file which contains the call graph for\n"),
io__write_string("\t\tthe library modules.\n"),
-
io__write_string("\nVerbosity Options:\n"),
io__write_string("\t-v, --verbose\n"),
io__write_string("\t\tOutput progress messages at each stage.\n"),
@@ -188,6 +187,6 @@
maybe_flush_output(yes) --> io__flush_output.
maybe_flush_output(no) --> [].
+%-----------------------------------------------------------------------------%
:- end_module options.
-
%-----------------------------------------------------------------------------%
Index: output.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/output.m,v
retrieving revision 1.20
diff -u -r1.20 output.m
--- output.m 8 Jul 2004 05:56:37 -0000 1.20
+++ output.m 1 Dec 2004 04:08:08 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% output.m
%
@@ -20,487 +17,422 @@
:- interface.
-:- import_module string, int, map, io.
:- import_module output_prof_info.
+:- import_module string, int, map, io.
-:- pred output__main(output, map(string, int), io__state, io__state).
-:- mode output__main(in, in, di, uo) is det.
+:- pred output__main(output::in, map(string, int)::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module globals.
+:- import_module options.
+:- import_module generate_output.
+
:- import_module assoc_list, bool, float, list, require, std_util.
-:- import_module globals, options, generate_output.
-output__main(Output, IndexMap) -->
- globals__io_get_globals(Globals),
- { globals__get_what_to_profile(Globals, WhatToProfile) },
- { what_to_profile(WhatToProfileString, WhatToProfile) },
- io__format("*** profiling %s ***\n\n", [s(WhatToProfileString)]),
+%-----------------------------------------------------------------------------%
- { Output = output(InfoMap, CallList, FlatList) },
- globals__io_lookup_bool_option(call_graph, CallGraphOpt),
- (
- { CallGraphOpt = yes }
- ->
- output__call_graph_headers,
- output_call_graph(CallList, InfoMap, IndexMap)
+output__main(Output, IndexMap, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__get_what_to_profile(Globals, WhatToProfile),
+ what_to_profile(WhatToProfileString, WhatToProfile),
+ io__format("*** profiling %s ***\n\n", [s(WhatToProfileString)], !IO),
+
+ Output = output(InfoMap, CallList, FlatList),
+ globals__io_lookup_bool_option(call_graph, CallGraphOpt, !IO),
+ ( CallGraphOpt = yes ->
+ output__call_graph_headers(!IO),
+ output_call_graph(CallList, InfoMap, IndexMap, !IO)
;
- { true }
+ true
),
- output__flat_headers,
- output__flat_profile(FlatList, 0.0, InfoMap, IndexMap),
+ output__flat_headers(!IO),
+ output__flat_profile(FlatList, 0.0, InfoMap, IndexMap, !IO),
- output_alphabet_headers,
- output_alphabet_listing(IndexMap).
+ output_alphabet_headers(!IO),
+ output_alphabet_listing(IndexMap, !IO).
:- type header_category
---> time_headers
; memory_words_headers
; memory_cells_headers.
-:- pred classify_profile(what_to_profile::in, header_category::out) is det.
-classify_profile(user_time, time_headers).
-classify_profile(user_plus_system_time, time_headers).
-classify_profile(real_time, time_headers).
-classify_profile(memory_words, memory_words_headers).
-classify_profile(memory_cells, memory_cells_headers).
-
-:- pred units(header_category::in, string::out, string::out, string::out, string::out,
- string::out, string::out, string::out, string::out) is det.
-units(time_headers, "time", "time", "running time",
- "seconds", "seconds", "milliseconds", "ms/call", "spent executing").
-units(memory_words_headers,
- "mem", "memory", "allocated memory",
- "k-words", "kilowords", "words", "wds/call", "allocated by").
-units(memory_cells_headers,
- "cells", "allocations", "number of memory allocations",
- "k-cells", "kilocells", "cells", "cls/call", "occurring in").
-
-:- pred output__call_graph_headers(io__state, io__state).
-:- mode output__call_graph_headers(di, uo) is det.
-
-output__call_graph_headers -->
- globals__io_get_globals(Globals),
- { globals__get_what_to_profile(Globals, WhatToProfile) },
- { classify_profile(WhatToProfile, Category) },
- { units(Category, ShortWhat, What, LongWhat,
- _ShortUnits, Units, _MilliUnits, _MilliUnitsPerCall, SpentIn) },
+:- func classify_profile(what_to_profile) = header_category.
+
+classify_profile(user_time) = time_headers.
+classify_profile(user_plus_system_time) = time_headers.
+classify_profile(real_time) = time_headers.
+classify_profile(memory_words) = memory_words_headers.
+classify_profile(memory_cells) = memory_cells_headers.
+
+:- pred units(header_category::in, string::out, string::out, string::out,
+ string::out, string::out, string::out, string::out, string::out)
+ is det.
+
+units(time_headers, "time", "time", "running time", "seconds", "seconds",
+ "milliseconds", "ms/call", "spent executing").
+units(memory_words_headers, "mem", "memory", "allocated memory",
+ "k-words", "kilowords", "words", "wds/call", "allocated by").
+units(memory_cells_headers, "cells", "allocations",
+ "number of memory allocations", "k-cells", "kilocells", "cells",
+ "cls/call", "occurring in").
+
+:- pred output__call_graph_headers(io::di, io::uo) is det.
+
+output__call_graph_headers(!IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__get_what_to_profile(Globals, WhatToProfile),
+ Category = classify_profile(WhatToProfile),
+ units(Category, ShortWhat, What, LongWhat,
+ _ShortUnits, Units, _MilliUnits, _MilliUnitsPerCall, SpentIn),
- io__write_string("call graph profile:\n"),
- io__format("\tSorted on the %%%s field.\n\n", [s(ShortWhat)]),
+ io__write_string("call graph profile:\n", !IO),
+ io__format("\tSorted on the %%%s field.\n\n", [s(ShortWhat)], !IO),
- io__write_string("\tprocedure entries:\n\n"),
+ io__write_string("\tprocedure entries:\n\n", !IO),
- io__write_string("index\t\tthe index number of the procedure in the call graph\n"),
- io__write_string("\t\tlisting.\n\n"),
+ io__write_string("index\t\tthe index number of the procedure in the call graph\n", !IO),
+ io__write_string("\t\tlisting.\n\n", !IO),
io__format("%%%s\t\tthe percentage of the total %s of\n",
- [s(ShortWhat), s(LongWhat)]),
+ [s(ShortWhat), s(LongWhat)], !IO),
io__format("\t\tthe program %s this procedure and its\n",
- [s(SpentIn)]),
- io__write_string("\t\tdescendents.\n\n"),
+ [s(SpentIn)], !IO),
+ io__write_string("\t\tdescendents.\n\n", !IO),
io__format("self\t\tthe number of %s actually %s\n",
- [s(Units), s(SpentIn)]),
- io__write_string("\t\tthe procedure's own code.\n\n"),
+ [s(Units), s(SpentIn)], !IO),
+ io__write_string("\t\tthe procedure's own code.\n\n", !IO),
io__format("descendents\tthe number of %s %s the\n",
- [s(Units), s(SpentIn)]),
- io__write_string("\t\tdescendents of the current procedure.\n\n"),
+ [s(Units), s(SpentIn)], !IO),
+ io__write_string("\t\tdescendents of the current procedure.\n\n", !IO),
- io__write_string("called\t\tthe number of times the current procedure is\n"),
- io__write_string("\t\tcalled (not counting self recursive calls).\n\n"),
+ io__write_string("called\t\tthe number of times the current procedure is\n", !IO),
+ io__write_string("\t\tcalled (not counting self recursive calls).\n\n", !IO),
- io__write_string("self\t\tthe number of self recursive calls.\n\n"),
+ io__write_string("self\t\tthe number of self recursive calls.\n\n", !IO),
- io__write_string("name\t\tthe name of the current procedure.\n\n"),
+ io__write_string("name\t\tthe name of the current procedure.\n\n", !IO),
- io__write_string("index\t\tan index number to locate the function easily.\n\n\n\n"),
+ io__write_string("index\t\tan index number to locate the function easily.\n\n\n\n", !IO),
- io__write_string("\tparent listings:\n\n"),
+ io__write_string("\tparent listings:\n\n", !IO),
io__format("self*\t\tthe number of %s of the current procedure's self\n",
- [s(Units)]),
+ [s(Units)], !IO),
io__format("\t\t%s due to calls from this parent.\n\n",
- [s(What)]),
+ [s(What)], !IO),
io__format("descendents*\tthe number of %s of the current procedure's descendent\n",
- [s(Units)]),
+ [s(Units)], !IO),
io__format("\t\t%s which is due to calls from this parent.\n\n",
- [s(What)]),
+ [s(What)], !IO),
- io__write_string("called*\t\tthe number of times the current procedure is called\n"),
- io__write_string("\t\tby this parent.\n\n"),
+ io__write_string("called*\t\tthe number of times the current procedure is called\n", !IO),
+ io__write_string("\t\tby this parent.\n\n", !IO),
- io__write_string("total\t\tthe number of times this procedure is called by its parents.\n\n"),
+ io__write_string("total\t\tthe number of times this procedure is called by its parents.\n\n", !IO),
- io__write_string("parents\t\tthe name of this parent.\n\n"),
+ io__write_string("parents\t\tthe name of this parent.\n\n", !IO),
- io__write_string("index\t\tthe index number of the parent procedure\n\n\n\n"),
+ io__write_string("index\t\tthe index number of the parent procedure\n\n\n\n", !IO),
-
-
- io__write_string("children listings:\n\n"),
+ io__write_string("children listings:\n\n", !IO),
io__format("self*\t\tthe number of %s of this child's self %s which is\n",
- [s(Units), s(What)]),
- io__write_string("\t\tdue to being called by the current procedure.\n\n"),
+ [s(Units), s(What)], !IO),
+ io__write_string("\t\tdue to being called by the current procedure.\n\n", !IO),
io__format("descendent*\tthe number of %s of this child's descendent %s which\n",
- [s(Units), s(What)]),
- io__write_string("\t\tis due to the current procedure.\n\n"),
-
- io__write_string("called*\t\tthe number of times this child is called by the current\n"),
- io__write_string("\t\tprocedure.\n\n"),
+ [s(Units), s(What)], !IO),
+ io__write_string("\t\tis due to the current procedure.\n\n", !IO),
- io__write_string("total*\t\tthe number of times this child is called by all procedures.\n\n"),
+ io__write_string("called*\t\tthe number of times this child is called by the current\n", !IO),
+ io__write_string("\t\tprocedure.\n\n", !IO),
- io__write_string("children\tthe name of this child.\n\n"),
+ io__write_string("total*\t\tthe number of times this child is called by all procedures.\n\n", !IO),
- io__write_string("index\t\tthe index number of the child.\n\n\n\n"),
+ io__write_string("children\tthe name of this child.\n\n", !IO),
+ io__write_string("index\t\tthe index number of the child.\n\n\n\n", !IO),
-
- io__write_string(" called/total"),
- io__write_string(" parents\n"),
- { string__append("%", ShortWhat, PercentShortWhat) },
+ io__write_string(" called/total", !IO),
+ io__write_string(" parents\n", !IO),
io__format("index %6s self descendents called+self",
- [s(PercentShortWhat)]),
- io__write_string(" name index\n"),
- io__write_string(" called/total"),
- io__write_string(" children\n\n").
+ [s("%" ++ ShortWhat)], !IO),
+ io__write_string(" name index\n", !IO),
+ io__write_string(" called/total", !IO),
+ io__write_string(" children\n\n", !IO).
-:- pred output_call_graph(list(string), map(string, output_prof),
- map(string, int), io__state, io__state).
-:- mode output_call_graph(in, in, in, di, uo) is det.
-
-output_call_graph([], _, _) --> [].
-output_call_graph([LabelName | LNs], InfoMap, IndexMap) -->
- { map__lookup(InfoMap, LabelName, PN) },
- { map__lookup(IndexMap, LabelName, Index) },
- output_formatted_prof_node(PN, Index, IndexMap),
- io__write_string("\n-----------------------------------------------\n\n"),
- output_call_graph(LNs, InfoMap, IndexMap).
-
+:- pred output_call_graph(list(string)::in, map(string, output_prof)::in,
+ map(string, int)::in, io::di, io::uo) is det.
+
+output_call_graph([], _, _, !IO).
+output_call_graph([LabelName | LNs], InfoMap, IndexMap, !IO) :-
+ map__lookup(InfoMap, LabelName, PN),
+ map__lookup(IndexMap, LabelName, Index),
+ output_formatted_prof_node(PN, Index, IndexMap, !IO),
+ io__write_string("\n-----------------------------------------------\n\n", !IO),
+ output_call_graph(LNs, InfoMap, IndexMap, !IO).
-:- pred output_formatted_prof_node(output_prof, int, map(string, int),
- io__state, io__state).
-:- mode output_formatted_prof_node(in, in, in, di, uo) is det.
+:- pred output_formatted_prof_node(output_prof::in, int::in, map(string, int)::in,
+ io::di, io::uo) is det.
-output_formatted_prof_node(ProfNode, Index, IndexMap) -->
+output_formatted_prof_node(ProfNode, Index, IndexMap, !IO) :-
(
- { ProfNode = output_prof( Name, CycleNum,
- Percentage,
- _, Self,
- Descendant, TotalCalls,
- SelfCalls, ParentList,
- ChildList, CycleParentList,
- CycleChildList
- )
- }
+ ProfNode = output_prof(Name, CycleNum, Percentage, _, Self,
+ Descendant, TotalCalls, SelfCalls, ParentList,
+ ChildList, CycleParentList, CycleChildList)
;
- { ProfNode = output_cycle_prof(_, _, _, _, _, _, _, _, _) },
- { error("output_formatted_prof_node: Cannot have output_cycle_prof\n") }
+ ProfNode = output_cycle_prof(_, _, _, _, _, _, _, _, _),
+ error("output_formatted_prof_node: Cannot have output_cycle_prof\n")
),
% Set up all the output strings.
- {
- output__construct_name(Name, CycleNum, FullName),
+ FullName = construct_name(Name, CycleNum),
string__int_to_string(Index, IndexStr0),
string__append_list(["[", IndexStr0, "] "], IndexStr),
string__format("%40d %s [%d]\n",
- [i(SelfCalls),s(FullName),i(Index)], SelfCallsString),
+ [i(SelfCalls),s(FullName),i(Index)], SelfCallsString),
string__format("%-6s %5.1f %7.2f %11.2f %7d", [s(IndexStr),
- f(Percentage) , f(Self), f(Descendant), i(TotalCalls)],
- InitMiddleStr)
- },
+ f(Percentage) , f(Self), f(Descendant), i(TotalCalls)],
+ InitMiddleStr),
- (
- { SelfCalls \= 0 }
- ->
- io__write_string(SelfCallsString)
+ ( SelfCalls \= 0 ->
+ io__write_string(SelfCallsString, !IO)
;
- []
+ true
),
- (
- { CycleParentList = [] },
- { ParentList = [] }
- ->
- { string__format("%67s", [s("<spontaneous>\n")], String) },
- io__write_string(String)
+ ( CycleParentList = [], ParentList = [] ->
+ io__format("%67s", [s("<spontaneous>\n")], !IO)
;
- { list__sort(CycleParentList, SortedCycleParentList) },
+ list__sort(CycleParentList, SortedCycleParentList),
output_formatted_cycle_parent_list(SortedCycleParentList,
- IndexMap),
- { list__sort(ParentList, SortedParentList) },
+ IndexMap, !IO),
+ list__sort(ParentList, SortedParentList),
output_formatted_parent_list(SortedParentList, IndexMap,
- TotalCalls)
+ TotalCalls, !IO)
),
% Output the info about the current procedure.
- io__write_string(InitMiddleStr),
- (
- { SelfCalls = 0 }
- ->
- io__write_string(" ")
+ io__write_string(InitMiddleStr, !IO),
+ ( SelfCalls = 0 ->
+ io__write_string(" ", !IO)
;
- io__write_string("+"),
- { string__format("%-7d", [i(SelfCalls)], Str) },
- io__write_string(Str)
+ io__format("+%-7d", [i(SelfCalls)], !IO)
),
- io__write_string(FullName),
- io__write_string(" "),
- io__write_string(IndexStr),
- io__write_string("\n"),
-
- { list__sort(ChildList, SortedChildList) },
- output_formatted_child_list(SortedChildList, IndexMap),
- { list__sort(CycleChildList, SortedCycleChildList) },
- output_formatted_cycle_child_list(SortedCycleChildList, IndexMap),
+ io__write_string(FullName ++ " " ++ IndexStr ++ "\n", !IO),
- (
- { SelfCalls \= 0 }
- ->
- io__write_string(SelfCallsString)
- ;
- []
- ).
-
-
-% output_formatted_cycle_parent_list
-% outputs the parents of a procedure that are in the same cycle.
-%
-:- pred output_formatted_cycle_parent_list(list(parent), map(string, int),
- io__state, io__state).
-:- mode output_formatted_cycle_parent_list(in, in, di, uo) is det.
-
-output_formatted_cycle_parent_list([], _) --> [].
-output_formatted_cycle_parent_list([Parent | Parents], IndexMap) -->
- { Parent = parent(LabelName, CycleNum, _Self,
- _Descendant, Calls
- ),
-
- output__construct_name(LabelName, CycleNum, Name),
- string__format("%40d %s [%d]\n",
- [i(Calls),s(Name),i(Index)], Output),
- map__lookup(IndexMap, LabelName, Index)
- },
- io__write_string(Output),
- output_formatted_cycle_parent_list(Parents, IndexMap).
-
+ list__sort(ChildList, SortedChildList),
+ output_formatted_child_list(SortedChildList, IndexMap, !IO),
+ list__sort(CycleChildList, SortedCycleChildList),
+ output_formatted_cycle_child_list(SortedCycleChildList, IndexMap, !IO),
-% output_formatted_parent_list:
-% Outputs the parent list of the current procedure
-
-:- pred output_formatted_parent_list(list(parent), map(string, int), int,
- io__state, io__state).
-:- mode output_formatted_parent_list(in, in, in, di, uo) is det.
-
-output_formatted_parent_list([], _, _) --> [].
-output_formatted_parent_list([Parent | Parents], IndexMap, TotalCalls) -->
- { Parent = parent(LabelName, CycleNum, Self,
- Descendant, Calls
- ),
- output__construct_name(LabelName, CycleNum, Name),
- string__format("%20.2f %11.2f %7d/%-11d %s [%d]\n", [f(Self),
- f(Descendant), i(Calls), i(TotalCalls),
- s(Name), i(Index)], Output),
- map__lookup(IndexMap, LabelName, Index)
- },
- io__write_string(Output),
- output_formatted_parent_list(Parents, IndexMap, TotalCalls).
-
-
-% output_formatted_cycle_child_list
-% outputs the children of a procedure that are in the same cycle.
-%
-:- pred output_formatted_cycle_child_list(list(child), map(string, int),
- io__state, io__state).
-:- mode output_formatted_cycle_child_list(in, in, di, uo) is det.
-
-output_formatted_cycle_child_list([], _) --> [].
-output_formatted_cycle_child_list([Child | Childs], IndexMap) -->
- { Child = child(LabelName, CycleNum, _Self,
- _Descendant, Calls, _
- ),
-
- output__construct_name(LabelName, CycleNum, Name),
- string__format("%40d %s [%d]\n",
- [i(Calls),s(Name),i(Index)], Output),
- map__lookup(IndexMap, LabelName, Index)
- },
- io__write_string(Output),
- output_formatted_cycle_child_list(Childs, IndexMap).
-
+ ( SelfCalls \= 0 ->
+ io__write_string(SelfCallsString, !IO)
+ ;
+ true
+ ).
-% output_formatted_child_list:
-% outputs the child list of the current procedure.
-%
-:- pred output_formatted_child_list(list(child), map(string, int),
- io__state, io__state).
-:- mode output_formatted_child_list(in, in, di, uo) is det.
-
-output_formatted_child_list([], _) --> [].
-output_formatted_child_list([Child | Children], IndexMap) -->
- { Child = child( LabelName, CycleNum, Self,
- Descendant, Calls, TotalCalls
- ),
- output__construct_name(LabelName, CycleNum, Name),
- string__format("%20.2f %11.2f %7d/%-11d %s [%d]\n", [f(Self),
- f(Descendant), i(Calls), i(TotalCalls),
- s(Name), i(Index)], Output),
- map__lookup(IndexMap, LabelName, Index)
- },
- io__write_string(Output),
- output_formatted_child_list(Children, IndexMap).
-
-:- pred output__flat_headers(io__state, io__state).
-:- mode output__flat_headers(di, uo) is det.
-
-output__flat_headers -->
- globals__io_get_globals(Globals),
- { globals__get_what_to_profile(Globals, WhatToProfile) },
- { classify_profile(WhatToProfile, Category) },
- { units(Category, ShortWhat, _What, LongWhat,
- ShortUnits, Units, MilliUnits, MilliUnitsPerCall, SpentIn) },
+ % output_formatted_cycle_parent_list
+ % outputs the parents of a procedure that are in the same cycle.
+ %
+:- pred output_formatted_cycle_parent_list(list(parent)::in, map(string, int)::in,
+ io::di, io::uo) is det.
+
+output_formatted_cycle_parent_list(Parents, IndexMap, !IO) :-
+ list.foldl((pred(Parent::in, !.IO::di, !:IO::uo) is det :-
+ Parent = parent(LabelName, CycleNum, _, _, Calls),
+ Name = construct_name(LabelName, CycleNum),
+ Index = IndexMap ^ det_elem(LabelName),
+ io__format("%40d %s [%d]\n",
+ [i(Calls), s(Name), i(Index)], !IO)
+ ), Parents, !IO).
+
+ % output_formatted_parent_list:
+ % Outputs the parent list of the current procedure.
+ %
+:- pred output_formatted_parent_list(list(parent)::in, map(string, int)::in,
+ int::in, io::di, io::uo) is det.
+
+output_formatted_parent_list([], _, _, !IO).
+output_formatted_parent_list([Parent | Parents], IndexMap, TotalCalls, !IO) :-
+ Parent = parent(LabelName, CycleNum, Self, Descendant, Calls),
+ Name = construct_name(LabelName, CycleNum),
+ Index = IndexMap ^ det_elem(LabelName),
+ io__format("%20.2f %11.2f %7d/%-11d %s [%d]\n", [f(Self),
+ f(Descendant), i(Calls), i(TotalCalls),
+ s(Name), i(Index)], !IO),
+ output_formatted_parent_list(Parents, IndexMap, TotalCalls, !IO).
+
+ % output_formatted_cycle_child_list
+ % Outputs the children of a procedure that are in the same cycle.
+ %
+:- pred output_formatted_cycle_child_list(list(child)::in,
+ map(string, int)::in, io::di, io::uo) is det.
+
+output_formatted_cycle_child_list([], _, !IO).
+output_formatted_cycle_child_list([Child | Childs], IndexMap, !IO) :-
+ Child = child(LabelName, CycleNum, _Self, _Descendant, Calls, _),
+ Name = output__construct_name(LabelName, CycleNum),
+ Index = IndexMap ^ det_elem(LabelName),
+ io__format("%40d %s [%d]\n",
+ [i(Calls),s(Name),i(Index)], !IO),
+ output_formatted_cycle_child_list(Childs, IndexMap, !IO).
+
+ % output_formatted_child_list:
+ % outputs the child list of the current procedure.
+ %
+:- pred output_formatted_child_list(list(child)::in, map(string, int)::in,
+ io::di, io::uo) is det.
+
+output_formatted_child_list(Children, IndexMap, !IO) :-
+ list.foldl((pred(Child::in, !.IO::di, !:IO::uo) is det :-
+ Child = child(LabelName, CycleNum, Self, Descendant, Calls,
+ TotalCalls),
+ Name = output__construct_name(LabelName, CycleNum),
+ Index = IndexMap ^ det_elem(LabelName),
+ Output = string__format("%20.2f %11.2f %7d/%-11d %s [%d]\n",
+ [f(Self), f(Descendant), i(Calls), i(TotalCalls),
+ s(Name), i(Index)]),
+ io__write_string(Output, !IO)
+ ), Children, !IO).
+
+:- pred output__flat_headers(io::di, io::uo) is det.
+
+output__flat_headers(!IO) :-
+ globals__io_get_globals(Globals, !IO),
+ globals__get_what_to_profile(Globals, WhatToProfile),
+ Category = classify_profile(WhatToProfile),
+ units(Category, ShortWhat, _What, LongWhat,
+ ShortUnits, Units, MilliUnits, MilliUnitsPerCall, SpentIn),
- io__write_string("\nflat profile:\n\n"),
+ io__write_string("\nflat profile:\n\n", !IO),
io__format("%%\t\tthe percentage of total %s of the program\n",
- [s(LongWhat)]),
+ [s(LongWhat)], !IO),
io__format("%s\t\tused by this procedure.\n\n",
- [s(ShortWhat)]),
+ [s(ShortWhat)], !IO),
io__format(
"cumulative\tthe total number of %s for the current procedure and\n",
- [s(Units)]),
+ [s(Units)], !IO),
io__format("%s\t\tthe ones listed above it.\n\n",
- [s(ShortUnits)]),
+ [s(ShortUnits)], !IO),
io__format(
"self\t\tthe number of %s accounted for by this procedure alone.\n",
- [s(Units)]),
+ [s(Units)], !IO),
io__format("%s\t\tThe listing is sorted on this row.\n\n",
- [s(ShortUnits)]),
+ [s(ShortUnits)], !IO),
- io__write_string(
- "calls\t\tthe number of times this procedure was called.\n\n"),
+ io__write_string("calls\t\tthe number of times this " ++
+ "procedure was called.\n\n", !IO),
io__format("self\t\tthe average number of %s %s\n",
- [s(MilliUnits), s(SpentIn)]),
+ [s(MilliUnits), s(SpentIn)], !IO),
io__format("%s \tthis procedure per call.\n\n",
- [s(MilliUnitsPerCall)]),
+ [s(MilliUnitsPerCall)], !IO),
io__format(
"total\t\tthe average number of %s %s this procedure and its\n",
- [s(MilliUnits), s(SpentIn)]),
+ [s(MilliUnits), s(SpentIn)], !IO),
io__format("%s \tdescendents per call.\n\n",
- [s(MilliUnitsPerCall)]),
+ [s(MilliUnitsPerCall)], !IO),
- io__write_string(
- "name\t\tthe name of the procedure followed by its index number.\n\n"),
+ io__write_string("name\t\tthe name of the procedure " ++
+ "followed by its index number.\n\n", !IO),
- io__write_string(" % cumulative self self"),
- io__write_string(" total\n"),
+ io__write_string(" % cumulative self self", !IO),
+ io__write_string(" total\n", !IO),
io__format(" %4s %7s %7s calls %8s %8s name\n",
[s(ShortWhat), s(ShortUnits), s(ShortUnits),
- s(MilliUnitsPerCall), s(MilliUnitsPerCall)]).
+ s(MilliUnitsPerCall), s(MilliUnitsPerCall)], !IO).
+:- pred flat_profile(list(string)::in, float::in, map(string, output_prof)::in,
+ map(string, int)::in, io::di, io::uo) is det.
-:- pred output__flat_profile(list(string), float, map(string, output_prof),
- map(string, int), io__state, io__state).
-:- mode output__flat_profile(in, in, in, in, di, uo) is det.
-
-output__flat_profile([], _, _, _) --> [].
-output__flat_profile([LabelName | LNs], CumTime0, InfoMap, IndexMap) -->
- { map__lookup(InfoMap, LabelName, ProfNode) },
- { map__lookup(IndexMap, LabelName, Index) },
+output__flat_profile([], _, _, _, !IO).
+output__flat_profile([LabelName | LNs], CumTime0, InfoMap, IndexMap, !IO) :-
+ map__lookup(InfoMap, LabelName, ProfNode),
+ map__lookup(IndexMap, LabelName, Index),
(
- { ProfNode = output_prof( Name, CycleNum,
- _Percentage,
- Percentage, Self,
- Descendant, TotalCalls,
- SelfCalls, _ParentList,
- _ChildList, _,
- _
- )
- }
+ ProfNode = output_prof(Name, CycleNum,
+ _Percentage,
+ Percentage, Self,
+ Descendant, TotalCalls,
+ SelfCalls, _ParentList,
+ _ChildList, _,
+ _
+ )
;
- { ProfNode = output_cycle_prof(_, _, _, _, _, _, _, _, _) },
- { error("output_flat_profile: Cannot have output_cycle_prof\n")}
+ ProfNode = output_cycle_prof(_, _, _, _, _, _, _, _, _),
+ error("output_flat_profile: Cannot have output_cycle_prof\n")
),
+ FloatTotalCalls = float(TotalCalls) + float(SelfCalls),
+ Calls = SelfCalls + TotalCalls,
+ CumTime = CumTime0 + Self,
+ SelfSeconds = checked_float_divide(Self, FloatTotalCalls),
+ DescSeconds = checked_float_divide(Descendant, FloatTotalCalls),
+ SelfMs = 1000.0 * SelfSeconds,
+ DescMs = 1000.0 * DescSeconds,
- {
- FloatSelfCalls = float__float(SelfCalls),
- FloatTotalCalls0 = float__float(TotalCalls),
- FloatTotalCalls is FloatTotalCalls0 + FloatSelfCalls,
- Calls is SelfCalls + TotalCalls,
- CumTime is CumTime0 + Self,
- checked_float_divide(Self, FloatTotalCalls, SelfSeconds),
- checked_float_divide(Descendant, FloatTotalCalls, DescSeconds),
- SelfMs is 1000.0 * SelfSeconds,
- DescMs is 1000.0 * DescSeconds,
-
- output__construct_name(Name, CycleNum, FullName),
+ FullName = construct_name(Name, CycleNum),
string__int_to_string(Index, IndexStr0),
string__append_list(["[", IndexStr0, "] "], IndexStr),
- string__format("%5.1f %10.2f %8.2f %8d %8.2f %8.2f %s %s\n",
- [ f(Percentage), f(CumTime),
- f(Self), i(Calls),
- f(SelfMs), f(DescMs),
- s(FullName), s(IndexStr)
- ],
- String)
- },
-
- io__write_string(String),
+ io__format("%5.1f %10.2f %8.2f %8d %8.2f %8.2f %s %s\n",
+ [ f(Percentage), f(CumTime),
+ f(Self), i(Calls),
+ f(SelfMs), f(DescMs),
+ s(FullName), s(IndexStr)
+ ],
+ !IO),
- output__flat_profile(LNs, CumTime, InfoMap, IndexMap).
+ output__flat_profile(LNs, CumTime, InfoMap, IndexMap, !IO).
+:- pred output_alphabet_headers(io::di, io::uo) is det.
-:- pred output_alphabet_headers(io__state, io__state).
-:- mode output_alphabet_headers(di, uo) is det.
+output_alphabet_headers(!IO) :-
+ io__write_string("\n\n\nalphabetic listing:\n\n", !IO).
-output_alphabet_headers -->
- io__write_string("\n\n\nalphabetic listing:\n\n").
+:- pred output_alphabet_listing(map(string, int)::in, io::di, io::uo) is det.
+output_alphabet_listing(IndexMap, !IO) :-
+ IndexList = map__to_assoc_list(IndexMap),
+ output_alphabet_listing_2(IndexList, !IO).
-:- pred output_alphabet_listing(map(string, int), io__state, io__state).
-:- mode output_alphabet_listing(in, di, uo) is det.
+:- pred output_alphabet_listing_2(assoc_list(string, int)::in, io::di, io::uo)
+ is det.
-output_alphabet_listing(IndexMap) -->
- { map__to_assoc_list(IndexMap, IndexList) },
- output_alphabet_listing_2(IndexList).
+output_alphabet_listing_2([], !IO) :- io__nl(!IO).
+output_alphabet_listing_2([Name - Index | T], !IO) :-
+ io__format("[%d]\t%-30s\n", [i(Index), s(Name)], !IO),
+ output_alphabet_listing_2(T, !IO).
-:- pred output_alphabet_listing_2(assoc_list(string, int), io__state, io__state).
-:- mode output_alphabet_listing_2(in, di, uo) is det.
+ % output__construct_name
+ % Constructs an output name with an optional cycle number if required.
+ %
+:- func construct_name(string, int) = string.
-output_alphabet_listing_2([]) -->
- io__write_string("\n").
-output_alphabet_listing_2([Name - Index | T]) -->
- { string__format("[%d]\t%-30s\n", [i(Index), s(Name)], String) },
- io__write_string(String),
- output_alphabet_listing_2(T).
-
-% output__construct_name
-% Constructs an output name with an optional cycle number if required.
-%
-:- pred output__construct_name(string, int, string).
-:- mode output__construct_name(in, in, out) is det.
-
-output__construct_name(Name, CycleNum, FullName) :-
+construct_name(Name, CycleNum) = FullName :-
(
CycleNum = 0
->
FullName = Name
;
string__int_to_string(CycleNum, CycleStr),
- string__append_list([Name, " <cycle ", CycleStr, ">"], FullName)
+ string__append_list([Name, " <cycle ", CycleStr, ">"],
+ FullName)
).
+
+%-----------------------------------------------------------------------------%
+:- end_module output.
+%-----------------------------------------------------------------------------%
Index: output_prof_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/output_prof_info.m,v
retrieving revision 1.5
diff -u -r1.5 output_prof_info.m
--- output_prof_info.m 27 Jul 1997 15:07:49 -0000 1.5
+++ output_prof_info.m 15 Nov 2004 10:47:40 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% output_prof_info.m
%
@@ -25,12 +22,11 @@
:- import_module float, int, list, map, string.
-
%-----------------------------------------------------------------------------%
% XXX Needs to be explained more clearly.
-:- type output --->
- output(
+:- type output
+ ---> output(
map(string, output_prof), % Map which contains all
% the info which is
% required to generate
@@ -41,10 +37,10 @@
% it is in the correct
% order for call.
list(string) % same except for flat
- ).
+ ).
-:- type output_prof --->
- output_prof(
+:- type output_prof
+ ---> output_prof(
string, % predicate name
int, % cycle number
float, % %time in current predicate and
@@ -85,8 +81,8 @@
list(child) % children of predicate
).
-:- type parent --->
- parent(
+:- type parent
+ ---> parent(
string, % parent name
int, % cycle number
float, % the number of seconds of
@@ -95,11 +91,11 @@
% this parent.
float, % same as above for descendants
int % calls to current predicate
- ).
+ ).
-:- type child --->
- child(
+:- type child
+ ---> child(
string, % child name
int, % cycle number
float, % the number of seconds of
@@ -109,7 +105,8 @@
float, % same as above for descendants
int, % number of times child called
int % total calls of child
- ).
-
+ ).
+%-----------------------------------------------------------------------------%
+:- end_module output_prof_info.
%-----------------------------------------------------------------------------%
Index: process_file.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/process_file.m,v
retrieving revision 1.18
diff -u -r1.18 process_file.m
--- process_file.m 24 Nov 2000 10:19:02 -0000 1.18
+++ process_file.m 15 Nov 2004 05:47:19 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% process_file.m
%
@@ -25,8 +22,8 @@
:- import_module prof_info.
:- import_module io, relation.
-:- pred process_file__main(prof, relation(string), io__state, io__state).
-:- mode process_file__main(out, out, di, uo) is det.
+:- pred process_file__main(prof::out, relation(string)::out, io::di, io::uo)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -38,315 +35,271 @@
:- import_module bool, int, require, std_util, string.
:- import_module list, map.
+%-----------------------------------------------------------------------------%
-process_file__main(Prof, DynamicCallGraph) -->
- globals__io_lookup_bool_option(very_verbose, VVerbose),
- globals__io_lookup_string_option(declfile, DeclFile),
- globals__io_lookup_string_option(countfile, CountFile),
- globals__io_lookup_string_option(pairfile, PairFile),
- % globals__io_lookup_string_option(libraryfile, LibFile),
- globals__io_lookup_bool_option(dynamic_cg, Dynamic),
+process_file__main(Prof, DynamicCallGraph, !IO) :-
+ globals__io_lookup_bool_option(very_verbose, VVerbose, !IO),
+ globals__io_lookup_string_option(declfile, DeclFile, !IO),
+ globals__io_lookup_string_option(countfile, CountFile, !IO),
+ globals__io_lookup_string_option(pairfile, PairFile, !IO),
+ % globals__io_lookup_string_option(libraryfile, LibFile, !IO),
+ globals__io_lookup_bool_option(dynamic_cg, Dynamic, !IO),
% process the decl file
- maybe_write_string(VVerbose, "\n\t% Processing "),
- maybe_write_string(VVerbose, DeclFile),
- maybe_write_string(VVerbose, "..."),
- process_addr_decl(AddrDeclMap0, ProfNodeMap0),
- maybe_write_string(VVerbose, " done.\n"),
+ maybe_write_string(VVerbose, "\n\t% Processing ", !IO),
+ maybe_write_string(VVerbose, DeclFile, !IO),
+ maybe_write_string(VVerbose, "...", !IO),
+ process_addr_decl(AddrDeclMap0, ProfNodeMap0, !IO),
+ maybe_write_string(VVerbose, " done.\n", !IO),
% process the timing counts file
- maybe_write_string(VVerbose, "\t% Processing "),
- maybe_write_string(VVerbose, CountFile),
- maybe_write_string(VVerbose, "..."),
+ maybe_write_string(VVerbose, "\t% Processing ", !IO),
+ maybe_write_string(VVerbose, CountFile, !IO),
+ maybe_write_string(VVerbose, "...", !IO),
process_addr(ProfNodeMap0, ProfNodeMap1, WhatToProfile, Scale, Units,
- TotalCounts),
- maybe_write_string(VVerbose, " done.\n"),
+ TotalCounts, !IO),
+ maybe_write_string(VVerbose, " done.\n", !IO),
% process the call pair counts file
- maybe_write_string(VVerbose, "\t% Processing "),
- maybe_write_string(VVerbose, PairFile),
- maybe_write_string(VVerbose, "..."),
- process_addr_pair(ProfNodeMap1, AddrDeclMap0, DynamicCallGraph,
- ProfNodeMap, AddrDeclMap),
- maybe_write_string(VVerbose, " done.\n"),
-
- { map__init(CycleMap) },
- { prof_set_entire(Scale, Units, TotalCounts, AddrDeclMap,
- ProfNodeMap, CycleMap, Prof) },
- globals__io_get_globals(Globals0),
- { globals__set_what_to_profile(Globals0, WhatToProfile, Globals) },
- globals__io_set_globals(Globals),
+ maybe_write_string(VVerbose, "\t% Processing ", !IO),
+ maybe_write_string(VVerbose, PairFile, !IO),
+ maybe_write_string(VVerbose, "...", !IO),
+ process_addr_pair(ProfNodeMap1, ProfNodeMap,
+ AddrDeclMap0, AddrDeclMap, DynamicCallGraph, !IO),
+ maybe_write_string(VVerbose, " done.\n", !IO),
+
+ map__init(CycleMap),
+ prof_set_entire(Scale, Units, TotalCounts, AddrDeclMap,
+ ProfNodeMap, CycleMap, Prof),
+ globals__io_get_globals(Globals0, !IO),
+ globals__set_what_to_profile(Globals0, WhatToProfile, Globals),
+ globals__io_set_globals(Globals, !IO),
- (
- { Dynamic = no }
- ->
+ ( Dynamic = no ->
% maybe_write_string(VVerbose, "\t% Processing "),
% maybe_write_string(VVerbose, LibFile),
% maybe_write_string(VVerbose, "..."),
% process_library_callgraph(_, _),
% maybe_write_string(VVerbose, " done.\n"),
- { true }
-
+ true
;
- { true }
+ true
).
-
%-----------------------------------------------------------------------------%
-
-% process_addr_decl:
-% Reads in the Prof.Decl file.
-% Builds the addrdecl map which associates label names(key) with
-% label addresses.
-% Also builds the prof_node_map which associates label addresses with
-% the prof_node structure. Initialises and inserts the label name into
-% the structure at the same time.
-%
-:- pred process_addr_decl(addrdecl, prof_node_map, io__state, io__state).
-:- mode process_addr_decl(out, out, di, uo) is det.
-
-process_addr_decl(AddrDeclMap, ProfNodeMap) -->
- { map__init(AddrDeclMap0) },
- { map__init(ProfNodeMap0) },
- globals__io_lookup_string_option(declfile, DeclFile),
- io__see(DeclFile, Result),
+ % process_addr_decl:
+ % Reads in the Prof.Decl file.
+ % Builds the addrdecl map which associates label names(key)
+ % with label addresses.
+ % Also builds the prof_node_map which associates label addresses
+ % with the prof_node structure. Initialises and inserts the
+ % label name into the structure at the same time.
+ %
+:- pred process_addr_decl(addrdecl::out, prof_node_map::out,
+ io::di, io::uo) is det.
+
+process_addr_decl(AddrDeclMap, ProfNodeMap, !IO) :-
+ globals__io_lookup_string_option(declfile, DeclFile, !IO),
+ io__see(DeclFile, Result, !IO),
(
- { Result = ok },
- process_addr_decl_2(AddrDeclMap0, ProfNodeMap0, AddrDeclMap,
- ProfNodeMap),
- io__seen
+ Result = ok,
+ process_addr_decl_2(map.init, AddrDeclMap, map.init,
+ ProfNodeMap, !IO),
+ io__seen(!IO)
;
- { Result = error(Error) },
- { io__error_message(Error, ErrorMsg) },
-
- { string__append("error opening declaration file `", DeclFile,
- Str0) },
- { string__append(Str0, "': ", Str1) },
- { string__append(Str1, ErrorMsg, Str2) },
- { string__append(Str2, "\n", ErrorStr) },
- { error(ErrorStr) }
+ Result = error(Error),
+ ErrorStr = "error opening declaration file `" ++ DeclFile ++
+ "': " ++ io.error_message(Error) ++ "\n",
+ error(ErrorStr)
).
-:- pred process_addr_decl_2(addrdecl, prof_node_map, addrdecl, prof_node_map,
- io__state, io__state).
-:- mode process_addr_decl_2(in, in, out, out, di, uo) is det.
+:- pred process_addr_decl_2(addrdecl::in, addrdecl::out, prof_node_map::in,
+ prof_node_map::out, io::di, io::uo) is det.
-process_addr_decl_2(AddrDecl0, ProfNodeMap0, AddrDecl, ProfNodeMap) -->
- maybe_read_label_addr(MaybeLabelAddr),
- (
- { MaybeLabelAddr = yes(LabelAddr) },
- read_label_name(LabelName),
- { prof_node_init(LabelName, ProfNode) },
- { map__det_insert(AddrDecl0, LabelName, LabelAddr, AddrDecl1) },
+process_addr_decl_2(!AddrDecl, !ProfNodeMap, !IO) :-
+ maybe_read_label_addr(MaybeLabelAddr, !IO),
+ ( MaybeLabelAddr = yes(LabelAddr) ->
+ read_label_name(LabelName, !IO),
+ ProfNode = prof_node_init(LabelName),
+ map__det_insert(!.AddrDecl, LabelName, LabelAddr, !:AddrDecl),
% Labels with different names but the same addresses.
(
- { map__insert(ProfNodeMap0, LabelAddr, ProfNode,
- ProfNodeMap1) }
+ map__insert(!.ProfNodeMap, LabelAddr, ProfNode,
+ !:ProfNodeMap)
->
- { AddrDecl2 = AddrDecl1 },
- { ProfNodeMap2 = ProfNodeMap1 }
+ true
;
- { lookup_addr(ProfNodeMap0, AddrDecl1, LabelAddr,
- ProfNode0, ProfNodeMap1, AddrDecl2) },
- { prof_node_concat_to_name_list(LabelName, ProfNode0,
- NewProfNode) },
- { map__det_update(ProfNodeMap1, LabelAddr, NewProfNode,
- ProfNodeMap2) }
+ lookup_addr(LabelAddr, ProfNode0, !AddrDecl,
+ !ProfNodeMap),
+ prof_node_concat_to_name_list(LabelName, ProfNode0,
+ NewProfNode),
+ map__det_update(!.ProfNodeMap, LabelAddr, NewProfNode,
+ !:ProfNodeMap)
),
- process_addr_decl_2(AddrDecl2, ProfNodeMap2, AddrDecl,
- ProfNodeMap)
+ process_addr_decl_2(!AddrDecl, !ProfNodeMap, !IO)
;
- { MaybeLabelAddr = no },
- { AddrDecl = AddrDecl0 },
- { ProfNodeMap = ProfNodeMap0 }
+ true
).
%-----------------------------------------------------------------------------%
-
-% process_addr:
-% Reads in the Prof.Counts file and stores all the counts in the
-% prof_node structure. Also sums the total counts at the same time.
-%
-:- pred process_addr(prof_node_map, prof_node_map,
- what_to_profile, float, string, int, io__state, io__state).
-:- mode process_addr(in, out, out, out, out, out, di, uo) is det.
-
-process_addr(ProfNodeMap0, ProfNodeMap, WhatToProfile, Scale, Units,
- TotalCounts) -->
- globals__io_lookup_string_option(countfile, CountFile),
- io__see(CountFile, Result),
+ % process_addr:
+ % Reads in the Prof.Counts file and stores all the counts in the
+ % prof_node structure. Also sums the total counts at the same time.
+ %
+:- pred process_addr(prof_node_map::in, prof_node_map::out,
+ what_to_profile::out, float::out, string::out, int::out,
+ io::di, io::uo) is det.
+
+process_addr(!ProfNodeMap, WhatToProfile, Scale, Units, TotalCounts, !IO) :-
+ globals__io_lookup_string_option(countfile, CountFile, !IO),
+ io__see(CountFile, Result, !IO),
(
- { Result = ok },
- read_what_to_profile(WhatToProfile),
- read_float(Scale),
- read_string(Units),
- process_addr_2(0, ProfNodeMap0, TotalCounts, ProfNodeMap),
- io__seen
+ Result = ok,
+ read_what_to_profile(WhatToProfile, !IO),
+ read_float(Scale, !IO),
+ read_string(Units, !IO),
+ process_addr_2(0, TotalCounts, !ProfNodeMap, !IO),
+ io__seen(!IO)
;
- { Result = error(Error) },
- { io__error_message(Error, ErrorMsg) },
- io__write_string("\nWarning: error opening `"),
- io__write_string(CountFile),
- io__write_string("': "),
- io__write_string(ErrorMsg),
- io__write_string("\n"),
- io__write_string("The generated profile will only include "),
- io__write_string("call counts.\n\n"),
- { TotalCounts = 0 },
- { ProfNodeMap = ProfNodeMap0 },
+ Result = error(Error),
+ io__error_message(Error, ErrorMsg),
+ io__write_string("\nWarning: error opening `", !IO),
+ io__write_string(CountFile, !IO),
+ io__write_string("': ", !IO),
+ io__write_string(ErrorMsg, !IO),
+ io__write_string("\n", !IO),
+ io__write_string("The generated profile will only include ", !IO),
+ io__write_string("call counts.\n\n", !IO),
+ TotalCounts = 0,
% We can use any arbitrary values for WhatToProfile and Scale;
% the values specified here won't be used,
% since all the times will be zero.
- { WhatToProfile = user_plus_system_time },
- { Scale = 1.0 },
- { Units = "" }
+ WhatToProfile = user_plus_system_time,
+ Scale = 1.0,
+ Units = ""
).
-:- pred process_addr_2(int, prof_node_map, int, prof_node_map,
- io__state, io__state).
-:- mode process_addr_2(in, in, out, out, di, uo) is det.
+:- pred process_addr_2(int::in, int::out,
+ prof_node_map::in, prof_node_map::out, io::di, io::uo) is det.
-process_addr_2(TotalCounts0, ProfNodeMap0, TotalCounts, ProfNodeMap) -->
- maybe_read_label_addr(MaybeLabelAddr),
- (
- { MaybeLabelAddr = yes(LabelAddr) },
- read_int(Count),
+process_addr_2(!TotalCounts, !ProfNodeMap, !IO) :-
+ maybe_read_label_addr(MaybeLabelAddr, !IO),
+ ( MaybeLabelAddr = yes(LabelAddr) ->
+ read_int(Count, !IO),
% Add to initial counts if we have a ProfNode structure
% for the address otherwise ignore it.
(
- {map__search(ProfNodeMap0,LabelAddr, ProfNode0)}
+ map__search(!.ProfNodeMap, LabelAddr, ProfNode0)
->
- { prof_node_get_initial_counts(ProfNode0,
- InitCount0) },
- { InitCount is InitCount0 + Count },
- { prof_node_set_initial_counts(InitCount,
- ProfNode0, ProfNode) },
- { map__set(ProfNodeMap0, LabelAddr, ProfNode,
- ProfNodeMap1) },
- { TC1 is TotalCounts0 + Count }
+ prof_node_get_initial_counts(ProfNode0,
+ InitCount0),
+ InitCount = InitCount0 + Count,
+ prof_node_set_initial_counts(InitCount,
+ ProfNode0, ProfNode),
+ map__set(!.ProfNodeMap, LabelAddr, ProfNode,
+ !:ProfNodeMap),
+ !:TotalCounts = !.TotalCounts + Count
;
- { TC1 = TotalCounts0 },
- { ProfNodeMap1 = ProfNodeMap0 },
- { string__format("\nWarning address %d not found! Ignoring address and continuing computation.\n", [ i(LabelAddr) ], String) },
- io__write_string(String)
+ io__format("\nWarning address " ++
+ "%d not found! Ignoring address and " ++
+ "continuing computation.\n",
+ [i(LabelAddr)], !IO)
),
-
- process_addr_2(TC1, ProfNodeMap1, TotalCounts, ProfNodeMap)
+ process_addr_2(!TotalCounts, !ProfNodeMap, !IO)
;
- { MaybeLabelAddr = no },
- { ProfNodeMap = ProfNodeMap0 },
- { TotalCounts = TotalCounts0 }
+ true
).
-
%-----------------------------------------------------------------------------%
-
-% process_addr_pair:
-% Reads in the Prof.CallPair file and stores the data in the relevant
-% lists of the prof_node structure. Also calculates the number of times
-% a predicate is called.
-%
-:- pred process_addr_pair(prof_node_map, addrdecl, relation(string),
- prof_node_map, addrdecl, io__state, io__state).
-:- mode process_addr_pair(in, in, out, out, out, di, uo) is det.
-
-process_addr_pair(ProfNodeMap0, AddrDecl0, DynamicCallGraph,
- ProfNodeMap, AddrDecl) -->
- { relation__init(DynamicCallGraph0) },
- globals__io_lookup_bool_option(dynamic_cg, Dynamic),
- globals__io_lookup_string_option(pairfile, PairFile),
- io__see(PairFile, Result),
+ % process_addr_pair:
+ % Reads in the Prof.CallPair file and stores the data in the relevant
+ % lists of the prof_node structure. Also calculates the number of
+ % times a predicate is called.
+ %
+:- pred process_addr_pair(prof_node_map::in, prof_node_map::out,
+ addrdecl::in, addrdecl::out, relation(string)::out, io::di, io::uo)
+ is det.
+
+process_addr_pair(!ProfNodeMap, !AddrDecl, DynamicCallGraph, !IO) :-
+ globals__io_lookup_bool_option(dynamic_cg, Dynamic, !IO),
+ globals__io_lookup_string_option(pairfile, PairFile, !IO),
+ io__see(PairFile, Result, !IO),
(
- { Result = ok },
- process_addr_pair_2(DynamicCallGraph0, ProfNodeMap0, AddrDecl0,
- Dynamic, DynamicCallGraph,
- ProfNodeMap, AddrDecl),
- io__seen
+ Result = ok,
+ process_addr_pair_2(Dynamic, relation.init, DynamicCallGraph,
+ !ProfNodeMap, !AddrDecl, !IO),
+ io__seen(!IO)
;
- { Result = error(Error) },
- { io__error_message(Error, ErrorMsg) },
- { string__append("error opening pair file `", PairFile,
- Str0) },
- { string__append(Str0, "': ", Str1) },
- { string__append(Str1, ErrorMsg, Str2) },
- { string__append(Str2, "\n", ErrorStr) },
- { error(ErrorStr) }
+ Result = error(Error),
+ ErrorStr = "error opening pair file `" ++ PairFile ++
+ "': " ++ io.error_message(Error) ++ "\n",
+ error(ErrorStr)
).
-:- pred process_addr_pair_2(relation(string), prof_node_map, addrdecl, bool,
- relation(string), prof_node_map, addrdecl,
- io__state, io__state).
-:- mode process_addr_pair_2(in, in, in, in, out, out, out, di, uo) is det.
-
-process_addr_pair_2(DynamicCallGraph0, ProfNodeMap0, AddrDecl0,
- Dynamic, DynamicCallGraph, ProfNodeMap, AddrDecl) -->
- maybe_read_label_addr(MaybeLabelAddr),
- (
- { MaybeLabelAddr = yes(CallerAddr) },
- read_label_addr(CalleeAddr),
- read_int(Count),
+:- pred process_addr_pair_2(bool::in,
+ relation(string)::in, relation(string)::out,
+ prof_node_map::in, prof_node_map::out,
+ addrdecl::in, addrdecl::out, io::di, io::uo) is det.
+
+process_addr_pair_2(Dynamic, !DynamicCallGraph, !ProfNodeMap, !AddrDecl,
+ !IO) :-
+ maybe_read_label_addr(MaybeLabelAddr, !IO),
+ ( MaybeLabelAddr = yes(CallerAddr) ->
+ read_label_addr(CalleeAddr, !IO),
+ read_int(Count, !IO),
% Get child and parent information
- { lookup_addr(ProfNodeMap0, AddrDecl0, CallerAddr,
- CallerProfNode0, ProfNodeMap0a, AddrDecl1) },
- { lookup_addr(ProfNodeMap0a, AddrDecl1, CalleeAddr,
- CalleeProfNode0, ProfNodeMap0b, AddrDecl2) },
- { prof_node_get_pred_name(CallerProfNode0, CallerName) },
- { prof_node_get_pred_name(CalleeProfNode0, CalleeName) },
+ lookup_addr(CallerAddr, CallerProfNode0, !AddrDecl,
+ !ProfNodeMap),
+ lookup_addr(CalleeAddr, CalleeProfNode0, !AddrDecl,
+ !ProfNodeMap),
+ prof_node_get_pred_name(CallerProfNode0, CallerName),
+ prof_node_get_pred_name(CalleeProfNode0, CalleeName),
% Insert child information
- { prof_node_concat_to_child(CalleeName, Count, CallerProfNode0,
- CallerProfNode) },
- {map__set(ProfNodeMap0b, CallerAddr, CallerProfNode,
- PNodeMap1)},
+ prof_node_concat_to_child(CalleeName, Count, CallerProfNode0,
+ CallerProfNode),
+ map__set(!.ProfNodeMap, CallerAddr, CallerProfNode,
+ !:ProfNodeMap),
% Update the total calls field if not self recursive
- ({
- CalleeAddr \= CallerAddr
- ->
+ ( CalleeAddr \= CallerAddr ->
prof_node_get_total_calls(CalleeProfNode0, TotalCalls0),
- TotalCalls is TotalCalls0 + Count,
+ TotalCalls = TotalCalls0 + Count,
prof_node_set_total_calls(TotalCalls, CalleeProfNode0,
- CalleeProfNode1),
+ CalleeProfNode1),
prof_node_concat_to_parent(CallerName, Count,
- CalleeProfNode1, CalleeProfNode)
+ CalleeProfNode1, CalleeProfNode)
;
prof_node_set_self_calls(Count, CalleeProfNode0,
- CalleeProfNode)
- }),
+ CalleeProfNode)
+ ),
% Insert parent information
- { map__set(PNodeMap1, CalleeAddr, CalleeProfNode, PNodeMap2) },
+ map__set(!.ProfNodeMap, CalleeAddr, CalleeProfNode, !:ProfNodeMap),
% Add edge to call graph if generating dynamic call graph.
- ({
- Dynamic = yes
- ->
- relation__add_element(DynamicCallGraph0,
- CallerName, CallerKey, DynamicCallGraph1),
- relation__add_element(DynamicCallGraph1,
- CalleeName, CalleeKey, DynamicCallGraph2),
- relation__add(DynamicCallGraph2, CallerKey,
- CalleeKey, DynamicCallGraph99)
+ ( Dynamic = yes ->
+ relation__add_element(!.DynamicCallGraph,
+ CallerName, CallerKey, !:DynamicCallGraph),
+ relation__add_element(!.DynamicCallGraph,
+ CalleeName, CalleeKey, !:DynamicCallGraph),
+ relation__add(!.DynamicCallGraph, CallerKey,
+ CalleeKey, !:DynamicCallGraph)
;
- DynamicCallGraph99 = DynamicCallGraph0
- }),
-
- process_addr_pair_2(DynamicCallGraph99, PNodeMap2, AddrDecl2,
- Dynamic, DynamicCallGraph, ProfNodeMap,
- AddrDecl)
+ true
+ ),
+ process_addr_pair_2(Dynamic, !DynamicCallGraph, !ProfNodeMap,
+ !AddrDecl, !IO)
;
- { MaybeLabelAddr = no },
- { DynamicCallGraph = DynamicCallGraph0 },
- { ProfNodeMap = ProfNodeMap0 },
- { AddrDecl = AddrDecl0 }
+ true
).
@@ -355,71 +308,62 @@
% process_library_callgraph:
% XXX
%
-:- pred process_library_callgraph(list(string), map(string, unit),
- io__state, io__state).
-:- mode process_library_callgraph(out, out, di, uo) is det.
-
-process_library_callgraph(LibraryATSort, LibPredMap) -->
- globals__io_lookup_string_option(libraryfile, LibFile),
- { map__init(LibPredMap0) },
- io__see(LibFile, Result),
+%
+
+:- pred process_library_callgraph(list(string)::out, map(string, unit)::out,
+ io::di, io::uo) is det.
+
+process_library_callgraph(LibraryATSort, LibPredMap, !IO) :-
+ globals__io_lookup_string_option(libraryfile, LibFile, !IO),
+ map__init(LibPredMap0),
+ io__see(LibFile, Result, !IO),
(
- { Result = ok },
+ Result = ok,
process_library_callgraph_2([], LibraryATSort, LibPredMap0,
- LibPredMap),
- io__seen
+ LibPredMap, !IO),
+ io__seen(!IO)
;
- { Result = error(Error) },
- { io__error_message(Error, ErrorMsg) },
- io__stderr_stream(StdErr),
+ Result = error(Error),
+ io__error_message(Error, ErrorMsg),
+ io__stderr_stream(StdErr, !IO),
io__write_strings(StdErr, ["mprof: error opening pair file `",
- LibFile, "': ", ErrorMsg, "\n"]),
- { LibraryATSort = [] },
- { LibPredMap = LibPredMap0 }
+ LibFile, "': ", ErrorMsg, "\n"], !IO),
+ LibraryATSort = [],
+ LibPredMap = LibPredMap0
).
-:- pred process_library_callgraph_2(list(string), list(string),
- map(string, unit), map(string, unit), io__state, io__state).
-:- mode process_library_callgraph_2(in, out, in, out, di, uo) is det.
-
-process_library_callgraph_2(LibATSort0, LibATSort, LibPredMap0, LibPredMap) -->
- maybe_read_label_name(MaybeLabelName),
- (
- { MaybeLabelName = yes(LabelName) },
-
- { map__det_insert(LibPredMap0, LabelName, unit, LibPredMap1) },
- { LibATSort1 = [ LabelName | LibATSort0 ] },
+:- pred process_library_callgraph_2(list(string)::in, list(string)::out,
+ map(string, unit)::in, map(string, unit)::out, io::di, io::uo) is det.
- process_library_callgraph_2(LibATSort1, LibATSort, LibPredMap1,
- LibPredMap)
+process_library_callgraph_2(!LibATSort, !LibPredMap, !IO) :-
+ maybe_read_label_name(MaybeLabelName, !IO),
+ ( MaybeLabelName = yes(LabelName) ->
+ map__det_insert(!.LibPredMap, LabelName, unit, !:LibPredMap),
+ list__cons(LabelName, !LibATSort),
+ process_library_callgraph_2(!LibATSort, !LibPredMap, !IO)
;
- { MaybeLabelName = no },
-
- { LibPredMap = LibPredMap0 },
- { LibATSort = LibATSort0 }
+ true
).
%-----------------------------------------------------------------------------%
+ % Attempt to lookup the addr in the prof_node_map, if it
+ % does not exist then record the name as unknown__<address>
+ % in the relevant data structures.
+ %
+:- pred lookup_addr(int::in, prof_node::out, addrdecl::in, addrdecl::out,
+ prof_node_map::in, prof_node_map::out) is det.
-% Attempt to lookup the addr in the prof_node_map, if it doesn't exist
-% record the name as unknown__<address> in the relevant data structures.
-
-:- pred lookup_addr(prof_node_map, addrdecl, int, prof_node,
- prof_node_map, addrdecl).
-:- mode lookup_addr(in, in, in, out, out, out) is det.
-
-lookup_addr(ProfNodeMap0, AddrDeclMap0, Addr, ProfNode,
- ProfNodeMap, AddrDeclMap) :-
- (
- map__search(ProfNodeMap0, Addr, ProfNode0)
- ->
- ProfNodeMap = ProfNodeMap0,
- AddrDeclMap = AddrDeclMap0,
+lookup_addr(Addr, ProfNode, !AddrDeclMap, !ProfNodeMap) :-
+ ( map__search(!.ProfNodeMap, Addr, ProfNode0) ->
ProfNode = ProfNode0
;
Str = string__format("unknown__%d", [i(Addr)]),
- prof_node_init(Str, ProfNode),
- map__det_insert(ProfNodeMap0, Addr, ProfNode, ProfNodeMap),
- map__det_insert(AddrDeclMap0, Str, Addr, AddrDeclMap)
+ ProfNode = prof_node_init(Str),
+ map__det_insert(!.ProfNodeMap, Addr, ProfNode, !:ProfNodeMap),
+ map__det_insert(!.AddrDeclMap, Str, Addr, !:AddrDeclMap)
).
+
+%-----------------------------------------------------------------------------%
+:- end_module process_file.
+%-----------------------------------------------------------------------------%
Index: prof_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/prof_debug.m,v
retrieving revision 1.6
diff -u -r1.6 prof_debug.m
--- prof_debug.m 27 Jul 1997 15:07:51 -0000 1.6
+++ prof_debug.m 30 Nov 2004 08:17:08 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% prof_debug.m: Debuging predicates for the mercury profiler
%
@@ -18,12 +15,10 @@
:- interface.
:- import_module set, list, string, io, assoc_list.
-:- pred output_cliques(list(set(string)), io__state, io__state).
-:- mode output_cliques(in, di, uo) is det.
+:- pred output_cliques(list(set(string))::in, io::di, io::uo) is det.
-:- pred output_propagate_info(set(string), assoc_list(string, int),
- io__state, io__state).
-:- mode output_propagate_info(in, in, di, uo) is det.
+:- pred output_propagate_info(set(string)::in, assoc_list(string, int)::in,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -31,8 +26,6 @@
:- implementation.
:- import_module std_util.
-% :- import_module writeln.
-
%-----------------------------------------------------------------------------%
@@ -81,5 +74,6 @@
io__write_string("\n"),
print_list(Xs).
-
+%-----------------------------------------------------------------------------%
+:- end_module prof_debug.
%-----------------------------------------------------------------------------%
Index: prof_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/prof_info.m,v
retrieving revision 1.11
diff -u -r1.11 prof_info.m
--- prof_info.m 5 Dec 1997 15:55:55 -0000 1.11
+++ prof_info.m 1 Dec 2004 02:03:56 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% prof_info.m
@@ -47,148 +44,134 @@
:- type pred_info.
:- type prof_node_type
- ---> predicate
- ; cycle.
-
+ ---> predicate
+ ; cycle.
%-----------------------------------------------------------------------------%
+ % Get prof_node from via predicate name.
+ %
+:- pred get_prof_node(string::in, addrdecl::in, prof_node_map::in,
+ prof_node::out) is det.
- % *** Get prof_node from via predicate name *** %
-
-:- pred get_prof_node(string, addrdecl, prof_node_map, prof_node).
-:- mode get_prof_node(in, in, in, out) is det.
-
-:- pred update_prof_node(string,prof_node,addrdecl,prof_node_map,prof_node_map).
-:- mode update_prof_node(in, in, in, in, out) is det.
-
-
- % *** Initialise prof predicates *** %
-
-:- pred prof_node_init(string, prof_node).
-:- mode prof_node_init(in, out) is det.
+:- pred update_prof_node(string::in, prof_node::in, addrdecl::in,
+ prof_node_map::in, prof_node_map::out) is det.
-:- pred prof_node_init_cycle(string, int, int, float, list(pred_info), int,
- int, prof_node).
-:- mode prof_node_init_cycle(in, in, in, in, in, in, in, out) is det.
+ % Initialise prof predicates.
+ %
+:- func prof_node_init(string) = prof_node.
+:- func prof_node_init_cycle(string, int, int, float, list(pred_info), int,
+ int) = prof_node.
- % *** Access prof predicates *** %
-
-:- pred prof_get_entire(prof,
- float, string, int, addrdecl, prof_node_map, cycle_map).
-:- mode prof_get_entire(in, out, out, out, out, out, out) is det.
-
-:- pred prof_get_addrdeclmap(prof, addrdecl).
-:- mode prof_get_addrdeclmap(in, out) is det.
-
-:- pred prof_get_profnodemap(prof, prof_node_map).
-:- mode prof_get_profnodemap(in, out) is det.
-
-
- % *** Update prof predicates *** %
-
-:- pred prof_set_entire(float, string, int, addrdecl, prof_node_map, cycle_map,
- prof).
-:- mode prof_set_entire(in, in, in, in, in, in, out) is det.
+%-----------------------------------------------------------------------------%
+%
+% `prof' access predicates.
+%
-:- pred prof_set_profnodemap(prof_node_map, prof, prof).
-:- mode prof_set_profnodemap(in, in, out) is det.
+:- pred prof_get_entire(prof::in, float::out, string::out, int::out,
+ addrdecl::out, prof_node_map::out, cycle_map::out) is det.
-:- pred prof_set_cyclemap(cycle_map, prof, prof).
-:- mode prof_set_cyclemap(in, in, out) is det.
+:- pred prof_get_addrdeclmap(prof::in, addrdecl::out) is det.
+:- pred prof_get_profnodemap(prof::in, prof_node_map::out) is det.
- % *** Special prof_node predicates *** %
+%-----------------------------------------------------------------------------%
+%
+% `prof' update predicates.
+%
-:- pred prof_node_type(prof_node, prof_node_type).
-:- mode prof_node_type(in, out) is det.
+:- pred prof_set_entire(float::in, string::in, int::in, addrdecl::in,
+ prof_node_map::in, cycle_map::in, prof::out) is det.
+:- pred prof_set_profnodemap(prof_node_map::in, prof::in, prof::out) is det.
- % *** Access Predicate for prof_node *** %
+:- pred prof_set_cyclemap(cycle_map::in, prof::in, prof::out) is det.
-:- pred prof_node_get_entire_pred(prof_node, string, int, int, float,
- list(pred_info), list(pred_info),
- int, int, list(string)).
-:- mode prof_node_get_entire_pred(in, out, out, out, out, out, out, out, out,
- out) is det.
+%-----------------------------------------------------------------------------%
+%
+% *** Special prof_node predicates ***
+%
-:- pred prof_node_get_entire_cycle(prof_node, string, int, int, float,
- list(pred_info), int, int).
-:- mode prof_node_get_entire_cycle(in,out,out,out,out,out,out,out) is det.
+:- pred prof_node_type(prof_node::in, prof_node_type::out) is det.
-:- pred prof_node_get_pred_name(prof_node, string).
-:- mode prof_node_get_pred_name(in, out) is det.
-:- pred prof_node_get_cycle_number(prof_node, int).
-:- mode prof_node_get_cycle_number(in, out) is det.
+%-----------------------------------------------------------------------------%
+%
+% *** Access Predicate for prof_node ***
+%
-:- pred prof_node_get_initial_counts(prof_node, int).
-:- mode prof_node_get_initial_counts(in, out) is det.
+:- pred prof_node_get_entire_pred(prof_node::in, string::out, int::out,
+ int::out, float::out, list(pred_info)::out, list(pred_info)::out,
+ int::out, int::out, list(string)::out) is det.
-:- pred prof_node_get_propagated_counts(prof_node, float).
-:- mode prof_node_get_propagated_counts(in, out) is det.
+:- pred prof_node_get_entire_cycle(prof_node::in, string::out, int::out,
+ int::out, float::out, list(pred_info)::out, int::out, int::out) is det.
-:- pred prof_node_get_parent_list(prof_node, list(pred_info)).
-:- mode prof_node_get_parent_list(in, out) is det.
+:- pred prof_node_get_pred_name(prof_node::in, string::out) is det.
-:- pred prof_node_get_child_list(prof_node, list(pred_info)).
-:- mode prof_node_get_child_list(in, out) is det.
+:- pred prof_node_get_cycle_number(prof_node::in, int::out) is det.
-:- pred prof_node_get_total_calls(prof_node, int).
-:- mode prof_node_get_total_calls(in, out) is det.
+:- pred prof_node_get_initial_counts(prof_node::in, int::out) is det.
-:- pred prof_node_get_self_calls(prof_node, int).
-:- mode prof_node_get_self_calls(in, out) is det.
+:- pred prof_node_get_propagated_counts(prof_node::in, float::out) is det.
+:- pred prof_node_get_parent_list(prof_node::in, list(pred_info)::out) is det.
- % *** Update prof_node predicates *** %
+:- pred prof_node_get_child_list(prof_node::in, list(pred_info)::out) is det.
-:- pred prof_node_set_cycle_num(int, prof_node, prof_node).
-:- mode prof_node_set_cycle_num(in, in, out) is det.
+:- pred prof_node_get_total_calls(prof_node::in, int::out) is det.
-:- pred prof_node_set_initial_counts(int, prof_node, prof_node).
-:- mode prof_node_set_initial_counts(in, in, out) is det.
+:- pred prof_node_get_self_calls(prof_node::in, int::out) is det.
-:- pred prof_node_set_propagated_counts(float, prof_node, prof_node).
-:- mode prof_node_set_propagated_counts(in, in, out) is det.
+%-----------------------------------------------------------------------------%
+%
+% *** Update prof_node predicates ***
+%
-:- pred prof_node_concat_to_parent(string, int, prof_node, prof_node).
-:- mode prof_node_concat_to_parent(in, in, in, out) is det.
+:- pred prof_node_set_cycle_num(int::in, prof_node::in, prof_node::out) is det.
-:- pred prof_node_concat_to_child(string, int, prof_node, prof_node).
-:- mode prof_node_concat_to_child(in, in, in, out) is det.
+:- pred prof_node_set_initial_counts(int::in, prof_node::in, prof_node::out)
+ is det.
-:- pred prof_node_set_total_calls(int, prof_node, prof_node).
-:- mode prof_node_set_total_calls(in, in, out) is det.
+:- pred prof_node_set_propagated_counts(float::in, prof_node::in,
+ prof_node::out) is det.
-:- pred prof_node_set_self_calls(int, prof_node, prof_node).
-:- mode prof_node_set_self_calls(in, in, out) is det.
+:- pred prof_node_concat_to_parent(string::in, int::in,
+ prof_node::in, prof_node::out) is det.
-:- pred prof_node_concat_to_name_list(string, prof_node, prof_node).
-:- mode prof_node_concat_to_name_list(in, in, out) is det.
+:- pred prof_node_concat_to_child(string::in, int::in,
+ prof_node::in, prof_node::out) is det.
-:- pred prof_node_concat_to_member(string, int, prof_node, prof_node).
-:- mode prof_node_concat_to_member(in, in, in, out) is det.
+:- pred prof_node_set_total_calls(int::in,
+ prof_node::in, prof_node::out) is det.
+:- pred prof_node_set_self_calls(int::in,
+ prof_node::in, prof_node::out) is det.
- % *** Init predicates for pred_info *** %
+:- pred prof_node_concat_to_name_list(string::in,
+ prof_node::in, prof_node::out) is det.
-:- pred pred_info_init(string, int, pred_info).
-:- mode pred_info_init(in, in, out) is det.
+:- pred prof_node_concat_to_member(string::in, int::in,
+ prof_node::in, prof_node::out) is det.
+%-----------------------------------------------------------------------------%
+%
+% *** Init predicates for pred_info ***
+%
- % *** Access predicates for pred_info *** %
+:- pred pred_info_init(string::in, int::in, pred_info::out) is det.
-:- pred pred_info_get_entire(pred_info, string, int).
-:- mode pred_info_get_entire(in, out, out) is det.
+%-----------------------------------------------------------------------------%
+%
+% *** Access predicates for pred_info ***
+%
-:- pred pred_info_get_pred_name(pred_info, string).
-:- mode pred_info_get_pred_name(in, out) is det.
+:- pred pred_info_get_entire(pred_info::in, string::out, int::out) is det.
-:- pred pred_info_get_counts(pred_info, int).
-:- mode pred_info_get_counts(in, out) is det.
+:- pred pred_info_get_pred_name(pred_info::in, string::out) is det.
+:- pred pred_info_get_counts(pred_info::in, int::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -311,9 +294,9 @@
% *** Initialise predicates *** %
-prof_node_init(PredName, pred_node(PredName, 0, 0, 0.0, [], [], 0, 0, [])).
+prof_node_init(PredName) = pred_node(PredName, 0, 0, 0.0, [], [], 0, 0, []).
-prof_node_init_cycle(A, B, C, D, E, F, G, cycle_node(A, B, C, D, E, F, G)).
+prof_node_init_cycle(A, B, C, D, E, F, G) = cycle_node(A, B, C, D, E, F, G).
%-----------------------------------------------------------------------------%
@@ -437,4 +420,6 @@
pred_info_get_counts(pred_info(_, Count), Count).
+%-----------------------------------------------------------------------------%
+:- end_module prof_info.
%-----------------------------------------------------------------------------%
Index: propagate.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/propagate.m,v
retrieving revision 1.12
diff -u -r1.12 propagate.m
--- propagate.m 8 Jul 2004 05:56:37 -0000 1.12
+++ propagate.m 15 Nov 2004 05:49:06 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
%
% propagate.m
%
@@ -25,12 +22,11 @@
:- interface.
-:- import_module io, relation.
:- import_module prof_info.
+:- import_module io, relation.
-:- pred propagate__counts(relation(string), prof, prof, io__state, io__state).
-:- mode propagate__counts(in, in, out, di, uo) is det.
-
+:- pred propagate__counts(relation(string)::in, prof::in, prof::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -39,310 +35,248 @@
:- import_module assoc_list, float, int, list, map, multi_map, require.
:- import_module string, sparse_bitset, std_util.
-% :- import_module writeln.
-:- type cycle_info == pair(
+%-----------------------------------------------------------------------------%
+
+:- type cycle_info == pair(
map(string, int), % predicate - cycle
multi_map(int, string) % cycle - list preds
).
-propagate__counts(CallGraph, Prof0, Prof) -->
- { prof_get_addrdeclmap(Prof0, AddrDeclMap) },
- { prof_get_profnodemap(Prof0, ProfNodeMap0) },
-
- { propagate__identify_cycles(CallGraph, ATSort, CycleInfo) },
- { propagate__update_cycles(CycleInfo, AddrDeclMap, ProfNodeMap0,
- ProfNodeMap1) },
+propagate__counts(CallGraph, !Prof, !IO) :-
+ prof_get_addrdeclmap(!.Prof, AddrDeclMap),
+ prof_get_profnodemap(!.Prof, ProfNodeMap0),
+ propagate__identify_cycles(CallGraph, ATSort, CycleInfo),
+ propagate__update_cycles(CycleInfo, AddrDeclMap, ProfNodeMap0,
+ ProfNodeMap1),
- { propagate__counts_2(ATSort, CycleInfo, AddrDeclMap, ProfNodeMap1,
- ProfNodeMap) },
-
- { CycleInfo = M - _MM },
- { prof_set_cyclemap(M, Prof0, Prof1) },
- { prof_set_profnodemap(ProfNodeMap, Prof1, Prof) }.
+ propagate__counts_2(ATSort, CycleInfo, AddrDeclMap, ProfNodeMap1,
+ ProfNodeMap),
+ prof_set_cyclemap(fst(CycleInfo), !Prof),
+ prof_set_profnodemap(ProfNodeMap, !Prof).
%-----------------------------------------------------------------------------%
-
-% propagate__identify_cycles:
-% Identifies the cycles in the callgraph and places the members of each
-% cycle into a map which associates a unique int with each cycle and a
-% multimap which associates with each cycle number a list of preds. Also
-% Approximate topologically sorts the call graph.
-%
-:- pred propagate__identify_cycles(relation(string), list(string),
- cycle_info).
-:- mode propagate__identify_cycles(in, out, out) is det.
+ % propagate__identify_cycles:
+ % Identifies the cycles in the callgraph and places the members of each
+ % cycle into a map which associates a unique int with each cycle and a
+ % multimap which associates with each cycle number a list of preds.
+ % Also approximate topologically sorts the call graph.
+ %
+:- pred propagate__identify_cycles(relation(string)::in, list(string)::out,
+ cycle_info::out) is det.
propagate__identify_cycles(Rel, ATSort, CycleInfo) :-
relation__dfsrev(Rel, DfsRev),
relation__inverse(Rel, RelInv),
- cycle_info_init(CycleInfo0),
- init(Visit0),
- propagate__identify_cycles_2(DfsRev, 1, RelInv, Visit0, [],
- CycleInfo0, ATSort, CycleInfo).
-
-
-:- pred propagate__identify_cycles_2(list(relation_key), int, relation(string),
- relation_key_set, list(string),
- cycle_info, list(string), cycle_info).
-:- mode propagate__identify_cycles_2(in, in, in, in, in, in, out, out) is det.
-
-propagate__identify_cycles_2([], _, _, _, ATSort, CycleInfo, ATSort, CycleInfo).
-propagate__identify_cycles_2([X | Xs0], CycleNum0, RelInv, Visit0, ATSort0,
- CycleInfo0, ATSort, CycleInfo) :-
+ propagate__identify_cycles_2(DfsRev, 1, RelInv, sparse_bitset.init,
+ [], ATSort, cycle_info_init, CycleInfo).
- % Do a DFS on R'. The nodes we can get to and have not
- % already visited before are one cycle in the call graph.
+:- pred propagate__identify_cycles_2(list(relation_key)::in, int::in,
+ relation(string)::in, relation_key_set::in,
+ list(string)::in, list(string)::out, cycle_info::in, cycle_info::out)
+ is det.
+
+propagate__identify_cycles_2([], _, _, _, !ATSort, !CycleInfo).
+propagate__identify_cycles_2([X | Xs0], CycleNum0, RelInv, Visit0, !ATSort,
+ !CycleInfo) :-
+ %
+ % Do a DFS on R'. The nodes we can get to and have not
+ % already visited before are one cycle in the call graph.
+ %
relation__dfsrev(RelInv, X, Visit0, Visit, DfsRev0),
list__map(relation__lookup_key(RelInv), DfsRev0, DfsRev),
- % writeln("*******************"),
- % writeln_list(DfsRev),
- % writeln("*******************"),
-
(
(
DfsRev = [_]
;
DfsRev = [], % This case should never happen
- error("propagate__identify_cycles_2: empty list\n")
+ error("propagate.identify_cycles_2: empty list\n")
)
->
- CycleNum = CycleNum0,
- CycleInfo1 = CycleInfo0
+ CycleNum = CycleNum0
;
- CycleNum is CycleNum0 + 1,
- propagate__add_to_cycle_map(CycleInfo0, DfsRev, CycleNum,
- CycleInfo1)
+ CycleNum = CycleNum0 + 1,
+ propagate__add_to_cycle_map(DfsRev, CycleNum, !CycleInfo)
),
- list__append(DfsRev, ATSort0, ATSort1),
-
- % Delete all visited elements from Xs0 as they have already
- % been identified as part of a cycle.
+ list__append(DfsRev, !ATSort),
+ %
+ % Delete all visited elements from Xs0 as they have already
+ % been identified as part of a cycle.
+ %
list__delete_elems(Xs0, DfsRev0, Xs),
- propagate__identify_cycles_2(Xs, CycleNum, RelInv, Visit, ATSort1,
- CycleInfo1, ATSort, CycleInfo).
+ propagate__identify_cycles_2(Xs, CycleNum, RelInv, Visit, !ATSort,
+ !CycleInfo).
+ % cycle_info_init:
+ % Initialise the cycle_info structure.
+ %
+:- func cycle_info_init = cycle_info.
+
+cycle_info_init = map.init - multi_map.init.
+
+ % propagate__add_to_cycle_map:
+ % Add all the predicates in a cycle into the cycle map.
+ %
+:- pred propagate__add_to_cycle_map(list(string)::in, int::in,
+ cycle_info::in, cycle_info::out) is det.
-% cycle_info_init:
-% Initialise the cycle_info structure.
-%
-:- pred cycle_info_init(cycle_info).
-:- mode cycle_info_init(out) is det.
-
-cycle_info_init(M - MM) :-
- map__init(M),
- multi_map__init(MM).
-
-
-% propagate__add_to_cycle_map:
-% Add all the predicates in a cycle into the cycle map
-%
-:- pred propagate__add_to_cycle_map(cycle_info, list(string), int,
- cycle_info).
-:- mode propagate__add_to_cycle_map(in, in, in, out) is det.
-
-propagate__add_to_cycle_map(CycleInfo, [], _, CycleInfo).
-propagate__add_to_cycle_map(M0 - MM0, [X | Xs], V, M - MM) :-
+propagate__add_to_cycle_map([], _, !CycleInfo).
+propagate__add_to_cycle_map([X | Xs], V, M0 - MM0, M - MM) :-
map__det_insert(M0, X, V, M1),
multi_map__set(MM0, V, X, MM1),
- propagate__add_to_cycle_map(M1 - MM1, Xs, V, M - MM).
-
+ propagate__add_to_cycle_map(Xs, V, M1 - MM1, M - MM).
%-----------------------------------------------------------------------------%
+:- pred propagate__update_cycles(cycle_info::in, addrdecl::in,
+ prof_node_map::in, prof_node_map::out) is det.
-:- pred propagate__update_cycles(cycle_info, addrdecl, prof_node_map,
- prof_node_map).
-:- mode propagate__update_cycles(in, in, in, out) is det.
-
-propagate__update_cycles(_M - MM, AddrDecl, ProfNodeMap0, ProfNodeMap) :-
- multi_map__to_assoc_list(MM, AssocList),
- propagate__update_cycles_2(AssocList, AddrDecl, ProfNodeMap0,
- ProfNodeMap).
-
-:- pred propagate__update_cycles_2(assoc_list(int, list(string)), addrdecl,
- prof_node_map, prof_node_map).
-:- mode propagate__update_cycles_2(in, in, in, out) is det.
-
-propagate__update_cycles_2([], _, ProfNodeMap, ProfNodeMap).
-propagate__update_cycles_2([ Num - Preds | Rest], AddrDecl, ProfNodeMap0,
- ProfNodeMap) :-
- propagate__update_cycles_3(Preds, Num, AddrDecl, ProfNodeMap0,
- ProfNodeMap1),
- propagate__update_cycles_2(Rest, AddrDecl, ProfNodeMap1, ProfNodeMap).
-
-:- pred propagate__update_cycles_3(list(string), int, addrdecl, prof_node_map,
- prof_node_map).
-:- mode propagate__update_cycles_3(in, in, in, in, out) is det.
-
-propagate__update_cycles_3([], _, _, ProfNodeMap, ProfNodeMap).
-propagate__update_cycles_3([P | Ps], CycleNum, AddrDecl, ProfNodeMap0,
- ProfNodeMap) :-
- get_prof_node(P, AddrDecl, ProfNodeMap0, ProfNode0),
+propagate__update_cycles(_M - MM, AddrDecl, !ProfNodeMap) :-
+ AssocList = multi_map__to_assoc_list(MM),
+ propagate__update_cycles_2(AssocList, AddrDecl, !ProfNodeMap).
+
+:- pred propagate__update_cycles_2(assoc_list(int, list(string))::in,
+ addrdecl::in, prof_node_map::in, prof_node_map::out) is det.
+
+propagate__update_cycles_2([], _, !ProfNodeMap).
+propagate__update_cycles_2([ Num - Preds | Rest], AddrDecl, !ProfNodeMap) :-
+ propagate__update_cycles_3(Preds, Num, AddrDecl, !ProfNodeMap),
+ propagate__update_cycles_2(Rest, AddrDecl, !ProfNodeMap).
+
+:- pred propagate__update_cycles_3(list(string)::in, int::in, addrdecl::in,
+ prof_node_map::in, prof_node_map::out) is det.
+
+propagate__update_cycles_3([], _, _, !ProfNodeMap).
+propagate__update_cycles_3([P | Ps], CycleNum, AddrDecl, !ProfNodeMap) :-
+ get_prof_node(P, AddrDecl, !.ProfNodeMap, ProfNode0),
prof_node_set_cycle_num(CycleNum, ProfNode0, ProfNode),
- update_prof_node(P, ProfNode, AddrDecl, ProfNodeMap0, ProfNodeMap1),
- propagate__update_cycles_3(Ps, CycleNum, AddrDecl, ProfNodeMap1,
- ProfNodeMap).
-
+ update_prof_node(P, ProfNode, AddrDecl, !ProfNodeMap),
+ propagate__update_cycles_3(Ps, CycleNum, AddrDecl, !ProfNodeMap).
%-----------------------------------------------------------------------------%
-
-% propagate__counts_2
-% XXX
-%
-:- pred propagate__counts_2(list(string), cycle_info, addrdecl,
- prof_node_map, prof_node_map).
-:- mode propagate__counts_2(in, in, in, in, out) is det.
-
-propagate__counts_2([], _, _, ProfNodeMap, ProfNodeMap).
-propagate__counts_2([Pred | Preds], M - MM, AddrDeclMap, ProfNodeMap0,
- ProfNodeMap) :-
- (
- % writeln("********************************"),
- % Determine if predicate is in a cycle
- map__search(M, Pred, Cycle)
- ->
- % writeln("Cycle:"),
- % writeln_list(CyclePreds),
-
+ % propagate__counts_2
+ % XXX
+ %
+:- pred propagate__counts_2(list(string)::in, cycle_info::in, addrdecl::in,
+ prof_node_map::in, prof_node_map::out) is det.
+
+propagate__counts_2([], _, _, !ProfNodeMap).
+propagate__counts_2([Pred | Preds], M - MM, AddrDeclMap, !ProfNodeMap) :-
+ ( map__search(M, Pred, Cycle) ->
multi_map__lookup(MM, Cycle, CyclePreds),
list__length(CyclePreds, Length),
(
- % Throw away the rest of the predicates to
- % be processed by the profiler as we are about
- % to make them into one cycle.
+ % Throw away the rest of the predicates to
+ % be processed by the profiler as we are about
+ % to make them into one cycle.
list__drop((Length - 1), Preds, NewPreds)
->
propagate__process_cycle(CyclePreds, Cycle, AddrDeclMap,
- ProfNodeMap0, ProfNodeMap1),
-
+ !ProfNodeMap),
propagate__counts_2(NewPreds, M-MM, AddrDeclMap,
- ProfNodeMap1, ProfNodeMap)
+ !ProfNodeMap)
;
- error("propagate__counts_2: list_drop failed\n")
+ error("propagate.counts_2: list_drop failed\n")
)
;
- get_prof_node(Pred, AddrDeclMap, ProfNodeMap0, ProfNode),
+ get_prof_node(Pred, AddrDeclMap, !.ProfNodeMap, ProfNode),
prof_node_get_initial_counts(ProfNode, InitCounts),
prof_node_get_propagated_counts(ProfNode, PropCounts),
prof_node_get_parent_list(ProfNode, ParentList),
prof_node_get_total_calls(ProfNode, TotalCalls),
- InitCountsFloat = float__float(InitCounts),
- % writeln("Predicate:"),
- % writeln(Pred),
- % writeln("Initial counts:"),
- % writeln_int(InitCounts),
- % writeln("Propagated Counts:"),
- % writeln_float(PropCounts),
-
- TotalCounts is InitCountsFloat + PropCounts,
-
- FltTotalCalls = float__float(TotalCalls),
-
- propagate__counts_3(ParentList, TotalCounts, FltTotalCalls,
- AddrDeclMap, ProfNodeMap0, ProfNodeMap1),
- propagate__counts_2(Preds, M-MM, AddrDeclMap, ProfNodeMap1,
- ProfNodeMap)
- ).
+ TotalCounts = float(InitCounts) + PropCounts,
+ propagate__counts_3(ParentList, TotalCounts, float(TotalCalls),
+ AddrDeclMap, !ProfNodeMap),
+ propagate__counts_2(Preds, M-MM, AddrDeclMap, !ProfNodeMap)
+ ).
-% propagate__process_cycle:
-% Takes the list of cycle preds and treats them as one single unit called
-% <cycle X>.
-%
-:- pred propagate__process_cycle(list(string), int, addrdecl, prof_node_map,
- prof_node_map).
-:- mode propagate__process_cycle(in, in, in, in, out) is det.
-
-propagate__process_cycle(Preds, Cycle, AddrMap, ProfNodeMap0, ProfNodeMap) :-
- % Determine the parents of a cycle
- propagate__cycle_parents(Preds, AddrMap, ProfNodeMap0, Total,
- Recursive, ParentList),
- % Build the cycle name
- string__int_to_string(Cycle, CycleStr),
- string__append("< cycle ", CycleStr, NameStr0),
- string__append(NameStr0, " as a whole >", NameStr),
-
- % Work out number of selfcounts
- propagate__sum_self_counts(Preds, AddrMap, ProfNodeMap0, SelfCounts),
-
- % Work out number of propagated counts
- propagate__sum_propagated_counts(Preds, AddrMap, ProfNodeMap0,
- PropCounts),
-
- % writeln("Self Counts :"),
- % writeln_int(SelfCounts),
- % writeln("Propagated Counts :"),
- % writeln_float(PropCounts),
-
- propagate__build_cycle_list(Preds, AddrMap, ProfNodeMap0, CycleList),
-
- prof_node_init_cycle(NameStr, 0, SelfCounts, PropCounts, CycleList,
- Total, Recursive, ProfNode),
-
- % NB we give the address of a cycle as being the negative of
- % the cycle number as this will be unique.
- Address is -Cycle,
- map__det_insert(ProfNodeMap0, Address, ProfNode, ProfNodeMap1),
-
-
- % Propagate the counts XXX
- FltSelfCounts = float__float(SelfCounts),
+ % propagate__process_cycle:
+ % Takes the list of cycle preds and treats them as one single unit
+ % called <cycle X>.
+ %
+:- pred propagate__process_cycle(list(string)::in, int::in, addrdecl::in,
+ prof_node_map::in, prof_node_map::out) is det.
+
+propagate__process_cycle(Preds, Cycle, AddrMap, !ProfNodeMap) :-
+ %
+ % Determine the parents of a cycle
+ %
+ propagate__cycle_parents(Preds, AddrMap, !.ProfNodeMap, Total,
+ Recursive, ParentList),
+ %
+ % Build the cycle name.
+ %
+ NameStr = string__format("< cycle %d as a whole >", [i(Cycle)]),
+ %
+ % Work out number of selfcounts.
+ %
+ SelfCounts = propagate__sum_self_counts(Preds, AddrMap, !.ProfNodeMap),
+ %
+ % Work out number of propagated counts.
+ %
+ PropCounts = propagate__sum_propagated_counts(Preds, AddrMap,
+ !.ProfNodeMap),
+
+ propagate__build_cycle_list(Preds, AddrMap, !.ProfNodeMap, CycleList),
+
+ ProfNode = prof_node_init_cycle(NameStr, 0, SelfCounts, PropCounts,
+ CycleList, Total, Recursive),
+ %
+ % NB we give the address of a cycle as being the negative of
+ % the cycle number as this will be unique.
+ %
+ Address = -Cycle,
+ map__det_insert(!.ProfNodeMap, Address, ProfNode, !:ProfNodeMap),
+ %
+ % Propagate the counts XXX
+ %
TotalCalls = float__float(Total),
- TotalCounts is FltSelfCounts + PropCounts,
+ TotalCounts = float(SelfCounts) + PropCounts,
propagate__counts_3(ParentList, TotalCounts, TotalCalls, AddrMap,
- ProfNodeMap1, ProfNodeMap).
-
-
-% propagate__sum_self_counts:
-% Sums the self counts fields for all the predicates.
-%
-:- pred propagate__sum_self_counts(list(string), addrdecl,
- prof_node_map, int).
-:- mode propagate__sum_self_counts(in, in, in, out) is det.
-
-propagate__sum_self_counts([], _, _, 0).
-propagate__sum_self_counts([P | Ps], ADMap, PNMap, X) :-
- propagate__sum_self_counts(Ps, ADMap, PNMap, X0),
+ !ProfNodeMap).
- get_prof_node(P, ADMap, PNMap, ProfNode),
- prof_node_get_initial_counts(ProfNode, InitCount),
- X is X0 + InitCount.
-
-
-% propagate__sum_propagated_counts:
-% Sums the propagated counts fields for all the predicates.
-%
-:- pred propagate__sum_propagated_counts(list(string), addrdecl, prof_node_map,
- float).
-:- mode propagate__sum_propagated_counts(in, in, in, out) is det.
-
-propagate__sum_propagated_counts([], _, _, 0.0).
-propagate__sum_propagated_counts([P | Ps], ADMap, PNMap, X) :-
- propagate__sum_propagated_counts(Ps, ADMap, PNMap, X0),
-
- get_prof_node(P, ADMap, PNMap, ProfNode),
- prof_node_get_propagated_counts(ProfNode, PropCount),
- X is X0 + PropCount.
-
-
-% propagate__build_cycle_list
-% Takes the list of predicates and works out how many times each predicate
-% is called by a fellow predicate
-% XXX Not fully implemented yet.
-%
-:- pred propagate__build_cycle_list(list(string), addrdecl, prof_node_map,
- list(pred_info)).
-:- mode propagate__build_cycle_list(in, in, in, out) is det.
+ % propagate__sum_self_counts:
+ % Sums the self counts fields for all the predicates.
+ %
+:- func propagate__sum_self_counts(list(string), addrdecl, prof_node_map) = int.
+
+propagate__sum_self_counts(Preds, ADMap, PNMap) =
+ list__foldl((func(Pred, Sum0) = Sum :-
+ get_prof_node(Pred, ADMap, PNMap, ProfNode),
+ prof_node_get_initial_counts(ProfNode, InitCount),
+ Sum = Sum0 + InitCount
+ ), Preds, 0).
+
+ % propagate__sum_propagated_counts:
+ % Sums the propagated counts fields for all the predicates.
+ %
+:- func propagate__sum_propagated_counts(list(string), addrdecl,
+ prof_node_map) = float.
+
+propagate__sum_propagated_counts(Preds, ADMap, PNMap) =
+ list__foldl((func(Pred, Sum0) = Sum :-
+ get_prof_node(Pred, ADMap, PNMap, ProfNode),
+ prof_node_get_propagated_counts(ProfNode, PropCount),
+ Sum = Sum0 + PropCount
+ ), Preds, 0.0).
+
+ % propagate__build_cycle_list
+ % Takes the list of predicates and works out how many times each
+ % predicate is called by a fellow predicate
+ % XXX Not fully implemented yet.
+ %
+:- pred propagate__build_cycle_list(list(string)::in, addrdecl::in,
+ prof_node_map::in, list(pred_info)::out) is det.
propagate__build_cycle_list([], _, _, []).
propagate__build_cycle_list([P | Ps], ADM, PNM, CycleList) :-
@@ -350,105 +284,88 @@
pred_info_init(P, 0, PredInfo),
CycleList = [ PredInfo | CycleList0].
+:- pred propagate__counts_3(list(pred_info)::in, float::in, float::in,
+ addrdecl::in, prof_node_map::in, prof_node_map::out) is det.
-:- pred propagate__counts_3(list(pred_info), float, float, addrdecl,
- prof_node_map, prof_node_map).
-:- mode propagate__counts_3(in, in, in, in, in, out) is det.
-
-propagate__counts_3([], _, _, _, ProfNodeMap, ProfNodeMap).
-propagate__counts_3([ P | Ps], TotalCounts, TotalCalls, AddrMap,
- ProfNodeMap0, ProfNodeMap) :-
+propagate__counts_3([], _, _, _, !ProfNodeMap).
+propagate__counts_3([ P | Ps], TotalCounts, TotalCalls, AddrMap,
+ !ProfNodeMap) :-
pred_info_get_entire(P, Pred, Calls),
-
- % Work out the number of counts to propagate.
- % XXX Probably need to do a 0.0 check
- FloatCalls = float__float(Calls),
- ToPropagateCounts is FloatCalls / TotalCalls * TotalCounts,
-
- % Add new counts to current propagated counts
- get_prof_node(Pred, AddrMap, ProfNodeMap0, ProfNode0),
+ %
+ % Work out the number of counts to propagate.
+ % XXX Probably need to do a 0.0 check
+ %
+ ToPropagateCounts = float(Calls) / TotalCalls * TotalCounts,
+ %
+ % Add new counts to current propagated counts.
+ %
+ get_prof_node(Pred, AddrMap, !.ProfNodeMap, ProfNode0),
prof_node_get_propagated_counts(ProfNode0, PropCount0),
- PropCount is PropCount0 + ToPropagateCounts,
+ PropCount = PropCount0 + ToPropagateCounts,
prof_node_set_propagated_counts(PropCount, ProfNode0, ProfNode),
- update_prof_node(Pred, ProfNode, AddrMap, ProfNodeMap0, ProfNodeMap1),
-
- % writeln("Propagating to "),
- % writeln(Pred),
- % writeln_float(ToPropagateCounts),
- propagate__counts_3(Ps, TotalCounts, TotalCalls, AddrMap, ProfNodeMap1,
- ProfNodeMap).
+ update_prof_node(Pred, ProfNode, AddrMap, !ProfNodeMap),
+ propagate__counts_3(Ps, TotalCounts, TotalCalls, AddrMap, !ProfNodeMap).
+ % propagate__cycle_parents
+ % Returns a list(pred_info) which is the list of parents of the cycle
+ % Also returns how may times the cycle is called and how may times
+ % predicates in a cycle call each other.
+ %
+:- pred propagate__cycle_parents(list(string)::in, addrdecl::in,
+ prof_node_map::in, int::out, int::out, list(pred_info)::out) is det.
-
-% propagate__cycle_parents
-% Returns a list(pred_info) which is the list of parents of the cycle
-% Also returns how may times the cycle is called and how may times
-% predicates in a cycle call each other.
-%
-:- pred propagate__cycle_parents(list(string), addrdecl, prof_node_map,
- int, int, list(pred_info)).
-:- mode propagate__cycle_parents(in, in, in, out, out, out) is det.
-
-propagate__cycle_parents(Preds, AddrMap, ProfNodeMap,
- TotalCalls, SelfCalls, ParentList) :-
+propagate__cycle_parents(Preds, AddrMap, ProfNodeMap, TotalCalls, SelfCalls,
+ ParentList) :-
propagate__build_parent_map(Preds, AddrMap, ProfNodeMap, TotalCalls,
- SelfCalls, ParentMap),
+ SelfCalls, ParentMap),
map__to_assoc_list(ParentMap, ParentAssocList),
- assoc_list_to_pred_info_list(ParentAssocList, ParentList).
-
+ ParentList = assoc_list_to_pred_info_list(ParentAssocList).
-% propagate__build_parent_map:
-% Builds a map which contains all the parents of a cycle, and the
-% total number of times that parent is called. Doesn't include the
-% cycle members, and callers which never call any of the members of
-% the cycle. At the same time also sums the total calls into the
-% cycle and the calls internal to the cycle.
-%
-:- pred propagate__build_parent_map(list(string), addrdecl, prof_node_map,
- int, int, map(string, int)).
-:- mode propagate__build_parent_map(in, in, in, out, out, out) is det.
+ % propagate__build_parent_map:
+ % Builds a map which contains all the parents of a cycle, and the
+ % total number of times that parent is called. Doesn't include the
+ % cycle members, and callers which never call any of the members of
+ % the cycle. At the same time also sums the total calls into the
+ % cycle and the calls internal to the cycle.
+ %
+:- pred propagate__build_parent_map(list(string)::in, addrdecl::in,
+ prof_node_map::in, int::out, int::out, map(string, int)::out) is det.
propagate__build_parent_map([], _AddrMap, _ProfNodeMap, _, _, _ParentMap) :-
error("build_parent_map: empty cycle list\n").
-propagate__build_parent_map([C | Cs], AddrMap, ProfNodeMap,
- TotalCalls, SelfCalls, ParentMap) :-
- map__init(ParentMap0),
- build_parent_map_2([C | Cs], [C | Cs], AddrMap, ProfNodeMap, 0, 0,
- ParentMap0, TotalCalls, SelfCalls, ParentMap).
+propagate__build_parent_map([C | Cs], AddrMap, ProfNodeMap, TotalCalls,
+ SelfCalls, ParentMap) :-
+ build_parent_map_2([C | Cs], [C | Cs], AddrMap, ProfNodeMap,
+ 0, TotalCalls, 0, SelfCalls, map.init, ParentMap).
+
+:- pred build_parent_map_2(list(string)::in, list(string)::in, addrdecl::in,
+ prof_node_map::in, int::in, int::out, int::in, int::out,
+ map(string, int)::in, map(string, int)::out) is det.
-
-:- pred build_parent_map_2(list(string), list(string), addrdecl, prof_node_map,
- int, int, map(string, int), int, int, map(string, int)).
-:- mode build_parent_map_2(in, in, in, in, in, in, in, out, out, out) is det.
-
-build_parent_map_2([], _, _, _, T, S, ParentMap, T, S, ParentMap).
+build_parent_map_2([], _, _, _, !TotalCalls, !SelfCalls, !ParentMap).
build_parent_map_2([C | Cs], CliqueList, AddrMap, ProfNodeMap,
- TotalCalls0, SelfCalls0, ParentMap0, TotalCalls,
- SelfCalls, ParentMap) :-
+ !TotalCalls, !SelfCalls, !ParentMap) :-
get_prof_node(C, AddrMap, ProfNodeMap, ProfNode),
prof_node_get_parent_list(ProfNode, ParentList),
- add_to_parent_map(ParentList, CliqueList, 0, 0, ParentMap0,
- TotalCalls1, SelfCalls1, ParentMap1),
+ add_to_parent_map(ParentList, CliqueList, 0, TotalCalls1,
+ 0, SelfCalls1, !ParentMap),
- TotalCalls2 is TotalCalls0 + TotalCalls1,
- SelfCalls2 is SelfCalls0 + SelfCalls1,
- build_parent_map_2(Cs, CliqueList, AddrMap, ProfNodeMap, TotalCalls2,
- SelfCalls2, ParentMap1, TotalCalls,
- SelfCalls, ParentMap).
-
+ !:TotalCalls = !.TotalCalls + TotalCalls1,
+ !:SelfCalls = !.SelfCalls + SelfCalls1,
+ build_parent_map_2(Cs, CliqueList, AddrMap, ProfNodeMap, !TotalCalls,
+ !SelfCalls, !ParentMap).
+
+ % add_to_parent_map:
+ % Adds list of parents to parent map. Ignores clique members and
+ % repeats and callers which never call current predicate.
+ % Also returns the total number of times predicate is called.
+ %
+:- pred add_to_parent_map(list(pred_info)::in, list(string)::in,
+ int::in, int::out, int::in, int::out,
+ map(string, int)::in, map(string, int)::out) is det.
-% add_to_parent_map:
-% Adds list of parents to parent map. Ignores clique members and
-% repeats and callers which never call current predicate.
-% Also returns the total number of times predicate is called.
-%
-:- pred add_to_parent_map(list(pred_info), list(string), int, int,
- map(string, int), int, int, map(string, int)).
-:- mode add_to_parent_map(in, in, in, in, in, out, out, out) is det.
-
-add_to_parent_map([], _CliqueList, T, S, ParentMap, T, S, ParentMap).
-add_to_parent_map([P | Ps], CliqueList, TotalCalls0, SelfCalls0, ParentMap0,
- TotalCalls, SelfCalls, ParentMap) :-
+add_to_parent_map([], _, !TotalCalls, !SelfCalls, !ParentMap).
+add_to_parent_map([P | Ps], CliqueList, !TotalCalls, !SelfCalls, !ParentMap) :-
pred_info_get_pred_name(P, PredName),
pred_info_get_counts(P, Counts),
(
@@ -458,31 +375,33 @@
Counts = 0
)
->
- SelfCalls1 is SelfCalls0 + Counts,
- add_to_parent_map(Ps, CliqueList, TotalCalls0, SelfCalls1,
- ParentMap0, TotalCalls, SelfCalls, ParentMap)
+ !:SelfCalls = !.SelfCalls + Counts,
+ add_to_parent_map(Ps, CliqueList, !TotalCalls, !SelfCalls,
+ !ParentMap)
;
(
- map__search(ParentMap0, PredName, CurrCount0)
+ map__search(!.ParentMap, PredName, CurrCount0)
->
- CurrCount is CurrCount0 + Counts,
- map__det_update(ParentMap0, PredName, CurrCount,
- ParentMap1)
+ CurrCount = CurrCount0 + Counts,
+ map__det_update(!.ParentMap, PredName, CurrCount,
+ !:ParentMap)
;
- map__det_insert(ParentMap0, PredName, Counts,
- ParentMap1)
+ map__det_insert(!.ParentMap, PredName, Counts,
+ !:ParentMap)
),
- TotalCalls1 is TotalCalls0 + Counts,
- add_to_parent_map(Ps, CliqueList, TotalCalls1, SelfCalls0,
- ParentMap1, TotalCalls, SelfCalls, ParentMap)
+ !:TotalCalls = !.TotalCalls + Counts,
+ add_to_parent_map(Ps, CliqueList, !TotalCalls, !SelfCalls,
+ !ParentMap)
).
+:- func assoc_list_to_pred_info_list(assoc_list(string, int)) = list(pred_info).
-:- pred assoc_list_to_pred_info_list(assoc_list(string, int), list(pred_info)).
-:- mode assoc_list_to_pred_info_list(in, out) is det.
-
-assoc_list_to_pred_info_list([], []).
-assoc_list_to_pred_info_list([S - I | Xs], List) :-
- assoc_list_to_pred_info_list(Xs, List0),
+assoc_list_to_pred_info_list([]) = [].
+assoc_list_to_pred_info_list([S - I | Xs]) = List :-
+ List0 = assoc_list_to_pred_info_list(Xs),
pred_info_init(S, I, PredInfo),
List = [ PredInfo | List0 ].
+
+%------------------------------------------------------------------------------%
+:- end_module propagate.
+%------------------------------------------------------------------------------%
Index: read.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/read.m,v
retrieving revision 1.10
diff -u -r1.10 read.m
--- read.m 1 Aug 2000 12:51:52 -0000 1.10
+++ read.m 1 Dec 2004 02:04:43 -0000
@@ -3,9 +3,6 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-%-----------------------------------------------------------------------------%
%
% read.m: Input predicates for use with mercury_profile
%
@@ -18,220 +15,198 @@
:- interface.
-:- import_module int, io, std_util, string.
:- import_module globals.
+:- import_module int, io, std_util, string.
-:- pred maybe_read_label_addr(maybe(int), io__state, io__state).
-:- mode maybe_read_label_addr(out, di, uo) is det.
+%-----------------------------------------------------------------------------%
+
+:- pred maybe_read_label_addr(maybe(int)::out, io::di, io::uo) is det.
-:- pred maybe_read_label_name(maybe(string), io__state, io__state).
-:- mode maybe_read_label_name(out, di, uo) is det.
+:- pred maybe_read_label_name(maybe(string)::out, io::di, io::uo) is det.
-:- pred read_label_addr(int, io__state, io__state).
-:- mode read_label_addr(out, di, uo) is det.
+:- pred read_label_addr(int::out, io::di, io::uo) is det.
-:- pred read_label_name(string, io__state, io__state).
-:- mode read_label_name(out, di, uo) is det.
+:- pred read_label_name(string::out, io::di, io::uo) is det.
-:- pred read_string(string, io__state, io__state).
-:- mode read_string(out, di, uo) is det.
+:- pred read_string(string::out, io::di, io::uo) is det.
-:- pred read_int(int, io__state, io__state).
-:- mode read_int(out, di, uo) is det.
+:- pred read_int(int::out, io::di, io::uo) is det.
-:- pred read_float(float, io__state, io__state).
-:- mode read_float(out, di, uo) is det.
+:- pred read_float(float::out, io::di, io::uo) is det.
-:- pred read_what_to_profile(what_to_profile, io__state, io__state).
-:- mode read_what_to_profile(out, di, uo) is det.
+:- pred read_what_to_profile(what_to_profile::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module demangle.
+:- import_module options.
+
:- import_module bool, list, char.
:- import_module require.
-:- import_module demangle, options.
-
%-----------------------------------------------------------------------------%
-
-maybe_read_label_addr(MaybeLabelAddr) -->
- io__read_word(WordResult),
+maybe_read_label_addr(MaybeLabelAddr, !IO) :-
+ io__read_word(WordResult, !IO),
(
- { WordResult = ok(CharList) },
- { string__from_char_list(CharList, LabelAddrStr) },
+ WordResult = ok(CharList),
+ string__from_char_list(CharList, LabelAddrStr),
(
- { string__base_string_to_int(10, LabelAddrStr,
- LabelAddr) }
+ string__base_string_to_int(10, LabelAddrStr,
+ LabelAddr)
->
- { MaybeLabelAddr = yes(LabelAddr) }
+ MaybeLabelAddr = yes(LabelAddr)
;
(
- { string__base_string_to_int(16, LabelAddrStr,
- LabelAddrHex) }
+ string__base_string_to_int(16, LabelAddrStr,
+ LabelAddrHex)
->
- { MaybeLabelAddr = yes(LabelAddrHex) }
+ MaybeLabelAddr = yes(LabelAddrHex)
;
- { error("maybe_read_label_addr: Label address not hexadecimal or integer\n") }
+ error("maybe_read_label_addr: Label " ++
+ "address not hexadecimal or integer\n")
)
)
;
- { WordResult = eof },
- { MaybeLabelAddr = no }
+ WordResult = eof,
+ MaybeLabelAddr = no
;
- { WordResult = error(Error) },
- { io__error_message(Error, ErrorStr) },
- { string__append("maybe_read_label_addr: ", ErrorStr, Str) },
- { error(Str) }
+ WordResult = error(Error),
+ error("maybe_read_label_addr: " ++ io.error_message(Error))
).
-
%-----------------------------------------------------------------------------%
-
-maybe_read_label_name(MaybeLabelName) -->
- globals__io_lookup_bool_option(demangle, Demangle),
- io__read_word(WordResult),
+maybe_read_label_name(MaybeLabelName, !IO) :-
+ globals__io_lookup_bool_option(demangle, Demangle, !IO),
+ io__read_word(WordResult, !IO),
(
- { WordResult = ok(CharList0) },
- { string__from_char_list(CharList0, MangledLabelName) },
+ WordResult = ok(CharList0),
+ string__from_char_list(CharList0, MangledLabelName),
(
- { Demangle = yes },
- { demangle(MangledLabelName, LabelName) },
- { MaybeLabelName = yes(LabelName) }
+ Demangle = yes,
+ demangle(MangledLabelName, LabelName),
+ MaybeLabelName = yes(LabelName)
;
- { Demangle = no },
- { MaybeLabelName = yes(MangledLabelName) }
+ Demangle = no,
+ MaybeLabelName = yes(MangledLabelName)
)
;
- { WordResult = eof },
- { MaybeLabelName = no }
+ WordResult = eof,
+ MaybeLabelName = no
;
- { WordResult = error(Error) },
- { io__error_message(Error, ErrorStr) },
- { string__append("maybe_read_label_name: ", ErrorStr, Str) },
- { error(Str) }
+ WordResult = error(Error),
+ error("maybe_read_label_name: " ++ io.error_message(Error))
).
-
%-----------------------------------------------------------------------------%
-read_label_addr(LabelAddr) -->
- io__read_word(WordResult),
+read_label_addr(LabelAddr, !IO) :-
+ io__read_word(WordResult, !IO),
(
- { WordResult = ok(CharList) },
- { string__from_char_list(CharList, LabelAddrStr) },
+ WordResult = ok(CharList),
+ string__from_char_list(CharList, LabelAddrStr),
(
- { string__base_string_to_int(10, LabelAddrStr,
- LabelAddr0) }
+ string__base_string_to_int(10, LabelAddrStr,
+ LabelAddr0)
->
- { LabelAddr = LabelAddr0 }
+ LabelAddr = LabelAddr0
;
(
- { string__base_string_to_int(16,LabelAddrStr,
- LabelAddrHex) }
+ string__base_string_to_int(16,LabelAddrStr,
+ LabelAddrHex)
->
- { LabelAddr = LabelAddrHex }
+ LabelAddr = LabelAddrHex
;
- { error("maybe_read_label_addr: Label address not hexadecimal or integer\n") }
+ error("maybe_read_label_addr: " ++
+ "Label address not hexadecimal or " ++
+ "integer\n")
)
)
;
- { WordResult = eof },
- { error("read_label_addr: EOF reached") }
+ WordResult = eof,
+ error("read_label_addr: EOF reached")
;
- { WordResult = error(Error) },
- { io__error_message(Error, ErrorStr) },
- { string__append("read_label_addr: ", ErrorStr, Str) },
- { error(Str) }
+ WordResult = error(Error),
+ error("read_label_addr: " ++ io.error_message(Error))
).
%-----------------------------------------------------------------------------%
-read_label_name(LabelName) -->
- globals__io_lookup_bool_option(demangle, Demangle),
- io__read_word(WordResult),
+read_label_name(LabelName, !IO) :-
+ globals__io_lookup_bool_option(demangle, Demangle, !IO),
+ io__read_word(WordResult, !IO),
(
- { WordResult = ok(CharList0) },
- { string__from_char_list(CharList0, MangledLabelName) },
+ WordResult = ok(CharList0),
+ string__from_char_list(CharList0, MangledLabelName),
(
- { Demangle = yes },
- { demangle(MangledLabelName, LabelName) }
+ Demangle = yes,
+ demangle(MangledLabelName, LabelName)
;
- { Demangle = no },
- { LabelName = MangledLabelName }
+ Demangle = no,
+ LabelName = MangledLabelName
)
;
- { WordResult = eof },
- { error("read_label_name: EOF reached") }
+ WordResult = eof,
+ error("read_label_name: EOF reached")
;
- { WordResult = error(Error) },
- { io__error_message(Error, ErrorStr) },
- { string__append("read_label_name: ", ErrorStr, Str) },
- { error(Str) }
+ WordResult = error(Error),
+ error("read_label_name: " ++ io.error_message(Error))
+
).
%-----------------------------------------------------------------------------%
-read_string(String) -->
- io__read_word(WordResult),
+read_string(String, !IO) :-
+ io__read_word(WordResult, !IO),
(
- { WordResult = ok(CharList) },
- { string__from_char_list(CharList, String) }
+ WordResult = ok(CharList),
+ string__from_char_list(CharList, String)
;
- { WordResult = eof },
- { error("read_string: EOF reached") }
+ WordResult = eof,
+ error("read_string: EOF reached")
;
- { WordResult = error(Error) },
- { io__error_message(Error, ErrorStr) },
- { string__append("read_string: ", ErrorStr, Str) },
- { error(Str) }
+ WordResult = error(Error),
+ error("read_string: " ++ io.error_message(Error))
).
%-----------------------------------------------------------------------------%
-read_int(Int) -->
- read_string(IntStr),
- (
- { string__to_int(IntStr, Int0) }
- ->
- { Int = Int0 }
+read_int(Int, !IO) :-
+ read_string(IntStr, !IO),
+ ( string__to_int(IntStr, Int0) ->
+ Int = Int0
;
- io__write_string("\nInteger = "),
- io__write_string(IntStr),
- { error("\nread_int: Not an integer\n") }
+ Error = "\nIntger = " ++ IntStr,
+ error("\nread_int: Not an integer\n" ++ Error)
).
%-----------------------------------------------------------------------------%
-read_float(Float) -->
- read_string(FloatStr),
- (
- { string__to_float(FloatStr, Float0) }
- ->
- { Float = Float0 }
+read_float(Float, !IO) :-
+ read_string(FloatStr, !IO),
+ ( string__to_float(FloatStr, Float0) ->
+ Float = Float0
;
- io__write_string("\nFloat = "),
- io__write_string(FloatStr),
- { error("\nread_float: Not an float\n") }
+ Error = "\nFloat = " ++ FloatStr,
+ error("\nread_float: Not an float\n" ++ Error)
).
%-----------------------------------------------------------------------------%
-read_what_to_profile(WhatToProfile) -->
- read_string(Str),
- (
- { what_to_profile(Str, WhatToProfile0) }
- ->
- { WhatToProfile = WhatToProfile0 }
- ;
- io__write_string("\nWhatToProfile = "),
- io__write_string(Str),
- { error("\nread_what_to_profile: invalid input\n") }
+read_what_to_profile(WhatToProfile, !IO) :-
+ read_string(Str, !IO),
+ ( what_to_profile(Str, WhatToProfile0) ->
+ WhatToProfile = WhatToProfile0
+ ;
+ Error = "\nWhatToProfile = " ++ Str,
+ error("\nread_what_to_profile: invalid input\n" ++ Error)
).
+%-----------------------------------------------------------------------------%
+:- end_module read.
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list