[m-rev.] for review: deep profiling.
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri May 4 18:18:11 AEST 2001
On 04-May-2001, Thomas Conway <conway at cs.mu.OZ.AU> wrote:
> You don't seem to have included a diff for the deep directory.
Sorry about that. The diff follows, together with the relevant part of a
(slightly updated) log message.
> > +#define procname ""det_call_port_code_ac""
> > +#define version_ac
> > +#undef need_new_outermost
> > +#include ""mercury_deep_call_port_body.h""
> > +#undef procname
> > +#undef version_ac
> > +}").
> > +
>
> Shouldn't these macro names have MR_ prefixes or some other
> appropriate namespacing (also for the rest of profiling_builtin.m)?
Not really, because they do not encroach on the user's namespace. They are
all explicitly undefined after being used.
Zoltan.
deep/interface.m:
The deep profiler consists of two programs: mdprof_cgi.m, which acts
as a CGI "script", and mdprof_server.m, which implements the server
process that the CGI script talks to. Interface.m defines the
interface between them.
deep/mdprof_cgi.m:
The CGI script.
deep/mdprof_server.m:
The top level predicates of the server.
deep/profile.m:
The main data structures of the server and their operations.
deep/read_profile.m:
Code for reading in profiling data files.
deep/startup.m:
Code for post-processing the information in profiling data files,
propagating costs from procedures to their ancestors and performing
various kinds of summaries.
deep/server.m:
Code for responding to requests from the CGI script.
deep/cliques.m:
Code to find cliques in graphs.
deep/array_util.m:
deep/util.m:
Utility predicates.
deep/dense_bitset.m:
An implementation of (part of) the set ADT with dense bit vectors.
deep/measurements.m:
Operations on profiling measurements.
deep/timeout.m:
An implementation of a timeout facility.
cvs diff: Diffing .
Index: array_util.m
===================================================================
RCS file: array_util.m
diff -N array_util.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ array_util.m Fri May 4 13:09:49 2001
@@ -0,0 +1,116 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains utility predicates for handling arrays.
+
+:- module array_util.
+
+:- interface.
+
+:- import_module array, list.
+
+:- func u(T) = T.
+:- mode (u(in) = array_uo) is det.
+
+:- pred array_foldl(pred(int, T, U, U), array(T), U, U).
+:- mode array_foldl(pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode array_foldl(pred(in, in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+:- mode array_foldl(pred(in, in, in, out) is det, in, in, out) is det.
+
+:- pred array_foldl0(pred(int, T, U, U), array(T), U, U).
+:- mode array_foldl0(pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode array_foldl0(pred(in, in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+:- mode array_foldl0(pred(in, in, in, out) is det, in, in, out) is det.
+
+:- pred array_foldl(int, int, pred(int, T, U, U), array(T), U, U).
+:- mode array_foldl(in, in, pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode array_foldl(in, in, pred(in, in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+:- mode array_foldl(in, in, pred(in, in, in, out) is det, in, in, out) is det.
+
+:- pred array_foldl2(pred(int, T, U, U, V, V), array(T), U, U, V, V).
+:- mode array_foldl2(pred(in, in, di, uo, di, uo) is det, in, di, uo, di, uo)
+ is det.
+:- mode array_foldl2(pred(in, in, array_di, array_uo, array_di, array_uo)
+ is det, in, array_di, array_uo, array_di, array_uo)
+ is det.
+:- mode array_foldl2(pred(in, in, in, out, di, uo) is det, in, in, out, di, uo)
+ is det.
+
+:- pred array_foldl2(int, int, pred(int, T, U, U, V, V), array(T), U, U, V, V).
+:- mode array_foldl2(in, in, pred(in, in, di, uo, di, uo) is det, in,
+ di, uo, di, uo) is det.
+:- mode array_foldl2(in, in, pred(in, in,
+ array_di, array_uo, array_di, array_uo) is det, in,
+ array_di, array_uo, array_di, array_uo) is det.
+:- mode array_foldl2(in, in, pred(in, in, in, out, di, uo) is det, in,
+ in, out, di, uo) is det.
+
+:- pred array_list_foldl(pred(T, array(U), array(U)), list(T),
+ array(U), array(U)).
+:- mode array_list_foldl(pred(in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+
+:- pred array_list_foldl2(pred(T, array(U), array(U), array(V), array(V)),
+ list(T), array(U), array(U), array(V), array(V)).
+:- mode array_list_foldl2(pred(in, array_di, array_uo, array_di, array_uo)
+ is det, in, array_di, array_uo, array_di, array_uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, string.
+
+:- pragma foreign_proc("C", u(A::in) = (B::array_uo),
+ [will_not_call_mercury, thread_safe],
+ "B = A;"
+).
+
+array_foldl(P, A, U0, U) :-
+ array__max(A, Max),
+ array_foldl(1, Max, P, A, U0, U).
+
+array_foldl0(P, A, U0, U) :-
+ array__max(A, Max),
+ array_foldl(0, Max, P, A, U0, U).
+
+array_foldl(N, Max, P, A, U0, U) :-
+ ( N =< Max ->
+ array__lookup(A, N, E),
+ call(P, N, E, U0, U1),
+ array_foldl(N + 1, Max, P, A, U1, U)
+ ;
+ U = U0
+ ).
+
+array_foldl2(P, A, U0, U, V0, V) :-
+ array__max(A, Max),
+ array_foldl2(1, Max, P, A, U0, U, V0, V).
+
+array_foldl2(N, Max, P, A, U0, U, V0, V) :-
+ ( N =< Max ->
+ array__lookup(A, N, E),
+ call(P, N, E, U0, U1, V0, V1),
+ array_foldl2(N + 1, Max, P, A, U1, U, V1, V)
+ ;
+ U = U0,
+ V = V0
+ ).
+
+array_list_foldl(_, [], Acc, Acc).
+array_list_foldl(P, [X | Xs], Acc0, Acc) :-
+ call(P, X, Acc0, Acc1),
+ array_list_foldl(P, Xs, Acc1, Acc).
+
+array_list_foldl2(_, [], AccU, AccU, AccV, AccV).
+array_list_foldl2(P, [X | Xs], AccU0, AccU, AccV0, AccV) :-
+ call(P, X, AccU0, AccU1, AccV0, AccV1),
+ array_list_foldl2(P, Xs, AccU1, AccU, AccV1, AccV).
Index: cliques.m
===================================================================
RCS file: cliques.m
diff -N cliques.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ cliques.m Fri May 4 13:04:10 2001
@@ -0,0 +1,170 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module allows you build a description of a directed graph (represented
+% as a set of arcs between nodes identified by integers) and then find the
+% strongly connected components (cliques) of that graph.
+
+:- module cliques.
+
+:- interface.
+
+:- type graph.
+
+:- import_module list, set.
+
+% Create a graph with no edges.
+:- pred init(graph::out) is det.
+
+% Add an arc from one node to another.
+:- pred add_arc(graph::in, int::in, int::in, graph::out) is det.
+
+% Perform a topological sort on the graph. Each set of integers in the
+% resulting list gives the ids of the nodes in a clique. The list contains
+% the cliques in bottom-up order: if there is an arc from node A to node B
+% and the two nodes are not in the same clique, then the clique containing
+% node A will be before the clique containing node B.
+:- pred topological_sort(graph::in, list(set(int))::out) is det.
+
+:- implementation.
+
+:- import_module array_util, dense_bitset.
+:- import_module array, int.
+
+:- type graph --->
+ graph(
+ int,
+ array(set(int))
+ ).
+
+:- type visit == dense_bitset.
+
+init(graph(1, Array)) :-
+ % The initial array size doesn't really matter.
+ array__init(16, set__init, Array).
+
+add_arc(graph(Size0, Array0), From, To, Graph) :-
+ ( array__in_bounds(Array0, From) ->
+ array__lookup(Array0, From, Tos0),
+ set__insert(Tos0, To, Tos),
+ array__set(u(Array0), From, Tos, Array),
+ Size = int__max(int__max(From, To), Size0),
+ Graph = graph(Size, Array)
+ ;
+ array__size(Array0, Size),
+ array__resize(u(Array0), Size * 2, init, Array1),
+ add_arc(graph(Size0, Array1), From, To, Graph)
+ ).
+
+:- pred successors(graph::in, int::in, set(int)::out) is det.
+
+successors(graph(_Size, Array), From, Tos) :-
+ ( array__in_bounds(Array, From) ->
+ array__lookup(Array, From, Tos)
+ ;
+ Tos = set__init
+ ).
+
+:- pred mklist(int::in, list(int)::in, list(int)::out) is det.
+
+mklist(N, Acc0, Acc) :-
+ ( N < 0 ->
+ Acc = Acc0
+ ;
+ Acc1 = [N | Acc0],
+ mklist(N - 1, Acc1, Acc)
+ ).
+
+topological_sort(Graph, TSort) :-
+ dfs_graph(Graph, Dfs),
+ inverse(Graph, InvGraph),
+ Visit = dense_bitset__init,
+ tsort(Dfs, InvGraph, Visit, [], TSort0),
+ reverse(TSort0, TSort).
+
+:- pred tsort(list(int)::in, graph::in, visit::array_di, list(set(int))::in,
+ list(set(int))::out) is det.
+
+tsort([], _InvGraph, _Visit, TSort, TSort).
+tsort([Node | Nodes], InvGraph, Visit0, TSort0, TSort) :-
+ ( dense_bitset__member(Node, Visit0) ->
+ tsort(Nodes, InvGraph, Visit0, TSort0, TSort)
+ ;
+ dfs([Node], InvGraph, Visit0, [], Visit, CliqueList),
+ set__list_to_set(CliqueList, Clique),
+ tsort(Nodes, InvGraph, Visit, [Clique | TSort0], TSort)
+ ).
+
+% Return a list containing all the nodes of the graph. The list is effectively
+% computed by randomly breaking all cycles, doing a pre-order traversal of
+% the resulting trees, and concatenating the resulting lists in a random order.
+
+:- pred dfs_graph(graph::in, list(int)::out) is det.
+
+dfs_graph(Graph, Dfs) :-
+ Graph = graph(Size, _Array),
+ mklist(Size, [], NodeList),
+ Visit = dense_bitset__init,
+ dfs_graph_2(NodeList, Graph, Visit, [], Dfs).
+
+:- pred dfs_graph_2(list(int)::in, graph::in, visit::array_di,
+ list(int)::in, list(int)::out) is det.
+
+dfs_graph_2([], _Graph, _Visit, Dfs, Dfs).
+dfs_graph_2([Node | Nodes], Graph, Visit0, Dfs0, Dfs) :-
+ dfs([Node], Graph, Visit0, Dfs0, Visit, Dfs1),
+ dfs_graph_2(Nodes, Graph, Visit, Dfs1, Dfs).
+
+% dfs(NodeList, Graph, Visit0, Dfs0, Visit, Dfs):
+% For every node in NodeList, add the node and all its successors to the front
+% of Dfs0, giving Dfs. The descendants of a node will in general be after that
+% node in Dfs. The only situation where that may not be the case is when two
+% nodes are descendants of each other. We detect such situations by passing
+% along the set of nodes that have been visited already.
+
+:- pred dfs(list(int)::in, graph::in, visit::array_di, list(int)::in,
+ visit::array_uo, list(int)::out) is det.
+
+dfs([], _Graph, Visit, Dfs, Visit, Dfs).
+dfs([Node | Nodes], Graph, Visit0, Dfs0, Visit, Dfs) :-
+ ( dense_bitset__member(Node, Visit0) ->
+ dfs(Nodes, Graph, Visit0, Dfs0, Visit, Dfs)
+ ;
+ Visit1 = dense_bitset__insert(Visit0, Node),
+ successors(Graph, Node, Succ),
+ set__to_sorted_list(Succ, SuccList),
+ dfs(SuccList, Graph, Visit1, Dfs0, Visit2, Dfs1),
+ Dfs2 = [Node | Dfs1],
+ dfs(Nodes, Graph, Visit2, Dfs2, Visit, Dfs)
+ ).
+
+:- pred inverse(graph::in, graph::out) is det.
+
+inverse(Graph, InvGraph) :-
+ init(InvGraph0),
+ Graph = graph(Size, _Array),
+ inverse_2(Size, Graph, InvGraph0, InvGraph).
+
+:- pred inverse_2(int::in, graph::in, graph::in, graph::out) is det.
+
+inverse_2(To, Graph, InvGraph0, InvGraph) :-
+ ( To >= 0 ->
+ successors(Graph, To, Froms),
+ set__to_sorted_list(Froms, FromList),
+ add_arcs_to(FromList, To, InvGraph0, InvGraph1),
+ inverse_2(To - 1, Graph, InvGraph1, InvGraph)
+ ;
+ InvGraph = InvGraph0
+ ).
+
+:- pred add_arcs_to(list(int)::in, int::in, graph::in, graph::out) is det.
+
+add_arcs_to([], _, Graph, Graph).
+add_arcs_to([From | FromList], To, Graph0, Graph) :-
+ add_arc(Graph0, From, To, Graph1),
+ add_arcs_to(FromList, To, Graph1, Graph).
Index: dense_bitset.m
===================================================================
RCS file: dense_bitset.m
diff -N dense_bitset.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ dense_bitset.m Fri May 4 12:47:46 2001
@@ -0,0 +1,138 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: conway.
+%
+% This module provides an ADT for storing sets of integers. The sets are
+% represented as bit vectors, which are implemented as arrays of integers.
+
+:- module dense_bitset.
+
+:- interface.
+
+:- import_module array, int.
+
+:- type dense_bitset.
+
+:- func init = dense_bitset.
+:- mode (init = array_uo) is det.
+
+:- pred member(int, dense_bitset).
+:- mode member(in, array_ui) is semidet.
+
+:- func insert(dense_bitset, int) = dense_bitset.
+:- mode (insert(array_di, in) = array_uo) is det.
+
+:- func delete(dense_bitset, int) = dense_bitset.
+:- mode (delete(array_di, in) = array_uo) is det.
+
+:- func union(dense_bitset, dense_bitset) = dense_bitset.
+:- mode (union(array_di, array_di) = array_uo) is det.
+
+% Not yet implemented.
+% :- func intersection(dense_bitset, dense_bitset) = dense_bitset.
+% :- mode (intersection(array_di, array_di) = array_uo) is det.
+
+% Not yet implemented.
+% :- func difference(dense_bitset, dense_bitset) = dense_bitset.
+% :- mode (difference(array_di, array_di) = array_uo) is det.
+
+:- pred foldl(pred(int, T, T), dense_bitset, T, T).
+:- mode foldl(pred(in, in, out) is det, array_ui, in, out) is det.
+:- mode foldl(pred(in, di, uo) is det, array_ui, di, uo) is det.
+:- mode foldl(pred(in, array_di, array_uo) is det, array_ui,
+ array_di, array_uo) is det.
+
+:- implementation.
+
+:- import_module list, require.
+
+:- type dense_bitset == array(int).
+
+init = array([0]).
+
+member(I, A) :-
+ max(A, Max),
+ ( word(I) >= 0, word(I) =< Max ->
+ lookup(A, word(I), Word),
+ bit(I) /\ Word \= 0
+ ;
+ fail
+ ).
+
+insert(A0, I) = A :-
+ max(A0, Max),
+ ( word(I) > Max ->
+ resize(A0, (Max + 1) * 2, 0, A1),
+ A = insert(A1, I)
+ ; I >= 0 ->
+ lookup(A0, word(I), Word0),
+ Word = Word0 \/ bit(I),
+ set(A0, word(I), Word, A)
+ ;
+ error("insert: cannot use indexes < 0")
+ ).
+
+delete(A0, I) = A :-
+ max(A0, Max),
+ ( I > Max ->
+ A = A0
+ ; I >= 0 ->
+ lookup(A0, word(I), Word0),
+ Word = Word0 /\ \ bit(I),
+ set(A0, word(I), Word, A)
+ ;
+ error("insert: cannot use indexes < 0")
+ ).
+
+union(A, B) = C :-
+ foldl((pred(I::in, C0::array_di, C1::array_uo) is det :-
+ C1 = insert(C0, I)
+ ), A, B, C).
+
+foldl(P, A0, Acc0, Acc) :-
+ max(A0, Max),
+ foldl1(0, Max, P, A0, Acc0, Acc).
+
+:- pred foldl1(int, int, pred(int, T, T), dense_bitset, T, T).
+:- mode foldl1(in, in, pred(in, in, out) is det, array_ui, in, out) is det.
+:- mode foldl1(in, in, pred(in, di, uo) is det, array_ui, di, uo) is det.
+:- mode foldl1(in, in, pred(in, array_di, array_uo) is det, array_ui,
+ array_di, array_uo) is det.
+
+foldl1(Min, Max, P, A0, Acc0, Acc) :-
+ ( Min =< Max ->
+ foldl2(0, Min, P, A0, Acc0, Acc1),
+ foldl1(Min + 1, Max, P, A0, Acc1, Acc)
+ ;
+ Acc = Acc0
+ ).
+
+:- pred foldl2(int, int, pred(int, T, T), dense_bitset, T, T).
+:- mode foldl2(in, in, pred(in, in, out) is det, array_ui, in, out) is det.
+:- mode foldl2(in, in, pred(in, di, uo) is det, array_ui, di, uo) is det.
+:- mode foldl2(in, in, pred(in, array_di, array_uo) is det, array_ui,
+ array_di, array_uo) is det.
+
+foldl2(B, W, P, A0, Acc0, Acc) :-
+ ( B =< 31 ->
+ lookup(A0, W, Word),
+ ( (1 << B) /\ Word \= 0 ->
+ I = B + W * 32,
+ call(P, I, Acc0, Acc1)
+ ;
+ Acc1 = Acc0
+ ),
+ foldl2(B + 1, W, P, A0, Acc1, Acc)
+ ;
+ Acc = Acc0
+ ).
+
+:- func word(int) = int.
+word(I) = I // 32.
+
+:- func bit(int) = int.
+bit(I) = (1 << (I /\ 31)).
Index: interface.m
===================================================================
RCS file: interface.m
diff -N interface.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ interface.m Fri May 4 12:47:46 2001
@@ -0,0 +1,387 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: zs.
+%
+% This module defines the type of the commands that the CGI program (cgi.m)
+% passes to the deep profiling server (deep.m), as well as utility predicates
+% for manipulating commands and responses.
+
+:- module interface.
+
+:- interface.
+
+:- import_module std_util, io.
+
+:- type cmd
+ ---> quit
+ ; timeout(int)
+ ; menu
+ ; root(fields)
+ ; clique(int, fields)
+ ; proc(int, fields)
+ ; top_procs(sort_measurement, include_descendants,
+ display_limit, fields)
+ ; proc_static(int)
+ ; proc_dynamic(int)
+ ; call_site_static(int)
+ ; call_site_dynamic(int)
+ ; raw_clique(int)
+ ; num_proc_statics
+ ; num_call_site_statics
+ ; num_proc_dynamics
+ ; num_call_site_dynamics.
+
+:- type sort_measurement
+ ---> calls
+ ; time
+ ; allocs
+ ; words.
+
+:- type include_descendants
+ ---> self
+ ; self_and_desc.
+
+:- type display_limit
+ ---> rank_range(int, int)
+ ; threshold(float).
+
+:- type resp
+ ---> html(string).
+
+:- type fields == string. % some subset of "pqtaw", meaning
+ % p: port counts
+ % q: quanta
+ % t: times
+ % a: memory allocations
+ % w: memory words
+ % The characters must be sorted.
+
+:- func default_fields = string.
+:- func all_fields = string.
+
+:- func to_server_pipe_name(string) = string.
+:- func from_server_pipe_name(string) = string.
+:- func server_startup_name(string) = string.
+
+:- pred to(string::in, cmd::in, io__state::di, io__state::uo) is det.
+:- pred from(string::in, resp::out, io__state::di, io__state::uo) is det.
+
+:- pred cmd_to_url(string::in, string::in, cmd::in, string::out) is det.
+:- pred cmd_to_query(cmd::in, string::out) is det.
+:- pred query_to_cmd(string::in, maybe(cmd)::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module util.
+:- import_module char, string, list, set, require.
+
+default_fields = "pqw".
+
+all_fields = "apqtw".
+
+to_server_pipe_name(DataFileName) =
+ server_dir ++ "/" ++
+ "mdprof_server_to" ++
+ filename_mangle(DataFileName).
+
+from_server_pipe_name(DataFileName) =
+ server_dir ++ "/" ++
+ "mdprof_server_from" ++
+ filename_mangle(DataFileName).
+
+server_startup_name(DataFileName) =
+ server_dir ++ "/" ++
+ "mdprof_startup_err" ++
+ filename_mangle(DataFileName).
+
+:- func server_dir = string.
+
+server_dir = "/var/tmp".
+
+:- func filename_mangle(string) = string.
+
+filename_mangle(FileName) =
+ string__replace_all(FileName, "/", ":").
+
+%-----------------------------------------------------------------------------%
+
+cmd_to_url(Machine, DataFileName, Cmd, URL) :-
+ cmd_to_query(Cmd, Query),
+ URL =
+ "http://" ++
+ Machine ++
+ "/cgi-bin/mdprof?" ++
+ Query ++
+ "$" ++
+ filename_mangle(DataFileName).
+
+cmd_to_query(Cmd, Query) :-
+ (
+ Cmd = quit,
+ Query = "quit"
+ ;
+ Cmd = timeout(Minutes),
+ Query = format("timeout+%d", [i(Minutes)])
+ ;
+ Cmd = menu,
+ Query = "menu"
+ ;
+ Cmd = root(Fields),
+ Query = format("root+%s", [s(Fields)])
+ ;
+ Cmd = clique(CliqueNum, Fields),
+ Query = format("clique+%s+%d", [s(Fields), i(CliqueNum)])
+ ;
+ Cmd = proc(ProcNum, Fields),
+ Query = format("proc+%s+%d", [s(Fields), i(ProcNum)])
+ ;
+ Cmd = top_procs(Sort, InclDesc, Limit, Fields),
+ sort_to_str(Sort, SortStr),
+ incl_desc_to_str(InclDesc, InclDescStr),
+ limit_to_str(Limit, LimitStr),
+ Query = format("procs+%s+%s+%s+%s",
+ [s(SortStr), s(InclDescStr), s(LimitStr), s(Fields)])
+ ;
+ Cmd = proc_static(PSI),
+ Query = format("proc_static+%d", [i(PSI)])
+ ;
+ Cmd = proc_dynamic(PDI),
+ Query = format("proc_dynamic+%d", [i(PDI)])
+ ;
+ Cmd = call_site_static(CSSI),
+ Query = format("call_site_static+%d", [i(CSSI)])
+ ;
+ Cmd = call_site_dynamic(CSDI),
+ Query = format("call_site_dynamic+%d", [i(CSDI)])
+ ;
+ Cmd = raw_clique(CI),
+ Query = format("raw_clique+%d", [i(CI)])
+ ;
+ Cmd = num_proc_statics,
+ Query = "num_proc_statics"
+ ;
+ Cmd = num_proc_dynamics,
+ Query = "num_proc_dynamics"
+ ;
+ Cmd = num_call_site_statics,
+ Query = "num_call_site_statics"
+ ;
+ Cmd = num_call_site_dynamics,
+ Query = "num_call_site_dynamics"
+ ).
+
+query_to_cmd(QueryString, MaybeCmd) :-
+ split(QueryString, ('+'), Pieces),
+ (
+ (
+ Pieces = ["clique", NStr],
+ string__to_int(NStr, N),
+ Fields = default_fields
+ ;
+ Pieces = ["clique", Fields, NStr],
+ string__to_int(NStr, N),
+ validate_fields(Fields)
+ )
+ ->
+ MaybeCmd = yes(clique(N, Fields))
+ ;
+ (
+ Pieces = ["proc", NStr],
+ string__to_int(NStr, N),
+ Fields = default_fields
+ ;
+ Pieces = ["proc", Fields, NStr],
+ string__to_int(NStr, N),
+ validate_fields(Fields)
+ )
+ ->
+ MaybeCmd = yes(proc(N, Fields))
+ ;
+ (
+ Pieces = ["procs", SortStr, InclDescStr,
+ LimitStr],
+ Fields = default_fields
+ ;
+ Pieces = ["procs", SortStr, InclDescStr,
+ LimitStr, Fields],
+ validate_fields(Fields)
+ ),
+ translate_criteria(SortStr, Sort,
+ InclDescStr, InclDesc, LimitStr, Limit)
+ ->
+ MaybeCmd = yes(top_procs(Sort, InclDesc, Limit, Fields))
+ ;
+ (
+ Pieces = ["root"],
+ Fields = default_fields
+ ;
+ Pieces = ["root", Fields],
+ validate_fields(Fields)
+ )
+ ->
+ MaybeCmd = yes(root(Fields))
+ ;
+ Pieces = ["menu"]
+ ->
+ MaybeCmd = yes(menu)
+ ;
+ Pieces = ["proc_static", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(proc_static(N))
+ ;
+ Pieces = ["proc_dynamic", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(proc_dynamic(N))
+ ;
+ Pieces = ["call_site_static", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(call_site_static(N))
+ ;
+ Pieces = ["call_site_dynamic", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(call_site_dynamic(N))
+ ;
+ Pieces = ["raw_clique", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(raw_clique(N))
+ ;
+ Pieces = ["num_proc_statics"]
+ ->
+ MaybeCmd = yes(num_proc_statics)
+ ;
+ Pieces = ["num_call_site_statics"]
+ ->
+ MaybeCmd = yes(num_call_site_statics)
+ ;
+ Pieces = ["num_proc_dynamics"]
+ ->
+ MaybeCmd = yes(num_proc_dynamics)
+ ;
+ Pieces = ["num_call_site_dynamics"]
+ ->
+ MaybeCmd = yes(num_call_site_dynamics)
+ ;
+ Pieces = ["timeout", TStr],
+ string__to_int(TStr, TimeOut)
+ ->
+ MaybeCmd = yes(timeout(TimeOut))
+ ;
+ Pieces = ["quit"]
+ ->
+ MaybeCmd = yes(quit)
+ ;
+ MaybeCmd = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred sort_to_str(sort_measurement::in, string::out) is det.
+
+sort_to_str(calls, "calls").
+sort_to_str(time, "time").
+sort_to_str(allocs, "allocs").
+sort_to_str(words, "words").
+
+:- pred incl_desc_to_str(include_descendants::in, string::out) is det.
+
+incl_desc_to_str(self, "self").
+incl_desc_to_str(self_and_desc, "both").
+
+:- pred limit_to_str(display_limit::in, string::out) is det.
+
+limit_to_str(rank_range(Lo, Hi), format("%d-%d", [i(Lo), i(Hi)])).
+limit_to_str(threshold(Threshold), format("%f", [f(Threshold)])).
+
+:- pred translate_criteria(string::in, sort_measurement::out,
+ string::in, include_descendants::out, string::in, display_limit::out)
+ is semidet.
+
+translate_criteria(SortStr, Sort, InclDescStr, InclDesc, LimitStr, Limit) :-
+ (
+ SortStr = "calls",
+ Sort = calls
+ ;
+ SortStr = "time",
+ Sort = time
+ ;
+ SortStr = "allocs",
+ Sort = allocs
+ ;
+ SortStr = "words",
+ Sort = words
+ ),
+ (
+ InclDescStr = "self",
+ InclDesc = self
+ ;
+ InclDescStr = "both",
+ InclDesc = self_and_desc
+ ),
+ (
+ split(LimitStr, '-', Pieces),
+ Pieces = [FirstStr, LastStr],
+ string__to_int(FirstStr, First),
+ string__to_int(LastStr, Last)
+ ->
+ Limit = rank_range(First, Last)
+ ;
+ string__to_float(LimitStr, Threshold)
+ ->
+ Limit = threshold(Threshold)
+ ;
+ fail
+ ).
+
+:- pred validate_fields(string::in) is semidet.
+
+validate_fields(String) :-
+ Chars = string__to_char_list(String),
+ list__sort_and_remove_dups(Chars, Chars),
+ validate_field_chars(Chars,
+ set__list_to_set(string__to_char_list(all_fields))).
+
+:- pred validate_field_chars(list(char)::in, set(char)::in) is semidet.
+
+validate_field_chars([], _).
+validate_field_chars([Char | Chars], AvailFields0) :-
+ set__delete(AvailFields0, Char, AvailFields1),
+ validate_field_chars(Chars, AvailFields1).
+
+%-----------------------------------------------------------------------------%
+
+to(Where, Cmd) -->
+ io__tell(Where, Res),
+ ( { Res = ok } ->
+ io__write(Cmd),
+ io__write_string(".\n"),
+ io__told
+ ;
+ { error("mdprof to: couldn't open pipe") }
+ ).
+
+from(Where, Resp) -->
+ io__see(Where, Res0),
+ ( { Res0 = ok } ->
+ io__read(Res1),
+ ( { Res1 = ok(Resp0) } ->
+ { Resp = Resp0 }
+ ;
+ { error("mdprof from: read failed") }
+ ),
+ io__seen
+ ;
+ { error("mdprof from: couldn't open pipe") }
+ ).
+
+%-----------------------------------------------------------------------------%
Index: measurements.m
===================================================================
RCS file: measurements.m
diff -N measurements.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ measurements.m Fri May 4 12:47:46 2001
@@ -0,0 +1,231 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module defines the data structures that store deep profiling
+% measurements and the operations on them.
+
+:- module measurements.
+
+:- interface.
+
+:- import_module list.
+
+:- type own_prof_info.
+:- type inherit_prof_info.
+
+:- func calls(own_prof_info) = int.
+:- func exits(own_prof_info) = int.
+:- func fails(own_prof_info) = int.
+:- func redos(own_prof_info) = int.
+:- func quanta(own_prof_info) = int.
+:- func mallocs(own_prof_info) = int.
+:- func words(own_prof_info) = int.
+
+:- func zero_own_prof_info = own_prof_info.
+
+:- func inherit_quanta(inherit_prof_info) = int.
+:- func inherit_mallocs(inherit_prof_info) = int.
+:- func inherit_words(inherit_prof_info) = int.
+
+:- func zero_inherit_prof_info = inherit_prof_info.
+
+:- func add_inherit_to_inherit(inherit_prof_info, inherit_prof_info)
+ = inherit_prof_info.
+:- func add_own_to_inherit(own_prof_info, inherit_prof_info)
+ = inherit_prof_info.
+:- func subtract_own_from_inherit(own_prof_info, inherit_prof_info)
+ = inherit_prof_info.
+:- func add_inherit_to_own(inherit_prof_info, own_prof_info) = own_prof_info.
+:- func add_own_to_own(own_prof_info, own_prof_info) = own_prof_info.
+
+:- func sum_own_infos(list(own_prof_info)) = own_prof_info.
+:- func sum_inherit_infos(list(inherit_prof_info)) = inherit_prof_info.
+
+:- func compress_profile(int, int, int, int, int, int, int) = own_prof_info.
+:- func compress_profile(own_prof_info) = own_prof_info.
+
+:- func own_to_string(own_prof_info) = string.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module string.
+
+:- type own_prof_info
+ ---> all(int, int, int, int, int, int, int)
+ % calls, exits, fails, redos, quanta,
+ % memory_mallocs, memory_words
+ ; det(int, int, int, int) % calls, quanta, mallocs, words;
+ % implicit exits == calls,
+ % implicit fails == redos == 0
+ ; zdet(int, int, int). % calls, mallocs, words;
+ % implicit exits == calls,
+ % implicit fails == redos == 0
+ % implicit quanta == 0
+
+:- type inherit_prof_info
+ ---> inherit_prof_info(
+ int, % quanta
+ int, % memory_mallocs
+ int % memory_words
+ ).
+
+calls(zdet(Calls, _, _)) = Calls.
+exits(zdet(Calls, _, _)) = Calls.
+fails(zdet(_, _, _)) = 0.
+redos(zdet(_, _, _)) = 0.
+quanta(zdet(_, _, _)) = 0.
+mallocs(zdet(_, Mallocs, _)) = Mallocs.
+words(zdet(_, _, Words)) = Words.
+
+calls(det(Calls, _, _, _)) = Calls.
+exits(det(Calls, _, _, _)) = Calls.
+fails(det(_, _, _, _)) = 0.
+redos(det(_, _, _, _)) = 0.
+quanta(det(_, Quanta, _, _)) = Quanta.
+mallocs(det(_, _, Mallocs, _)) = Mallocs.
+words(det(_, _, _, Words)) = Words.
+
+calls(all(Calls, _, _, _, _, _, _)) = Calls.
+exits(all(_, Exits, _, _, _, _, _)) = Exits.
+fails(all(_, _, Fails, _, _, _, _)) = Fails.
+redos(all(_, _, _, Redos, _, _, _)) = Redos.
+quanta(all(_, _, _, _, Quanta, _, _)) = Quanta.
+mallocs(all(_, _, _, _, _, Mallocs, _)) = Mallocs.
+words(all(_, _, _, _, _, _, Words)) = Words.
+
+zero_own_prof_info = zdet(0, 0, 0).
+
+inherit_quanta(inherit_prof_info(Quanta, _, _)) = Quanta.
+inherit_mallocs(inherit_prof_info(_, Mallocs, _)) = Mallocs.
+inherit_words(inherit_prof_info(_, _, Words)) = Words.
+
+zero_inherit_prof_info = inherit_prof_info(0, 0, 0).
+
+add_inherit_to_inherit(PI1, PI2) = SumPI :-
+ Quanta = inherit_quanta(PI1) + inherit_quanta(PI2),
+ Mallocs = inherit_mallocs(PI1) + inherit_mallocs(PI2),
+ Words = inherit_words(PI1) + inherit_words(PI2),
+ SumPI = inherit_prof_info(Quanta, Mallocs, Words).
+
+add_own_to_inherit(PI1, PI2) = SumPI :-
+ Quanta = quanta(PI1) + inherit_quanta(PI2),
+ Mallocs = mallocs(PI1) + inherit_mallocs(PI2),
+ Words = words(PI1) + inherit_words(PI2),
+ SumPI = inherit_prof_info(Quanta, Mallocs, Words).
+
+subtract_own_from_inherit(PI1, PI2) = SumPI :-
+ Quanta = inherit_quanta(PI2) - quanta(PI1),
+ Mallocs = inherit_mallocs(PI2) - mallocs(PI1),
+ Words = inherit_words(PI2) - words(PI1),
+ SumPI = inherit_prof_info(Quanta, Mallocs, Words).
+
+add_inherit_to_own(PI1, PI2) = SumPI :-
+ Calls = calls(PI2),
+ Exits = exits(PI2),
+ Fails = fails(PI2),
+ Redos = redos(PI2),
+ Quanta = inherit_quanta(PI1) + quanta(PI2),
+ Mallocs = inherit_mallocs(PI1) + mallocs(PI2),
+ Words = inherit_words(PI1) + words(PI2),
+ SumPI = compress_profile(Calls, Exits, Fails, Redos,
+ Quanta, Mallocs, Words).
+
+add_own_to_own(PI1, PI2) = SumPI :-
+ Calls = calls(PI1) + calls(PI2),
+ Exits = exits(PI1) + exits(PI2),
+ Fails = fails(PI1) + fails(PI2),
+ Redos = redos(PI1) + redos(PI2),
+ Quanta = quanta(PI1) + quanta(PI2),
+ Mallocs = mallocs(PI1) + mallocs(PI2),
+ Words = words(PI1) + words(PI2),
+ SumPI = compress_profile(Calls, Exits, Fails, Redos,
+ Quanta, Mallocs, Words).
+
+sum_own_infos(Owns) =
+ list__foldl(add_own_to_own, Owns, zero_own_prof_info).
+
+sum_inherit_infos(Inherits) =
+ list__foldl(add_inherit_to_inherit, Inherits, zero_inherit_prof_info).
+
+compress_profile(Calls, Exits, Fails, Redos, Quanta, Mallocs, Words) = PI :-
+ (
+ Calls = Exits,
+ Fails = 0,
+ Redos = 0
+ ->
+ (
+ Quanta = 0
+ ->
+ PI = zdet(Calls, Mallocs, Words)
+ ;
+ PI = det(Calls, Quanta, Mallocs, Words)
+ )
+ ;
+ PI = all(Calls, Exits, Fails, Redos, Quanta, Mallocs, Words)
+ ).
+
+compress_profile(PI0) = PI :-
+ (
+ PI0 = all(Calls, Exits, Fails, Redos, Quanta, Mallocs, Words),
+ (
+ Calls = Exits,
+ Fails = 0,
+ Redos = 0
+ ->
+ (
+ Quanta = 0
+ ->
+ PI = zdet(Calls, Mallocs, Words)
+ ;
+ PI = det(Calls, Quanta, Mallocs, Words)
+ )
+ ;
+ PI = PI0
+ )
+ ;
+ PI0 = det(Calls, Quanta, Mallocs, Words),
+ (
+ Quanta = 0
+ ->
+ PI = zdet(Calls, Mallocs, Words)
+ ;
+ PI = PI0
+ )
+ ;
+ PI0 = zdet(_, _, _),
+ PI = PI0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+own_to_string(all(Calls, Exits, Fails, Redos, Quanta, Allocs, Words)) =
+ "all(" ++
+ string__int_to_string(Calls) ++ ", " ++
+ string__int_to_string(Exits) ++ ", " ++
+ string__int_to_string(Fails) ++ ", " ++
+ string__int_to_string(Redos) ++ ", " ++
+ string__int_to_string(Quanta) ++ ", " ++
+ string__int_to_string(Allocs) ++ ", " ++
+ string__int_to_string(Words) ++
+ ")".
+own_to_string(det(Calls, Quanta, Allocs, Words)) =
+ "det(" ++
+ string__int_to_string(Calls) ++ ", " ++
+ string__int_to_string(Quanta) ++ ", " ++
+ string__int_to_string(Allocs) ++ ", " ++
+ string__int_to_string(Words) ++
+ ")".
+own_to_string(zdet(Calls, Allocs, Words)) =
+ "det(" ++
+ string__int_to_string(Calls) ++ ", " ++
+ string__int_to_string(Allocs) ++ ", " ++
+ string__int_to_string(Words) ++
+ ")".
Index: profile.m
===================================================================
RCS file: profile.m
diff -N profile.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ profile.m Fri May 4 13:06:26 2001
@@ -0,0 +1,546 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This file defines the main data structures of the Mercury deep profiler,
+% and predicates for accessing it. The main concern of the access predicates
+% is ensuring the safety of array accesses.
+
+:- module profile.
+
+:- interface.
+
+:- import_module measurements.
+:- import_module std_util, array, list, map.
+
+:- type profile_stats --->
+ profile_stats(
+ instrument_quanta :: int,
+ user_quanta :: int,
+ num_csds :: int,
+ num_pds :: int,
+ num_csss :: int,
+ num_pss :: int
+ ).
+
+:- type initial_deep --->
+ initial_deep(
+ init_profile_stats :: profile_stats,
+ init_root :: proc_dynamic_ptr,
+ % The main arrays, each indexed by own xxx_ptr int
+ init_call_site_dynamics :: call_site_dynamics,
+ init_proc_dynamics :: proc_dynamics,
+ init_call_site_statics :: call_site_statics,
+ init_proc_statics :: proc_statics
+ ).
+
+:- type deep --->
+ deep(
+ profile_stats :: profile_stats,
+ server_name :: string,
+ data_file_name :: string,
+
+ root :: proc_dynamic_ptr,
+ % The main arrays, each indexed by own xxx_ptr int
+ call_site_dynamics :: call_site_dynamics,
+ proc_dynamics :: proc_dynamics,
+ call_site_statics :: call_site_statics,
+ proc_statics :: proc_statics,
+ % Clique information
+ clique_index :: array(clique_ptr),
+ % index: proc_dynamic_ptr int
+ clique_members :: array(list(proc_dynamic_ptr)),
+ % index: clique_ptr int
+ clique_parents :: array(call_site_dynamic_ptr),
+ % index: clique_ptr int
+ clique_maybe_child :: array(maybe(clique_ptr)),
+ % index: call_site_dynamic_ptr int
+ % Reverse links
+ proc_callers :: array(list(call_site_dynamic_ptr)),
+ % index: proc_static_ptr int
+ call_site_static_map :: call_site_static_map,
+ % index: call_site_dynamic_ptr int
+ call_site_calls :: array(map(proc_static_ptr,
+ list(call_site_dynamic_ptr))),
+ % index: call_site_static_ptr int
+ % Propagated timing info
+ pd_own :: array(own_prof_info),
+ pd_desc :: array(inherit_prof_info),
+ csd_desc :: array(inherit_prof_info),
+ ps_own :: array(own_prof_info),
+ ps_desc :: array(inherit_prof_info),
+ css_own :: array(own_prof_info),
+ css_desc :: array(inherit_prof_info)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type proc_dynamics == array(proc_dynamic).
+:- type proc_statics == array(proc_static).
+:- type call_site_dynamics == array(call_site_dynamic).
+:- type call_site_statics == array(call_site_static).
+:- type call_site_static_map == array(call_site_static_ptr).
+
+:- type proc_dynamic_ptr
+ ---> proc_dynamic_ptr(int).
+
+:- type proc_static_ptr
+ ---> proc_static_ptr(int).
+
+:- type call_site_dynamic_ptr
+ ---> call_site_dynamic_ptr(int).
+
+:- type call_site_static_ptr
+ ---> call_site_static_ptr(int).
+
+:- type clique_ptr
+ ---> clique_ptr(int).
+
+%-----------------------------------------------------------------------------%
+
+:- type proc_dynamic
+ ---> proc_dynamic(
+ pd_proc_static :: proc_static_ptr,
+ pd_sites :: array(call_site_array_slot)
+ ).
+
+:- type proc_static
+ ---> proc_static(
+ ps_id :: proc_id, % procedure ID
+ ps_refined_id :: string, % refined procedure id
+ ps_raw_id :: string, % raw procedure id
+ ps_filename :: string, % file name
+ ps_sites :: array(call_site_static_ptr)
+ ).
+
+:- type call_site_dynamic
+ ---> call_site_dynamic(
+ csd_caller :: proc_dynamic_ptr,
+ csd_callee :: proc_dynamic_ptr,
+ csd_own_prof :: own_prof_info
+ ).
+
+:- type call_site_static
+ ---> call_site_static(
+ css_container :: proc_static_ptr,
+ % the containing procedure
+ css_slot_num :: int,
+ % slot number in the
+ % containing procedure
+ css_kind :: call_site_kind_and_callee,
+ css_line_num :: int,
+ css_goal_path :: string
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type pred_or_func
+ ---> predicate
+ ; function.
+
+:- type proc_id
+ ---> user_defined(
+ user_pred_or_func :: pred_or_func,
+ user_decl_module :: string,
+ user_def_module :: string,
+ user_name :: string,
+ user_arity :: int,
+ user_mode :: int
+ )
+ ; compiler_generated(
+ comp_gen_type_name :: string,
+ comp_gen_type_module :: string,
+ comp_gen_def_module :: string,
+ comp_gen_pred_name :: string,
+ comp_gen_arity :: int,
+ comp_gen_mode :: int
+ ).
+
+:- type call_site_array_slot
+ ---> normal(call_site_dynamic_ptr)
+ ; multi(array(call_site_dynamic_ptr)).
+
+:- type call_site_kind
+ ---> normal_call
+ ; special_call
+ ; higher_order_call
+ ; method_call
+ ; callback.
+
+:- type call_site_kind_and_callee
+ ---> normal_call(proc_static_ptr, string)
+ ; special_call
+ ; higher_order_call
+ ; method_call
+ ; callback.
+
+:- type call_site_callees
+ ---> call_site_callees(
+ list(proc_dynamic_ptr)
+ ).
+
+:- type call_site_caller
+ ---> call_site_caller(
+ call_site_static_ptr
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func dummy_proc_id = proc_id.
+:- func main_parent_proc_id = proc_id.
+
+:- pred valid_clique_ptr(deep::in, clique_ptr::in) is semidet.
+:- pred valid_proc_dynamic_ptr(deep::in, proc_dynamic_ptr::in) is semidet.
+:- pred valid_proc_static_ptr(deep::in, proc_static_ptr::in) is semidet.
+:- pred valid_call_site_dynamic_ptr(deep::in, call_site_dynamic_ptr::in)
+ is semidet.
+:- pred valid_call_site_static_ptr(deep::in, call_site_static_ptr::in)
+ is semidet.
+
+:- pred valid_proc_dynamic_ptr_raw(proc_dynamics::in, proc_dynamic_ptr::in)
+ is semidet.
+:- pred valid_proc_static_ptr_raw(proc_statics::in, proc_static_ptr::in)
+ is semidet.
+:- pred valid_call_site_dynamic_ptr_raw(call_site_dynamics::in,
+ call_site_dynamic_ptr::in) is semidet.
+:- pred valid_call_site_static_ptr_raw(call_site_statics::in,
+ call_site_static_ptr::in) is semidet.
+
+:- pred lookup_call_site_dynamics(call_site_dynamics::in,
+ call_site_dynamic_ptr::in, call_site_dynamic::out) is det.
+:- pred lookup_call_site_statics(call_site_statics::in,
+ call_site_static_ptr::in, call_site_static::out) is det.
+:- pred lookup_proc_dynamics(proc_dynamics::in,
+ proc_dynamic_ptr::in, proc_dynamic::out) is det.
+:- pred lookup_proc_statics(proc_statics::in,
+ proc_static_ptr::in, proc_static::out) is det.
+:- pred lookup_clique_index(array(clique_ptr)::in,
+ proc_dynamic_ptr::in, clique_ptr::out) is det.
+:- pred lookup_clique_members(array(list(proc_dynamic_ptr))::in,
+ clique_ptr::in, list(proc_dynamic_ptr)::out) is det.
+:- pred lookup_clique_parents(array(call_site_dynamic_ptr)::in,
+ clique_ptr::in, call_site_dynamic_ptr::out) is det.
+:- pred lookup_clique_maybe_child(array(maybe(clique_ptr))::in,
+ call_site_dynamic_ptr::in, maybe(clique_ptr)::out) is det.
+:- pred lookup_call_site_static_map(call_site_static_map::in,
+ call_site_dynamic_ptr::in, call_site_static_ptr::out) is det.
+:- pred lookup_call_site_calls(array(map(proc_static_ptr,
+ list(call_site_dynamic_ptr)))::in, call_site_static_ptr::in,
+ map(proc_static_ptr, list(call_site_dynamic_ptr))::out) is det.
+
+:- pred deep_lookup_call_site_dynamics(deep::in, call_site_dynamic_ptr::in,
+ call_site_dynamic::out) is det.
+:- pred deep_lookup_call_site_statics(deep::in, call_site_static_ptr::in,
+ call_site_static::out) is det.
+:- pred deep_lookup_proc_dynamics(deep::in, proc_dynamic_ptr::in,
+ proc_dynamic::out) is det.
+:- pred deep_lookup_proc_statics(deep::in, proc_static_ptr::in,
+ proc_static::out) is det.
+:- pred deep_lookup_clique_index(deep::in, proc_dynamic_ptr::in,
+ clique_ptr::out) is det.
+:- pred deep_lookup_clique_members(deep::in, clique_ptr::in,
+ list(proc_dynamic_ptr)::out) is det.
+:- pred deep_lookup_clique_parents(deep::in, clique_ptr::in,
+ call_site_dynamic_ptr::out) is det.
+:- pred deep_lookup_clique_maybe_child(deep::in, call_site_dynamic_ptr::in,
+ maybe(clique_ptr)::out) is det.
+:- pred deep_lookup_call_site_static_map(deep::in, call_site_dynamic_ptr::in,
+ call_site_static_ptr::out) is det.
+:- pred deep_lookup_call_site_calls(deep::in, call_site_static_ptr::in,
+ map(proc_static_ptr, list(call_site_dynamic_ptr))::out) is det.
+:- pred deep_lookup_proc_dynamic_sites(deep::in, proc_dynamic_ptr::in,
+ array(call_site_array_slot)::out) is det.
+
+:- pred deep_lookup_pd_own(deep::in, proc_dynamic_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_pd_desc(deep::in, proc_dynamic_ptr::in,
+ inherit_prof_info::out) is det.
+:- pred deep_lookup_csd_own(deep::in, call_site_dynamic_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_csd_desc(deep::in, call_site_dynamic_ptr::in,
+ inherit_prof_info::out) is det.
+:- pred deep_lookup_ps_own(deep::in, proc_static_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_ps_desc(deep::in, proc_static_ptr::in,
+ inherit_prof_info::out) is det.
+:- pred deep_lookup_css_own(deep::in, call_site_static_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_css_desc(deep::in, call_site_static_ptr::in,
+ inherit_prof_info::out) is det.
+
+:- pred update_call_site_dynamics(call_site_dynamics::array_di,
+ call_site_dynamic_ptr::in, call_site_dynamic::in,
+ call_site_dynamics::array_uo) is det.
+:- pred update_call_site_statics(call_site_statics::array_di,
+ call_site_static_ptr::in, call_site_static::in,
+ call_site_statics::array_uo) is det.
+:- pred update_proc_dynamics(proc_dynamics::array_di,
+ proc_dynamic_ptr::in, proc_dynamic::in,
+ proc_dynamics::array_uo) is det.
+:- pred update_proc_statics(proc_statics::array_di,
+ proc_static_ptr::in, proc_static::in, proc_statics::array_uo) is det.
+:- pred update_call_site_static_map(call_site_static_map::array_di,
+ call_site_dynamic_ptr::in, call_site_static_ptr::in,
+ call_site_static_map::array_uo) is det.
+
+:- pred deep_update_csd_desc(deep::in, call_site_dynamic_ptr::in,
+ inherit_prof_info::in, deep::out) is det.
+:- pred deep_update_pd_desc(deep::in, proc_dynamic_ptr::in,
+ inherit_prof_info::in, deep::out) is det.
+:- pred deep_update_pd_own(deep::in, proc_dynamic_ptr::in,
+ own_prof_info::in, deep::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array_util.
+:- import_module int, require.
+
+dummy_proc_id = user_defined(predicate, "unknown", "unknown", "unknown",
+ -1, -1).
+
+main_parent_proc_id = user_defined(predicate, "mercury_runtime",
+ "mercury_runtime", "main_parent", 0, 0).
+
+%-----------------------------------------------------------------------------%
+
+valid_clique_ptr(Deep, clique_ptr(CliqueNum)) :-
+ CliqueNum > 0,
+ array__in_bounds(Deep ^ clique_members, CliqueNum).
+
+valid_proc_dynamic_ptr(Deep, proc_dynamic_ptr(PDI)) :-
+ PDI > 0,
+ array__in_bounds(Deep ^ proc_dynamics, PDI).
+
+valid_proc_static_ptr(Deep, proc_static_ptr(PSI)) :-
+ PSI > 0,
+ array__in_bounds(Deep ^ proc_statics, PSI).
+
+valid_call_site_dynamic_ptr(Deep, call_site_dynamic_ptr(CSDI)) :-
+ CSDI > 0,
+ array__in_bounds(Deep ^ call_site_dynamics, CSDI).
+
+valid_call_site_static_ptr(Deep, call_site_static_ptr(CSSI)) :-
+ CSSI > 0,
+ array__in_bounds(Deep ^ call_site_statics, CSSI).
+
+%-----------------------------------------------------------------------------%
+
+valid_proc_dynamic_ptr_raw(ProcDynamics, proc_dynamic_ptr(PDI)) :-
+ PDI > 0,
+ array__in_bounds(ProcDynamics, PDI).
+
+valid_proc_static_ptr_raw(ProcStatics, proc_static_ptr(PSI)) :-
+ PSI > 0,
+ array__in_bounds(ProcStatics, PSI).
+
+valid_call_site_dynamic_ptr_raw(CallSiteDynamics,
+ call_site_dynamic_ptr(CSDI)) :-
+ CSDI > 0,
+ array__in_bounds(CallSiteDynamics, CSDI).
+
+valid_call_site_static_ptr_raw(CallSiteStatics, call_site_static_ptr(CSSI)) :-
+ CSSI > 0,
+ array__in_bounds(CallSiteStatics, CSSI).
+
+%-----------------------------------------------------------------------------%
+
+lookup_call_site_dynamics(CallSiteDynamics, CSDPtr, CSD) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0, array__in_bounds(CallSiteDynamics, CSDI) ->
+ array__lookup(CallSiteDynamics, CSDI, CSD)
+ ;
+ error("lookup_call_site_dynamics: bounds error")
+ ).
+
+lookup_call_site_statics(CallSiteStatics, CSSPtr, CSS) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( CSSI > 0, array__in_bounds(CallSiteStatics, CSSI) ->
+ array__lookup(CallSiteStatics, CSSI, CSS)
+ ;
+ error("lookup_call_site_statics: bounds error")
+ ).
+
+lookup_proc_dynamics(ProcDynamics, PDPtr, PD) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0, array__in_bounds(ProcDynamics, PDI) ->
+ array__lookup(ProcDynamics, PDI, PD)
+ ;
+ error("lookup_proc_dynamics: bounds error")
+ ).
+
+lookup_proc_statics(ProcStatics, PSPtr, PS) :-
+ PSPtr = proc_static_ptr(PSI),
+ ( PSI > 0, array__in_bounds(ProcStatics, PSI) ->
+ array__lookup(ProcStatics, PSI, PS)
+ ;
+ error("lookup_proc_statics: bounds error")
+ ).
+
+lookup_clique_index(CliqueIndex, PDPtr, CliquePtr) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0, array__in_bounds(CliqueIndex, PDI) ->
+ array__lookup(CliqueIndex, PDI, CliquePtr)
+ ;
+ error("lookup_clique_index: bounds error")
+ ).
+
+lookup_clique_members(CliqueMembers, CliquePtr, PDPtrs) :-
+ CliquePtr = clique_ptr(CI),
+ ( array__in_bounds(CliqueMembers, CI) ->
+ array__lookup(CliqueMembers, CI, PDPtrs)
+ ;
+ error("lookup_clique_members: bounds error")
+ ).
+
+lookup_clique_parents(CliqueParents, CliquePtr, CSDPtr) :-
+ CliquePtr = clique_ptr(CI),
+ ( array__in_bounds(CliqueParents, CI) ->
+ array__lookup(CliqueParents, CI, CSDPtr)
+ ;
+ error("lookup_clique_parents: bounds error")
+ ).
+
+lookup_clique_maybe_child(CliqueMaybeChild, CSDPtr, MaybeCliquePtr) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0, array__in_bounds(CliqueMaybeChild, CSDI) ->
+ array__lookup(CliqueMaybeChild, CSDI, MaybeCliquePtr)
+ ;
+ error("lookup_clique_maybe_child: bounds error")
+ ).
+
+lookup_call_site_static_map(CallSiteStaticMap, CSDPtr, CSSPtr) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0, array__in_bounds(CallSiteStaticMap, CSDI) ->
+ array__lookup(CallSiteStaticMap, CSDI, CSSPtr)
+ ;
+ error("lookup_call_site_static_map: bounds error")
+ ).
+
+lookup_call_site_calls(CallSiteCalls, CSSPtr, Calls) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( CSSI > 0, array__in_bounds(CallSiteCalls, CSSI) ->
+ array__lookup(CallSiteCalls, CSSI, Calls)
+ ;
+ error("lookup_call_site_static_map: bounds error")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD) :-
+ lookup_call_site_dynamics(Deep ^ call_site_dynamics, CSDPtr, CSD).
+
+deep_lookup_call_site_statics(Deep, CSSPtr, CSS) :-
+ lookup_call_site_statics(Deep ^ call_site_statics, CSSPtr, CSS).
+
+deep_lookup_proc_dynamics(Deep, PDPtr, PD) :-
+ lookup_proc_dynamics(Deep ^ proc_dynamics, PDPtr, PD).
+
+deep_lookup_proc_statics(Deep, PSPtr, PS) :-
+ lookup_proc_statics(Deep ^ proc_statics, PSPtr, PS).
+
+deep_lookup_clique_index(Deep, PDPtr, CliquePtr) :-
+ lookup_clique_index(Deep ^ clique_index, PDPtr, CliquePtr).
+
+deep_lookup_clique_members(Deep, CliquePtr, PDPtrs) :-
+ lookup_clique_members(Deep ^ clique_members, CliquePtr, PDPtrs).
+
+deep_lookup_clique_parents(Deep, CliquePtr, CSDPtr) :-
+ lookup_clique_parents(Deep ^ clique_parents, CliquePtr, CSDPtr).
+
+deep_lookup_clique_maybe_child(Deep, CSDPtr, MaybeCliquePtr) :-
+ lookup_clique_maybe_child(Deep ^ clique_maybe_child, CSDPtr,
+ MaybeCliquePtr).
+
+deep_lookup_call_site_static_map(Deep, CSDPtr, CSSPtr) :-
+ lookup_call_site_static_map(Deep ^ call_site_static_map, CSDPtr,
+ CSSPtr).
+
+deep_lookup_call_site_calls(Deep, CSSPtr, Calls) :-
+ lookup_call_site_calls(Deep ^ call_site_calls, CSSPtr, Calls).
+
+deep_lookup_proc_dynamic_sites(Deep, PDPtr, PDSites) :-
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PDSites = PD ^ pd_sites.
+
+%-----------------------------------------------------------------------------%
+
+deep_lookup_pd_own(Deep, PDPtr, Own) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(Deep ^ pd_own, PDI, Own).
+
+deep_lookup_pd_desc(Deep, PDPtr, Desc) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(Deep ^ pd_desc, PDI, Desc).
+
+deep_lookup_csd_own(Deep, CSDPtr, Own) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__lookup(Deep ^ call_site_dynamics, CSDI, CSD),
+ CSD = call_site_dynamic(_, _, Own).
+
+deep_lookup_csd_desc(Deep, CSDPtr, Desc) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__lookup(Deep ^ csd_desc, CSDI, Desc).
+
+deep_lookup_ps_own(Deep, PSPtr, Own) :-
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(Deep ^ ps_own, PSI, Own).
+
+deep_lookup_ps_desc(Deep, PSPtr, Desc) :-
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(Deep ^ ps_desc, PSI, Desc).
+
+deep_lookup_css_own(Deep, CSSPtr, Own) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__lookup(Deep ^ css_own, CSSI, Own).
+
+deep_lookup_css_desc(Deep, CSSPtr, Desc) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__lookup(Deep ^ css_desc, CSSI, Desc).
+
+%-----------------------------------------------------------------------------%
+
+update_call_site_dynamics(CallSiteDynamics0, CSDPtr, CSD, CallSiteDynamics) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__set(CallSiteDynamics0, CSDI, CSD, CallSiteDynamics).
+
+update_call_site_statics(CallSiteStatics0, CSSPtr, CSS, CallSiteStatics) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__set(CallSiteStatics0, CSSI, CSS, CallSiteStatics).
+
+update_proc_dynamics(ProcDynamics0, PDPtr, PD, ProcDynamics) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__set(ProcDynamics0, PDI, PD, ProcDynamics).
+
+update_proc_statics(ProcStatics0, PSPtr, PS, ProcStatics) :-
+ PSPtr = proc_static_ptr(PSI),
+ array__set(ProcStatics0, PSI, PS, ProcStatics).
+
+update_call_site_static_map(CallSiteStaticMap0, CSDPtr, CSSPtr,
+ CallSiteStaticMap) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__set(CallSiteStaticMap0, CSDI, CSSPtr, CallSiteStaticMap).
+
+%-----------------------------------------------------------------------------%
+
+deep_update_csd_desc(Deep0, CSDPtr, CSDDesc, Deep) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__set(u(Deep0 ^ csd_desc), CSDI, CSDDesc, CSDDescs),
+ Deep = Deep0 ^ csd_desc := CSDDescs.
+
+deep_update_pd_desc(Deep0, PDPtr, PDDesc, Deep) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__set(u(Deep0 ^ pd_desc), PDI, PDDesc, PDDescs),
+ Deep = Deep0 ^ pd_desc := PDDescs.
+
+deep_update_pd_own(Deep0, PDPtr, PDOwn, Deep) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__set(u(Deep0 ^ pd_own), PDI, PDOwn, PDOwns),
+ Deep = Deep0 ^ pd_own := PDOwns.
+
+%-----------------------------------------------------------------------------%
Index: read_profile.m
===================================================================
RCS file: read_profile.m
diff -N read_profile.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ read_profile.m Fri May 4 13:16:52 2001
@@ -0,0 +1,1382 @@
+%-----------------------------------------------------------------------------% % Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains code for reading in a deep profiling data file.
+% Such files, named Deep.data, are created by deep profiled executables.
+
+:- module read_profile.
+
+:- interface.
+
+:- import_module profile.
+:- import_module io.
+
+:- type deep_result(T)
+ ---> ok(T)
+ ; error(string).
+
+:- pred read_call_graph(string::in, deep_result(initial_deep)::out,
+ io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module measurements, array_util.
+:- import_module array, char, string, int, float, std_util, list, require.
+
+:- type deep_result2(T1, T2)
+ ---> ok2(T1, T2)
+ ; error2(string).
+
+:- type nodes_result
+ ---> ok_eof(initial_deep, ptr_info)
+ ; at_limit(initial_deep, ptr_info)
+ ; error_nodes(string).
+
+:- type ptr_info --->
+ ptr_info(
+ ps :: int,
+ css :: int,
+ pd :: int,
+ csd :: int
+ ).
+
+:- type ptr_kind
+ ---> ps
+ ; pd
+ ; css
+ ; csd.
+
+read_call_graph(FileName, Res) -->
+ io__see_binary(FileName, Res0),
+ (
+ { Res0 = ok },
+ read_id_string(Res1),
+ (
+ { Res1 = ok(_) },
+ read_sequence6(
+ read_fixed_size_int,
+ read_fixed_size_int,
+ read_fixed_size_int,
+ read_fixed_size_int,
+ read_num,
+ read_num,
+ (pred(NumCSDs::in, NumCSSs::in,
+ NumPDs::in, NumPSs::in,
+ InstrumentQuanta::in,
+ UserQuanta::in,
+ ResInitDeep::out) is det :-
+ init_deep(NumCSDs, NumCSSs,
+ NumPDs, NumPSs,
+ InstrumentQuanta, UserQuanta,
+ InitDeep0),
+ ResInitDeep = ok(InitDeep0)
+ ),
+ Res2),
+ (
+ { Res2 = ok(InitDeep) },
+ { PtrInfo0 = ptr_info(0, 0, 0, 0) },
+ read_nodes(InitDeep, PtrInfo0, Res3),
+ io__seen_binary,
+ { resize_arrays(Res3, Res) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Msg) },
+ { Res = error(Msg) }
+ )
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error(Msg) }
+ ).
+
+:- pred read_id_string(deep_result(string)::out,
+ io__state::di, io__state::uo) is det.
+
+read_id_string(Res) -->
+ read_n_byte_string(string__length(id_string), Res0),
+ (
+ { Res0 = ok(String) },
+ ( { String = id_string } ->
+ { Res = ok(id_string) }
+ ;
+ { Res = error("not a deep profiling data file") }
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- func id_string = string.
+
+id_string = "Mercury deep profiler data".
+
+:- pred init_deep(int::in, int::in, int::in, int::in, int::in, int::in,
+ initial_deep::out) is det.
+
+init_deep(NumCSDs, NumCSSs, NumPDs, NumPSs, InstrumentQuanta, UserQuanta,
+ InitDeep) :-
+ InitStats = profile_stats(
+ InstrumentQuanta,
+ UserQuanta,
+ -1, -1, -1, -1),
+ InitDeep = initial_deep(
+ InitStats,
+ proc_dynamic_ptr(-1),
+ array__init(NumCSDs + 1,
+ call_site_dynamic(
+ proc_dynamic_ptr(-1),
+ proc_dynamic_ptr(-1),
+ zero_own_prof_info
+ )),
+ array__init(NumPDs + 1,
+ proc_dynamic(proc_static_ptr(-1), array([]))),
+ array__init(NumCSSs + 1,
+ call_site_static(
+ proc_static_ptr(-1), -1,
+ normal_call(proc_static_ptr(-1), ""), -1, ""
+ )),
+ array__init(NumPSs + 1,
+ proc_static(dummy_proc_id, "", "", "", array([])))
+ ).
+
+:- pred read_nodes(initial_deep::in, ptr_info::in,
+ deep_result2(initial_deep, ptr_info)::out,
+ io__state::di, io__state::uo) is det.
+
+read_nodes(InitDeep0, PtrInfo0, Res) -->
+ read_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_call_site_static } ->
+ read_call_site_static(Res1),
+ (
+ { Res1 = ok2(CallSiteStatic, CSSI) },
+ { deep_insert(
+ InitDeep0 ^ init_call_site_statics,
+ CSSI, CallSiteStatic, CSSs) },
+ { InitDeep1 = InitDeep0
+ ^ init_call_site_statics := CSSs },
+ { PtrInfo1 = PtrInfo0 ^ css
+ := max(PtrInfo0 ^ css, CSSI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_proc_static } ->
+ read_proc_static(Res1),
+ (
+ { Res1 = ok2(ProcStatic, PSI) },
+ { deep_insert(
+ InitDeep0 ^ init_proc_statics,
+ PSI, ProcStatic, PSs) },
+ { InitDeep1 = InitDeep0
+ ^ init_proc_statics := PSs },
+ { PtrInfo1 = PtrInfo0 ^ ps
+ := max(PtrInfo0 ^ ps, PSI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_call_site_dynamic } ->
+ read_call_site_dynamic(Res1),
+ (
+ { Res1 = ok2(CallSiteDynamic, CSDI) },
+ { deep_insert(
+ InitDeep0 ^ init_call_site_dynamics,
+ CSDI, CallSiteDynamic, CSDs) },
+ { InitDeep1 = InitDeep0
+ ^ init_call_site_dynamics := CSDs },
+ { PtrInfo1 = PtrInfo0 ^ csd
+ := max(PtrInfo0 ^ csd, CSDI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_proc_dynamic } ->
+ read_proc_dynamic(Res1),
+ (
+ { Res1 = ok2(ProcDynamic, PDI) },
+ { deep_insert(
+ InitDeep0 ^ init_proc_dynamics,
+ PDI, ProcDynamic, PDs) },
+ { InitDeep1 = InitDeep0
+ ^ init_proc_dynamics := PDs },
+ { PtrInfo1 = PtrInfo0 ^ pd
+ := max(PtrInfo0 ^ pd, PDI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_root } ->
+ read_root(Res1),
+ (
+ { Res1 = ok(PDPtr) },
+ { InitDeep1 = InitDeep0 ^ init_root := PDPtr },
+ read_nodes(InitDeep1, PtrInfo0, Res)
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { format("unexpected token %d", [i(Byte)], Msg) },
+ { Res = error2(Msg) }
+ )
+ ;
+ { Res0 = eof },
+ { Res = ok2(InitDeep0, PtrInfo0) }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error2(Msg) }
+ ).
+
+:- pred read_root(deep_result(proc_dynamic_ptr)::out,
+ io__state::di, io__state::uo) is det.
+
+read_root(Res) -->
+ % format("reading root.\n", []),
+ read_ptr(pd, Res0),
+ (
+ { Res0 = ok(PDI) },
+ { PDPtr = proc_dynamic_ptr(PDI) },
+ { Res = ok(PDPtr) }
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_call_site_static(deep_result2(call_site_static, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_static(Res) -->
+ % format("reading call_site_static.\n", []),
+ read_sequence4(
+ read_ptr(css),
+ read_call_site_kind_and_callee,
+ read_num,
+ read_string,
+ (pred(CSSI0::in, Kind::in, LineNumber::in, Str::in, Res0::out)
+ is det :-
+ DummyPSPtr = proc_static_ptr(-1),
+ DummySlotNum = -1,
+ CallSiteStatic0 = call_site_static(DummyPSPtr,
+ DummySlotNum, Kind, LineNumber, Str),
+ Res0 = ok({CallSiteStatic0, CSSI0})
+ ),
+ Res1),
+ (
+ { Res1 = ok({CallSiteStatic, CSSI}) },
+ { Res = ok2(CallSiteStatic, CSSI) }
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+
+:- pred read_proc_static(deep_result2(proc_static, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_static(Res) -->
+ % format("reading proc_static.\n", []),
+ read_sequence4(
+ read_ptr(ps),
+ read_proc_id,
+ read_string,
+ read_num,
+ (pred(PSI0::in, Id0::in, F0::in, N0::in, Stuff0::out) is det :-
+ Stuff0 = ok({PSI0, Id0, F0, N0})
+ ),
+ Res1),
+ (
+ { Res1 = ok({PSI, Id, FileName, N}) },
+ read_n_things(N, read_ptr(css), Res2),
+ (
+ { Res2 = ok(Ptrs0) },
+ { map((pred(Ptr1::in, Ptr2::out) is det :-
+ Ptr2 = call_site_static_ptr(Ptr1)
+ ), Ptrs0, Ptrs) },
+ { RefinedStr = refined_proc_id_to_string(Id) },
+ { RawStr = raw_proc_id_to_string(Id) },
+ { ProcStatic =
+ proc_static(Id, RefinedStr, RawStr,
+ FileName, array(Ptrs)) },
+ { Res = ok2(ProcStatic, PSI) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+:- pred read_proc_id(deep_result(proc_id)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_id(Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_isa_compiler_generated } ->
+ read_proc_id_compiler_generated(Res)
+ ; { Byte = token_isa_predicate } ->
+ read_proc_id_user_defined(predicate, Res)
+ ; { Byte = token_isa_function } ->
+ read_proc_id_user_defined(function, Res)
+ ;
+ { format("unexpected proc_id_kind %d",
+ [i(Byte)], Msg) },
+ { Res = error(Msg) }
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_proc_id_compiler_generated(deep_result(proc_id)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_id_compiler_generated(Res) -->
+ read_sequence6(
+ read_string,
+ read_string,
+ read_string,
+ read_string,
+ read_num,
+ read_num,
+ (pred(TypeName::in, TypeModule::in, DefModule::in,
+ PredName::in, Arity::in, Mode::in, ProcId::out)
+ is det :-
+ ProcId = ok(compiler_generated(TypeName, TypeModule,
+ DefModule, PredName, Arity, Mode))
+ ),
+ Res).
+
+:- pred read_proc_id_user_defined(pred_or_func::in, deep_result(proc_id)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_id_user_defined(PredOrFunc, Res) -->
+ read_sequence5(
+ read_string,
+ read_string,
+ read_string,
+ read_num,
+ read_num,
+ (pred(DeclModule::in, DefModule::in, Name::in,
+ Arity::in, Mode::in, ProcId::out)
+ is det :-
+ ProcId = ok(user_defined(PredOrFunc, DeclModule,
+ DefModule, Name, Arity, Mode))
+ ),
+ Res).
+
+:- func raw_proc_id_to_string(proc_id) = string.
+
+raw_proc_id_to_string(compiler_generated(TypeName, TypeModule, _DefModule,
+ PredName, Arity, Mode)) =
+ string__append_list(
+ [PredName, " for ", TypeModule, ":", TypeName,
+ "/", string__int_to_string(Arity),
+ " mode ", string__int_to_string(Mode)]).
+raw_proc_id_to_string(user_defined(PredOrFunc, DeclModule, _DefModule,
+ Name, Arity, Mode)) =
+ string__append_list([DeclModule, ":", Name,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" ),
+ "-", string__int_to_string(Mode)]).
+
+:- func refined_proc_id_to_string(proc_id) = string.
+
+refined_proc_id_to_string(compiler_generated(TypeName, TypeModule, _DefModule,
+ RawPredName, Arity, Mode)) = Name :-
+ ( RawPredName = "__Unify__" ->
+ PredName = "Unify"
+ ; RawPredName = "__Compare__" ->
+ PredName = "Compare"
+ ; RawPredName = "__Index__" ->
+ PredName = "Index"
+ ;
+ string__append("unknown special predicate name ", RawPredName,
+ Msg),
+ error(Msg)
+ ),
+ Name0 = string__append_list(
+ [PredName, " for ", TypeModule, ":", TypeName,
+ "/", string__int_to_string(Arity)]),
+ ( Mode = 0 ->
+ Name = Name0
+ ;
+ Name = string__append_list([Name0, " mode ",
+ string__int_to_string(Mode)])
+ ).
+refined_proc_id_to_string(user_defined(PredOrFunc, DeclModule, _DefModule,
+ ProcName, Arity, Mode)) = Name :-
+ (
+ string__append("TypeSpecOf__", ProcName1, ProcName),
+ ( string__append("pred__", ProcName2A, ProcName1) ->
+ ProcName2 = ProcName2A
+ ; string__append("func__", ProcName2B, ProcName1) ->
+ ProcName2 = ProcName2B
+ ; string__append("pred_or_func__", ProcName2C, ProcName1) ->
+ ProcName2 = ProcName2C
+ ;
+ error("typespec: neither pred nor func")
+ ),
+ string__to_char_list(ProcName2, ProcName2Chars),
+ fix_type_spec_suffix(ProcName2Chars, ProcNameChars, SpecInfo)
+ ->
+ RefinedProcName = string__from_char_list(ProcNameChars),
+ Name = string__append_list([DeclModule, ":", RefinedProcName,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" ),
+ "-", string__int_to_string(Mode),
+ " [", SpecInfo, "]"])
+ ;
+ string__append("IntroducedFrom__", ProcName1, ProcName),
+ ( string__append("pred__", ProcName2A, ProcName1) ->
+ ProcName2 = ProcName2A
+ ; string__append("func__", ProcName2B, ProcName1) ->
+ ProcName2 = ProcName2B
+ ;
+ error("lambda: neither pred nor func")
+ ),
+ string__to_char_list(ProcName2, ProcName2Chars),
+ split_lambda_name(ProcName2Chars, Segments),
+ glue_lambda_name(Segments, ContainingNameChars,
+ LineNumberChars)
+ ->
+ string__from_char_list(ContainingNameChars, ContainingName),
+ string__from_char_list(LineNumberChars, LineNumber),
+ Name = string__append_list([DeclModule, ":", ContainingName,
+ " lambda line ", LineNumber,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" )])
+ ;
+ Name = string__append_list([DeclModule, ":", ProcName,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" ),
+ "-", string__int_to_string(Mode)])
+ ).
+
+:- pred fix_type_spec_suffix(list(char)::in, list(char)::out, string::out)
+ is semidet.
+
+fix_type_spec_suffix(Chars0, Chars, SpecInfoStr) :-
+ ( Chars0 = ['_', '_', '[' | SpecInfo0 ] ->
+ Chars = [],
+ list__takewhile(non_right_bracket, SpecInfo0, SpecInfo, _),
+ string__from_char_list(SpecInfo, SpecInfoStr)
+ ; Chars0 = [Char | TailChars0] ->
+ fix_type_spec_suffix(TailChars0, TailChars, SpecInfoStr),
+ Chars = [Char | TailChars]
+ ;
+ fail
+ ).
+
+:- pred non_right_bracket(char::in) is semidet.
+
+non_right_bracket(C) :-
+ C \= ']'.
+
+:- pred split_lambda_name(list(char)::in, list(list(char))::out) is det.
+
+split_lambda_name([], []).
+split_lambda_name([Char0 | Chars0], StringList) :-
+ ( Chars0 = ['_', '_' | Chars1 ] ->
+ split_lambda_name(Chars1, StringList0),
+ StringList = [[Char0] | StringList0]
+ ;
+ split_lambda_name(Chars0, StringList0),
+ (
+ StringList0 = [],
+ StringList = [[Char0]]
+ ;
+ StringList0 = [String0 | StringList1],
+ StringList = [[Char0 | String0] | StringList1]
+ )
+ ).
+
+:- pred glue_lambda_name(list(list(char))::in, list(char)::out,
+ list(char)::out) is semidet.
+
+glue_lambda_name(Segments, PredName, LineNumber) :-
+ ( Segments = [LineNumberPrime, _] ->
+ PredName = [],
+ LineNumber = LineNumberPrime
+ ; Segments = [Segment | TailSegments] ->
+ glue_lambda_name(TailSegments, PredName1, LineNumber),
+ ( PredName1 = [] ->
+ PredName = Segment
+ ;
+ list__append(Segment, ['_', '_' | PredName1], PredName)
+ )
+ ;
+ fail
+ ).
+
+:- pred read_proc_dynamic(deep_result2(proc_dynamic, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_dynamic(Res) -->
+ % format("reading proc_dynamic.\n", []),
+ read_sequence3(
+ read_ptr(pd),
+ read_ptr(ps),
+ read_num,
+ (pred(PDI0::in, PSI0::in, N0::in, Stuff0::out) is det :-
+ Stuff0 = ok({PDI0, PSI0, N0})
+ ),
+ Res1),
+ (
+ { Res1 = ok({PDI, PSI, N}) },
+ read_n_things(N, read_call_site_ref, Res2),
+ (
+ { Res2 = ok(Refs) },
+ { PSPtr = proc_static_ptr(PSI) },
+ { ProcDynamic = proc_dynamic(PSPtr, array(Refs)) },
+ { Res = ok2(ProcDynamic, PDI) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+:- pred read_call_site_dynamic(deep_result2(call_site_dynamic, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_dynamic(Res) -->
+ % format("reading call_site_dynamic.\n", []),
+ read_ptr(csd, Res1),
+ (
+ { Res1 = ok(CSDI) },
+ read_ptr(pd, Res2),
+ (
+ { Res2 = ok(PDI) },
+ read_profile(Res3),
+ (
+ { Res3 = ok(Profile) },
+ { PDPtr = proc_dynamic_ptr(PDI) },
+ { DummyPDPtr = proc_dynamic_ptr(-1) },
+ { CallSiteDynamic = call_site_dynamic(
+ DummyPDPtr, PDPtr, Profile) },
+ { Res = ok2(CallSiteDynamic, CSDI) }
+ ;
+ { Res3 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+:- pred read_profile(deep_result(own_prof_info)::out,
+ io__state::di, io__state::uo) is det.
+
+read_profile(Res) -->
+ read_num(Res0),
+ (
+ { Res0 = ok(Mask) },
+ { MaybeError0 = no },
+ ( { Mask /\ 0x0001 \= 0 } ->
+ maybe_read_num_handle_error(Calls,
+ MaybeError0, MaybeError1)
+ ;
+ { Calls = 0 },
+ { MaybeError1 = MaybeError0 }
+ ),
+ ( { Mask /\ 0x0002 \= 0 } ->
+ maybe_read_num_handle_error(Exits,
+ MaybeError1, MaybeError2)
+ ;
+ { Exits = 0 },
+ { MaybeError2 = MaybeError1 }
+ ),
+ ( { Mask /\ 0x0004 \= 0 } ->
+ maybe_read_num_handle_error(Fails,
+ MaybeError2, MaybeError3)
+ ;
+ { Fails = 0 },
+ { MaybeError3 = MaybeError2 }
+ ),
+ ( { Mask /\ 0x0008 \= 0 } ->
+ maybe_read_num_handle_error(Redos,
+ MaybeError3, MaybeError4)
+ ;
+ { Redos = 0 },
+ { MaybeError4 = MaybeError3 }
+ ),
+ ( { Mask /\ 0x0010 \= 0 } ->
+ maybe_read_num_handle_error(Quanta,
+ MaybeError4, MaybeError5)
+ ;
+ { Quanta = 0 },
+ { MaybeError5 = MaybeError4 }
+ ),
+ ( { Mask /\ 0x0020 \= 0 } ->
+ maybe_read_num_handle_error(Mallocs,
+ MaybeError5, MaybeError6)
+ ;
+ { Mallocs = 0 },
+ { MaybeError6 = MaybeError5 }
+ ),
+ ( { Mask /\ 0x0040 \= 0 } ->
+ maybe_read_num_handle_error(Words,
+ MaybeError6, MaybeError7)
+ ;
+ { Words = 0 },
+ { MaybeError7 = MaybeError6 }
+ ),
+ (
+ { MaybeError7 = yes(Error) },
+ { Res = error(Error) }
+ ;
+ { MaybeError7 = no },
+ { Res = ok(compress_profile(Calls, Exits, Fails, Redos,
+ Quanta, Mallocs, Words)) }
+ )
+ ;
+ { Res0 = error(Error) },
+ { Res = error(Error) }
+ ).
+
+:- pred maybe_read_num_handle_error(int::out,
+ maybe(string)::in, maybe(string)::out,
+ io__state::di, io__state::uo) is det.
+
+maybe_read_num_handle_error(Value, MaybeError0, MaybeError) -->
+ read_num(Res),
+ (
+ { Res = ok(Value) },
+ { MaybeError = MaybeError0 }
+ ;
+ { Res = error(Error) },
+ { Value = 0 },
+ { MaybeError = yes(Error) }
+ ).
+
+:- pred read_call_site_ref(deep_result(call_site_array_slot)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_ref(Res) -->
+ % format("reading call_site_ref.\n", []),
+ read_call_site_kind(Res1),
+ (
+ { Res1 = ok(Kind) },
+ ( { Kind = normal_call } ->
+ read_ptr(csd, Res2),
+ (
+ { Res2 = ok(Ptr) },
+ { CDPtr = call_site_dynamic_ptr(Ptr) },
+ { Res = ok(normal(CDPtr)) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ read_things(read_ptr(csd), Res2),
+ (
+ { Res2 = ok(Ptrs0) },
+ { map((pred(PtrX::in, PtrY::out) is det :-
+ PtrY = call_site_dynamic_ptr(PtrX)
+ ), Ptrs0, Ptrs) },
+ { Res = ok(multi(array(Ptrs))) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_call_site_kind(deep_result(call_site_kind)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_kind(Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_normal_call } ->
+ { Res = ok(normal_call) }
+ ; { Byte = token_special_call } ->
+ { Res = ok(special_call) }
+ ; { Byte = token_higher_order_call } ->
+ { Res = ok(higher_order_call) }
+ ; { Byte = token_method_call } ->
+ { Res = ok(method_call) }
+ ; { Byte = token_callback } ->
+ { Res = ok(callback) }
+ ;
+ { format("unexpected call_site_kind %d",
+ [i(Byte)], Msg) },
+ { Res = error(Msg) }
+ )
+ % io__write_string("call_site_kind "),
+ % io__write(Res),
+ % io__write_string("\n")
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_call_site_kind_and_callee(
+ deep_result(call_site_kind_and_callee)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_kind_and_callee(Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_normal_call } ->
+ read_num(Res1),
+ (
+ { Res1 = ok(CalleeProcStatic) },
+ read_string(Res2),
+ (
+ { Res2 = ok(TypeSubst) },
+ { Res = ok(normal_call(
+ proc_static_ptr(
+ CalleeProcStatic),
+ TypeSubst)) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ )
+ ; { Byte = token_special_call } ->
+ { Res = ok(special_call) }
+ ; { Byte = token_higher_order_call } ->
+ { Res = ok(higher_order_call) }
+ ; { Byte = token_method_call } ->
+ { Res = ok(method_call) }
+ ; { Byte = token_callback } ->
+ { Res = ok(callback) }
+ ;
+ { format("unexpected call_site_kind %d",
+ [i(Byte)], Msg) },
+ { Res = error(Msg) }
+ )
+ % io__write_string("call_site_kind_and_callee "),
+ % io__write(Res),
+ % io__write_string("\n")
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred read_n_things(int, pred(deep_result(T), io__state, io__state),
+ deep_result(list(T)), io__state, io__state).
+:- mode read_n_things(in, pred(out, di, uo) is det, out, di, uo) is det.
+
+read_n_things(N, ThingReader, Res) -->
+ read_n_things(N, ThingReader, [], Res0),
+ (
+ { Res0 = ok(Things0) },
+ { reverse(Things0, Things) },
+ { Res = ok(Things) }
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_n_things(int, pred(deep_result(T), io__state, io__state),
+ list(T), deep_result(list(T)), io__state, io__state).
+:- mode read_n_things(in, pred(out, di, uo) is det, in, out, di, uo) is det.
+
+read_n_things(N, ThingReader, Things0, Res) -->
+ ( { N =< 0 } ->
+ { Res = ok(Things0) }
+ ;
+ call(ThingReader, Res1),
+ (
+ { Res1 = ok(Thing) },
+ read_n_things(N - 1, ThingReader, [Thing|Things0], Res)
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ )
+ ).
+
+:- pred read_things(pred(deep_result(T), io__state, io__state),
+ deep_result(list(T)), io__state, io__state).
+:- mode read_things(pred(out, di, uo) is det, out, di, uo) is det.
+
+read_things(ThingReader, Res) -->
+ read_things(ThingReader, [], Res).
+
+:- pred read_things(pred(deep_result(T), io__state, io__state),
+ list(T), deep_result(list(T)), io__state, io__state).
+:- mode read_things(pred(out, di, uo) is det, in, out, di, uo) is det.
+
+read_things(ThingReader, Things0, Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = 0 } ->
+ { Res = ok(Things0) }
+ ;
+ putback_byte(Byte),
+ call(ThingReader, Res1),
+ (
+ { Res1 = ok(Thing) },
+ read_things(ThingReader, [Thing|Things0], Res)
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ )
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred read_sequence2(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(T1, T2, deep_result(T3)),
+ deep_result(T3), io__state, io__state).
+:- mode read_sequence2(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence2(P1, P2, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ { call(Combine, T1, T2, Res) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_sequence3(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(deep_result(T3), io__state, io__state),
+ pred(T1, T2, T3, deep_result(T4)),
+ deep_result(T4), io__state, io__state).
+:- mode read_sequence3(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence3(P1, P2, P3, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ call(P3, Res3),
+ (
+ { Res3 = ok(T3) },
+ { call(Combine, T1, T2, T3, Res) }
+ ;
+ { Res3 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_sequence4(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(deep_result(T3), io__state, io__state),
+ pred(deep_result(T4), io__state, io__state),
+ pred(T1, T2, T3, T4, deep_result(T5)),
+ deep_result(T5), io__state, io__state).
+:- mode read_sequence4(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence4(P1, P2, P3, P4, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ call(P3, Res3),
+ (
+ { Res3 = ok(T3) },
+ call(P4, Res4),
+ (
+ { Res4 = ok(T4) },
+ { call(Combine, T1, T2, T3, T4, Res) }
+ ;
+ { Res4 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res3 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_sequence5(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(deep_result(T3), io__state, io__state),
+ pred(deep_result(T4), io__state, io__state),
+ pred(deep_result(T5), io__state, io__state),
+ pred(T1, T2, T3, T4, T5, deep_result(T6)),
+ deep_result(T6), io__state, io__state).
+:- mode read_sequence5(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, in, in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence5(P1, P2, P3, P4, P5, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ call(P3, Res3),
+ (
+ { Res3 = ok(T3) },
+ call(P4, Res4),
+ (
+ { Res4 = ok(T4) },
+ call(P5, Res5),
+ (
+ { Res5 = ok(T5) },
+ { call(Combine, T1, T2, T3, T4,
+ T5, Res) }
+ ;
+ { Res5 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res4 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res3 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_sequence6(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(deep_result(T3), io__state, io__state),
+ pred(deep_result(T4), io__state, io__state),
+ pred(deep_result(T5), io__state, io__state),
+ pred(deep_result(T6), io__state, io__state),
+ pred(T1, T2, T3, T4, T5, T6, deep_result(T7)),
+ deep_result(T7), io__state, io__state).
+:- mode read_sequence6(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, in, in, in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence6(P1, P2, P3, P4, P5, P6, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ call(P3, Res3),
+ (
+ { Res3 = ok(T3) },
+ call(P4, Res4),
+ (
+ { Res4 = ok(T4) },
+ call(P5, Res5),
+ (
+ { Res5 = ok(T5) },
+ call(P6, Res6),
+ (
+ { Res6 = ok(T6) },
+ { call(Combine, T1, T2,
+ T3, T4, T5,
+ T6, Res) }
+ ;
+ { Res6 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res5 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res4 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res3 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred read_string(deep_result(string)::out,
+ io__state::di, io__state::uo) is det.
+
+read_string(Res) -->
+ read_num(Res0),
+ (
+ { Res0 = ok(Length) },
+ ( { Length = 0 } ->
+ { Res = ok("") }
+ ;
+ read_n_byte_string(Length, Res)
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_n_byte_string(int::in, deep_result(string)::out,
+ io__state::di, io__state::uo) is det.
+
+read_n_byte_string(Length, Res) -->
+ read_n_bytes(Length, Res1),
+ (
+ { Res1 = ok(Bytes) },
+ (
+ { map((pred(I::in, C::out) is semidet :-
+ char__to_int(C, I)
+ ), Bytes, Chars) }
+ ->
+ { string__from_char_list(Chars, Str) },
+ { Res = ok(Str) }
+ ;
+ { Res = error("string contained bad char") }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+ % io__write_string("string "),
+ % io__write(Res),
+ % io__write_string("\n")
+
+:- pred read_ptr(ptr_kind::in, deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_ptr(_Kind, Res) -->
+ read_num1(0, Res).
+ % io__write_string("ptr "),
+ % io__write(Res),
+ % io__write_string("\n").
+
+:- pred read_num(deep_result(int)::out, io__state::di, io__state::uo) is det.
+
+read_num(Res) -->
+ read_num1(0, Res).
+ % io__write_string("num "),
+ % io__write(Res),
+ % io__write_string("\n").
+
+:- pred read_num1(int::in, deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_num1(Num0, Res) -->
+ read_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ { Num1 = (Num0 << 7) \/ (Byte /\ 0x7F) },
+ ( { Byte /\ 0x80 \= 0 } ->
+ read_num1(Num1, Res)
+ ;
+ { Res = ok(Num1) }
+ )
+ ;
+ { Res0 = eof },
+ { Res = error("unexpected end of file") }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error(Msg) }
+ ).
+
+:- func fixed_size_int_bytes = int.
+
+% Must correspond to MR_FIXED_SIZE_INT_BYTES
+% in runtime/mercury_deep_profiling.c.
+
+fixed_size_int_bytes = 4.
+
+:- pred read_fixed_size_int(deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_fixed_size_int(Res) -->
+ read_fixed_size_int1(fixed_size_int_bytes, 0, 0, Res).
+
+:- pred read_fixed_size_int1(int::in, int::in, int::in, deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_fixed_size_int1(BytesLeft, Num0, ShiftBy, Res) -->
+ ( { BytesLeft =< 0 } ->
+ { Res = ok(Num0) }
+ ;
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ { Num1 = Num0 \/ ( Byte << ShiftBy) },
+ read_fixed_size_int1(BytesLeft - 1, Num1, ShiftBy + 8,
+ Res)
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ )
+ ).
+
+:- pred read_n_bytes(int::in, deep_result(list(int))::out,
+ io__state::di, io__state::uo) is det.
+
+read_n_bytes(N, Res) -->
+ read_n_bytes(N, [], Res0),
+ (
+ { Res0 = ok(Bytes0) },
+ { reverse(Bytes0, Bytes) },
+ { Res = ok(Bytes) }
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_n_bytes(int::in, list(int)::in, deep_result(list(int))::out,
+ io__state::di, io__state::uo) is det.
+
+read_n_bytes(N, Bytes0, Res) -->
+ ( { N =< 0 } ->
+ { Res = ok(Bytes0) }
+ ;
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ read_n_bytes(N - 1, [Byte | Bytes0], Res)
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ )
+ ).
+
+:- pred read_deep_byte(deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_deep_byte(Res) -->
+ read_byte(Res0),
+ % io__write_string("byte "),
+ % io__write(Res),
+ % io__write_string("\n"),
+ (
+ { Res0 = ok(Byte) },
+ { Res = ok(Byte) }
+ ;
+ { Res0 = eof },
+ { Res = error("unexpected end of file") }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error(Msg) }
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred deep_insert(array(T)::in, int::in, T::in, array(T)::out) is det.
+
+deep_insert(A0, Ind, Thing, A) :-
+ array__max(A0, Max),
+ ( Ind > Max ->
+ array__lookup(A0, 0, X),
+ array__resize(u(A0), 2 * (Max + 1), X, A1),
+ deep_insert(A1, Ind, Thing, A)
+ ;
+ set(u(A0), Ind, Thing, A)
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_header_code("
+#include ""mercury_deep_profiling.h""
+").
+
+:- func token_root = int.
+:- pragma c_code(token_root = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_root;").
+
+:- func token_call_site_static = int.
+:- pragma c_code(token_call_site_static = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_call_site_static;").
+
+:- func token_call_site_dynamic = int.
+:- pragma c_code(token_call_site_dynamic = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_call_site_dynamic;").
+
+:- func token_proc_static = int.
+:- pragma c_code(token_proc_static = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_proc_static;").
+
+:- func token_proc_dynamic = int.
+:- pragma c_code(token_proc_dynamic = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_proc_dynamic;").
+
+:- func token_normal_call = int.
+:- pragma c_code(token_normal_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_normal_call;").
+
+:- func token_special_call = int.
+:- pragma c_code(token_special_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_special_call;").
+
+:- func token_higher_order_call = int.
+:- pragma c_code(token_higher_order_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_higher_order_call;").
+
+:- func token_method_call = int.
+:- pragma c_code(token_method_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_method_call;").
+
+:- func token_callback = int.
+:- pragma c_code(token_callback = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_callback;").
+
+:- func token_isa_predicate = int.
+:- pragma c_code(token_isa_predicate = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_isa_predicate;").
+
+:- func token_isa_function = int.
+:- pragma c_code(token_isa_function = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_isa_function;").
+
+:- func token_isa_compiler_generated = int.
+:- pragma c_code(token_isa_compiler_generated = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_isa_compiler_generated;").
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- pred resize_arrays(deep_result2(initial_deep, ptr_info)::in,
+ deep_result(initial_deep)::out) is det.
+
+resize_arrays(error2(Err), error(Err)).
+resize_arrays(ok2(InitDeep0, PI), ok(InitDeep)) :-
+ PI ^ csd = CSDMax,
+ CSDs0 = InitDeep0 ^ init_call_site_dynamics,
+ array__lookup(CSDs0, 0, CSDx),
+ array__resize(u(CSDs0), CSDMax + 1, CSDx, CSDs),
+ InitDeep1 = InitDeep0 ^ init_call_site_dynamics := CSDs,
+
+ PI ^ pd = PDMax,
+ PDs0 = InitDeep1 ^ init_proc_dynamics,
+ array__lookup(PDs0, 0, PDx),
+ array__resize(u(PDs0), PDMax + 1, PDx, PDs),
+ InitDeep2 = InitDeep1 ^ init_proc_dynamics := PDs,
+
+ PI ^ css = CSSMax,
+ CSSs0 = InitDeep2 ^ init_call_site_statics,
+ array__lookup(CSSs0, 0, CSSx),
+ array__resize(u(CSSs0), CSSMax + 1, CSSx, CSSs),
+ InitDeep3 = InitDeep2 ^ init_call_site_statics := CSSs,
+
+ PI ^ ps = PSMax,
+ PSs0 = InitDeep3 ^ init_proc_statics,
+ array__lookup(PSs0, 0, PSx),
+ array__resize(u(PSs0), PSMax + 1, PSx, PSs),
+ InitDeep4 = InitDeep3 ^ init_proc_statics := PSs,
+
+ ProfileStats0 = InitDeep4 ^ init_profile_stats,
+ ProfileStats0 = profile_stats(InstrumentQuanta, UserQuanta,
+ _, _, _, _),
+ ProfileStats = profile_stats(InstrumentQuanta, UserQuanta,
+ CSDMax, PDMax, CSSMax, PSMax),
+ InitDeep = InitDeep4 ^ init_profile_stats := ProfileStats.
+
+%-----------------------------------------------------------------------------%
Index: server.m
===================================================================
RCS file: server.m
diff -N server.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ server.m Fri May 4 13:17:08 2001
@@ -0,0 +1,1801 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains the main server loop of the Mercury deep profiler:
+% each iteration of the server loop servers up one web page.
+%
+% The module also contains test code for checking that all the web pages
+% can be created without runtime aborts.
+
+:- module server.
+
+:- interface.
+
+:- import_module profile.
+:- import_module bool, io.
+
+:- pred test_server(string::in, deep::in, string::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+:- pred server(int::in, bool::in, bool::in, deep::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module interface, measurements, timeout.
+:- import_module std_util, int, float, char, string.
+:- import_module array, list, assoc_list, map.
+:- import_module exception, require.
+
+:- type call_site_line_number
+ ---> call_site_line_number
+ ; no_call_site_line_number.
+
+%-----------------------------------------------------------------------------%
+
+test_server(DirName, Deep, Fields) -->
+ { string__format("mkdir -p %s", [s(DirName)], Cmd) },
+ io__call_system(Cmd, _),
+ { array__max(Deep ^ clique_members, NumCliques) },
+ test_cliques(1, NumCliques, DirName, Deep, Fields),
+ { array__max(Deep ^ proc_statics, NumProcStatics) },
+ test_procs(1, NumProcStatics, DirName, Deep, Fields).
+
+:- pred test_cliques(int::in, int::in, string::in, deep::in,
+ string::in, io__state::di, io__state::uo) is cc_multi.
+
+test_cliques(Cur, Max, DirName, Deep, Fields) -->
+ ( { Cur =< Max } ->
+ { try_exec(clique(Cur, Fields), Deep, HTML) },
+ write_html(DirName, "clique", Cur, HTML),
+ test_cliques(Cur + 1, Max, DirName, Deep, Fields)
+ ;
+ []
+ ).
+
+:- pred test_procs(int::in, int::in, string::in, deep::in,
+ string::in, io__state::di, io__state::uo) is cc_multi.
+
+test_procs(Cur, Max, DirName, Deep, Fields) -->
+ ( { Cur =< Max } ->
+ { try_exec(proc(Cur, Fields), Deep, HTML) },
+ write_html(DirName, "proc", Cur, HTML),
+ test_procs(Cur + 1, Max, DirName, Deep, Fields)
+ ;
+ []
+ ).
+
+:- pred write_html(string::in, string::in, int::in, string::in,
+ io__state::di, io__state::uo) is det.
+
+write_html(DirName, BaseName, Num, HTML) -->
+ % For large programs such as the Mercury compiler, the profiler data
+ % file may contain hundreds of thousands of cliques. We therefore put
+ % each batch of pages in a different subdirectory, thus limiting the
+ % number of files/subdirs in each directory.
+ { Bunch = (Num - 1) // 1000 },
+ ( { (Num - 1) rem 1000 = 0 } ->
+ { string__format("mkdir -p %s/%s_%04d",
+ [s(DirName), s(BaseName), i(Bunch)], Cmd) },
+ io__call_system(Cmd, _)
+ ;
+ []
+ ),
+ { string__format("%s/%s_%04d/%s_%06d.html",
+ [s(DirName), s(BaseName), i(Bunch), s(BaseName), i(Num)],
+ FileName) },
+ io__tell(FileName, _),
+ io__write_string(HTML),
+ io__told.
+
+%-----------------------------------------------------------------------------%
+
+server(TimeOut, CreatePipes, Debug, Deep) -->
+ { DataFileName = Deep ^ data_file_name },
+ { InputPipe = to_server_pipe_name(DataFileName) },
+ { OutputPipe = from_server_pipe_name(DataFileName) },
+ (
+ { CreatePipes = yes },
+ { format("mknod -m a=rw %s p", [s(InputPipe)],
+ MakeInputPipeCmd) },
+ { format("mknod -m a=rw %s p", [s(OutputPipe)],
+ MakeOutputPipeCmd) },
+ io__call_system(MakeInputPipeCmd, InputRes),
+ ( { InputRes = ok(0) } ->
+ []
+ ;
+ []
+ % { error("could not make pipe to server") }
+ ),
+ io__call_system(MakeOutputPipeCmd, OutputRes),
+ ( { OutputRes = ok(0) } ->
+ []
+ ;
+ []
+ % { error("could not make pipe from server") }
+ )
+ ;
+ { CreatePipes = no }
+ ),
+ detach_server_loop,
+ server_loop(InputPipe, OutputPipe, TimeOut, Debug, 0, Deep).
+
+:- pragma foreign_decl("C", "
+#include <unistd.h>
+").
+
+:- pred detach_server_loop(io__state::di, io__state::uo) is cc_multi.
+
+:- pragma foreign_proc("C", detach_server_loop(S0::di, S::uo),
+ [will_not_call_mercury], "
+{
+ int status;
+
+ S = S0;
+ fflush(stdout);
+ fflush(stderr);
+ status = fork();
+ if (status < 0) {
+ /*
+ ** The fork failed; we cannot detach the server loop from the
+ ** startup process. The cgi script would therefore wait forever
+ ** if we did not exit now
+ */
+
+ exit(1);
+ } else if (status > 0) {
+ /*
+ ** The fork succeeded; we are in the parent. We therefore exit
+ ** now to let the io__call_system in the cgi script succeed.
+ */
+
+ exit(0);
+ }
+
+ /*
+ ** Else the fork succeeded; we are in the child. We continue
+ ** executing, and start serving answers to queries.
+ */
+}").
+
+:- pred server_loop(string::in, string::in, int::in, bool::in, int::in,
+ deep::in, io__state::di, io__state::uo) is cc_multi.
+
+server_loop(InputPipe, OutputPipe, TimeOut, Debug, QueryNum, Deep) -->
+ setup_timeout(InputPipe, OutputPipe, TimeOut),
+ io__see(InputPipe, SeeRes),
+ (
+ { SeeRes = ok },
+ io__read(ReadRes),
+ stderr_stream(StdErr),
+ (
+ { Debug = yes },
+ io__write(StdErr, ReadRes),
+ io__nl(StdErr)
+ ;
+ { Debug = no }
+ ),
+ (
+ { ReadRes = eof },
+ (
+ { Debug = yes },
+ write_string(StdErr, "eof.\n")
+ ;
+ { Debug = no }
+ ),
+ server_loop(InputPipe, OutputPipe,
+ TimeOut, Debug, QueryNum + 1, Deep)
+ ;
+ { ReadRes = error(Msg, Line) },
+ (
+ { Debug = yes },
+ format(StdErr,
+ "error reading input line %d: %s\n",
+ [i(Line), s(Msg)])
+ ;
+ { Debug = no }
+ ),
+ server_loop(InputPipe, OutputPipe,
+ TimeOut, Debug, QueryNum + 1, Deep)
+ ;
+ { ReadRes = ok(Cmd) },
+ { try_exec(Cmd, Deep, HTML) },
+ (
+ { Debug = yes },
+ format(StdErr, "query %d output:\n%s\n",
+ [i(QueryNum), s(HTML)])
+ ;
+ { Debug = no }
+ ),
+
+ % If we can't open the output pipe, then we have
+ % no way to report our failure anyway.
+ io__tell(OutputPipe, _),
+ io__write(html(HTML)),
+ io__write_string(".\n"),
+ io__told,
+ ( { Cmd = quit } ->
+ { format("rm -f %s %s",
+ [s(InputPipe), s(OutputPipe)],
+ RemovePipesCmd) },
+ % If we can't open remove the pipes, then
+ % we have no way to report our failure anyway.
+ io__call_system(RemovePipesCmd, _)
+ ; { Cmd = timeout(NewTimeOut) } ->
+ server_loop(InputPipe, OutputPipe,
+ NewTimeOut, Debug, QueryNum + 1, Deep)
+ ;
+ server_loop(InputPipe, OutputPipe,
+ TimeOut, Debug, QueryNum + 1, Deep)
+ )
+ )
+ ;
+ { SeeRes = error(Error) },
+ { io__error_message(Error, Msg) },
+ io__write_string(Msg),
+ io__set_exit_status(1)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred try_exec(cmd::in, deep::in, string::out) is cc_multi.
+
+try_exec(Cmd, Deep, HTML) :-
+ try(exec(Cmd, Deep), Result),
+ (
+ Result = succeeded(HTML)
+ ;
+ Result = exception(Exception),
+ ( univ_to_type(Exception, MsgPrime) ->
+ Msg = MsgPrime
+ ;
+ Msg = "unknown exception"
+ ),
+ HTML =
+ format("<H1>AN EXCEPTION HAS OCCURRED: %s.</H1>\n",
+ [s(Msg)])
+ ).
+
+:- pred exec(cmd::in, deep::in, string::out) is det.
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = quit,
+ HTML =
+ format("<H1>Shutting down deep profile server for %s.</H1>\n",
+ [s(Deep ^ data_file_name)]).
+
+exec(Cmd, _Deep, HTML) :-
+ Cmd = timeout(TimeOut),
+ HTML = format("<H1>Timeout set to %d minutes</H1>\n", [i(TimeOut)]).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = menu,
+ HTML =
+ banner ++
+ "<p>\n" ++
+ menu_text ++
+ "<ul>\n" ++
+ "<li>\n" ++
+ menu_item(Deep, root(default_fields),
+ "Exploring the call graph.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: time, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self_and_desc,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: time, self+desc.")
+ ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: words, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self_and_desc,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: words, self+desc.")
+ ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self,
+ threshold(0.1), default_fields),
+ "Procedures above 0.1% threshold: time, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self_and_desc,
+ threshold(1.0), default_fields),
+ "Procedures above 1% threshold: time, self+desc.")
+ ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self,
+ threshold(0.1), default_fields),
+ "Procedures above 0.1% threshold: words, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self_and_desc,
+ threshold(1.0), default_fields),
+ "Procedures above 1% threshold: words, self+desc.")
+ ++
+ "</ul>\n" ++
+ "<p>\n" ++
+ present_stats(Deep) ++
+ footer(Cmd, Deep).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = root(Fields),
+ deep_lookup_clique_index(Deep, Deep ^ root, RootCliquePtr),
+ RootCliquePtr = clique_ptr(RootCliqueNum),
+ exec(clique(RootCliqueNum, Fields), Deep, HTML).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = clique(CliqueNum, Fields),
+ ( valid_clique_ptr(Deep, clique_ptr(CliqueNum)) ->
+ HTML =
+ banner ++
+ "<TABLE>\n" ++
+ fields_header(Fields) ++
+ clique_to_html(Deep, Fields,
+ clique_ptr(CliqueNum)) ++
+ "</TABLE>\n" ++
+ footer(Cmd, Deep)
+ ;
+ HTML =
+ banner ++
+ "There is no clique with that number.\n" ++
+ footer(Cmd, Deep)
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = top_procs(Sort, InclDesc, Limit, Fields),
+ find_top_procs(Sort, InclDesc, Limit, Deep, MaybeTopPSIs),
+ (
+ MaybeTopPSIs = error(ErrorMessage),
+ HTML =
+ banner ++
+ ErrorMessage ++ "\n" ++
+ footer(Cmd, Deep)
+ ;
+ MaybeTopPSIs = ok(TopPSIs),
+ ( TopPSIs = [] ->
+ HTML =
+ banner ++
+ "No procedures match the specification.\n" ++
+ footer(Cmd, Deep)
+ ;
+ TopProcSummaries = list__map(
+ proc_total_summary_to_html(Deep, Fields),
+ TopPSIs),
+ HTML =
+ banner ++
+ "<TABLE>\n" ++
+ fields_header(Fields) ++
+ string__append_list(TopProcSummaries) ++
+ "</TABLE>\n" ++
+ footer(Cmd, Deep)
+ )
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = proc(PSI, Fields),
+ HTML =
+ "<HTML>\n" ++
+ banner ++
+ "<TABLE>\n" ++
+ fields_header(Fields) ++
+ proc_summary_to_html(Deep, Fields, PSI) ++
+ "</TABLE>\n" ++
+ footer(Cmd, Deep).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = proc_static(PSI),
+ PSPtr = proc_static_ptr(PSI),
+ ( valid_proc_static_ptr(Deep, PSPtr) ->
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ Refined = PS ^ ps_refined_id,
+ Raw = PS ^ ps_raw_id,
+ FileName = PS ^ ps_filename,
+ HTML =
+ "<HTML>\n" ++
+ Refined ++ " " ++ Raw ++ " " ++ FileName ++ " " ++
+ string__int_to_string(array__max(PS ^ ps_sites)) ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid proc_static_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = proc_dynamic(PDI),
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( valid_proc_dynamic_ptr(Deep, PDPtr) ->
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ PSPtr = proc_static_ptr(PSI),
+ HTML =
+ "<HTML>\n" ++
+ format("proc_static %d, ", [i(PSI)]) ++
+ array_slots_to_html(PD ^ pd_sites) ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid proc_dynamic_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = call_site_static(CSSI),
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( valid_call_site_static_ptr(Deep, CSSPtr) ->
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ ContainerPtr = CSS ^ css_container,
+ ContainerPtr = proc_static_ptr(Container),
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Container) ++ " " ++
+ string__int_to_string(CSS ^ css_slot_num) ++ " " ++
+ string__int_to_string(CSS ^ css_line_num) ++ " " ++
+ kind_and_callee_to_string(CSS ^ css_kind) ++ " " ++
+ CSS ^ css_goal_path ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid call_site_static_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = call_site_dynamic(CSDI),
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( valid_call_site_dynamic_ptr(Deep, CSDPtr) ->
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ CSD ^ csd_caller = proc_dynamic_ptr(CallerPDI),
+ CSD ^ csd_callee = proc_dynamic_ptr(CalleePDI),
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(CallerPDI) ++ " -> " ++
+ string__int_to_string(CalleePDI) ++ ": " ++
+ own_to_string(CSD ^ csd_own_prof) ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid call_site_dynamic_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = raw_clique(CI),
+ CliquePtr = clique_ptr(CI),
+ ( valid_clique_ptr(Deep, CliquePtr) ->
+ deep_lookup_clique_parents(Deep, CliquePtr, Parent),
+ Parent = call_site_dynamic_ptr(ParentPDI),
+ ParentStr = format("%d ->", [i(ParentPDI)]),
+ deep_lookup_clique_members(Deep, CliquePtr, Members),
+ HTML =
+ "<HTML>\n" ++
+ ParentStr ++
+ list__foldl(append_pdi_to_string, Members, "") ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid call_site_dynamic_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_proc_dynamics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_pds) ++
+ "</HTML>\n".
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_call_site_dynamics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_csds) ++
+ "</HTML>\n".
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_proc_statics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_pss) ++
+ "</HTML>\n".
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_call_site_statics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_csss) ++
+ "</HTML>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func array_slots_to_html(array(call_site_array_slot)) = string.
+
+array_slots_to_html(SlotArray) = HTML :-
+ array__to_list(SlotArray, SlotList),
+ list__foldl(append_slot_to_string, SlotList, "multi", HTML).
+
+:- pred append_slot_to_string(call_site_array_slot::in,
+ string::in, string::out) is det.
+
+append_slot_to_string(Slot, Str0, Str) :-
+ Str = Str0 ++ " " ++ array_slot_to_html(Slot).
+
+:- func array_slot_to_html(call_site_array_slot) = string.
+
+array_slot_to_html(normal(CSDPtr)) = HTML :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ HTML = "normal " ++ string__int_to_string(CSDI).
+array_slot_to_html(multi(CSDPtrArray)) = HTML :-
+ array__to_list(CSDPtrArray, CSDPtrs),
+ list__foldl(append_csdi_to_string, CSDPtrs, "", CSDI_HTML),
+ list__length(CSDPtrs, CSDPtrCount),
+ HTML = format("multi(%d): [", [i(CSDPtrCount)]) ++ CSDI_HTML ++ "]".
+
+:- pred append_csdi_to_string(call_site_dynamic_ptr::in,
+ string::in, string::out) is det.
+
+append_csdi_to_string(call_site_dynamic_ptr(CSDI), Str0, Str) :-
+ Str = Str0 ++ " " ++ string__int_to_string(CSDI).
+
+:- func append_pdi_to_string(proc_dynamic_ptr, string) = string.
+
+append_pdi_to_string(proc_dynamic_ptr(PDI), Str0) =
+ Str0 ++ " " ++ string__int_to_string(PDI).
+
+%-----------------------------------------------------------------------------%
+
+:- func kind_and_callee_to_string(call_site_kind_and_callee) = string.
+
+kind_and_callee_to_string(normal_call(proc_static_ptr(PSI), TypeSpec)) =
+ "normal " ++ string__int_to_string(PSI) ++ " " ++ TypeSpec.
+kind_and_callee_to_string(special_call) = "special_call".
+kind_and_callee_to_string(higher_order_call) = "higher_order_call".
+kind_and_callee_to_string(method_call) = "method_call".
+kind_and_callee_to_string(callback) = "callback".
+
+:- func present_stats(deep) = string.
+
+present_stats(Deep) = HTML :-
+ Stats = Deep ^ profile_stats,
+ HTML =
+ "<TABLE>\n" ++
+ "<TR><TD ALIGN=left>Quanta in user code:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ user_quanta)]) ++
+ "<TR><TD ALIGN=left>Quanta in instrumentation:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ instrument_quanta)]) ++
+ "<TR><TD ALIGN=left>CallSiteDynamic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_csds)]) ++
+ "<TR><TD ALIGN=left>ProcDynamic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_pds)]) ++
+ "<TR><TD ALIGN=left>CallSiteStatic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_csss)]) ++
+ "<TR><TD ALIGN=left>ProcStatic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_pss)]) ++
+ "<TR><TD ALIGN=left>Cliques:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(array__max(Deep ^ clique_members))]) ++
+ "</TABLE>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func clique_to_html(deep, fields, clique_ptr) = string.
+
+clique_to_html(Deep, Fields, CliquePtr) = HTML :-
+ Ancestors = clique_ancestors_to_html(Deep, Fields, CliquePtr),
+ deep_lookup_clique_members(Deep, CliquePtr, PDPtrs),
+ list__foldl(group_proc_dynamics_by_proc_static(Deep), PDPtrs,
+ map__init, PStoPDsMap),
+ map__to_assoc_list(PStoPDsMap, PStoPDsList0),
+
+ deep_lookup_clique_parents(Deep, CliquePtr, EntryCSDPtr),
+ ( valid_call_site_dynamic_ptr(Deep, EntryCSDPtr) ->
+ deep_lookup_call_site_dynamics(Deep, EntryCSDPtr, EntryCSD),
+ EntryPDPtr = EntryCSD ^ csd_callee,
+ list__filter(proc_group_contains(EntryPDPtr), PStoPDsList0,
+ EntryGroup, RestGroup),
+ list__append(EntryGroup, RestGroup, PStoPDsList)
+ ;
+ PStoPDsList = PStoPDsList0
+ ),
+
+ PDsStrs = list__map(procs_in_clique_to_html(Deep, Fields, CliquePtr),
+ PStoPDsList),
+ string__append_list(PDsStrs, ProcGroups),
+ HTML =
+ Ancestors ++
+ "<a name=""after_ancestors"">\n" ++
+ ProcGroups.
+
+:- pred proc_group_contains(proc_dynamic_ptr::in,
+ pair(proc_static_ptr, list(proc_dynamic_ptr))::in) is semidet.
+
+proc_group_contains(EntryPDPtr, _ - PDPtrs) :-
+ list__member(EntryPDPtr, PDPtrs).
+
+:- func clique_ancestors_to_html(deep, fields, clique_ptr) = string.
+
+clique_ancestors_to_html(Deep, Fields, CliquePtr) = HTML :-
+ deep_lookup_clique_index(Deep, Deep ^ root, RootCliquePtr),
+ ( CliquePtr = RootCliquePtr ->
+ HTML = ""
+ ;
+ deep_lookup_clique_parents(Deep, CliquePtr, EntryCSDPtr),
+ ThisHTML = call_site_dynamic_to_html(Deep, Fields,
+ call_site_line_number, no, EntryCSDPtr),
+ deep_lookup_call_site_dynamics(Deep, EntryCSDPtr, EntryCSD),
+ EntryCSD = call_site_dynamic(EntryPDPtr, _, _),
+ require(valid_proc_dynamic_ptr(Deep, EntryPDPtr),
+ "clique_ancestors_to_html: invalid proc_dynamic"),
+ deep_lookup_clique_index(Deep, EntryPDPtr, EntryCliquePtr),
+ AncestorHTML = clique_ancestors_to_html(Deep, Fields,
+ EntryCliquePtr),
+ HTML =
+ AncestorHTML ++
+ ThisHTML
+ ).
+
+:- pred group_proc_dynamics_by_proc_static(deep::in, proc_dynamic_ptr::in,
+ map(proc_static_ptr, list(proc_dynamic_ptr))::in,
+ map(proc_static_ptr, list(proc_dynamic_ptr))::out) is det.
+
+group_proc_dynamics_by_proc_static(Deep, PDPtr, PStoPDsMap0, PStoPDsMap) :-
+ require(valid_proc_dynamic_ptr(Deep, PDPtr),
+ "group_proc_dynamics_by_proc_static: invalid PDPtr"),
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ ( map__search(PStoPDsMap0, PSPtr, PSPDs0) ->
+ PSPDs = [PDPtr | PSPDs0],
+ map__det_update(PStoPDsMap0, PSPtr, PSPDs, PStoPDsMap)
+ ;
+ map__det_insert(PStoPDsMap0, PSPtr, [PDPtr], PStoPDsMap)
+ ).
+
+:- func procs_in_clique_to_html(deep, fields, clique_ptr,
+ pair(proc_static_ptr, list(proc_dynamic_ptr))) = string.
+
+procs_in_clique_to_html(Deep, Fields, CliquePtr, PSPtr - PDPtrs) = HTML :-
+ ( PDPtrs = [] ->
+ HTML = ""
+ ; PDPtrs = [PDPtr] ->
+ HTML = proc_in_clique_to_html(Deep, Fields, CliquePtr, PDPtr)
+ ;
+ Separator = separator_row(Fields),
+ list__map(deep_lookup_pd_own(Deep), PDPtrs, ProcOwns),
+ list__map(deep_lookup_pd_desc(Deep), PDPtrs, ProcDescs),
+ ProcOwn = sum_own_infos(ProcOwns),
+ ProcDesc = sum_inherit_infos(ProcDescs),
+ ProcTotal = proc_total_in_clique(Deep, Fields,
+ PSPtr, no, ProcOwn, ProcDesc),
+ ComponentHTMLs = list__map(proc_in_clique_to_html(Deep, Fields,
+ CliquePtr), PDPtrs),
+ string__append_list(ComponentHTMLs, ComponentHTML),
+ HTML =
+ Separator ++
+ ProcTotal ++
+ Separator ++
+ ComponentHTML
+ ).
+
+:- func proc_in_clique_to_html(deep, fields, clique_ptr, proc_dynamic_ptr)
+ = string.
+
+proc_in_clique_to_html(Deep, Fields, CliquePtr, PDPtr) = HTML :-
+ ( valid_proc_dynamic_ptr(Deep, PDPtr) ->
+ InitialSeparator = separator_row(Fields),
+ deep_lookup_pd_own(Deep, PDPtr, ProcOwn),
+ deep_lookup_pd_desc(Deep, PDPtr, ProcDesc),
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PD = proc_dynamic(PSPtr, _),
+ ProcTotal = proc_total_in_clique(Deep, Fields,
+ PSPtr, yes, ProcOwn, ProcDesc),
+ child_call_sites(Deep ^ proc_dynamics, Deep ^ proc_statics,
+ PDPtr, GroupPairs),
+ list__foldl(call_site_group_to_html(Deep, Fields, CliquePtr),
+ GroupPairs, map__init, GroupMap),
+ map__to_assoc_list(GroupMap, GroupPairLists),
+ assoc_list__values(GroupPairLists, GroupLists),
+ list__condense(GroupLists, GroupList),
+ string__append_list(GroupList, GroupStr0),
+ ( GroupList = [] ->
+ GroupStr = GroupStr0
+ ;
+ GroupStr = separator_row(Fields) ++ GroupStr0
+ ),
+ HTML =
+ InitialSeparator ++
+ ProcTotal ++
+ GroupStr
+ ;
+ HTML = ""
+ ).
+
+:- pred child_call_sites(proc_dynamics::in, proc_statics::in,
+ proc_dynamic_ptr::in,
+ assoc_list(call_site_static_ptr, call_site_array_slot)::out) is det.
+
+child_call_sites(ProcDynamics, ProcStatics, PDPtr, PairedSlots) :-
+ lookup_proc_dynamics(ProcDynamics, PDPtr, PD),
+ PD = proc_dynamic(PSPtr, CSDArray),
+ lookup_proc_statics(ProcStatics, PSPtr, PS),
+ CSSArray = PS ^ ps_sites,
+ array__to_list(CSDArray, CSDSlots),
+ array__to_list(CSSArray, CSSSlots),
+ assoc_list__from_corresponding_lists(CSSSlots, CSDSlots, PairedSlots).
+
+:- func proc_total_in_clique(deep, fields, proc_static_ptr, bool,
+ own_prof_info, inherit_prof_info) = string.
+
+proc_total_in_clique(Deep, Fields, PSPtr, Only, Own, Desc) = HTML :-
+ ProcName = proc_static_to_html_ref(Deep, Fields, PSPtr),
+ (
+ Only = no,
+ OnlyStr = "summary "
+ ;
+ Only = yes,
+ OnlyStr = ""
+ ),
+ HTML =
+ "<TR>\n" ++
+ format("<TD COLSPAN=2><B>%s%s</B></TD>\n",
+ [s(OnlyStr), s(ProcName)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+:- pred call_site_group_to_html(deep::in, fields::in,
+ clique_ptr::in, pair(call_site_static_ptr, call_site_array_slot)::in,
+ map(pair(string, int), list(string))::in,
+ map(pair(string, int), list(string))::out) is det.
+
+call_site_group_to_html(Deep, Fields, ThisCliquePtr, Pair,
+ GroupMap0, GroupMap) :-
+ Pair = CSSPtr - CallSiteArray,
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ CSS = call_site_static(PSPtr, _SlotNum, Kind, LineNumber, _GoalPath),
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ FileName = PS ^ ps_filename,
+ ( Kind = normal_call(_CalleePSPtr, _) ->
+ ( CallSiteArray = normal(CSDPtr0) ->
+ CSDPtr = CSDPtr0
+ ;
+ error("call_site_group_to_html: normal_call error")
+ ),
+ HTML = maybe_call_site_dynamic_to_html(Deep, Fields,
+ call_site_line_number, ThisCliquePtr, CSDPtr)
+ ;
+ ( CallSiteArray = multi(CSDPtrs0) ->
+ array__to_list(CSDPtrs0, CSDPtrs)
+ ;
+ error("call_site_group_to_html: non-normal_call error")
+ ),
+ Tuple0 = { "", zero_own_prof_info, zero_inherit_prof_info },
+ Tuple = list__foldl(call_site_array_to_html(Deep, Fields,
+ no_call_site_line_number, ThisCliquePtr),
+ CSDPtrs, Tuple0),
+ Tuple = { GroupHTML, SumOwn, SumDesc },
+ CallSiteName0 = call_site_kind_and_callee_to_html(Kind),
+ ( GroupHTML = "" ->
+ CallSiteName = CallSiteName0 ++ " (no calls made)"
+ ;
+ CallSiteName = CallSiteName0
+ ),
+ HTML =
+ "<TR>\n" ++
+ format("<TD>%s:%d</TD>\n",
+ [s(FileName), i(LineNumber)]) ++
+ format("<TD>%s</TD>\n", [s(CallSiteName)]) ++
+ own_and_desc_to_html(SumOwn, SumDesc, Deep, Fields) ++
+ "</TR>\n" ++
+ GroupHTML
+ ),
+ Key = FileName - LineNumber,
+ ( map__search(GroupMap0, Key, HTMLs0) ->
+ map__det_update(GroupMap0, Key, [HTML | HTMLs0], GroupMap)
+ ;
+ map__det_insert(GroupMap0, Key, [HTML], GroupMap)
+ ).
+
+:- func call_site_array_to_html(deep, fields, call_site_line_number,
+ clique_ptr, call_site_dynamic_ptr,
+ {string, own_prof_info, inherit_prof_info}) =
+ {string, own_prof_info, inherit_prof_info}.
+
+call_site_array_to_html(Deep, Fields, PrintCallSiteLineNmber,
+ ThisCliquePtr, CSDPtr, Tuple0) = Tuple :-
+ ( valid_call_site_dynamic_ptr(Deep, CSDPtr) ->
+ Tuple0 = { HTML0, Own0, Desc0 },
+ HTML1 = call_site_dynamic_to_html(Deep, Fields,
+ PrintCallSiteLineNmber, yes(ThisCliquePtr), CSDPtr),
+ string__append(HTML0, HTML1, HTML),
+ deep_lookup_csd_own(Deep, CSDPtr, CallSiteOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CallSiteDesc),
+ Own = add_own_to_own(Own0, CallSiteOwn),
+ Desc = add_inherit_to_inherit(Desc0, CallSiteDesc),
+ Tuple = { HTML, Own, Desc }
+ ;
+ Tuple = Tuple0
+ ).
+
+:- pred process_call_site_dynamics_group(list(call_site_dynamic_ptr)::in,
+ deep::in, proc_static_ptr::in,
+ maybe(clique_ptr)::in, maybe(clique_ptr)::out,
+ own_prof_info::in, own_prof_info::out,
+ inherit_prof_info::in, inherit_prof_info::out) is det.
+
+process_call_site_dynamics_group([], _, _, MaybeToCliquePtr, MaybeToCliquePtr,
+ Own, Own, Desc, Desc).
+process_call_site_dynamics_group([CSDPtr | CSDPtrs], Deep, CalleePSPtr,
+ MaybeToCliquePtr0, MaybeToCliquePtr, Own0, Own, Desc0, Desc) :-
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ PDPtr = CSD ^ csd_callee,
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ require(unify(CalleePSPtr, PSPtr),
+ "process_call_site_dynamics_group: callee mismatch"),
+ deep_lookup_clique_index(Deep, PDPtr, ToCliquePtr),
+ (
+ MaybeToCliquePtr0 = no,
+ MaybeToCliquePtr1 = yes(ToCliquePtr)
+ ;
+ MaybeToCliquePtr0 = yes(PrevToCliquePtr),
+ MaybeToCliquePtr1 = MaybeToCliquePtr0,
+ require(unify(PrevToCliquePtr, ToCliquePtr),
+ "process_call_site_dynamics_group: clique mismatch")
+ ),
+ deep_lookup_csd_own(Deep, CSDPtr, CSDOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CSDDesc),
+ Own1 = add_own_to_own(Own0, CSDOwn),
+ Desc1 = add_inherit_to_inherit(Desc0, CSDDesc),
+ process_call_site_dynamics_group(CSDPtrs, Deep, CalleePSPtr,
+ MaybeToCliquePtr1, MaybeToCliquePtr, Own1, Own, Desc1, Desc).
+
+:- func call_site_dynamics_to_html(deep, fields, maybe(pair(string, int)),
+ clique_ptr, clique_ptr, proc_static_ptr,
+ own_prof_info, inherit_prof_info) = string.
+
+call_site_dynamics_to_html(Deep, Fields, MaybeFileNameLineNumber,
+ ThisCliquePtr, ToCliquePtr, PSPtr, Own, Desc) = HTML :-
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ CalleeName = PS ^ ps_refined_id,
+ ( ThisCliquePtr = ToCliquePtr ->
+ % We don't link recursive calls
+ ProcName = CalleeName
+ ;
+ ToCliquePtr = clique_ptr(ToCliqueNum),
+ ToCliqueURL = deep_cmd_to_url(Deep,
+ clique(ToCliqueNum, Fields)),
+ ProcName =
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(ToCliqueURL), s(CalleeName)])
+ ),
+ ( MaybeFileNameLineNumber = yes(FileName - LineNumber) ->
+ SourceField =
+ format("<TD>%s:%d</TD>\n",
+ [s(FileName), i(LineNumber)])
+ ;
+ SourceField = "<TD> </TD>\n"
+ ),
+ HTML =
+ "<TR>\n" ++
+ SourceField ++
+ format("<TD>%s</TD>\n", [s(ProcName)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+:- func maybe_call_site_dynamic_to_html(deep, fields, call_site_line_number,
+ clique_ptr, call_site_dynamic_ptr) = string.
+
+maybe_call_site_dynamic_to_html(Deep, Fields, PrintCallSiteLineNmber,
+ ThisCliquePtr, CSDPtr) = HTML :-
+ ( valid_call_site_dynamic_ptr(Deep, CSDPtr) ->
+ HTML = call_site_dynamic_to_html(Deep, Fields,
+ PrintCallSiteLineNmber, yes(ThisCliquePtr), CSDPtr)
+ ;
+ HTML = ""
+ ).
+
+:- func call_site_dynamic_to_html(deep, fields, call_site_line_number,
+ maybe(clique_ptr), call_site_dynamic_ptr) = string.
+
+call_site_dynamic_to_html(Deep, Fields, PrintCallSiteLineNmber,
+ MaybeThisCliquePtr, CSDPtr) = HTML :-
+ require(valid_call_site_dynamic_ptr(Deep, CSDPtr),
+ "call_site_dynamic_to_html: invalid call_site_dynamic_ptr"),
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ CSD = call_site_dynamic(_FromPtr, ToProcPtr, CallSiteOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CallSiteDesc),
+ ( valid_proc_dynamic_ptr(Deep, ToProcPtr) ->
+ deep_lookup_clique_index(Deep, ToProcPtr, ToCliquePtr),
+ CalleeName = call_site_dynamic_label(Deep, CSDPtr),
+ (
+ MaybeThisCliquePtr = yes(ThisCliquePtr),
+ ThisCliquePtr = ToCliquePtr
+ ->
+ % We don't link recursive calls
+ ProcName = CalleeName
+ ;
+ ToCliquePtr = clique_ptr(ToCliqueNum),
+ ToCliqueURL = deep_cmd_to_url(Deep,
+ clique(ToCliqueNum, Fields)),
+ ProcName =
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(ToCliqueURL), s(CalleeName)])
+ )
+ ;
+ ProcName = "builtin special procedure"
+ ),
+ ( PrintCallSiteLineNmber = call_site_line_number ->
+ deep_lookup_call_site_static_map(Deep, CSDPtr, CSSPtr),
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ CSS = call_site_static(PSPtr, _, _, LineNumber, _),
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ SourceField =
+ format("<TD>%s:%d</TD>\n",
+ [s(PS ^ ps_filename), i(LineNumber)])
+ ;
+ SourceField = "<TD> </TD>\n"
+ ),
+ HTML =
+ "<TR>\n" ++
+ SourceField ++
+ format("<TD>%s</TD>\n", [s(ProcName)]) ++
+ own_and_desc_to_html(CallSiteOwn, CallSiteDesc,
+ Deep, Fields) ++
+ "</TR>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func proc_summary_to_html(deep, string, int) = string.
+
+proc_summary_to_html(Deep, Fields, PSI) = HTML :-
+ deep_lookup_proc_statics(Deep, proc_static_ptr(PSI), PS),
+ CSSPtrsArray = PS ^ ps_sites,
+ array__to_list(CSSPtrsArray, CSSPtrs),
+ CallSiteSummaryList =
+ list__map(call_site_summary_to_html(Deep, Fields), CSSPtrs),
+ string__append_list(CallSiteSummaryList, CallSiteSummaries),
+ HTML =
+ proc_total_summary_to_html(Deep, Fields, PSI) ++
+ CallSiteSummaries.
+
+:- func proc_total_summary_to_html(deep, string, int) = string.
+
+proc_total_summary_to_html(Deep, Fields, PSI) = HTML :-
+ PSPtr = proc_static_ptr(PSI),
+ deep_lookup_ps_own(Deep, PSPtr, Own),
+ deep_lookup_ps_desc(Deep, PSPtr, Desc),
+ HTML =
+ "<TR>\n" ++
+ format("<TD COLSPAN=2>%s</TD>\n",
+ [s(proc_static_to_html_ref(Deep, Fields,
+ proc_static_ptr(PSI)))]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func call_site_summary_to_html(deep, string, call_site_static_ptr) = string.
+
+call_site_summary_to_html(Deep, Fields, CSSPtr) = HTML :-
+ deep_lookup_css_own(Deep, CSSPtr, Own),
+ deep_lookup_css_desc(Deep, CSSPtr, Desc),
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ CSS = call_site_static(PSPtr, _, Kind, LineNumber, _GoalPath),
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ FileName = PS ^ ps_filename,
+ deep_lookup_call_site_calls(Deep, CSSPtr, CallSiteCallMap),
+ map__to_assoc_list(CallSiteCallMap, CallSiteCallList),
+ ( Kind = normal_call(CalleePSPtr, _) ->
+ ( CallSiteCallList = [] ->
+ deep_lookup_proc_statics(Deep, CalleePSPtr, CalleePS)
+ ; CallSiteCallList = [CallSiteCall] ->
+ CallSiteCall = CalleePSPtr2 - _CallSet,
+ require(unify(CalleePSPtr, CalleePSPtr2),
+ "call_site_summary_to_html: callee mismatch"),
+ deep_lookup_proc_statics(Deep, CalleePSPtr, CalleePS)
+ ;
+ error("normal call site calls more than one procedure")
+ ),
+ MainLineRest =
+ format("<TD>%s</TD>\n",
+ [s(CalleePS ^ ps_refined_id)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields),
+ AdditionalLines = ""
+ ;
+ CallSiteName0 = call_site_kind_and_callee_to_html(Kind),
+ ( CallSiteCallList = [] ->
+ CallSiteName = CallSiteName0 ++
+ " (no&nbps;calls&nbps;made)"
+ ;
+ CallSiteName = CallSiteName0
+ ),
+ MainLineRest =
+ format("<TD>%s</TD>\n",
+ [s(CallSiteName)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields),
+ CallSiteCallLines = list__map(
+ call_site_summary_group_to_html(Deep, Fields),
+ CallSiteCallList),
+ string__append_list(CallSiteCallLines, AdditionalLines)
+ ),
+ HTML =
+ "<TR>\n" ++
+ format("<TD>%s:%d</TD>\n", [s(FileName), i(LineNumber)]) ++
+ MainLineRest ++
+ "</TR>\n" ++
+ AdditionalLines.
+
+:- func call_site_kind_and_callee_to_html(call_site_kind_and_callee) = string.
+
+call_site_kind_and_callee_to_html(normal_call(_, _)) = "normal_call".
+call_site_kind_and_callee_to_html(special_call) = "special_call".
+call_site_kind_and_callee_to_html(higher_order_call) = "higher_order_call".
+call_site_kind_and_callee_to_html(method_call) = "method_call".
+call_site_kind_and_callee_to_html(callback) = "callback".
+
+:- func call_site_summary_group_to_html(deep, string,
+ pair(proc_static_ptr, list(call_site_dynamic_ptr))) = string.
+
+call_site_summary_group_to_html(Deep, Fields, PSPtr - CSDPtrs) = HTML :-
+ list__foldl2(accumulate_csd_prof_info(Deep), CSDPtrs,
+ zero_own_prof_info, Own, zero_inherit_prof_info, Desc),
+ HTML =
+ "<TR>\n" ++
+ format("<TD></TD><TD>%s</TD>\n",
+ [s(proc_static_to_html_ref(Deep, Fields, PSPtr))]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+:- pred accumulate_csd_prof_info(deep::in, call_site_dynamic_ptr::in,
+ own_prof_info::in, own_prof_info::out,
+ inherit_prof_info::in, inherit_prof_info::out) is det.
+
+accumulate_csd_prof_info(Deep, CSDPtr, Own0, Own, Desc0, Desc) :-
+ deep_lookup_csd_own(Deep, CSDPtr, CSDOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CSDDesc),
+
+ add_own_to_own(Own0, CSDOwn) = Own,
+ add_inherit_to_inherit(Desc0, CSDDesc) = Desc.
+
+%-----------------------------------------------------------------------------%
+
+:- func call_site_dynamic_label(deep, call_site_dynamic_ptr) = string.
+
+call_site_dynamic_label(Deep, CSDPtr) = Name :-
+ (
+ valid_call_site_dynamic_ptr(Deep, CSDPtr),
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ CSD = call_site_dynamic(_, PDPtr, _),
+ valid_proc_dynamic_ptr(Deep, PDPtr),
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PD = proc_dynamic(PSPtr, _),
+ valid_proc_static_ptr(Deep, PSPtr),
+ deep_lookup_proc_statics(Deep, PSPtr, PS)
+ ->
+ Name = PS ^ ps_refined_id
+ ;
+ Name = "unknown procedure"
+ ).
+
+:- func proc_static_to_html_ref(deep, string, proc_static_ptr) = string.
+
+proc_static_to_html_ref(Deep, Fields, PSPtr) = HTML :-
+ ( valid_proc_static_ptr(Deep, PSPtr) ->
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ PSPtr = proc_static_ptr(PSI),
+ PSURL = deep_cmd_to_url(Deep, proc(PSI, Fields)),
+ HTML = format("<A HREF=""%s"">%s</A>\n",
+ [s(PSURL), s(PS ^ ps_refined_id)])
+ ;
+ HTML =
+ "mercury_runtime"
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func quantum_time(int) = string.
+
+quantum_time(Quanta) = TimeStr :-
+ Time = Quanta * 10, % a quantum is 10 milliseconds on our machines
+ format("%d", [i(Time)], Str0),
+ string__to_char_list(Str0, Chars0),
+ reverse(Chars0, RevChars0),
+ string__from_char_list(reverse(
+ milliseconds_to_seconds(RevChars0)), TimeStr).
+
+:- func commas(int) = string.
+
+commas(Num) = Str :-
+ format("%d", [i(Num)], Str0),
+ string__to_char_list(Str0, Chars0),
+ reverse(Chars0, RevChars0),
+ string__from_char_list(reverse(add_commas(RevChars0)), Str).
+
+:- func milliseconds_to_seconds(list(char)) = list(char).
+
+milliseconds_to_seconds([]) = ['0', '0', '.', '0'].
+milliseconds_to_seconds([_C]) = ['0', '0', '.', '0'].
+milliseconds_to_seconds([_C, D]) = [D, '0', '.', '0'].
+milliseconds_to_seconds([_C, D, E]) = [D, E, '.', '0'].
+milliseconds_to_seconds([_C, D, E, F | R]) = [D, E, '.' | add_commas([F | R])].
+
+:- func add_commas(list(char)) = list(char).
+
+add_commas([]) = [].
+add_commas([C]) = [C].
+add_commas([C, D]) = [C, D].
+add_commas([C, D, E]) = [C, D, E].
+add_commas([C, D, E, F | R]) = [C, D, E, (',') | add_commas([F | R])].
+
+%-----------------------------------------------------------------------------%
+
+:- pred show_port_counts(fields::in) is semidet.
+
+show_port_counts(Fields) :-
+ string__contains_char(Fields, 'p').
+
+:- pred show_quanta(fields::in) is semidet.
+
+show_quanta(Fields) :-
+ string__contains_char(Fields, 'q').
+
+:- pred show_times(fields::in) is semidet.
+
+show_times(Fields) :-
+ string__contains_char(Fields, 't').
+
+:- pred show_allocs(fields::in) is semidet.
+
+show_allocs(Fields) :-
+ string__contains_char(Fields, 'a').
+
+:- pred show_words(fields::in) is semidet.
+
+show_words(Fields) :-
+ string__contains_char(Fields, 'w').
+
+%-----------------------------------------------------------------------------%
+
+:- pred find_top_procs(sort_measurement::in, include_descendants::in,
+ display_limit::in, deep::in, maybe_error(list(int))::out) is det.
+
+find_top_procs(Sort, InclDesc, Limit, Deep, MaybeTopPSIs) :-
+ find_top_sort_predicate(Sort, InclDesc, SortCompatible, RawSortPred),
+ (
+ SortCompatible = no,
+ MaybeTopPSIs = error("bad sort specification")
+ ;
+ SortCompatible = yes,
+ ProcStatics = Deep ^ proc_statics,
+ array__max(ProcStatics, MaxProcStatic),
+ PSIs = int_list_from_to(1, MaxProcStatic),
+ SortPred = (pred(PSI1::in, PSI2::in, ComparisonResult::out)
+ is det :-
+ call(RawSortPred, Deep, PSI1, PSI2, ComparisonResult)
+ ),
+ list__sort(SortPred, PSIs, AscendingPSIs),
+ list__reverse(AscendingPSIs, DescendingPSIs),
+ (
+ Limit = rank_range(First, Last),
+ (
+ list__drop(First - 1, DescendingPSIs,
+ RemainingPSIs)
+ ->
+ list__take_upto(Last - First + 1,
+ RemainingPSIs, TopPSIs),
+ MaybeTopPSIs = ok(TopPSIs)
+ ;
+ MaybeTopPSIs = ok([])
+ )
+ ;
+ Limit = threshold(Threshold),
+ find_threshold_predicate(Sort, InclDesc,
+ ThresholdCompatible, RawThresholdPred),
+ (
+ ThresholdCompatible = no,
+ MaybeTopPSIs =
+ error("bad threshold specification")
+ ;
+ ThresholdCompatible = yes,
+ ThresholdPred = (pred(PSI::in) is semidet :-
+ call(RawThresholdPred, Deep, Threshold,
+ PSI)
+ ),
+ list__takewhile(ThresholdPred, DescendingPSIs,
+ TopPSIs, _),
+ MaybeTopPSIs = ok(TopPSIs)
+ )
+ )
+ ).
+
+:- func int_list_from_to(int, int) = list(int).
+
+int_list_from_to(From, To) = List :-
+ ( From > To ->
+ List = []
+ ;
+ List = [From | int_list_from_to(From + 1, To)]
+ ).
+
+:- pred find_top_sort_predicate(sort_measurement, include_descendants,
+ bool, pred(deep, int, int, comparison_result)).
+:- mode find_top_sort_predicate(in, in, out, out(pred(in, in, in, out) is det))
+ is det.
+
+find_top_sort_predicate(calls, self, yes, compare_ps_calls_self).
+find_top_sort_predicate(calls, self_and_desc, no, compare_ps_calls_self).
+find_top_sort_predicate(time, self, yes, compare_ps_time_self).
+find_top_sort_predicate(time, self_and_desc, yes, compare_ps_time_both).
+find_top_sort_predicate(allocs, self, yes, compare_ps_allocs_self).
+find_top_sort_predicate(allocs, self_and_desc, yes, compare_ps_allocs_both).
+find_top_sort_predicate(words, self, yes, compare_ps_words_self).
+find_top_sort_predicate(words, self_and_desc, yes, compare_ps_words_both).
+
+:- pred find_threshold_predicate(sort_measurement, include_descendants,
+ bool, pred(deep, float, int)).
+:- mode find_threshold_predicate(in, in, out, out(pred(in, in, in) is semidet))
+ is det.
+
+find_threshold_predicate(calls, self, no, threshold_ps_time_self).
+find_threshold_predicate(calls, self_and_desc, no, threshold_ps_time_self).
+find_threshold_predicate(time, self, yes, threshold_ps_time_self).
+find_threshold_predicate(time, self_and_desc, yes, threshold_ps_time_both).
+find_threshold_predicate(allocs, self, yes, threshold_ps_allocs_self).
+find_threshold_predicate(allocs, self_and_desc, yes, threshold_ps_allocs_both).
+find_threshold_predicate(words, self, yes, threshold_ps_words_self).
+find_threshold_predicate(words, self_and_desc, yes, threshold_ps_words_both).
+
+:- pred compare_ps_calls_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_calls_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnCalls1 = calls(Own1),
+ OwnCalls2 = calls(Own2),
+ compare(Result, OwnCalls1, OwnCalls2).
+
+:- pred compare_ps_time_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_time_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnQuanta1 = quanta(Own1),
+ OwnQuanta2 = quanta(Own2),
+ compare(Result, OwnQuanta1, OwnQuanta2).
+
+:- pred compare_ps_time_both(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_time_both(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ array__lookup(PSDesc, PSI1, Desc1),
+ array__lookup(PSDesc, PSI2, Desc2),
+ OwnQuanta1 = quanta(Own1),
+ OwnQuanta2 = quanta(Own2),
+ DescQuanta1 = inherit_quanta(Desc1),
+ DescQuanta2 = inherit_quanta(Desc2),
+ TotalQuanta1 = OwnQuanta1 + DescQuanta1,
+ TotalQuanta2 = OwnQuanta2 + DescQuanta2,
+ compare(Result, TotalQuanta1, TotalQuanta2).
+
+:- pred compare_ps_allocs_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_allocs_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnAllocs1 = mallocs(Own1),
+ OwnAllocs2 = mallocs(Own2),
+ compare(Result, OwnAllocs1, OwnAllocs2).
+
+:- pred compare_ps_allocs_both(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_allocs_both(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ array__lookup(PSDesc, PSI1, Desc1),
+ array__lookup(PSDesc, PSI2, Desc2),
+ OwnAllocs1 = mallocs(Own1),
+ OwnAllocs2 = mallocs(Own2),
+ DescAllocs1 = inherit_mallocs(Desc1),
+ DescAllocs2 = inherit_mallocs(Desc2),
+ TotalAllocs1 = OwnAllocs1 + DescAllocs1,
+ TotalAllocs2 = OwnAllocs2 + DescAllocs2,
+ compare(Result, TotalAllocs1, TotalAllocs2).
+
+:- pred compare_ps_words_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_words_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnWords1 = words(Own1),
+ OwnWords2 = words(Own2),
+ compare(Result, OwnWords1, OwnWords2).
+
+:- pred compare_ps_words_both(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_words_both(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ array__lookup(PSDesc, PSI1, Desc1),
+ array__lookup(PSDesc, PSI2, Desc2),
+ OwnWords1 = words(Own1),
+ OwnWords2 = words(Own2),
+ DescWords1 = inherit_words(Desc1),
+ DescWords2 = inherit_words(Desc2),
+ TotalWords1 = OwnWords1 + DescWords1,
+ TotalWords2 = OwnWords2 + DescWords2,
+ compare(Result, TotalWords1, TotalWords2).
+
+:- pred threshold_ps_time_self(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_time_self(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI, Own),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnQuanta = quanta(Own),
+ RootOwnQuanta = quanta(RootOwn),
+ RootDescQuanta = inherit_quanta(RootDesc),
+ RootTotalQuanta = RootOwnQuanta + RootDescQuanta,
+ 100.0 * float(OwnQuanta) > Threshold * float(RootTotalQuanta).
+
+:- pred threshold_ps_time_both(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_time_both(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI, Own),
+ array__lookup(PSDesc, PSI, Desc),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnQuanta = quanta(Own),
+ RootOwnQuanta = quanta(RootOwn),
+ DescQuanta = inherit_quanta(Desc),
+ RootDescQuanta = inherit_quanta(RootDesc),
+ TotalQuanta = OwnQuanta + DescQuanta,
+ RootTotalQuanta = RootOwnQuanta + RootDescQuanta,
+ 100.0 * float(TotalQuanta) > Threshold * float(RootTotalQuanta).
+
+:- pred threshold_ps_allocs_self(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_allocs_self(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI, Own),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnAllocs = mallocs(Own),
+ RootOwnAllocs = mallocs(RootOwn),
+ RootDescAllocs = inherit_mallocs(RootDesc),
+ RootTotalAllocs = RootOwnAllocs + RootDescAllocs,
+ 100.0 * float(OwnAllocs) > Threshold * float(RootTotalAllocs).
+
+:- pred threshold_ps_allocs_both(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_allocs_both(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI, Own),
+ array__lookup(PSDesc, PSI, Desc),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnAllocs = mallocs(Own),
+ RootOwnAllocs = mallocs(RootOwn),
+ DescAllocs = inherit_mallocs(Desc),
+ RootDescAllocs = inherit_mallocs(RootDesc),
+ TotalAllocs = OwnAllocs + DescAllocs,
+ RootTotalAllocs = RootOwnAllocs + RootDescAllocs,
+ 100.0 * float(TotalAllocs) > Threshold * float(RootTotalAllocs).
+
+:- pred threshold_ps_words_self(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_words_self(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI, Own),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnWords = words(Own),
+ RootOwnWords = words(RootOwn),
+ RootDescWords = inherit_words(RootDesc),
+ RootTotalWords = RootOwnWords + RootDescWords,
+ 100.0 * float(OwnWords) > Threshold * float(RootTotalWords).
+
+:- pred threshold_ps_words_both(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_words_both(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI, Own),
+ array__lookup(PSDesc, PSI, Desc),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnWords = words(Own),
+ RootOwnWords = words(RootOwn),
+ DescWords = inherit_words(Desc),
+ RootDescWords = inherit_words(RootDesc),
+ TotalWords = OwnWords + DescWords,
+ RootTotalWords = RootOwnWords + RootDescWords,
+ 100.0 * float(TotalWords) > Threshold * float(RootTotalWords).
+
+%-----------------------------------------------------------------------------%
+
+:- func banner = string.
+
+banner =
+ "<HTML>\n" ++
+ "<TITLE>The University of Melbourne Mercury Deep Profiler.</TITLE>\n".
+
+:- func footer(cmd, deep) = string.
+
+footer(Cmd, Deep) = HTML :-
+ % Link back to root,
+ % Search, etc, etc.
+ HTML =
+ footer_field_select(Cmd, Deep) ++
+ "<p>\n" ++
+ format("<A HREF=""%s"">Menu</A>\n",
+ [s(deep_cmd_to_url(Deep, menu))]) ++
+ format("<A HREF=""%s"">Quit</A>\n",
+ [s(deep_cmd_to_url(Deep, quit))]) ++
+ "</HTML>\n".
+
+:- func footer_field_select(cmd, deep) = string.
+
+footer_field_select(quit, _) = "".
+footer_field_select(timeout(_), _) = "".
+footer_field_select(menu, _) = "".
+footer_field_select(root(Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = root(ArgFields) :- true).
+footer_field_select(clique(CI, Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = clique(CI, ArgFields) :- true).
+footer_field_select(proc(PSI, Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = proc(PSI, ArgFields) :- true).
+footer_field_select(top_procs(Sort, InclDesc, Limit, Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = top_procs(Sort, InclDesc, Limit, ArgFields)
+ :- true).
+footer_field_select(proc_static(_), _) = "".
+footer_field_select(proc_dynamic(_), _) = "".
+footer_field_select(call_site_static(_), _) = "".
+footer_field_select(call_site_dynamic(_), _) = "".
+footer_field_select(raw_clique(_), _) = "".
+footer_field_select(num_proc_statics, _) = "".
+footer_field_select(num_call_site_statics, _) = "".
+footer_field_select(num_proc_dynamics, _) = "".
+footer_field_select(num_call_site_dynamics, _) = "".
+
+:- func footer_field_toggle(deep, string, func(string) = cmd) = string.
+
+footer_field_toggle(Deep, Fields, MakeCmd) = HTML :-
+ FieldsChars = string__to_char_list(Fields),
+ ( show_port_counts(Fields) ->
+ PortChars = list__delete_all(FieldsChars, 'p'),
+ PortMsg = "Don't show port counts"
+ ;
+ PortChars = ['p' | FieldsChars],
+ PortMsg = "Show port counts"
+ ),
+ ( show_quanta(Fields) ->
+ QuantaChars = list__delete_all(FieldsChars, 'q'),
+ QuantaMsg = "Don't show quanta"
+ ;
+ QuantaChars = ['q' | FieldsChars],
+ QuantaMsg = "Show quanta"
+ ),
+ ( show_times(Fields) ->
+ TimesChars = list__delete_all(FieldsChars, 't'),
+ TimesMsg = "Don't show time"
+ ;
+ TimesChars = ['t' | FieldsChars],
+ TimesMsg = "Show time"
+ ),
+ ( show_allocs(Fields) ->
+ AllocsChars = list__delete_all(FieldsChars, 'a'),
+ AllocsMsg = "Don't show allocations"
+ ;
+ AllocsChars = ['a' | FieldsChars],
+ AllocsMsg = "Show allocations"
+ ),
+ ( show_words(Fields) ->
+ WordsChars = list__delete_all(FieldsChars, 'w'),
+ WordsMsg = "Don't show words"
+ ;
+ WordsChars = ['w' | FieldsChars],
+ WordsMsg = "Show words"
+ ),
+ CmdPort = MakeCmd(string__from_char_list(list__sort(PortChars))),
+ CmdQuanta = MakeCmd(string__from_char_list(list__sort(QuantaChars))),
+ CmdTimes = MakeCmd(string__from_char_list(list__sort(TimesChars))),
+ CmdAllocs = MakeCmd(string__from_char_list(list__sort(AllocsChars))),
+ CmdWords = MakeCmd(string__from_char_list(list__sort(WordsChars))),
+ HTML =
+ "<p>\n" ++
+ "Toggle fields: " ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdPort)), s(PortMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdQuanta)), s(QuantaMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdTimes)), s(TimesMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdAllocs)), s(AllocsMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdWords)), s(WordsMsg)]).
+
+:- func menu_text = string.
+
+menu_text =
+ "You can start exploring the deep profile at the following points.\n".
+
+:- func menu_item(deep, cmd, string) = string.
+
+menu_item(Deep, Cmd, Text) =
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, Cmd)), s(Text)]).
+
+%-----------------------------------------------------------------------------%
+
+:- func root_total_info(deep) = inherit_prof_info.
+
+root_total_info(Deep) = RootTotal :-
+ deep_lookup_pd_own(Deep, Deep ^ root, RootOwn),
+ deep_lookup_pd_desc(Deep, Deep ^ root, RootDesc),
+ add_own_to_inherit(RootOwn, RootDesc) = RootTotal.
+
+:- func root_desc_info(deep) = inherit_prof_info.
+
+root_desc_info(Deep) = RootDesc :-
+ deep_lookup_pd_desc(Deep, Deep ^ root, RootDesc).
+
+:- func root_own_info(deep) = own_prof_info.
+
+root_own_info(Deep) = RootOwn :-
+ deep_lookup_pd_own(Deep, Deep ^ root, RootOwn).
+
+%-----------------------------------------------------------------------------%
+
+:- func fields_header(fields) = string.
+
+fields_header(Fields) =
+ "<TR>\n" ++
+ "<TD>Source</TD>\n" ++
+ "<TD>Procedure</TD>\n" ++
+ ( show_port_counts(Fields) ->
+ "<TD ALIGN=RIGHT>Calls</TD>\n" ++
+ "<TD ALIGN=RIGHT>Exits</TD>\n" ++
+ "<TD ALIGN=RIGHT>Fails</TD>\n" ++
+ "<TD ALIGN=RIGHT>Redos</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ "<TD ALIGN=RIGHT>Self quanta</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ "<TD ALIGN=RIGHT>Self time</TD>\n"
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ "<TD ALIGN=RIGHT>Total quanta</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ "<TD ALIGN=RIGHT>Total time</TD>\n"
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_allocs(Fields) ->
+ "<TD ALIGN=RIGHT>Self allocs</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n" ++
+ "<TD ALIGN=RIGHT>Total allocs</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_words(Fields) ->
+ "<TD ALIGN=RIGHT>Self words</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n" ++
+ "<TD ALIGN=RIGHT>Total words</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ "</TR>\n".
+
+:- func separator_row(fields) = string.
+
+separator_row(Fields) = Separator :-
+ Fixed = 2, % Source, Procedure
+ ( show_port_counts(Fields) ->
+ Port = 4
+ ;
+ Port = 4
+ ),
+ ( show_quanta(Fields) ->
+ Quanta = 2
+ ;
+ Quanta = 0
+ ),
+ ( show_times(Fields) ->
+ Times = 2
+ ;
+ Times = 0
+ ),
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ Percentage = 2
+ ;
+ Percentage = 0
+ ),
+ ( show_allocs(Fields) ->
+ Allocs = 4
+ ;
+ Allocs = 0
+ ),
+ ( show_words(Fields) ->
+ Words = 4
+ ;
+ Words = 0
+ ),
+ Count = Fixed + Port + Quanta + Times + Percentage + Allocs + Words,
+ Separator = string__format("<TR><TD COLSPAN=%d> </TD></TR>\n",
+ [i(Count)]).
+
+:- func own_and_desc_to_html(own_prof_info, inherit_prof_info,
+ deep, fields) = string.
+
+own_and_desc_to_html(Own, Desc, Deep, Fields) = HTML :-
+ add_own_to_inherit(Own, Desc) = OwnPlusDesc,
+ Root = root_total_info(Deep),
+ Calls = calls(Own),
+ Exits = exits(Own),
+ Fails = fails(Own),
+ Redos = redos(Own),
+
+ OwnQuanta = quanta(Own),
+ TotalQuanta = inherit_quanta(OwnPlusDesc),
+ RootQuanta = inherit_quanta(Root),
+ OwnQuantaProp = 100.0 * float(OwnQuanta) / float(RootQuanta),
+ TotalQuantaProp = 100.0 * float(TotalQuanta) / float(RootQuanta),
+
+ OwnAllocs = mallocs(Own),
+ TotalAllocs = inherit_mallocs(OwnPlusDesc),
+ RootAllocs = inherit_mallocs(Root),
+ OwnAllocProp = 100.0 * float(OwnAllocs) / float(RootAllocs),
+ TotalAllocProp = 100.0 * float(TotalAllocs) / float(RootAllocs),
+
+ OwnWords = words(Own),
+ TotalWords = inherit_words(OwnPlusDesc),
+ RootWords = inherit_words(Root),
+ OwnWordProp = 100.0 * float(OwnWords) / float(RootWords),
+ TotalWordProp = 100.0 * float(TotalWords) / float(RootWords),
+
+ HTML =
+ ( show_port_counts(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Calls))]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Exits))]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Fails))]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Redos))])
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(OwnQuanta))])
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(quantum_time(OwnQuanta))])
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(OwnQuantaProp)])
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(TotalQuanta))])
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(quantum_time(TotalQuanta))])
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(TotalQuantaProp)])
+ ;
+ ""
+ ) ++
+ ( show_allocs(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(OwnAllocs))]) ++
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(OwnAllocProp)]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(TotalAllocs))]) ++
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(TotalAllocProp)])
+ ;
+ ""
+ ) ++
+ ( show_words(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(OwnWords))]) ++
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(OwnWordProp)]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(TotalWords))]) ++
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(TotalWordProp)])
+ ;
+ ""
+ ).
+
+:- func deep_cmd_to_url(deep, cmd) = string.
+
+deep_cmd_to_url(Deep, Cmd) = URL :-
+ cmd_to_url(Deep ^ server_name, Deep ^ data_file_name, Cmd, URL).
+
+%-----------------------------------------------------------------------------%
Index: startup.m
===================================================================
RCS file: startup.m
diff -N startup.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ startup.m Fri May 4 13:17:25 2001
@@ -0,0 +1,719 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains the code for turning the raw list of nodes read in by
+% deep.io.m into the data structure that deep.server.m needs to service
+% requests for web pages. The algorithm it implements is documented in the
+% deep profiling paper.
+
+:- module startup.
+
+:- interface.
+
+:- import_module profile.
+:- import_module io.
+
+:- pred startup(string::in, string::in, initial_deep::in, deep::out,
+ io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module measurements, cliques, profile, array_util.
+:- import_module std_util, int, array, list, set, map, require.
+
+startup(Machine, DataFileName, InitialDeep, Deep) -->
+ stderr_stream(StdErr),
+
+ { InitialDeep = initial_deep(InitStats, Root,
+ CallSiteDynamics0, ProcDynamics,
+ CallSiteStatics0, ProcStatics) },
+
+ format(StdErr,
+ " Mapping static call sites to containing procedures...\n",
+ []),
+ { array_foldl(record_css_containers, ProcStatics,
+ u(CallSiteStatics0), CallSiteStatics) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr,
+ " Mapping dynamic call sites to containing procedures...\n",
+ []),
+ { array_foldl(record_csd_containers, ProcDynamics,
+ u(CallSiteDynamics0), CallSiteDynamics) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing graph...\n", []),
+ make_graph(InitialDeep, Graph),
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing cliques...\n", []),
+ { topological_sort(Graph, CliqueList0) },
+
+ % Turn each of the sets into a list.
+ % (We use foldl here because the list may be very
+ % long and map runs out of stack space, and we
+ % want the final list in reverse order anyway.)
+ { list__foldl((pred(Set::in, L0::in, L::out) is det :-
+ set__to_sorted_list(Set, List0),
+ map((pred(PDI::in, PDPtr::out) is det :-
+ PDPtr = proc_dynamic_ptr(PDI)
+ ), List0, List),
+ L = [List | L0]
+ ), CliqueList0, [], CliqueList) },
+ % It's actually more convenient to have the list in
+ % reverse order so that foldl works from the bottom
+ % of the tsort to the top, so that we can use it to
+ % do the propagation simply.
+ { Cliques = array(CliqueList) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing clique indexes...\n", []),
+ flush_output(StdErr),
+
+ { array__max(ProcDynamics, PDMax) },
+ { NPDs = PDMax + 1 },
+ { array__max(CallSiteDynamics, CSDMax) },
+ { NCSDs = CSDMax + 1 },
+ { array__max(ProcStatics, PSMax) },
+ { NPSs = PSMax + 1 },
+ { array__max(CallSiteStatics, CSSMax) },
+ { NCSSs = CSSMax + 1 },
+
+ { array__init(NPDs, clique_ptr(-1), CliqueIndex0) },
+
+ % For each clique, add entries in an array
+ % that maps from each clique member (ProcDynamic)
+ % back to the clique to which it belongs.
+ { array_foldl((pred(CliqueN::in, CliqueMembers::in,
+ I0::array_di, I::array_uo) is det :-
+ array_list_foldl((pred(X::in, I1::array_di, I2::array_uo)
+ is det :-
+ X = proc_dynamic_ptr(Y),
+ array__set(I1, Y, clique_ptr(CliqueN), I2)
+ ), CliqueMembers, I0, I)
+ ), Cliques, CliqueIndex0, CliqueIndex) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing clique parent map...\n", []),
+
+ % For each CallSiteDynamic pointer, if it points to
+ % a ProcDynamic which is in a different clique to
+ % the one from which the CallSiteDynamic's parent
+ % came, then this CallSiteDynamic is the entry to
+ % the [lower] clique. We need to compute this information
+ % so that we can print clique-based timing summaries in
+ % the browser.
+ { array__max(Cliques, CliqueMax) },
+ { NCliques = CliqueMax + 1 },
+ { array__init(NCliques, call_site_dynamic_ptr(-1), CliqueParents0) },
+ { array__init(NCSDs, no, CliqueMaybeChildren0) },
+ { array_foldl2(construct_clique_parents(InitialDeep, CliqueIndex),
+ CliqueIndex,
+ CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren) },
+
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Finding procedure callers...\n", []),
+ { array__init(NPSs, [], ProcCallers0) },
+ { array_foldl(construct_proc_callers(InitialDeep), CallSiteDynamics,
+ ProcCallers0, ProcCallers) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing call site static map...\n", []),
+ { array__init(NCSDs, call_site_static_ptr(-1), CallSiteStaticMap0) },
+ { array_foldl(construct_call_site_caller(InitialDeep), ProcDynamics,
+ CallSiteStaticMap0, CallSiteStaticMap) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Finding call site calls...\n", []),
+ { array__init(NCSSs, map__init, CallSiteCalls0) },
+ { array_foldl(construct_call_site_calls(InitialDeep), ProcDynamics,
+ CallSiteCalls0, CallSiteCalls) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Propagating time up call graph...\n", []),
+
+ { array__init(NCSDs, zero_inherit_prof_info, CSDDesc0) },
+ { array__init(NPDs, zero_own_prof_info, PDOwn0) },
+ { array_foldl(sum_call_sites_in_proc_dynamic,
+ CallSiteDynamics, PDOwn0, PDOwn) },
+ { array__init(NPDs, zero_inherit_prof_info, PDDesc0) },
+ { array__init(NPSs, zero_own_prof_info, PSOwn0) },
+ { array__init(NPSs, zero_inherit_prof_info, PSDesc0) },
+ { array__init(NCSSs, zero_own_prof_info, CSSOwn0) },
+ { array__init(NCSSs, zero_inherit_prof_info, CSSDesc0) },
+
+ { Deep0 = deep(InitStats, Machine, DataFileName, Root,
+ CallSiteDynamics, ProcDynamics, CallSiteStatics, ProcStatics,
+ CliqueIndex, Cliques, CliqueParents, CliqueMaybeChildren,
+ ProcCallers, CallSiteStaticMap, CallSiteCalls,
+ PDOwn, PDDesc0, CSDDesc0,
+ PSOwn0, PSDesc0, CSSOwn0, CSSDesc0) },
+
+ { array_foldl(propagate_to_clique, Cliques, Deep0, Deep1) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Summarizing information...\n", []),
+ { summarize_proc_dynamics(Deep1, Deep2) },
+ { summarize_call_site_dynamics(Deep2, Deep) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats.
+
+%-----------------------------------------------------------------------------%
+
+:- pred make_graph(initial_deep::in, graph::out,
+ io__state::di, io__state::uo) is det.
+
+make_graph(InitialDeep, Graph) -->
+ { init(Graph0) },
+ array_foldl2((pred(PDI::in, PD::in, G1::in, G2::out, di, uo) is det -->
+ { From = PDI },
+ { PD = proc_dynamic(_ProcStatic, CallSiteRefArray) },
+ { array__to_list(CallSiteRefArray, CallSiteRefList) },
+ list__foldl2((pred(CSR::in, G5::in, G6::out, di, uo) is det -->
+ (
+ { CSR = normal(call_site_dynamic_ptr(CSDI)) },
+ ( { CSDI > 0 } ->
+ { array__lookup(
+ InitialDeep ^ init_call_site_dynamics,
+ CSDI, CSD) },
+ { CSD = call_site_dynamic(_, CPDPtr, _) },
+ { CPDPtr = proc_dynamic_ptr(To) },
+ { add_arc(G5, From, To, G6) }
+ ;
+ { G6 = G5 }
+ )
+ ;
+ { CSR = multi(CallSiteArray) },
+ { array__to_list(CallSiteArray, CallSites) },
+ list__foldl2((pred(CSDPtr1::in, G7::in, G8::out,
+ di, uo) is det -->
+ { CSDPtr1 = call_site_dynamic_ptr(CSDI) },
+ ( { CSDI > 0 } ->
+ { array__lookup(
+ InitialDeep ^ init_call_site_dynamics,
+ CSDI, CSD) },
+ { CSD = call_site_dynamic(_, CPDPtr, _) },
+ { CPDPtr = proc_dynamic_ptr(To) },
+ { add_arc(G7, From, To, G8) }
+ ;
+ { G8 = G7 }
+ )
+ ), CallSites, G5, G6)
+ )
+ ), CallSiteRefList, G1, G2)
+ ), InitialDeep ^ init_proc_dynamics, Graph0, Graph).
+
+%-----------------------------------------------------------------------------%
+
+:- pred record_css_containers(int::in, proc_static::in,
+ array(call_site_static)::array_di,
+ array(call_site_static)::array_uo) is det.
+
+record_css_containers(PSI, PS, CallSiteStatics0, CallSiteStatics) :-
+ PS = proc_static(_, _, _, _, CSSPtrs),
+ PSPtr = proc_static_ptr(PSI),
+ array__max(CSSPtrs, MaxCS),
+ record_css_containers_2(MaxCS, PSPtr, CSSPtrs,
+ CallSiteStatics0, CallSiteStatics).
+
+:- pred record_css_containers_2(int::in, proc_static_ptr::in,
+ array(call_site_static_ptr)::in,
+ array(call_site_static)::array_di,
+ array(call_site_static)::array_uo) is det.
+
+record_css_containers_2(SlotNum, PSPtr, CSSPtrs,
+ CallSiteStatics0, CallSiteStatics) :-
+ ( SlotNum >= 0 ->
+ array__lookup(CSSPtrs, SlotNum, CSSPtr),
+ lookup_call_site_statics(CallSiteStatics0, CSSPtr, CSS0),
+ CSS0 = call_site_static(PSPtr0, SlotNum0,
+ Kind, LineNumber, GoalPath),
+ require(unify(PSPtr0, proc_static_ptr(-1)),
+ "record_css_containers_2: real proc_static_ptr"),
+ require(unify(SlotNum0, -1),
+ "record_css_containers_2: real slot_num"),
+ CSS = call_site_static(PSPtr, SlotNum,
+ Kind, LineNumber, GoalPath),
+ update_call_site_statics(CallSiteStatics0, CSSPtr, CSS,
+ CallSiteStatics1),
+ record_css_containers_2(SlotNum - 1,
+ PSPtr, CSSPtrs, CallSiteStatics1, CallSiteStatics)
+ ;
+ CallSiteStatics = CallSiteStatics0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred record_csd_containers(int::in, proc_dynamic::in,
+ array(call_site_dynamic)::array_di,
+ array(call_site_dynamic)::array_uo) is det.
+
+record_csd_containers(PDI, PD, CallSiteDynamics0, CallSiteDynamics) :-
+ PD = proc_dynamic(_, CSDArray),
+ PDPtr = proc_dynamic_ptr(PDI),
+ flatten_call_sites(CSDArray, CSDPtrs),
+ record_csd_containers_2(PDPtr, CSDPtrs,
+ CallSiteDynamics0, CallSiteDynamics).
+
+:- pred record_csd_containers_2(proc_dynamic_ptr::in,
+ list(call_site_dynamic_ptr)::in,
+ array(call_site_dynamic)::array_di,
+ array(call_site_dynamic)::array_uo) is det.
+
+record_csd_containers_2(_, [], CallSiteDynamics, CallSiteDynamics).
+record_csd_containers_2(PDPtr, [CSDPtr | CSDPtrs],
+ CallSiteDynamics0, CallSiteDynamics) :-
+ lookup_call_site_dynamics(CallSiteDynamics0, CSDPtr, CSD0),
+ CSD0 = call_site_dynamic(CallerPSPtr0, CalleePSPtr, Own),
+ require(unify(CallerPSPtr0, proc_dynamic_ptr(-1)),
+ "record_csd_containers_2: real proc_dynamic_ptr"),
+ CSD = call_site_dynamic(PDPtr, CalleePSPtr, Own),
+ update_call_site_dynamics(CallSiteDynamics0, CSDPtr, CSD,
+ CallSiteDynamics1),
+ record_csd_containers_2(PDPtr, CSDPtrs,
+ CallSiteDynamics1, CallSiteDynamics).
+
+%-----------------------------------------------------------------------------%
+
+:- pred construct_clique_parents(initial_deep::in, array(clique_ptr)::in,
+ int::in, clique_ptr::in,
+ array(call_site_dynamic_ptr)::array_di,
+ array(call_site_dynamic_ptr)::array_uo,
+ array(maybe(clique_ptr))::array_di,
+ array(maybe(clique_ptr))::array_uo) is det.
+
+construct_clique_parents(InitialDeep, CliqueIndex, PDI, CliquePtr,
+ CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren) :-
+ ( PDI > 0 ->
+ flat_call_sites(InitialDeep ^ init_proc_dynamics,
+ proc_dynamic_ptr(PDI), CSDPtrs),
+ array_list_foldl2(
+ construct_clique_parents_2(InitialDeep,
+ CliqueIndex, CliquePtr),
+ CSDPtrs, CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren)
+ ;
+ error("emit nasal daemons")
+ ).
+
+:- pred construct_clique_parents_2(initial_deep::in, array(clique_ptr)::in,
+ clique_ptr::in, call_site_dynamic_ptr::in,
+ array(call_site_dynamic_ptr)::array_di,
+ array(call_site_dynamic_ptr)::array_uo,
+ array(maybe(clique_ptr))::array_di,
+ array(maybe(clique_ptr))::array_uo) is det.
+
+construct_clique_parents_2(InitialDeep, CliqueIndex, ParentCliquePtr, CSDPtr,
+ CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ array__lookup(InitialDeep ^ init_call_site_dynamics, CSDI,
+ CSD),
+ CSD = call_site_dynamic(_, ChildPDPtr, _),
+ ChildPDPtr = proc_dynamic_ptr(ChildPDI),
+ ( ChildPDI > 0 ->
+ array__lookup(CliqueIndex, ChildPDI, ChildCliquePtr),
+ ( ChildCliquePtr \= ParentCliquePtr ->
+ ChildCliquePtr = clique_ptr(ChildCliqueNum),
+ array__set(CliqueParents0, ChildCliqueNum,
+ CSDPtr, CliqueParents),
+ array__set(CliqueMaybeChildren0, CSDI,
+ yes(ChildCliquePtr),
+ CliqueMaybeChildren)
+ ;
+ CliqueParents = CliqueParents0,
+ CliqueMaybeChildren = CliqueMaybeChildren0
+ )
+ ;
+ CliqueParents = CliqueParents0,
+ CliqueMaybeChildren = CliqueMaybeChildren0
+ )
+ ;
+ CliqueParents = CliqueParents0,
+ CliqueMaybeChildren = CliqueMaybeChildren0
+ ).
+
+:- pred flat_call_sites(proc_dynamics::in, proc_dynamic_ptr::in,
+ list(call_site_dynamic_ptr)::out) is det.
+
+flat_call_sites(ProcDynamics, PDPtr, CSDPtrs) :-
+ ( PDPtr = proc_dynamic_ptr(PDI), PDI > 0 ->
+ array__lookup(ProcDynamics, PDI, PD),
+ PD = proc_dynamic(_PSPtr, CallSiteArray),
+ flatten_call_sites(CallSiteArray, CSDPtrs)
+ ;
+ CSDPtrs = []
+ ).
+
+:- pred flatten_call_sites(array(call_site_array_slot)::in,
+ list(call_site_dynamic_ptr)::out) is det.
+
+flatten_call_sites(CallSiteArray, CSDPtrs) :-
+ array__to_list(CallSiteArray, CallSites),
+ list__foldl((pred(Slot::in, CSDPtrs0::in, CSDPtrs1::out) is det :-
+ (
+ Slot = normal(CSDPtr),
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ CSDPtrs1 = [[CSDPtr] | CSDPtrs0]
+ ;
+ CSDPtrs1 = CSDPtrs0
+ )
+ ;
+ Slot = multi(PtrArray),
+ array__to_list(PtrArray, PtrList0),
+ filter((pred(CSDPtr::in) is semidet :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ CSDI > 0
+ ), PtrList0, PtrList1),
+ CSDPtrs1 = [PtrList1 | CSDPtrs0]
+ )
+ ), CallSites, [], CSDPtrsList0),
+ list__reverse(CSDPtrsList0, CSDPtrsList),
+ list__condense(CSDPtrsList, CSDPtrs).
+
+:- pred construct_proc_callers(initial_deep::in, int::in,
+ call_site_dynamic::in,
+ array(list(call_site_dynamic_ptr))::array_di,
+ array(list(call_site_dynamic_ptr))::array_uo) is det.
+
+construct_proc_callers(InitialDeep, CSDI, CSD, ProcCallers0, ProcCallers) :-
+ CSD = call_site_dynamic(_, PDPtr, _),
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0, array__in_bounds(InitialDeep ^ init_proc_dynamics, PDI) ->
+ array__lookup(InitialDeep ^ init_proc_dynamics, PDI, PD),
+ PD = proc_dynamic(PSPtr, _),
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(ProcCallers0, PSI, Callers0),
+ Callers = [call_site_dynamic_ptr(CSDI) | Callers0],
+ array__set(ProcCallers0, PSI, Callers, ProcCallers)
+ ;
+ ProcCallers = ProcCallers0
+ ).
+
+:- pred construct_call_site_caller(initial_deep::in, int::in, proc_dynamic::in,
+ array(call_site_static_ptr)::array_di,
+ array(call_site_static_ptr)::array_uo) is det.
+
+construct_call_site_caller(InitialDeep, _PDI, PD,
+ CallSiteStaticMap0, CallSiteStaticMap) :-
+ PD = proc_dynamic(PSPtr, CSDArraySlots),
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(InitialDeep ^ init_proc_statics, PSI, PS),
+ PS = proc_static(_, _, _, _, CSSPtrs),
+ array__max(CSDArraySlots, MaxCS),
+ construct_call_site_caller_2(MaxCS,
+ InitialDeep ^ init_call_site_dynamics, CSSPtrs, CSDArraySlots,
+ CallSiteStaticMap0, CallSiteStaticMap).
+
+:- pred construct_call_site_caller_2(int::in, call_site_dynamics::in,
+ array(call_site_static_ptr)::in,
+ array(call_site_array_slot)::in,
+ array(call_site_static_ptr)::array_di,
+ array(call_site_static_ptr)::array_uo) is det.
+
+construct_call_site_caller_2(SlotNum, Deep, CSSPtrs, CSDArraySlots,
+ CallSiteStaticMap0, CallSiteStaticMap) :-
+ ( SlotNum >= 0 ->
+ array__lookup(CSDArraySlots, SlotNum, CSDArraySlot),
+ array__lookup(CSSPtrs, SlotNum, CSSPtr),
+ (
+ CSDArraySlot = normal(CSDPtr),
+ construct_call_site_caller_3(Deep, CSSPtr, -1, CSDPtr,
+ CallSiteStaticMap0, CallSiteStaticMap1)
+
+ ;
+ CSDArraySlot = multi(CSDPtrs),
+ array_foldl0(
+ construct_call_site_caller_3(Deep, CSSPtr),
+ CSDPtrs,
+ CallSiteStaticMap0, CallSiteStaticMap1)
+ ),
+ construct_call_site_caller_2(SlotNum - 1, Deep, CSSPtrs,
+ CSDArraySlots, CallSiteStaticMap1, CallSiteStaticMap)
+ ;
+ CallSiteStaticMap = CallSiteStaticMap0
+ ).
+
+:- pred construct_call_site_caller_3(call_site_dynamics::in,
+ call_site_static_ptr::in, int::in, call_site_dynamic_ptr::in,
+ array(call_site_static_ptr)::array_di,
+ array(call_site_static_ptr)::array_uo) is det.
+
+construct_call_site_caller_3(CallSiteDynamics, CSSPtr, _Dummy, CSDPtr,
+ CallSiteStaticMap0, CallSiteStaticMap) :-
+ ( valid_call_site_dynamic_ptr_raw(CallSiteDynamics, CSDPtr) ->
+ update_call_site_static_map(CallSiteStaticMap0,
+ CSDPtr, CSSPtr, CallSiteStaticMap)
+ ;
+ CallSiteStaticMap = CallSiteStaticMap0
+ ).
+
+:- pred construct_call_site_calls(initial_deep::in, int::in, proc_dynamic::in,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_di,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_uo)
+ is det.
+
+construct_call_site_calls(InitialDeep, _PDI, PD,
+ CallSiteCalls0, CallSiteCalls) :-
+ PD = proc_dynamic(PSPtr, CSDArraySlots),
+ array__max(CSDArraySlots, MaxCS),
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(InitialDeep ^ init_proc_statics, PSI, PS),
+ PS = proc_static(_, _, _, _, CSSPtrs),
+ CallSiteDynamics = InitialDeep ^ init_call_site_dynamics,
+ ProcDynamics = InitialDeep ^ init_proc_dynamics,
+ construct_call_site_calls_2(CallSiteDynamics, ProcDynamics, MaxCS,
+ CSSPtrs, CSDArraySlots, CallSiteCalls0, CallSiteCalls).
+
+:- pred construct_call_site_calls_2(call_site_dynamics::in, proc_dynamics::in,
+ int::in, array(call_site_static_ptr)::in,
+ array(call_site_array_slot)::in,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_di,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_uo)
+ is det.
+
+construct_call_site_calls_2(CallSiteDynamics, ProcDynamics, SlotNum,
+ CSSPtrs, CSDArraySlots, CallSiteCalls0, CallSiteCalls) :-
+ ( SlotNum >= 0 ->
+ array__lookup(CSDArraySlots, SlotNum, CSDArraySlot),
+ array__lookup(CSSPtrs, SlotNum, CSSPtr),
+ (
+ CSDArraySlot = normal(CSDPtr),
+ construct_call_site_calls_3(CallSiteDynamics,
+ ProcDynamics, CSSPtr, -1,
+ CSDPtr, CallSiteCalls0, CallSiteCalls1)
+ ;
+ CSDArraySlot = multi(CSDPtrs),
+ array_foldl0(
+ construct_call_site_calls_3(CallSiteDynamics,
+ ProcDynamics, CSSPtr),
+ CSDPtrs, CallSiteCalls0, CallSiteCalls1)
+ ),
+ construct_call_site_calls_2(CallSiteDynamics, ProcDynamics,
+ SlotNum - 1, CSSPtrs, CSDArraySlots,
+ CallSiteCalls1, CallSiteCalls)
+ ;
+ CallSiteCalls = CallSiteCalls0
+ ).
+
+:- pred construct_call_site_calls_3(call_site_dynamics::in, proc_dynamics::in,
+ call_site_static_ptr::in, int::in, call_site_dynamic_ptr::in,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_di,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_uo)
+ is det.
+
+construct_call_site_calls_3(CallSiteDynamics, ProcDynamics, CSSPtr,
+ _Dummy, CSDPtr, CallSiteCalls0, CallSiteCalls) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ array__lookup(CallSiteDynamics, CSDI, CSD),
+ CSD = call_site_dynamic(_, PDPtr, _),
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(ProcDynamics, PDI, PD),
+ PD = proc_dynamic(PSPtr, _),
+
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__lookup(CallSiteCalls0, CSSI, CallMap0),
+ ( map__search(CallMap0, PSPtr, CallList0) ->
+ CallList = [CSDPtr | CallList0],
+ map__det_update(CallMap0, PSPtr, CallList, CallMap)
+ ;
+ CallList = [CSDPtr],
+ map__det_insert(CallMap0, PSPtr, CallList, CallMap)
+ ),
+ array__set(CallSiteCalls0, CSSI, CallMap, CallSiteCalls)
+ ;
+ CallSiteCalls = CallSiteCalls0
+ ).
+
+:- pred sum_call_sites_in_proc_dynamic(int::in, call_site_dynamic::in,
+ array(own_prof_info)::array_di, array(own_prof_info)::array_uo) is det.
+
+sum_call_sites_in_proc_dynamic(_, CSD, PDO0, PDO) :-
+ CSD = call_site_dynamic(_, PDPtr, PI),
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0 ->
+ array__lookup(PDO0, PDI, OwnPI0),
+ OwnPI = add_own_to_own(PI, OwnPI0),
+ array__set(PDO0, PDI, OwnPI, PDO)
+ ;
+ PDO = PDO0
+ ).
+
+:- pred summarize_proc_dynamics(deep::in, deep::out) is det.
+
+summarize_proc_dynamics(Deep0, Deep) :-
+ PSOwn0 = Deep0 ^ ps_own,
+ PSDesc0 = Deep0 ^ ps_desc,
+ array_foldl2(summarize_proc_dynamic(Deep0 ^ pd_own, Deep0 ^ pd_desc),
+ Deep0 ^ proc_dynamics,
+ copy(PSOwn0), PSOwn, copy(PSDesc0), PSDesc),
+ Deep = ((Deep0
+ ^ ps_own := PSOwn)
+ ^ ps_desc := PSDesc).
+
+:- pred summarize_proc_dynamic(array(own_prof_info)::in,
+ array(inherit_prof_info)::in, int::in, proc_dynamic::in,
+ array(own_prof_info)::array_di, array(own_prof_info)::array_uo,
+ array(inherit_prof_info)::array_di, array(inherit_prof_info)::array_uo)
+ is det.
+
+summarize_proc_dynamic(PDOwn, PDDesc, PDI, PD,
+ PSOwn0, PSOwn, PSDesc0, PSDesc) :-
+ PD = proc_dynamic(PSPtr, _),
+ PSPtr = proc_static_ptr(PSI),
+ ( PSI > 0 ->
+ array__lookup(PDOwn, PDI, PDOwnPI),
+ array__lookup(PDDesc, PDI, PDDescPI),
+
+ array__lookup(PSOwn0, PSI, PSOwnPI0),
+ array__lookup(PSDesc0, PSI, PSDescPI0),
+
+ add_own_to_own(PDOwnPI, PSOwnPI0) = PSOwnPI,
+ add_inherit_to_inherit(PDDescPI, PSDescPI0) = PSDescPI,
+ array__set(u(PSOwn0), PSI, PSOwnPI, PSOwn),
+ array__set(u(PSDesc0), PSI, PSDescPI, PSDesc)
+ ;
+ error("emit nasal devils")
+ ).
+
+:- pred summarize_call_site_dynamics(deep::in, deep::out) is det.
+
+summarize_call_site_dynamics(Deep0, Deep) :-
+ CSSOwn0 = Deep0 ^ css_own,
+ CSSDesc0 = Deep0 ^ css_desc,
+ array_foldl2(summarize_call_site_dynamic(Deep0 ^ call_site_static_map,
+ Deep0 ^ csd_desc),
+ Deep0 ^ call_site_dynamics,
+ copy(CSSOwn0), CSSOwn, copy(CSSDesc0), CSSDesc),
+ Deep = ((Deep0
+ ^ css_own := CSSOwn)
+ ^ css_desc := CSSDesc).
+
+:- pred summarize_call_site_dynamic(call_site_static_map::in,
+ array(inherit_prof_info)::in, int::in, call_site_dynamic::in,
+ array(own_prof_info)::array_di, array(own_prof_info)::array_uo,
+ array(inherit_prof_info)::array_di, array(inherit_prof_info)::array_uo)
+ is det.
+
+summarize_call_site_dynamic(CallSiteStaticMap, CSDDescs, CSDI, CSD,
+ CSSOwn0, CSSOwn, CSSDesc0, CSSDesc) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ lookup_call_site_static_map(CallSiteStaticMap, CSDPtr, CSSPtr),
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( CSSI > 0 ->
+ CSD = call_site_dynamic(_, _, CSDOwnPI),
+ array__lookup(CSDDescs, CSDI, CSDDescPI),
+
+ array__lookup(CSSOwn0, CSSI, CSSOwnPI0),
+ array__lookup(CSSDesc0, CSSI, CSSDescPI0),
+
+ add_own_to_own(CSDOwnPI, CSSOwnPI0)
+ = CSSOwnPI,
+ add_inherit_to_inherit(CSDDescPI, CSSDescPI0)
+ = CSSDescPI,
+ array__set(u(CSSOwn0), CSSI, CSSOwnPI, CSSOwn),
+ array__set(u(CSSDesc0), CSSI, CSSDescPI, CSSDesc)
+ ;
+ error("emit nasal gorgons")
+ ).
+
+:- pred propagate_to_clique(int::in, list(proc_dynamic_ptr)::in,
+ deep::in, deep::out) is det.
+
+propagate_to_clique(CliqueNumber, Members, Deep0, Deep) :-
+ array__lookup(Deep0 ^ clique_parents, CliqueNumber, ParentCSDPtr),
+ list__foldl(propagate_to_proc_dynamic(CliqueNumber, ParentCSDPtr),
+ Members, Deep0, Deep1),
+ (
+ valid_call_site_dynamic_ptr_raw(Deep1 ^ call_site_dynamics,
+ ParentCSDPtr)
+ ->
+ lookup_call_site_dynamics(Deep1 ^ call_site_dynamics,
+ ParentCSDPtr, ParentCSD),
+ ParentCSD = call_site_dynamic(_, _, ParentOwnPI),
+ deep_lookup_csd_desc(Deep1, ParentCSDPtr, ParentDesc0),
+ subtract_own_from_inherit(ParentOwnPI, ParentDesc0) =
+ ParentDesc,
+ deep_update_csd_desc(Deep1, ParentCSDPtr, ParentDesc, Deep)
+ ;
+ Deep = Deep1
+ ).
+
+:- pred propagate_to_proc_dynamic(int::in, call_site_dynamic_ptr::in,
+ proc_dynamic_ptr::in, deep::in, deep::out) is det.
+
+propagate_to_proc_dynamic(CliqueNumber, ParentCSDPtr, PDPtr,
+ Deep0, Deep) :-
+ flat_call_sites(Deep0 ^ proc_dynamics, PDPtr, CSDPtrs),
+ list__foldl(propagate_to_call_site(CliqueNumber, PDPtr),
+ CSDPtrs, Deep0, Deep1),
+ (
+ valid_call_site_dynamic_ptr_raw(Deep1 ^ call_site_dynamics,
+ ParentCSDPtr)
+ ->
+ deep_lookup_csd_desc(Deep1, ParentCSDPtr, ParentDesc0),
+ deep_lookup_pd_desc(Deep1, PDPtr, DescPI),
+ deep_lookup_pd_own(Deep1, PDPtr, OwnPI),
+ add_own_to_inherit(OwnPI, ParentDesc0) = ParentDesc1,
+ add_inherit_to_inherit(DescPI, ParentDesc1) = ParentDesc,
+ deep_update_csd_desc(Deep1, ParentCSDPtr, ParentDesc, Deep)
+ ;
+ Deep = Deep1
+ ).
+
+:- pred propagate_to_call_site(int::in, proc_dynamic_ptr::in,
+ call_site_dynamic_ptr::in, deep::in, deep::out) is det.
+
+propagate_to_call_site(CliqueNumber, PDPtr, CSDPtr, Deep0, Deep) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ array__lookup(Deep0 ^ call_site_dynamics, CSDI, CSD),
+ CSD = call_site_dynamic(_, CPDPtr, CPI),
+ CPDPtr = proc_dynamic_ptr(CPDI),
+ ( CPDI > 0 ->
+ array__lookup(Deep0 ^ clique_index, CPDI,
+ clique_ptr(ChildCliqueNumber)),
+ ( ChildCliqueNumber \= CliqueNumber ->
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(Deep0 ^ pd_desc, PDI, PDTotal0),
+ array__lookup(Deep0 ^ csd_desc, CSDI, CDesc),
+ add_own_to_inherit(CPI, PDTotal0) = PDTotal1,
+ add_inherit_to_inherit(CDesc, PDTotal1)
+ = PDTotal,
+ array__set(u(Deep0 ^ pd_desc), PDI, PDTotal,
+ PDDesc),
+ Deep = Deep0 ^ pd_desc := PDDesc
+ ;
+ Deep = Deep0
+ )
+ ;
+ Deep = Deep0
+ )
+ ;
+ Deep = Deep0
+ ).
+
+%-----------------------------------------------------------------------------%
Index: timeout.m
===================================================================
RCS file: timeout.m
diff -N timeout.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ timeout.m Fri May 4 12:47:46 2001
@@ -0,0 +1,83 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: zs.
+%
+% This module implements timeouts for the deep profiler.
+%
+% The deep profiler uses timeouts to shut down the server process if the
+% programmer has not sent it queries in a while. Before shutdown, we remove the
+% named pipes that the CGI script and the server process use to communicate.
+% Any later invocation of the CGI script will take the absence of the named
+% pipes as indicating that there is no server process for the given data file,
+% and will create a new server process, which will recreate the named pipes.
+%
+% Since the receipt of the alarm signal, the removal the pipes and exiting
+% is not an atomic action, there is a potential race condition. However,
+% there is no simple, portable way to eliminate the race condition, and the
+% window of vulnerability is quite small.
+
+:- module timeout.
+
+:- interface.
+
+:- import_module io.
+
+:- pred setup_timeout(string::in, string::in, int::in,
+ io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module string.
+
+:- pragma foreign_decl("C",
+"
+#include <stdio.h>
+#include <signal.h>
+#include <unistd.h>
+#include ""mercury_signal.h""
+
+extern char *MP_timeout_file1;
+extern char *MP_timeout_file2;
+
+extern void delete_timeout_files_and_exit(void);
+").
+
+:- pragma foreign_code("C",
+"
+char *MP_timeout_file1;
+char *MP_timeout_file2;
+
+void
+delete_timeout_files_and_exit(void)
+{
+ if (unlink(MP_timeout_file1) != 0) {
+ perror(MP_timeout_file1);
+ }
+
+ if (unlink(MP_timeout_file2) != 0) {
+ perror(MP_timeout_file2);
+ }
+
+ exit(0);
+}
+").
+
+:- pragma foreign_proc("C",
+ setup_timeout(File1::in, File2::in, Minutes::in, IO0::di, IO::uo),
+ [will_not_call_mercury],
+"
+ int seconds;
+
+ seconds = Minutes * 60;
+ MP_timeout_file1 = File1;
+ MP_timeout_file2 = File2;
+ MR_setup_signal(SIGALRM, delete_timeout_files_and_exit, FALSE,
+ ""Mercury deep profiler: cannot setup timeout"");
+ (void) alarm(seconds);
+ IO = IO0;
+").
Index: util.m
===================================================================
RCS file: util.m
diff -N util.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ util.m Fri May 4 13:08:20 2001
@@ -0,0 +1,71 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module defines utility predicates for both the CGI program and
+% for the server.
+
+:- module util.
+
+:- interface.
+
+:- import_module char, list.
+
+:- pred split(string::in, char::in, list(string)::out) is det.
+
+:- implementation.
+
+:- import_module string, require.
+
+split(Str0, SChar, Strs) :-
+ string__to_char_list(Str0, Chars0),
+ split(Chars0, SChar, [], [], Strs0),
+ list__reverse(Strs0, Strs).
+
+:- pred split(list(char)::in, char::in, list(char)::in,
+ list(string)::in, list(string)::out) is det.
+
+split([], _SChar, Chars0, Strs0, Strs) :-
+ (
+ Chars0 = [],
+ Strs = Strs0
+ ;
+ Chars0 = [_|_],
+ list__reverse(Chars0, Chars),
+ string__from_char_list(Chars, Str),
+ Strs = [Str|Strs0]
+ ).
+split([C|Cs], SChar, Chars0, Strs0, Strs) :-
+ ( C = SChar ->
+ (
+ Chars0 = [],
+ Strs1 = Strs0
+ ;
+ Chars0 = [_|_],
+ list__reverse(Chars0, Chars),
+ string__from_char_list(Chars, Str),
+ Strs1 = [Str|Strs0]
+ ),
+ split(Cs, SChar, [], Strs1, Strs)
+ ;
+ split(Cs, SChar, [C|Chars0], Strs0, Strs)
+ ).
+
+:- pred require_isnt(pred, string).
+:- mode require_isnt((pred) is semidet, in) is det.
+
+require_isnt(Goal, Message) :-
+ ( call(Goal) ->
+ error(Message)
+ ;
+ true
+ ).
+
+:- pred is_member(T::in, list(T)::in) is semidet.
+
+is_member(Elem, List) :-
+ member(Elem, List).
--------------------------------------------------------------------------
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