aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tools/src/fprof.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/tools/src/fprof.erl')
-rw-r--r--lib/tools/src/fprof.erl2762
1 files changed, 2762 insertions, 0 deletions
diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl
new file mode 100644
index 0000000000..155965a65a
--- /dev/null
+++ b/lib/tools/src/fprof.erl
@@ -0,0 +1,2762 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%----------------------------------------------------------------------
+%%% File : fprof.erl
+%%% Author : Raimo Niskanen <[email protected]>
+%%% Purpose : File tracing profiling tool wich accumulated times.
+%%% Created : 18 Jun 2001 by Raimo Niskanen <[email protected]>
+%%%----------------------------------------------------------------------
+
+-module(fprof).
+-author('[email protected]').
+
+%% External exports
+-export([
+ apply/2, apply/3, apply/4,
+ start/0, stop/0, stop/1,
+ trace/1, trace/2,
+ profile/0, profile/1, profile/2,
+ analyse/0, analyse/1, analyse/2]).
+%% Debug functions
+-export([get_state/0,
+ save_profile/0, save_profile/1, save_profile/2,
+ load_profile/0, load_profile/1, load_profile/2,
+ code_change/0]).
+
+%% Debug exports
+-export([call/1, just_call/1, reply/2]).
+-export([trace_off/0, trace_on/3]).
+-export([getopts/2, setopts/1]).
+-export([println/5, print_callers/2, print_func/2, print_called/2]).
+-export([trace_call_collapse/1]).
+-export([parsify/1]).
+
+%% Internal exports
+-export(['$code_change'/1]).
+
+
+
+-define(FNAME_WIDTH, 72).
+-define(NR_WIDTH, 15).
+
+-define(TRACE_FILE, "fprof.trace").
+-define(DUMP_FILE, "fprof.dump").
+-define(PROFILE_FILE, "fprof.profile").
+-define(ANALYSIS_FILE, "fprof.analysis").
+
+-define(FPROF_SERVER, fprof_server).
+-define(FPROF_SERVER_TIMEOUT, infinity).
+
+
+
+-define(debug, 9).
+%-define(debug, 0).
+-ifdef(debug).
+dbg(Level, F, A) when Level >= ?debug ->
+ io:format(F, A),
+ ok;
+dbg(_, _, _) ->
+ ok.
+-define(dbg(Level, F, A), dbg((Level), (F), (A))).
+-else.
+-define(dbg(Level, F, A), ok).
+-endif.
+
+
+
+%%%----------------------------------------------------------------------
+%%% Higher order API functions
+%%%----------------------------------------------------------------------
+
+
+
+apply({M, F} = Function, Args)
+ when is_atom(M), is_atom(F), is_list(Args) ->
+ apply_1(Function, Args, []);
+apply(Fun, Args)
+ when is_function(Fun), is_list(Args) ->
+ apply_1(Fun, Args, []);
+apply(A, B) ->
+ erlang:error(badarg, [A, B]).
+
+apply(M, F, Args) when is_atom(M), is_atom(F), is_list(Args) ->
+ apply_1({M, F}, Args, []);
+apply({M, F} = Function, Args, Options)
+ when is_atom(M), is_atom(F), is_list(Args), is_list(Options) ->
+ apply_1(Function, Args, Options);
+apply(Fun, Args, Options)
+ when is_function(Fun), is_list(Args), is_list(Options) ->
+ apply_1(Fun, Args, Options);
+apply(A, B, C) ->
+ erlang:error(badarg, [A, B, C]).
+
+apply(Module, Function, Args, Options)
+ when is_atom(Module), is_atom(Function), is_list(Args), is_list(Options) ->
+ apply_1({Module, Function}, Args, Options);
+apply(A, B, C, D) ->
+ erlang:error(badarg, [A, B, C, D]).
+
+
+apply_1(Function, Args, Options) ->
+ {[_, Procs, Continue], Options_1} =
+ getopts(Options, [start, procs, continue]),
+ Procs_1 = case Procs of
+ [{procs, P}] when is_list(P) ->
+ P;
+ _ ->
+ []
+ end,
+ case Continue of
+ [] ->
+ apply_start_stop(Function, Args, Procs_1, Options_1);
+ [continue] ->
+ apply_continue(Function, Args, Procs_1, Options_1);
+ _ ->
+ erlang:error(badarg, [Function, Args, Options])
+ end.
+
+
+
+apply_start_stop(Function, Args, Procs, Options) ->
+ Ref = make_ref(),
+ Parent = self(),
+ Child =
+ spawn(
+ fun() ->
+ MRef = erlang:monitor(process, Parent),
+ receive
+ {Parent, Ref, start_trace} ->
+ case trace([start,
+ {procs, [Parent | Procs]}
+ | Options]) of
+ ok ->
+ catch Parent ! {self(), Ref, trace_started},
+ receive
+ {Parent, Ref, stop_trace} ->
+ trace([stop]),
+ catch Parent
+ ! {self(), Ref, trace_stopped},
+ done;
+ {'DOWN', MRef, _, _, _} ->
+ trace([stop])
+ end;
+ {error, Reason} ->
+ exit(Reason)
+ end;
+ {'DOWN', MRef, _, _, _} ->
+ done
+ end
+ end),
+ MRef = erlang:monitor(process, Child),
+ catch Child ! {self(), Ref, start_trace},
+ receive
+ {Child, Ref, trace_started} ->
+ try erlang:apply(Function, Args)
+ after
+ catch Child ! {self(), Ref, stop_trace},
+ receive
+ {Child, Ref, trace_stopped} ->
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ end;
+ {'DOWN', MRef, _, _, _} ->
+ trace([stop])
+ end
+ end;
+ {'DOWN', MRef, _, _, Reason} ->
+ exit(Reason)
+ end.
+
+apply_continue(Function, Args, Procs, Options) ->
+ Ref = make_ref(),
+ Parent = self(),
+ Child =
+ spawn(
+ fun() ->
+ MRef = erlang:monitor(process, Parent),
+ receive
+ {Parent, Ref, start_trace} ->
+ case trace([start,
+ {procs, [Parent | Procs]}
+ | Options]) of
+ ok ->
+ exit({Ref, trace_started});
+ {error, Reason} ->
+ exit(Reason)
+ end;
+ {'DOWN', MRef, _, _, _} ->
+ done
+ end
+ end),
+ MRef = erlang:monitor(process, Child),
+ catch Child ! {self(), Ref, start_trace},
+ receive
+ {'DOWN', MRef, _, _, {Ref, trace_started}} ->
+ erlang:apply(Function, Args);
+ {'DOWN', MRef, _, _, Reason} ->
+ exit(Reason)
+ end.
+
+
+
+%%%----------------------------------------------------------------------
+%%% Requests to ?FPROF_SERVER
+%%%----------------------------------------------------------------------
+
+-record(trace_start, {procs, % List of processes
+ mode, % normal | verbose
+ type, % file | tracer
+ dest}). % Filename | Pid/Port
+
+-record(trace_stop, {}).
+
+% -record(open_out, {file}).
+
+% -record(close_out, {}).
+
+-record(profile, {src, % Filename
+ group_leader, % IoPid
+ dump, % Filename | IoPid
+ flags}). % List
+
+-record(profile_start, {group_leader, % IoPid
+ dump, % Filename | IoPid
+ flags}). % List
+
+-record(profile_stop, {}).
+
+-record(analyse, {group_leader, % IoPid
+ dest, % Filename | IoPid
+ flags, % List
+ cols, % Integer
+ callers, % Boolean
+ sort, % acc_r | own_r
+ totals, % Boolean
+ details}). % Boolean
+
+-record(stop, {
+ reason}).
+
+
+
+%%---------------
+%% Debug requests
+%%---------------
+
+-record(get_state, {}).
+
+-record(save_profile, {file}).
+
+-record(load_profile, {file}).
+
+
+
+%%%----------------------------------------------------------------------
+%%% Basic API functions
+%%%----------------------------------------------------------------------
+
+
+
+trace(start, Filename) ->
+ trace([start, {file, Filename}]);
+trace(verbose, Filename) ->
+ trace([start, verbose, {file, Filename}]);
+trace(Option, Value) when is_atom(Option) ->
+ trace([{Option, Value}]);
+trace(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+trace(stop) ->
+ %% This shortcut is present to minimize the number of undesired
+ %% function calls at the end of the trace.
+ call(#trace_stop{});
+trace(verbose) ->
+ trace([start, verbose]);
+trace([stop]) ->
+ %% This shortcut is present to minimize the number of undesired
+ %% function calls at the end of the trace.
+ call(#trace_stop{});
+trace({Opt, _Val} = Option) when is_atom(Opt) ->
+ trace([Option]);
+trace(Option) when is_atom(Option) ->
+ trace([Option]);
+trace(Options) when is_list(Options) ->
+ case getopts(Options,
+ [start, stop, procs, verbose, file, tracer, cpu_time]) of
+ {[[], [stop], [], [], [], [], []], []} ->
+ call(#trace_stop{});
+ {[[start], [], Procs, Verbose, File, Tracer, CpuTime], []} ->
+ {Type, Dest} = case {File, Tracer} of
+ {[], [{tracer, Pid} = T]}
+ when is_pid(Pid); is_port(Pid) ->
+ T;
+ {[file], []} ->
+ {file, ?TRACE_FILE};
+ {[{file, []}], []} ->
+ {file, ?TRACE_FILE};
+ {[{file, _} = F], []} ->
+ F;
+ {[], []} ->
+ {file, ?TRACE_FILE};
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ V = case Verbose of
+ [] -> normal;
+ [verbose] -> verbose;
+ [{verbose, true}] -> verbose;
+ [{verbose, false}] -> normal;
+ _ -> erlang:error(badarg, [Options])
+ end,
+ CT = case CpuTime of
+ [] -> wallclock;
+ [cpu_time] -> cpu_time;
+ [{cpu_time, true}] -> cpu_time;
+ [{cpu_time, false}] -> wallclock;
+ _ -> erlang:error(badarg, [Options])
+ end,
+ call(#trace_start{procs = case Procs of
+ [] ->
+ [self()];
+ [{procs, P}] when is_list(P) ->
+ P;
+ [{procs, P}] ->
+ [P];
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ mode = {V, CT},
+ type = Type,
+ dest = Dest});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+trace(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+profile() ->
+ profile([]).
+
+profile(Option, Value) when is_atom(Option) ->
+ profile([{Option, Value}]);
+profile(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+profile(Option) when is_atom(Option) ->
+ profile([Option]);
+profile({Opt, _Val} = Option) when is_atom(Opt) ->
+ profile([Option]);
+profile(Options) when is_list(Options) ->
+ case getopts(Options, [start, stop, file, dump, append]) of
+ {[Start, [], File, Dump, Append], []} ->
+ {Target, Flags} =
+ case {Dump, Append} of
+ {[], []} ->
+ {[], []};
+ {[dump], []} ->
+ {group_leader(), []};
+ {[{dump, []}], []} ->
+ {?DUMP_FILE, []};
+ {[{dump, []}], [append]} ->
+ {?DUMP_FILE, [append]};
+ {[{dump, D}], [append]} when is_pid(D) ->
+ erlang:error(badarg, [Options]);
+ {[{dump, D}], [append]} ->
+ {D, [append]};
+ {[{dump, D}], []} ->
+ {D, []};
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ case {Start, File} of
+ {[start], []} ->
+ call(#profile_start{group_leader = group_leader(),
+ dump = Target,
+ flags = Flags});
+ {[], _} ->
+ Src =
+ case File of
+ [] ->
+ ?TRACE_FILE;
+ [file] ->
+ ?TRACE_FILE;
+ [{file, []}] ->
+ ?TRACE_FILE;
+ [{file, F}] ->
+ F;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ call(#profile{src = Src,
+ group_leader = group_leader(),
+ dump = Target,
+ flags = Flags});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+ {[[], [stop], [], [], []], []} ->
+ call(#profile_stop{});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+profile(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+analyse() ->
+ analyse([]).
+
+analyse(Option, Value) when is_atom(Option) ->
+ analyse([{Option, Value}]);
+analyse(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+analyse(Option) when is_atom(Option) ->
+ analyse([Option]);
+analyse({Opt, _Val} = Option) when is_atom(Opt) ->
+ analyse([Option]);
+analyse(Options) when is_list(Options) ->
+ case getopts(Options,
+ [dest, append, cols, callers, no_callers,
+ sort, totals, details, no_details]) of
+ {[Dest, Append, Cols, Callers, NoCallers,
+ Sort, Totals, Details, NoDetails], []} ->
+ {Target, Flags} =
+ case {Dest, Append} of
+ {[], []} ->
+ {group_leader(), []};
+ {[dest], []} ->
+ {group_leader(), []};
+ {[{dest, []}], []} ->
+ {?ANALYSIS_FILE, []};
+ {[{dest, []}], [append]} ->
+ {?ANALYSIS_FILE, [append]};
+ {[{dest, F}], [append]} when is_pid(F) ->
+ erlang:error(badarg, [Options]);
+ {[{dest, F}], [append]} ->
+ {F, [append]};
+ {[{dest, F}], []} ->
+ {F, []};
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ call(#analyse{group_leader = group_leader(),
+ dest = Target,
+ flags = Flags,
+ cols = case Cols of
+ [] ->
+ 80;
+ [{cols, C}] when is_integer(C), C > 0 ->
+ C;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ callers = case {Callers, NoCallers} of
+ {[], []} ->
+ true;
+ {[callers], []} ->
+ true;
+ {[{callers, true}], []} ->
+ true;
+ {[{callers, false}], []} ->
+ false;
+ {[], [no_callers]} ->
+ false;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ sort = case Sort of
+ [] ->
+ acc;
+ [{sort, acc}] ->
+ acc;
+ [{sort, own}] ->
+ own;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ totals = case Totals of
+ [] ->
+ false;
+ [totals] ->
+ true;
+ [{totals, true}] ->
+ true;
+ [{totals, false}] ->
+ false;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ details = case {Details, NoDetails} of
+ {[], []} ->
+ true;
+ {[details], []} ->
+ true;
+ {[{details, true}], []} ->
+ true;
+ {[{details, false}], []} ->
+ false;
+ {[], [no_details]} ->
+ false;
+ _ ->
+ erlang:error(badarg, [Options])
+ end});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+analyse(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+%%----------------
+%% Debug functions
+%%----------------
+
+
+
+get_state() ->
+ just_call(#get_state{}).
+
+
+
+save_profile() ->
+ save_profile([]).
+
+save_profile(Option, Value) when is_atom(Option) ->
+ save_profile([{Option, Value}]);
+save_profile(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+save_profile(Option) when is_atom(Option) ->
+ save_profile([Option]);
+save_profile(Options) when is_list(Options) ->
+ case getopts(Options, [file]) of
+ {[File], []} ->
+ call(#save_profile{file = case File of
+ [] ->
+ ?PROFILE_FILE;
+ [{file, F}] ->
+ F;
+ _ ->
+ erlang:error(badarg, [Options])
+ end});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+save_profile(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+load_profile() ->
+ load_profile([]).
+
+load_profile(Option, Value) when is_atom(Option) ->
+ load_profile([{Option, Value}]);
+load_profile(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+load_profile(Option) when is_atom(Option) ->
+ load_profile([Option]);
+load_profile(Options) when is_list(Options) ->
+ case getopts(Options, [file]) of
+ {[File], []} ->
+ call(#load_profile{file = case File of
+ [] ->
+ ?PROFILE_FILE;
+ [{file, F}] ->
+ F;
+ _ ->
+ erlang:error(badarg, [Options])
+ end});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+load_profile(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+code_change() ->
+ just_call('$code_change').
+
+
+
+%%%----------------------------------------------------------------------
+%%% ETS table record definitions
+%%% The field 'id' must be first in these records;
+%%% it is the common ets table index field.
+%%%----------------------------------------------------------------------
+
+-record(clocks, {
+ id,
+ cnt = 0, % Number of calls
+ own = 0, % Own time (wall clock)
+ acc = 0}). % Accumulated time : own + subfunctions (wall clock)
+
+-record(proc, {
+ id,
+ parent,
+ spawned_as, % Spawned MFArgs
+ init_log = [], % List of first calls, head is newest
+ init_cnt = 2}). % First calls counter, counts down to 0
+
+-record(misc, {id,
+ data}).
+
+
+
+%% Analysis summary record
+-record(funcstat, {
+ callers_sum, % #clocks{id = {Pid, Caller, Func}}
+ called_sum, % #clocks{id = {Pid, Caller, Func}}
+ callers = [], % [#clocks{}, ...]
+ called = []}). % [#clocks{}, ...]
+
+
+
+%%%----------------------------------------------------------------------
+%%% ?FPROF_SERVER
+%%%----------------------------------------------------------------------
+
+%%%-------------------
+%%% Exported functions
+%%%-------------------
+
+%% Start server process
+start() ->
+ spawn_3step(
+ fun () ->
+ try register(?FPROF_SERVER, self()) of
+ true ->
+ process_flag(trap_exit, true),
+ {{ok, self()}, loop}
+ catch
+ error:badarg ->
+ {{error, {already_started, whereis(?FPROF_SERVER)}},
+ already_started}
+ end
+ end,
+ fun (X) ->
+ X
+ end,
+ fun (loop) ->
+ put(trace_state, idle),
+ put(profile_state, {idle, undefined}),
+ put(pending_stop, []),
+ server_loop([]);
+ (already_started) ->
+ ok
+ end).
+
+
+
+%% Stop server process
+
+stop() ->
+ stop(normal).
+
+stop(kill) ->
+ case whereis(?FPROF_SERVER) of
+ undefined ->
+ ok;
+ Pid ->
+ exit(Pid, kill),
+ ok
+ end;
+stop(Reason) ->
+ just_call(#stop{reason = Reason}),
+ ok.
+
+
+
+%%%------------------------
+%%% Client helper functions
+%%%------------------------
+
+%% Send request to server process and return the server's reply.
+%% First start server if it ain't started.
+call(Request) ->
+ case whereis(?FPROF_SERVER) of
+ undefined ->
+ start(),
+ just_call(Request);
+ Server ->
+ just_call(Server, Request)
+ end.
+
+%% Send request to server process, and return the server's reply.
+%% Returns {'EXIT', Pid, Reason} if the server dies during the
+%% call, or if it wasn't started.
+just_call(Request) ->
+ just_call(whereis(?FPROF_SERVER), Request).
+
+just_call(undefined, _) ->
+ {'EXIT', ?FPROF_SERVER, noproc};
+just_call(Pid, Request) ->
+ Mref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Mref, _, _, Reason} ->
+ {'EXIT', Pid, Reason}
+ after 0 ->
+ Tag = {Mref, self()},
+ {T, Demonitor} = case Request of
+ #stop{} ->
+ {?FPROF_SERVER_TIMEOUT, false};
+ _ ->
+ {0, true}
+ end,
+ %% io:format("~p request: ~p~n", [?MODULE, Request]),
+ catch Pid ! {?FPROF_SERVER, Tag, Request},
+ receive
+ {?FPROF_SERVER, Mref, Reply} ->
+ case Demonitor of
+ true -> erlang:demonitor(Mref);
+ false -> ok
+ end,
+ receive {'DOWN', Mref, _, _, _} -> ok after T -> ok end,
+ Reply;
+ {'DOWN', Mref, _, _, Reason} ->
+ receive {?FPROF_SERVER, Mref, _} -> ok after T -> ok end,
+ {'EXIT', Pid, Reason}
+ after ?FPROF_SERVER_TIMEOUT ->
+ timeout
+ end
+ end.
+
+
+
+%%%------------------------
+%%% Server helper functions
+%%%------------------------
+
+%% Return the reply to the client's request.
+reply({Mref, Pid}, Reply) when is_reference(Mref), is_pid(Pid) ->
+ catch Pid ! {?FPROF_SERVER, Mref, Reply},
+ ok.
+
+
+
+server_loop(State) ->
+ receive
+ {?FPROF_SERVER, {Mref, Pid} = Tag, '$code_change'}
+ when is_reference(Mref), is_pid(Pid) ->
+ reply(Tag, ok),
+ ?MODULE:'$code_change'(State);
+ {?FPROF_SERVER, {Mref, Pid} = Tag, Request}
+ when is_reference(Mref), is_pid(Pid) ->
+ server_loop(handle_req(Request, Tag, State));
+ Other ->
+ server_loop(handle_other(Other, State))
+ end.
+
+%-export.
+'$code_change'(State) ->
+ case lists:keysearch(time, 1, module_info(compile)) of
+ {value, {time, {Y, M, D, HH, MM, SS}}} ->
+ io:format("~n~w: code change to compile time "
+ ++"~4..0w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w~n",
+ [?MODULE, Y, M, D, HH, MM, SS]);
+ false ->
+ ok
+ end,
+ server_loop(State).
+
+
+
+%% Server help function that stops the server iff the
+%% sub state machines are in proper states. Sends the reply
+%% to all waiting clients.
+try_pending_stop(State) ->
+ case {get(trace_state), get(profile_state), get(pending_stop)} of
+ {idle, {idle, _}, [_|_] = PendingStop} ->
+ Reason = get(stop_reason),
+ Reply = result(Reason),
+ lists:foreach(
+ fun (Tag) ->
+ reply(Tag, Reply)
+ end,
+ PendingStop),
+ exit(Reason);
+ _ ->
+ State
+ end.
+
+%%------------------
+%% Server handle_req
+%%------------------
+
+handle_req(#trace_start{procs = Procs,
+ mode = Mode,
+ type = file,
+ dest = Filename}, Tag, State) ->
+ case {get(trace_state), get(pending_stop)} of
+ {idle, []} ->
+ trace_off(),
+ Port = open_dbg_trace_port(file, Filename),
+ case trace_on(Procs, Port, Mode) of
+ ok ->
+ put(trace_state, running),
+ put(trace_type, file),
+ put(trace_pid, Port),
+ reply(Tag, ok),
+ State;
+ Error ->
+ reply(Tag, Error),
+ State
+ end;
+ _ ->
+ reply(Tag, {error, already_tracing}),
+ State
+ end;
+handle_req(#trace_start{procs = Procs,
+ mode = Mode,
+ type = tracer,
+ dest = Tracer}, Tag, State) ->
+ case {get(trace_state), get(pending_stop)} of
+ {idle, []} ->
+ trace_off(),
+ case trace_on(Procs, Tracer, Mode) of
+ ok ->
+ put(trace_state, running),
+ put(trace_type, tracer),
+ put(trace_pid, Tracer),
+ reply(Tag, ok),
+ State;
+ Error ->
+ reply(Tag, Error),
+ State
+ end;
+ _ ->
+ reply(Tag, {error, already_tracing}),
+ State
+ end;
+
+handle_req(#trace_stop{}, Tag, State) ->
+ case get(trace_state) of
+ running ->
+ TracePid = get(trace_pid),
+ trace_off(),
+ case erase(trace_type) of
+ file ->
+ catch erlang:port_close(TracePid),
+ put(trace_state, stopping),
+ put(trace_tag, Tag),
+ State;
+ tracer ->
+ erase(trace_pid),
+ put(trace_state, idle),
+ case {get(profile_state), get(profile_type),
+ get(profile_pid)} of
+ {running, tracer, TracePid} ->
+ exit(TracePid, normal),
+ put(profile_tag, Tag),
+ State;
+ _ ->
+ reply(Tag, ok),
+ try_pending_stop(State)
+ end
+ end;
+ _ ->
+ reply(Tag, {error, not_tracing}),
+ State
+ end;
+
+handle_req(#profile{src = Filename,
+ group_leader = GroupLeader,
+ dump = Dump,
+ flags = Flags}, Tag, State) ->
+ case {get(profile_state), get(pending_stop)} of
+ {{idle, _}, []} ->
+ case ensure_open(Dump, [write | Flags]) of
+ {already_open, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, false);
+ {ok, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, true);
+ {error, _} = Error ->
+ reply(Tag, Error),
+ State
+ end,
+ Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]),
+ Pid = spawn_link_dbg_trace_client(Filename, Table,
+ GroupLeader,
+ get(profile_dump)),
+ put(profile_state, running),
+ put(profile_type, file),
+ put(profile_pid, Pid),
+ put(profile_tag, Tag),
+ put(profile_table, Table),
+ State;
+ _ ->
+ reply(Tag, {error, already_profiling}),
+ State
+ end;
+
+handle_req(#profile_start{group_leader = GroupLeader,
+ dump = Dump,
+ flags = Flags}, Tag, State) ->
+ case {get(profile_state), get(pending_stop)} of
+ {{idle, _}, []} ->
+ case ensure_open(Dump, [write | Flags]) of
+ {already_open, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, false);
+ {ok, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, true);
+ {error, _} = Error ->
+ reply(Tag, Error),
+ State
+ end,
+ Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]),
+ Pid = spawn_link_trace_client(Table, GroupLeader,
+ get(profile_dump)),
+ put(profile_state, running),
+ put(profile_type, tracer),
+ put(profile_pid, Pid),
+ put(profile_table, Table),
+ reply(Tag, {ok, Pid}),
+ State;
+ _ ->
+ reply(Tag, {error, already_profiling}),
+ State
+ end;
+
+handle_req(#profile_stop{}, Tag, State) ->
+ case {get(profile_state), get(profile_type)} of
+ {running, tracer} ->
+ ProfilePid = get(profile_pid),
+ case {get(trace_state), get(trace_type), get(trace_pid)} of
+ {running, tracer, ProfilePid} ->
+ trace_off(),
+ erase(trace_type),
+ erase(trace_pid),
+ put(trace_state, idle);
+ _ ->
+ ok
+ end,
+ exit(ProfilePid, normal),
+ put(profile_tag, Tag),
+ State;
+ {running, file} ->
+ reply(Tag, {error, profiling_file}),
+ State;
+ {_, _} ->
+ reply(Tag, {error, not_profiling}),
+ State
+ end;
+
+handle_req(#analyse{dest = Dest,
+ flags = Flags} = Request, Tag, State) ->
+ case get(profile_state) of
+ {idle, undefined} ->
+ reply(Tag, {error, no_profile}),
+ State;
+ {idle, _} ->
+ case ensure_open(Dest, [write | Flags]) of
+ {error, _} = Error ->
+ reply(Tag, Error),
+ State;
+ {DestState, DestPid} ->
+ ProfileTable = get(profile_table),
+ reply(Tag,
+ spawn_3step(
+ fun() ->
+ do_analyse(ProfileTable,
+ Request#analyse{dest = DestPid})
+ end,
+ fun(Result) ->
+ {Result,finish}
+ end,
+ fun(finish) ->
+ ok
+ end)),
+ case DestState of
+ already_open ->
+ ok;
+ ok ->
+ file:close(DestPid)
+ end,
+ State
+ end;
+ _ ->
+ reply(Tag, {error, profiling}),
+ State
+ end;
+
+handle_req(#stop{reason = Reason}, Tag, State) ->
+ PendingStop = get(pending_stop),
+ case PendingStop of
+ [] ->
+ put(stop_reason, Reason);
+ _ ->
+ ok
+ end,
+ put(pending_stop, [Tag | PendingStop]),
+ try_pending_stop(State);
+
+%%----------------------
+%% Server debug requests
+%%----------------------
+
+handle_req(#get_state{}, Tag, State) ->
+ reply(Tag, {ok, get()}),
+ State;
+
+handle_req(#save_profile{file = File}, Tag, State) ->
+ case get(profile_state) of
+ {idle, undefined} ->
+ reply(Tag, {error, no_profile});
+ {idle, _} ->
+ reply(Tag, ets:tab2file(get(profile_table), File)),
+ State;
+ _ ->
+ reply(Tag, {error, profiling}),
+ State
+ end;
+
+handle_req(#load_profile{file = File}, Tag, State) ->
+ case get(profile_state) of
+ {idle, Result} ->
+ case ets:file2tab(File) of
+ {ok, Table} ->
+ put(profile_state, {idle, ok}),
+ case Result of
+ {error, no_profile} ->
+ ets:delete(put(profile_table, Table));
+ _ ->
+ put(profile_table, Table)
+ end,
+ reply(Tag, ok),
+ State;
+ Error ->
+ reply(Tag, Error),
+ State
+ end;
+ _ ->
+ reply(Tag, {error, profiling}),
+ State
+ end;
+
+
+
+handle_req(Request, Tag, State) ->
+ io:format("~n~p:handle_req, unknown request - ~p~n",
+ [?MODULE, Request]),
+ reply(Tag, {error, unknown_request}),
+ State.
+
+%%--------------------
+%% Server handle_other
+%%--------------------
+
+handle_other({'EXIT', Pid, Reason} = Other, State) when is_pid(Pid); is_port(Pid) ->
+ case {get(trace_state), get(trace_pid)} of
+ {running, Pid} ->
+ trace_off(),
+ io:format("~n~p:handle_other, unexpected ~p (trace_pid)~n",
+ [?MODULE, Other]),
+ put(trace_state, idle),
+ erase(trace_type),
+ erase(trace_pid),
+ try_pending_stop(State);
+ {stopping, Pid} ->
+ put(trace_state, idle),
+ erase(trace_pid),
+ reply(erase(trace_tag), result(Reason)),
+ try_pending_stop(State);
+ _ ->
+ case {get(profile_state), get(profile_pid)} of
+ {running, Pid} ->
+ Result = result(Reason),
+ put(profile_state, {idle, Result}),
+ erase(profile_type),
+ erase(profile_pid),
+ case erase(profile_close_dump) of
+ true ->
+ file:close(erase(profile_dump));
+ false ->
+ erase(profile_dump)
+ end,
+ reply(erase(profile_tag), Result),
+ try_pending_stop(State);
+ _ ->
+ io:format("~n~p:handle_other, unexpected ~p~n",
+ [?MODULE, Other]),
+ State
+ end
+ end;
+
+handle_other(Other, State) ->
+ io:format("~p:handle_other, unknown - ~p",
+ [?MODULE, Other]),
+ State.
+
+
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+result(normal) ->
+ ok;
+result(Reason) ->
+ {error, Reason}.
+
+ensure_open(Pid, _Options) when is_pid(Pid) ->
+ {already_open, Pid};
+ensure_open([], _Options) ->
+ {already_open, undefined};
+ensure_open(Filename, Options) when is_atom(Filename); is_list(Filename) ->
+ file:open(Filename, Options).
+
+%%%---------------------------------
+%%% Fairly generic utility functions
+%%%---------------------------------
+
+
+
+%% getopts(List, Options)) -> {DecodedOptions, RestOptions}
+%%
+%% List = [Option]
+%% Options = [OptionTag]
+%% Option = OptionTag | OptionTuple
+%% OptionTuple = tuple(), element(1, OptionTuple) == OptionTag
+%% OptionTag = term()
+%% OptionValue = term()
+%% DecodedOptions = [OptionList]
+%% OptionList = [Option]
+%% RestOptions = [Option]
+%%
+%% Searches List for options with tags defined in Options.
+%% Returns DecodedOptions containing one OptionList per
+%% OptionTag in Options, and RestOptions which contains
+%% all terms from List not matching any OptionTag.
+%%
+%% All returned lists preserve the order from Options and List.
+%%
+%% An example:
+%% getopts([{f, 1}, e, {d, 2}, {c, 3, 4}, {b, 5}, a, b],
+%% [a, b, c, d]) ->
+%% {[[a], [{b, 5}, b],[{c, 3, 4}], [{d, 2}]],
+%% [{f, 1}, e]}
+%%
+getopts(List, Options) when is_list(List), is_list(Options) ->
+ getopts_1(Options, List, []).
+
+getopts_1([], List, Result) ->
+ {lists:reverse(Result), List};
+getopts_1([Option | Options], List, Result) ->
+ {Optvals, Remaining} = getopts_2(List, Option, [], []),
+ getopts_1(Options, Remaining, [Optvals | Result]).
+
+getopts_2([], _Option, Result, Remaining) ->
+ {lists:reverse(Result), lists:reverse(Remaining)};
+getopts_2([Option | Tail], Option, Result, Remaining) ->
+ getopts_2(Tail, Option, [Option | Result], Remaining);
+getopts_2([Optval | Tail], Option, Result, Remaining)
+ when element(1, Optval) =:= Option ->
+ getopts_2(Tail, Option, [Optval | Result], Remaining);
+getopts_2([Other | Tail], Option, Result, Remaining) ->
+ getopts_2(Tail, Option, Result, [Other | Remaining]).
+
+%% setopts(Options) -> List
+%%
+%% The reverse of getopts, almost.
+%% Re-creates (approximately) List from DecodedOptions in
+%% getopts/2 above. The original order is not preserved,
+%% but rather the order from Options.
+%%
+%% An example:
+%% setopts([[a], [{b,5}, b], [{c, 3, 4}], [{d,2}]]) ->
+%% [a, {b, 5}, b, {c, 3, 4}, {d, 2}]
+%%
+%% And a more generic example:
+%% {D, R} = getopts(L, O),
+%% L2 = setopts(D) ++ R
+%% L2 will contain exactly the same terms as L, but not in the same order.
+%%
+setopts(Options) when is_list(Options) ->
+ lists:append(Options).
+
+
+
+spawn_3step(FunPrelude, FunAck, FunBody) ->
+ spawn_3step(spawn, FunPrelude, FunAck, FunBody).
+
+spawn_link_3step(FunPrelude, FunAck, FunBody) ->
+ spawn_3step(spawn_link, FunPrelude, FunAck, FunBody).
+
+spawn_3step(Spawn, FunPrelude, FunAck, FunBody)
+ when Spawn =:= spawn; Spawn =:= spawn_link ->
+ Parent = self(),
+ Ref = make_ref(),
+ Child =
+ erlang:Spawn(
+ fun() ->
+ Ack = FunPrelude(),
+ catch Parent ! {self(), Ref, Ack},
+ MRef = erlang:monitor(process, Parent),
+ receive
+ {Parent, Ref, Go} ->
+ erlang:demonitor(MRef),
+ receive {'DOWN', MRef, _, _, _} -> ok
+ after 0 -> ok
+ end,
+ FunBody(Go);
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ end
+ end),
+ MRef = erlang:monitor(process, Child),
+ receive
+ {Child, Ref, Ack} ->
+ erlang:demonitor(MRef),
+ receive {'DOWN', MRef, _, _, _} -> ok after 0 -> ok end,
+ try FunAck(Ack) of
+ {Result, Go} ->
+ catch Child ! {Parent, Ref, Go},
+ Result
+ catch
+ Class:Reason ->
+ Stacktrace = erlang:get_stacktrace(),
+ catch exit(Child, kill),
+ erlang:raise(Class, Reason, Stacktrace)
+ end;
+ {'DOWN', MRef, _, _, Reason} ->
+ receive {Child, Ref, _Ack} -> ok after 0 -> ok end,
+ case Spawn of
+ spawn_link ->
+ receive {'EXIT', Reason} -> ok after 0 -> ok end;
+ spawn ->
+ ok
+ end,
+ exit(Reason)
+ end.
+
+
+
+%%%---------------------------------
+%%% Trace message handling functions
+%%%---------------------------------
+
+trace_off() ->
+ try erlang:trace_delivered(all) of
+ Ref -> receive {trace_delivered, all, Ref} -> ok end
+ catch
+ error:undef -> ok
+ end,
+ try erlang:trace(all, false, [all, cpu_timestamp])
+ catch
+ error:badarg -> erlang:trace(all, false, [all])
+ end,
+ erlang:trace_pattern(on_load, false, [local]),
+ erlang:trace_pattern({'_', '_', '_'}, false, [local]),
+ ok.
+
+
+
+trace_on(Procs, Tracer, {V, CT}) ->
+ case case CT of
+ cpu_time ->
+ try erlang:trace(all, true, [cpu_timestamp]) of _ -> ok
+ catch
+ error:badarg -> {error, not_supported}
+ end;
+ wallclock -> ok
+ end
+ of ok ->
+ MatchSpec = [{'_', [], [{message, {{cp, {caller}}}}]}],
+ erlang:trace_pattern(on_load, MatchSpec, [local]),
+ erlang:trace_pattern({'_', '_', '_'}, MatchSpec, [local]),
+ lists:foreach(
+ fun (P) ->
+ erlang:trace(P, true, [{tracer, Tracer} | trace_flags(V)])
+ end,
+ Procs),
+ ok;
+ Error ->
+ Error
+ end.
+
+
+
+trace_flags(normal) ->
+ [call, return_to,
+ running, procs, garbage_collection,
+ arity, timestamp, set_on_spawn];
+trace_flags(verbose) ->
+ [call, return_to,
+ send, 'receive',
+ running, procs, garbage_collection,
+ timestamp, set_on_spawn].
+
+
+
+%%%-------------------------------------
+%%% Tracer process functions, for
+%%% the 'dbg' tracer and for a lookalike
+%%%-------------------------------------
+
+open_dbg_trace_port(Type, Spec) ->
+ Fun = dbg:trace_port(Type, Spec),
+ Fun().
+
+
+
+spawn_link_dbg_trace_client(File, Table, GroupLeader, Dump) ->
+ case dbg:trace_client(file, File,
+ {fun handler/2,
+ {init, GroupLeader, Table, Dump}}) of
+ Pid when is_pid(Pid) ->
+ link(Pid),
+ Pid;
+ Other ->
+ exit(Other)
+ end.
+
+
+
+
+spawn_link_trace_client(Table, GroupLeader, Dump) ->
+ Parent = self(),
+ spawn_link_3step(
+ fun() ->
+ process_flag(trap_exit, true),
+ {self(),go}
+ end,
+ fun(Ack) ->
+ Ack
+ end,
+ fun(go) ->
+ Init = {init, GroupLeader, Table, Dump},
+ tracer_loop(Parent, fun handler/2, Init)
+ end).
+
+tracer_loop(Parent, Handler, State) ->
+ receive
+ Trace when element(1, Trace) =:= trace ->
+ tracer_loop(Parent, Handler, Handler(Trace, State));
+ Trace when element(1, Trace) =:= trace_ts ->
+ tracer_loop(Parent, Handler, Handler(Trace, State));
+ {'EXIT', Parent, Reason} ->
+ handler(end_of_trace, State),
+ exit(Reason);
+ _ ->
+ tracer_loop(Parent, Handler, State)
+ end.
+
+
+
+%%%---------------------------------
+%%% Trace message handling functions
+%%%---------------------------------
+
+handler(end_of_trace, {init, GroupLeader, Table, Dump}) ->
+ dump(Dump, start_of_trace),
+ dump(Dump, end_of_trace),
+ info(GroupLeader, Dump, "Empty trace!~n", []),
+ end_of_trace(Table, undefined),
+ done;
+handler(end_of_trace, {error, Reason, _, GroupLeader, Dump}) ->
+ info(GroupLeader, Dump, "~nEnd of erroneous trace!~n", []),
+ exit(Reason);
+handler(end_of_trace, {_, TS, GroupLeader, Table, Dump}) ->
+ dump(Dump, end_of_trace),
+ info(GroupLeader, Dump, "~nEnd of trace!~n", []),
+ end_of_trace(Table, TS),
+ done;
+handler(Trace, {init, GroupLeader, Table, Dump}) ->
+ dump(Dump, start_of_trace),
+ info(GroupLeader, Dump, "Reading trace data...~n", []),
+ try trace_handler(Trace, Table, GroupLeader, Dump) of
+ TS ->
+ ets:insert(Table, #misc{id = first_ts, data = TS}),
+ ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}),
+ {1, TS, GroupLeader, Table, Dump}
+ catch
+ Error ->
+ dump(Dump, {error, Error}),
+ end_of_trace(Table, undefined),
+ {error, Error, 1, GroupLeader, Dump}
+ end;
+%% case catch trace_handler(Trace, Table, GroupLeader, Dump) of
+%% {'EXIT', Reason} ->
+%% dump(Dump, {error, Reason}),
+%% end_of_trace(Table, undefined),
+%% {error, Reason, 1, GroupLeader, Dump};
+%% TS ->
+%% ets:insert(Table, #misc{id = first_ts, data = TS}),
+%% ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}),
+%% {1, TS, GroupLeader, Table, Dump}
+%% end;
+handler(_, {error, Reason, M, GroupLeader, Dump}) ->
+ N = M+1,
+ info_dots(GroupLeader, Dump, N),
+ {error, Reason, N, GroupLeader, Dump};
+handler(Trace, {M, TS0, GroupLeader, Table, Dump}) ->
+ N = M+1,
+ info_dots(GroupLeader, Dump, N),
+ try trace_handler(Trace, Table, GroupLeader, Dump) of
+ TS ->
+ ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}),
+ {N, TS, GroupLeader, Table, Dump}
+ catch
+ Error ->
+ dump(Dump, {error, Error}),
+ end_of_trace(Table, TS0),
+ {error, Error, N, GroupLeader, Dump}
+ end.
+%% case catch trace_handler(Trace, Table, GroupLeader, Dump) of
+%% {'EXIT', Reason} ->
+%% dump(Dump, {error, Reason}),
+%% end_of_trace(Table, TS0),
+%% {error, Reason, N, GroupLeader, Dump};
+%% TS ->
+%% ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}),
+%% {N, TS, GroupLeader, Table, Dump}
+%% end.
+
+
+
+end_of_trace(Table, TS) ->
+ %%
+ %% Close all process stacks, as if the processes exited.
+ %%
+ Procs = get(),
+ put(table, Table),
+ ?dbg(2, "get() -> ~p~n", [Procs]),
+ lists:map(
+ fun ({Pid, _}) when is_pid(Pid) ->
+ trace_exit(Table, Pid, TS)
+ end,
+ Procs),
+ erase(),
+ ok.
+
+
+
+info_dots(GroupLeader, GroupLeader, _) ->
+ ok;
+info_dots(GroupLeader, _, N) ->
+ if (N rem 100000) =:= 0 ->
+ io:format(GroupLeader, ",~n", []);
+ (N rem 50000) =:= 0 ->
+ io:format(GroupLeader, ".~n", []);
+ (N rem 1000) =:= 0 ->
+ io:put_chars(GroupLeader, ".");
+ true ->
+ ok
+ end.
+
+info_suspect_call(GroupLeader, GroupLeader, _, _) ->
+ ok;
+info_suspect_call(GroupLeader, _, Func, Pid) ->
+ io:format(GroupLeader,
+ "~nWarning: ~p called in ~p - trace may become corrupt!~n",
+ parsify([Func, Pid])).
+
+info(GroupLeader, GroupLeader, _, _) ->
+ ok;
+info(GroupLeader, _, Format, List) ->
+ io:format(GroupLeader, Format, List).
+
+dump_stack(undefined, _, _) ->
+ false;
+dump_stack(Dump, Stack, Term) ->
+ {Depth, _D} =
+ case Stack of
+ undefined ->
+ {0, 0};
+ _ ->
+ case length(Stack) of
+ 0 ->
+ {0, 0};
+ N ->
+ {N, length(hd(Stack))}
+ end
+ end,
+ io:format(Dump, "~s~p.~n", [lists:duplicate(Depth, " "), parsify(Term)]),
+ true.
+
+dump(undefined, _) ->
+ false;
+dump(Dump, Term) ->
+ io:format(Dump, "~p.~n", [parsify(Term)]),
+ true.
+
+
+
+%%%----------------------------------
+%%% Profiling state machine functions
+%%%----------------------------------
+
+
+
+trace_handler({trace_ts, Pid, call, _MFA, _TS} = Trace,
+ _Table, _, Dump) ->
+ Stack = get(Pid),
+ dump_stack(Dump, Stack, Trace),
+ throw({incorrect_trace_data, ?MODULE, ?LINE,
+ [Trace, Stack]});
+trace_handler({trace_ts, Pid, call, {_M, _F, Arity} = Func,
+ {cp, CP}, TS} = Trace,
+ Table, GroupLeader, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ case Func of
+ {erlang, trace, 3} ->
+ info_suspect_call(GroupLeader, Dump, Func, Pid);
+ {erlang, trace_pattern, 3} ->
+ info_suspect_call(GroupLeader, Dump, Func, Pid);
+ _ ->
+ ok
+ end,
+ trace_call(Table, Pid, Func, TS, CP),
+ TS;
+trace_handler({trace_ts, Pid, call, {_M, _F, Args} = MFArgs,
+ {cp, CP}, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_call(Table, Pid, Func, TS, CP),
+ TS;
+%%
+%% return_to
+trace_handler({trace_ts, Pid, return_to, undefined, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_return_to(Table, Pid, undefined, TS),
+ TS;
+trace_handler({trace_ts, Pid, return_to, {_M, _F, Arity} = Func, TS} = Trace,
+ Table, _, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_return_to(Table, Pid, Func, TS),
+ TS;
+trace_handler({trace_ts, Pid, return_to, {_M, _F, Args} = MFArgs, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_return_to(Table, Pid, Func, TS),
+ TS;
+%%
+%% spawn
+trace_handler({trace_ts, Pid, spawn, Child, MFArgs, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_spawn(Table, Child, MFArgs, TS, Pid),
+ TS;
+%%
+%% exit
+trace_handler({trace_ts, Pid, exit, _Reason, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_exit(Table, Pid, TS),
+ TS;
+%%
+%% out
+trace_handler({trace_ts, Pid, out, 0, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_out(Table, Pid, undefined, TS),
+ TS;
+trace_handler({trace_ts, Pid, out, {_M, _F, Arity} = Func, TS} = Trace,
+ Table, _, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_out(Table, Pid, Func, TS),
+ TS;
+trace_handler({trace_ts, Pid, out, {_M, _F, Args} = MFArgs, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_out(Table, Pid, Func, TS),
+ TS;
+%%
+%% in
+trace_handler({trace_ts, Pid, in, 0, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_in(Table, Pid, undefined, TS),
+ TS;
+trace_handler({trace_ts, Pid, in, {_M, _F, Arity} = Func, TS} = Trace,
+ Table, _, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_in(Table, Pid, Func, TS),
+ TS;
+trace_handler({trace_ts, Pid, in, {_M, _F, Args} = MFArgs, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_in(Table, Pid, Func, TS),
+ TS;
+%%
+%% gc_start
+trace_handler({trace_ts, Pid, gc_start, _Func, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_gc_start(Table, Pid, TS),
+ TS;
+%%
+%% gc_end
+trace_handler({trace_ts, Pid, gc_end, _Func, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_gc_end(Table, Pid, TS),
+ TS;
+%%
+%% link
+trace_handler({trace_ts, Pid, link, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% unlink
+trace_handler({trace_ts, Pid, unlink, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% getting_linked
+trace_handler({trace_ts, Pid, getting_linked, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% getting_unlinked
+trace_handler({trace_ts, Pid, getting_unlinked, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% register
+trace_handler({trace_ts, Pid, register, _Name, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% unregister
+trace_handler({trace_ts, Pid, unregister, _Name, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% send
+trace_handler({trace_ts, Pid, send, _OtherPid, _Msg, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% 'receive'
+trace_handler({trace_ts, Pid, 'receive', _Msg, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% Others
+trace_handler(Trace, _Table, _, Dump) ->
+ dump(Dump, Trace),
+ throw({incorrect_trace_data, ?MODULE, ?LINE, [Trace]}).
+
+
+
+%% The call stack
+%% --------------
+%%
+%% The call stack can be modeled as a tree, with each level in the tree
+%% corresponding to a real (non-tail recursive) stack entry,
+%% and the nodes within a level corresponding to tail recursive
+%% calls on that real stack depth.
+%%
+%% Example:
+%% a() ->
+%% b().
+%% b() ->
+%% c(),
+%% d().
+%% c() -> ok.
+%% d() ->
+%% e(),
+%% c().
+%% e() ->
+%% f().
+%% f() -> ok.
+%%
+%% During the execution the call tree would be, for each call and return_to:
+%%
+%% a() b() c() ->b d() e() f() ->d c() ->a
+%%
+%% a a a a a a a a a a
+%% | | | |\ |\ |\ |\ /|\
+%% b b b b d b d b d b d b d c
+%% | | /|
+%% c e e f
+%%
+%% The call tree is in this code represented as a two level list,
+%% which for the biggest tree (5 nodes) in the example above would be:
+%% [[{f, _}, {e, _}], [{d, _}, {b, _}], [{a, _}]]
+%% where the undefined fields are timestamps of the calls to the
+%% functions, and the function name fields are really
+%% {Module, Function, Arity} tuples.
+%%
+%% Since tail recursive calls can form an infinite loop, cycles
+%% within a tail recursive level must be collapsed or else the
+%% stack (tree) size may grow towards infinity.
+
+
+
+trace_call(Table, Pid, Func, TS, CP) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_call(~p, ~p, ~p, ~p)~n~p~n",
+ [Pid, Func, TS, CP, Stack]),
+ {Proc,InitCnt} =
+ case ets:lookup(Table, Pid) of
+ [#proc{init_cnt = N} = P] ->
+ {P,N};
+ [] ->
+ {undefined,0}
+ end,
+ case Stack of
+ [] ->
+ init_log(Table, Proc, Func),
+ OldStack =
+ if CP =:= undefined ->
+ Stack;
+ true ->
+ [[{CP, TS}]]
+ end,
+ put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack));
+ [[{Func, FirstInTS}]] when InitCnt=:=2 ->
+ %% First call on this process. Take the timestamp for first
+ %% time the process was scheduled in.
+ init_log(Table, Proc, Func),
+ OldStack =
+ if CP =:= undefined ->
+ [];
+ true ->
+ [[{CP, FirstInTS}]]
+ end,
+ put(Pid, trace_call_push(Table, Pid, Func, FirstInTS, OldStack));
+ [[{suspend, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, CP, Stack]});
+ [[{garbage_collect, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, CP, Stack]});
+ [[{CP, _} | _], [{CP, _} | _] | _] ->
+ %% This is a difficult case - current function becomes
+ %% new stack top but is already pushed. It might be that
+ %% this call is actually tail recursive, or maybe not.
+ %% Assume tail recursive to not build the stack infinitely
+ %% and fix the problem at the next call after a return to
+ %% this level.
+ %%
+ %% This can be viewed as collapsing a very short stack
+ %% recursive stack cykle.
+ init_log(Table, Proc, Func),
+ put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack));
+ [[{CP, _} | _] | _] ->
+ %% Current function becomes new stack top -> stack push
+ init_log(Table, Proc, Func),
+ put(Pid, trace_call_push(Table, Pid, Func, TS, Stack));
+ [_, [{CP, _} | _] | _] ->
+ %% Stack top unchanged -> no push == tail recursive call
+ init_log(Table, Proc, Func),
+ put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack));
+ [[{Func0, _} | _], [{Func0, _} | _], [{CP, _} | _] | _] ->
+ %% Artificial case that only should happen when
+ %% stack recursive short cycle collapsing has been done,
+ %% otherwise CP should not occur so far from the stack front.
+ %%
+ %% It is a tail recursive call but fix the stack first.
+ init_log(Table, Proc, Func),
+ put(Pid,
+ trace_call_shove(Table, Pid, Func, TS,
+ trace_return_to_int(Table, Pid, Func0, TS,
+ Stack)));
+ [[{_, TS0} | _] = Level0] ->
+ %% Current function known, but not stack top
+ %% -> assume tail recursive call
+ init_log(Table, Proc, Func),
+ OldStack =
+ if CP =:= undefined ->
+ Stack;
+ true ->
+ [Level0, [{CP, TS0}]]
+ end,
+ put(Pid, trace_call_shove(Table, Pid, Func, TS, OldStack));
+ [_ | _] ->
+ %% Weird case when the stack is seriously f***ed up.
+ %% CP is not at stack top nor at previous stack top,
+ %% which is impossible, if we had a correct stack view.
+ OldStack =
+ if CP =:= undefined ->
+ %% Assume that CP is unknown because it is
+ %% the stack bottom for the process, and that
+ %% the whole call stack is invalid. Waste it.
+ trace_return_to_int(Table, Pid, CP, TS, Stack);
+ true ->
+ %% Assume that we have collapsed a tail recursive
+ %% call stack cykle too many. Introduce CP in
+ %% the current tail recursive level so it at least
+ %% gets charged for something.
+ init_log(Table, Proc, CP),
+ trace_call_shove(Table, Pid, CP, TS, Stack)
+ end,
+ %% Regard this call as a stack push.
+ init_log(Table, Pid, Func), % will lookup Pid in Table
+ put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack))
+ end,
+ ok.
+
+%% Normal stack push
+trace_call_push(Table, Pid, Func, TS, Stack) ->
+ case Stack of
+ [] ->
+ ok;
+ [_ | _] ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.own)
+ end,
+ NewStack = [[{Func, TS}] | Stack],
+ trace_clock(Table, Pid, 1, NewStack, #clocks.cnt),
+ NewStack.
+
+%% Tail recursive stack push
+trace_call_shove(Table, Pid, Func, TS, Stack) ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.own),
+ [[_ | NewLevel0] | NewStack1] =
+ case Stack of
+ [] ->
+ [[{Func, TS}]];
+ [Level0 | Stack1] ->
+ [trace_call_collapse([{Func, TS} | Level0]) | Stack1]
+ end,
+ NewStack = [[{Func, TS} | NewLevel0] | NewStack1],
+ trace_clock(Table, Pid, 1, NewStack, #clocks.cnt),
+ NewStack.
+
+%% Collapse tail recursive call stack cycles to prevent them from
+%% growing to infinite length.
+trace_call_collapse([]) ->
+ [];
+trace_call_collapse([_] = Stack) ->
+ Stack;
+trace_call_collapse([_, _] = Stack) ->
+ Stack;
+trace_call_collapse([_ | Stack1] = Stack) ->
+ trace_call_collapse_1(Stack, Stack1, 1).
+
+%% Find some other instance of the current function in the call stack
+%% and try if that instance may be used as stack top instead.
+trace_call_collapse_1(Stack, [], _) ->
+ Stack;
+trace_call_collapse_1([{Func0, _} | _] = Stack, [{Func0, _} | S1] = S, N) ->
+ case trace_call_collapse_2(Stack, S, N) of
+ true ->
+ S;
+ false ->
+ trace_call_collapse_1(Stack, S1, N+1)
+ end;
+trace_call_collapse_1(Stack, [_ | S1], N) ->
+ trace_call_collapse_1(Stack, S1, N+1).
+
+%% Check if all caller/called pairs in the perhaps to be collapsed
+%% stack segment (at the front) are present in the rest of the stack,
+%% and also in the same order.
+trace_call_collapse_2(_, _, 0) ->
+ true;
+trace_call_collapse_2([{Func1, _} | [{Func2, _} | _] = Stack2],
+ [{Func1, _} | [{Func2, _} | _] = S2],
+ N) ->
+ trace_call_collapse_2(Stack2, S2, N-1);
+trace_call_collapse_2([{Func1, _} | _], [{Func1, _} | _], _N) ->
+ false;
+trace_call_collapse_2(_Stack, [_], _N) ->
+ false;
+trace_call_collapse_2(Stack, [_ | S], N) ->
+ trace_call_collapse_2(Stack, S, N);
+trace_call_collapse_2(_Stack, [], _N) ->
+ false.
+
+
+
+trace_return_to(Table, Pid, Func, TS) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_return_to(~p, ~p, ~p)~n~p~n",
+ [Pid, Func, TS, Stack]),
+ case Stack of
+ [[{suspend, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, Stack]});
+ [[{garbage_collect, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, Stack]});
+ [_ | _] ->
+ put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack));
+ [] ->
+ put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack))
+ end,
+ ok.
+
+trace_return_to_int(Table, Pid, Func, TS, Stack) ->
+ %% The old stack must be sent to trace_clock, so
+ %% the function we just returned from is charged with
+ %% own time.
+ trace_clock(Table, Pid, TS, Stack, #clocks.own),
+ case trace_return_to_2(Table, Pid, Func, TS, Stack) of
+ {undefined, _} ->
+ [[{Func, TS}] | Stack];
+ {[[{Func, _} | Level0] | Stack1], _} ->
+ [[{Func, TS} | Level0] | Stack1];
+ {NewStack, _} ->
+ NewStack
+ end.
+
+%% A list of charged functions is passed around to assure that
+%% any function is charged with ACC time only once - the first time
+%% it is encountered. The function trace_return_to_1 is called only
+%% for the front of a tail recursive level, and if the front
+%% does not match the returned-to function, trace_return_to_2
+%% is called for all functions within the tail recursive level.
+%%
+%% Charging is done in reverse order, i.e from stack rear to front.
+
+%% Search the call stack until the returned-to function is found at
+%% a tail recursive level's front, and charge it with ACC time.
+trace_return_to_1(_, _, undefined, _, []) ->
+ {[], []};
+trace_return_to_1(_, _, _, _, []) ->
+ {undefined, []};
+trace_return_to_1(Table, Pid, Func, TS,
+ [[{Func, _} | Level0] | Stack1] = Stack) ->
+ %% Match at front of tail recursive level
+ Charged = trace_return_to_3([Level0 | Stack1], []),
+ case lists:member(Func, Charged) of
+ false ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.acc),
+ {Stack, [Func | Charged]};
+ true ->
+ {Stack, Charged}
+ end;
+trace_return_to_1(Table, Pid, Func, TS, Stack) ->
+ trace_return_to_2(Table, Pid, Func, TS, Stack).
+
+%% Charge all functions within one tail recursive level,
+%% from rear to front, with ACC time.
+trace_return_to_2(Table, Pid, Func, TS, [] = Stack) ->
+ trace_return_to_1(Table, Pid, Func, TS, Stack);
+trace_return_to_2(Table, Pid, Func, TS, [[] | Stack1]) ->
+ trace_return_to_1(Table, Pid, Func, TS, Stack1);
+trace_return_to_2(Table, Pid, Func, TS,
+ [[{Func0, _} | Level1] | Stack1] = Stack) ->
+ case trace_return_to_2(Table, Pid, Func, TS, [Level1 | Stack1]) of
+ {undefined, _} = R ->
+ R;
+ {NewStack, Charged} = R ->
+ case lists:member(Func0, Charged) of
+ false ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.acc),
+ {NewStack, [Func0 | Charged]};
+ true ->
+ R
+ end
+ end.
+
+%% Return a flat list of all function names in the given stack
+trace_return_to_3([], R) ->
+ R;
+trace_return_to_3([[] | Stack1], R) ->
+ trace_return_to_3(Stack1, R);
+trace_return_to_3([[{Func0, _} | Level0] | Stack1], R) ->
+ trace_return_to_3([Level0 | Stack1], [Func0 | R]).
+
+
+
+trace_spawn(Table, Pid, MFArgs, TS, Parent) ->
+ Stack = get(Pid),
+ ?dbg(0, "trace_spawn(~p, ~p, ~p, ~p)~n~p~n",
+ [Pid, MFArgs, TS, Parent, Stack]),
+ case Stack of
+ undefined ->
+ {M,F,Args} = MFArgs,
+ OldStack = [[{{M,F,length(Args)},TS}]],
+ put(Pid, trace_call_push(Table, Pid, suspend, TS, OldStack)),
+ ets:insert(Table, #proc{id = Pid, parent = Parent,
+ spawned_as = MFArgs});
+ _ ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, MFArgs, TS, Parent, Stack]})
+ end.
+
+
+
+trace_exit(Table, Pid, TS) ->
+ Stack = erase(Pid),
+ ?dbg(0, "trace_exit(~p, ~p)~n~p~n", [Pid, TS, Stack]),
+ case Stack of
+ undefined ->
+ ok;
+ [] ->
+ ok;
+ [_ | _] = Stack ->
+ trace_return_to_int(Table, Pid, undefined, TS, Stack),
+ ok
+ end,
+ ok.
+
+
+
+trace_out(Table, Pid, Func, TS) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_out(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]),
+ case Stack of
+ [] ->
+ put(Pid, trace_call_push(Table, Pid, suspend, TS,
+ case Func of
+ undefined -> [];
+ _ ->
+ [[{Func,TS}]]
+ end));
+ [[{suspend,_}] | _] ->
+ %% No stats update for a suspend on suspend
+ put(Pid, [[{suspend,TS}] | Stack]);
+ [_ | _] ->
+ put(Pid, trace_call_push(Table, Pid, suspend, TS, Stack))
+ end.
+
+
+
+trace_in(Table, Pid, Func, TS) ->
+ Stack = get(Pid),
+ ?dbg(0, "trace_in(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]),
+ case Stack of
+ undefined ->
+ %% First activity on a process which existed at the time
+ %% the fprof trace was started.
+ put(Pid, [[{Func,TS}]]);
+ [] ->
+ put(Pid, [[{Func,TS}]]);
+ [[{suspend, _}]] ->
+ put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack));
+ [[{suspend,_}] | [[{suspend,_}] | _]=NewStack] ->
+ %% No stats update for a suspend on suspend
+ put(Pid, NewStack);
+ [[{suspend, _}] | [[{Func1, _} | _] | _]] ->
+ %% This is a new process (suspend and Func1 was inserted
+ %% by trace_spawn) or any process that has just been
+ %% scheduled out and now back in.
+ put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack));
+ _ ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, Stack]})
+ end.
+
+
+
+trace_gc_start(Table, Pid, TS) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_gc_start(~p, ~p)~n~p~n", [Pid, TS, Stack]),
+ put(Pid, trace_call_push(Table, Pid, garbage_collect, TS, Stack)).
+
+
+
+trace_gc_end(Table, Pid, TS) ->
+ Stack = get(Pid),
+ ?dbg(0, "trace_gc_end(~p, ~p)~n~p~n", [Pid, TS, Stack]),
+ case Stack of
+ undefined ->
+ put(Pid, []);
+ [] ->
+ ok;
+ [[{garbage_collect, _}]] ->
+ put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack));
+ [[{garbage_collect, _}], [{Func1, _} | _] | _] ->
+ put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack));
+ _ ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, TS, Stack]})
+ end.
+
+
+
+%%%-----------------------------------------
+%%% Statistics calculating support functions
+%%%-----------------------------------------
+
+
+
+get_stack(Id) ->
+ case get(Id) of
+ undefined ->
+ [];
+ Stack ->
+ Stack
+ end.
+
+
+
+mfarity({M, F, Args}) when is_list(Args) ->
+ {M, F, length(Args)};
+mfarity(MFA) ->
+ MFA.
+
+
+
+init_log(_Table, _Proc, suspend) ->
+ ok;
+init_log(_Table, _Proc, void) ->
+ ok;
+init_log(_Table, undefined, _Entry) ->
+ ok;
+init_log(_Table, #proc{init_cnt = 0}, _Entry) ->
+ ok;
+init_log(Table, #proc{init_cnt = N, init_log = L} = Proc, Entry) ->
+ ets:insert(Table, Proc#proc{init_cnt = N-1, init_log = [Entry | L]});
+init_log(Table, Id, Entry) ->
+ Proc =
+ case ets:lookup(Table, Id) of
+ [P] -> P;
+ [] -> undefined
+ end,
+ init_log(Table,Proc,Entry).
+
+
+trace_clock(_Table, _Pid, _T,
+ [[{suspend, _}], [{suspend, _}] | _]=_Stack, _Clock) ->
+ ?dbg(9, "trace_clock(Table, ~w, ~w, ~w, ~w)~n",
+ [_Pid, _T, _Stack, _Clock]),
+ void;
+trace_clock(Table, Pid, T,
+ [[{garbage_collect, TS0}], [{suspend, _}]], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, undefined, garbage_collect, Clock);
+trace_clock(Table, Pid, T,
+ [[{garbage_collect, TS0}], [{suspend, _}], [{Func2, _} | _] | _],
+ Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, Func2, garbage_collect, Clock);
+trace_clock(Table, Pid, T, [[{Func0, TS0}, {Func1, _} | _] | _], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock);
+trace_clock(Table, Pid, T, [[{Func0, TS0}], [{Func1, _} | _] | _], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock);
+trace_clock(Table, Pid, T, [[{Func0, TS0}]], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, undefined, Func0, Clock);
+trace_clock(_, _, _, [], _) ->
+ void.
+
+trace_clock_1(Table, Pid, _, _, Caller, suspend, #clocks.own) ->
+ clock_add(Table, {Pid, Caller, suspend}, #clocks.own, 0);
+trace_clock_1(Table, Pid, T, TS, Caller, Func, Clock) ->
+ clock_add(Table, {Pid, Caller, Func}, Clock,
+ if is_integer(T) ->
+ T;
+ true ->
+ ts_sub(T, TS)
+ end).
+
+clock_add(Table, Id, Clock, T) ->
+ ?dbg(1, "clock_add(Table, ~w, ~w, ~w)~n", [Id, Clock, T]),
+ try ets:update_counter(Table, Id, {Clock, T})
+ catch
+ error:badarg ->
+ ets:insert(Table, #clocks{id = Id}),
+ X = ets:update_counter(Table, Id, {Clock, T}),
+ if X >= 0 -> ok;
+ true -> ?dbg(0, "Negative counter value ~p ~p ~p ~p~n",
+ [X, Id, Clock, T])
+ end,
+ X
+ end.
+
+clocks_add(Table, #clocks{id = Id} = Clocks) ->
+ ?dbg(1, "clocks_add(Table, ~w)~n", [Clocks]),
+ case ets:lookup(Table, Id) of
+ [Clocks0] ->
+ ets:insert(Table, clocks_sum(Clocks, Clocks0, Id));
+ [] ->
+ ets:insert(Table, Clocks)
+ end.
+
+
+
+clocks_sum(#clocks{id = _Id1,
+ cnt = Cnt1,
+ own = Own1,
+ acc = Acc1},
+ #clocks{id = _Id2,
+ cnt = Cnt2,
+ own = Own2,
+ acc = Acc2},
+ Id) ->
+ #clocks{id = Id,
+ cnt = Cnt1 + Cnt2,
+ own = Own1 + Own2,
+ acc = Acc1 + Acc2}.
+
+
+
+ts_sub({A, B, C} = _T, {A0, B0, C0} = _T0) ->
+ X = ((((A-A0)*1000000) + (B-B0))*1000000) + C - C0,
+ if X >= 0 -> ok;
+ true -> ?dbg(9, "Negative counter value ~p ~p ~p~n",
+ [X, _T, _T0])
+ end,
+ X;
+ts_sub(_, _) ->
+ undefined.
+
+
+
+%%%--------------------------------
+%%% Profile data analysis functions
+%%%--------------------------------
+
+
+
+do_analyse(Table, Analyse) ->
+ ?dbg(5, "do_analyse_1(~p, ~p)~n", [Table, Analyse]),
+ Result =
+ try do_analyse_1(Table, Analyse)
+ catch
+ Error -> Error
+ end,
+ ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]),
+ Result.
+
+do_analyse_1(Table,
+ #analyse{group_leader = GroupLeader,
+ dest = Io,
+ cols = Cols0,
+ callers = PrintCallers,
+ sort = Sort,
+ totals = PrintTotals,
+ details = PrintDetails} = _Analyse) ->
+ Waste = 11,
+ MinCols = Waste + 12, %% We need Width >= 1
+ Cols = if Cols0 < MinCols -> MinCols; true -> Cols0 end,
+ Width = (Cols-Waste) div 12,
+ FnameWidth = Cols - Waste - 5*Width,
+ Dest = {Io, [FnameWidth, Width, 2*Width, 2*Width]},
+ SortElement = case Sort of
+ own ->
+ #clocks.own;
+ acc ->
+ #clocks.acc
+ end,
+ %%
+ %% Clean out the process dictionary before the next step
+ %%
+ _Erase = erase(),
+ ?dbg(2, "erase() -> ~p~n", [_Erase]),
+ %%
+ %% Process the collected data and spread it to 3 places:
+ %% * Per {process, caller, func}. Stored in the process dictionary.
+ %% * Sum per process. Stored in an ets table.
+ %% * Extra info per process. Stored in another ets table.
+ %%
+ io:format(GroupLeader, "Processing data...~n", []),
+ PidTable = ets:new(?MODULE, [set, private, {keypos, #clocks.id}]),
+ ProcTable = ets:new(?MODULE, [set, private, {keypos, #proc.id}]),
+ ets_select_foreach(
+ Table, [{'_', [], ['$_']}], 100,
+ fun (#clocks{id = {Pid, Caller, Func}} = Clocks) ->
+ case PrintDetails of
+ true ->
+ funcstat_pd(Pid, Caller, Func, Clocks),
+ clocks_add(PidTable, Clocks#clocks{id = Pid});
+ false ->
+ ok
+ end,
+ clocks_add(PidTable, Clocks#clocks{id = totals}),
+ case PrintTotals of
+ true ->
+ funcstat_pd(totals, Caller, Func, Clocks);
+ false ->
+ ok
+ end;
+ (#proc{} = Proc) ->
+ ets:insert(ProcTable, Proc);
+ (#misc{} = Misc) ->
+ ets:insert(ProcTable, Misc)
+ end),
+ ?dbg(3, "get() -> ~p~n", [get()]),
+ {FirstTS, LastTS, _TraceCnt} =
+ case {ets:lookup(ProcTable, first_ts),
+ ets:lookup(ProcTable, last_ts_n)} of
+ {[#misc{data = FTS}], [#misc{data = {LTS, TC}}]}
+ when FTS =/= undefined, LTS =/= undefined ->
+ {FTS, LTS, TC};
+ _ ->
+ throw({error,empty_trace})
+ end,
+ Totals0 =
+ case ets:lookup(PidTable, totals) of
+ [T0] ->
+ ets:delete(PidTable, totals),
+ T0;
+ _ ->
+ throw({error,empty_trace})
+ end,
+ Totals = Totals0#clocks{acc = ts_sub(LastTS, FirstTS)},
+ ?dbg(3, "Totals0 = ~p~n", [Totals0]),
+ ?dbg(3, "PidTable = ~p~n", [ets:tab2list(PidTable)]),
+ ?dbg(3, "ProcTable = ~p~n", [ets:tab2list(ProcTable)]),
+ ?dbg(4, "Totals = ~p~n", [Totals]),
+ %%
+ %% Reorganize the process dictionary by Pid.
+ %%
+ lists:foreach(
+ fun ({{Pid, _Func}, Funcstat}) ->
+ put(Pid, [Funcstat | case get(Pid) of
+ undefined -> [];
+ Other -> Other
+ end])
+ end,
+ erase()),
+ ?dbg(4, "get() -> ~p~n", [get()]),
+ %%
+ %% Sort the processes
+ %%
+ PidSorted =
+ postsort_r(
+ lists:sort(
+ ets:select(PidTable,
+ [{'_', [], [[{element, #clocks.own, '$_'} | '$_']]}]))),
+ ?dbg(4, "PidSorted = ~p~n", [PidSorted]),
+ %%
+ %% Print the functions per process
+ %%
+ io:format(GroupLeader, "Creating output...~n", []),
+ println(Dest, "%% ", [], "Analysis results:", ""),
+ println(Dest, "{ ", analysis_options, ",", ""),
+ println(Dest, " [{", {callers, PrintCallers}, "},", ""),
+ println(Dest, " {", {sort, Sort}, "},", ""),
+ println(Dest, " {", {totals, PrintTotals}, "},", ""),
+ println(Dest, " {", {details, PrintDetails}, "}]}.", ""),
+ println(Dest),
+ lists:foreach(
+ fun ({#clocks{} = Clocks, ProcOrPid, FuncstatList}) ->
+ println(Dest, "% ", head, "", ""),
+ case ProcOrPid of
+ #proc{} ->
+ println(Dest, "[{ ", Clocks, "},", "%%"),
+ print_proc(Dest, ProcOrPid);
+ totals ->
+ println(Dest, "[{ ", Clocks, "}].", "%%%");
+ _ when is_pid(ProcOrPid) ->
+ println(Dest, "[{ ", Clocks, "}].", "%%")
+ end,
+ println(Dest),
+ lists:foreach(
+ fun (#funcstat{callers_sum = CallersSum,
+% called_sum = CalledSum,
+ callers = Callers,
+ called = Called}) ->
+ case {PrintCallers, Callers} of
+% {true, []} ->
+% ok;
+ {true, _} ->
+ print_callers(Dest, Callers),
+ println(Dest, " { ", CallersSum, "},", "%"),
+ print_called(Dest, Called),
+ println(Dest);
+ {false, _} ->
+ println(Dest, "{ ", CallersSum, "}.", "")
+ end,
+ ok
+ end,
+ %% Sort the functions within the process,
+ %% and the callers and called within the function.
+ funcstat_sort_r(FuncstatList, SortElement)),
+ println(Dest)
+ end,
+ %% Look up the processes in sorted order
+ lists:map(
+ fun (#clocks{id = Pid} = Clocks) ->
+ Proc = case ets:lookup(ProcTable, Pid) of
+ [] -> Pid;
+ [ProcX] -> ProcX
+ end,
+ FuncstatList =
+ case get(Pid) of
+ undefined ->
+ [];
+ FL ->
+ FL
+ end,
+ {Clocks, Proc, FuncstatList}
+ end,
+ case PrintDetails of
+ true ->
+ [Totals | PidSorted];
+ false ->
+ [Totals]
+ end)),
+ %%
+ %% Cleanup
+ %%
+ ets:delete(PidTable),
+ ets:delete(ProcTable),
+ io:format(GroupLeader, "Done!~n", []),
+ ok.
+
+
+
+%%----------------------------
+%% Analysis printout functions
+%%----------------------------
+
+
+
+print_proc({undefined, _}, _) ->
+ ok;
+print_proc(Dest,
+ #proc{id = _Pid,
+ parent = Parent,
+ spawned_as = SpawnedAs,
+ init_log = InitLog}) ->
+ case {Parent, SpawnedAs, InitLog} of
+ {undefined, undefined, []} ->
+ println(Dest, " ", [], "].", "");
+ {_, undefined, []} ->
+ println(Dest, " { ", {spawned_by, parsify(Parent)}, "}].", "");
+ _ ->
+ println(Dest, " { ", {spawned_by, parsify(Parent)}, "},", ""),
+ case {SpawnedAs, InitLog} of
+ {_, []} ->
+ println(Dest, " { ",
+ {spawned_as, SpawnedAs},
+ "}].", "");
+ {undefined, _} ->
+ println(Dest, " { ",
+ {initial_calls, lists:reverse(InitLog)},
+ "}].", "");
+ _ ->
+ println(Dest, " { ",
+ {spawned_as, SpawnedAs},
+ "},", ""),
+ println(Dest, " { ",
+ {initial_calls, lists:reverse(InitLog)},
+ "}].", "")
+ end
+ end.
+
+
+
+print_callers(Dest, []) ->
+ println(Dest, "{[", [], "],", "");
+print_callers(Dest, [Clocks]) ->
+ println(Dest, "{[{", Clocks, "}],", "");
+print_callers(Dest, [Clocks | Tail]) ->
+ println(Dest, "{[{", Clocks, "},", ""),
+ print_callers_1(Dest, Tail).
+
+print_callers_1(Dest, [Clocks]) ->
+ println(Dest, " {", Clocks, "}],", "");
+print_callers_1(Dest, [Clocks | Tail]) ->
+ println(Dest, " {", Clocks, "},", ""),
+ print_callers_1(Dest, Tail).
+
+
+
+print_func(Dest, Clocks) ->
+ println(Dest, " { ", Clocks, "},", "%").
+
+
+
+print_called(Dest, []) ->
+ println(Dest, " [", [], "]}.", "");
+print_called(Dest, [Clocks]) ->
+ println(Dest, " [{", Clocks, "}]}.", "");
+print_called(Dest, [Clocks | Tail]) ->
+ println(Dest, " [{", Clocks, "},", ""),
+ print_called_1(Dest, Tail).
+
+print_called_1(Dest, [Clocks]) ->
+ println(Dest, " {", Clocks, "}]}.", "");
+print_called_1(Dest, [Clocks | Tail]) ->
+ println(Dest, " {", Clocks, "},", ""),
+ print_called_1(Dest, Tail).
+
+
+
+println({undefined, _}) ->
+ ok;
+println({Io, _}) ->
+ io:nl(Io).
+
+println({undefined, _}, _Head,
+ _,
+ _Tail, _Comment) ->
+ ok;
+println({Io, [W1, W2, W3, W4]}, Head,
+ #clocks{id = Pid, cnt = Cnt, acc = _, own = Own},
+ Tail, Comment) when is_pid(Pid) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ flat_format(parsify(Pid), $,, W1),
+ flat_format(Cnt, $,, W2, right),
+ flat_format(undefined, $,, W3, right),
+ flat_format(Own*0.001, [], W4-1, right),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, [W1, W2, W3, W4]}, Head,
+ #clocks{id = {_M, _F, _A} = Func, cnt = Cnt, acc = Acc, own = Own},
+ Tail, Comment) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ flat_format(Func, $,, W1),
+ flat_format(Cnt, $,, W2, right),
+ flat_format(Acc*0.001, $,, W3, right),
+ flat_format(Own*0.001, [], W4-1, right),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, [W1, W2, W3, W4]}, Head,
+ #clocks{id = Id, cnt = Cnt, acc = Acc, own = Own},
+ Tail, Comment) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ flat_format(parsify(Id), $,, W1),
+ flat_format(Cnt, $,, W2, right),
+ flat_format(Acc*0.001, $,, W3, right),
+ flat_format(Own*0.001, [], W4-1, right),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, [W1, W2, W3, W4]}, Head,
+ head,
+ Tail, Comment) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ pad(" ", $ , W1),
+ pad($ , " CNT ", W2),
+ pad($ , " ACC ", W3),
+ pad($ , " OWN", W4-1),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, _}, Head,
+ [],
+ Tail, Comment) ->
+ io:format(Io, "~s~s~s~n",
+ [pad(Head, $ , 3), Tail, Comment]);
+println({Io, _}, Head,
+ {Tag, Term},
+ Tail, Comment) ->
+ io:format(Io, "~s~p, ~p~s~s~n",
+ [pad(Head, $ , 3), parsify(Tag), parsify(Term), Tail, Comment]);
+println({Io, _}, Head,
+ Term,
+ Tail, Comment) ->
+ io:format(Io, "~s~p~s~s~n",
+ [pad(Head, $ , 3), parsify(Term), Tail, Comment]).
+
+
+
+%%%--------------------------
+%%% Sorting support functions
+%%%--------------------------
+
+
+%% Add a Clocks record to the callers and called funcstat records
+%% in the process dictionary.
+%%
+funcstat_pd(Pid, Func1, Func0, Clocks) ->
+ put({Pid, Func0},
+ case get({Pid, Func0}) of
+ undefined ->
+ #funcstat{callers_sum = Clocks#clocks{id = Func0},
+ called_sum = #clocks{id = Func0},
+ callers = [Clocks#clocks{id = Func1}]};
+ #funcstat{callers_sum = CallersSum,
+ callers = Callers} = FuncstatCallers ->
+ FuncstatCallers#funcstat{
+ callers_sum = clocks_sum(CallersSum, Clocks, Func0),
+ callers = [Clocks#clocks{id = Func1} | Callers]}
+ end),
+ put({Pid, Func1},
+ case get({Pid, Func1}) of
+ undefined ->
+ #funcstat{callers_sum = #clocks{id = Func1},
+ called_sum = Clocks#clocks{id = Func1},
+ called = [Clocks#clocks{id = Func0}]};
+ #funcstat{called_sum = CalledSum,
+ called = Called} = FuncstatCalled ->
+ FuncstatCalled#funcstat{
+ called_sum = clocks_sum(CalledSum, Clocks, Func1),
+ called = [Clocks#clocks{id = Func0} | Called]}
+ end).
+
+
+
+%% Sort a list of funcstat records,
+%% and sort the callers and called lists within the funcstat record.
+funcstat_sort_r(FuncstatList, Element) ->
+ funcstat_sort_r_1(FuncstatList, Element, []).
+
+funcstat_sort_r_1([], _, R) ->
+ postsort_r(lists:sort(R));
+funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks,
+ callers = Callers,
+ called = Called} = Funcstat
+ | L],
+ Element,
+ R) ->
+ funcstat_sort_r_1(L,
+ Element,
+ [[element(Element, Clocks)
+ |Funcstat#funcstat{
+ callers = clocks_sort_r(Callers, Element),
+ called = clocks_sort_r(Called, Element)}]
+ | R]).
+
+
+
+%% Sort a list of clocks records.
+clocks_sort_r(L, E) ->
+ clocks_sort_r_1(L, E, []).
+
+clocks_sort_r_1([], _, R) ->
+ postsort_r(lists:sort(R));
+clocks_sort_r_1([#clocks{} = C | L], E, R) ->
+ clocks_sort_r_1(L, E, [[element(E, C)|C] | R]).
+
+
+%% Take a list of terms with sort headers and strip the headers.
+postsort_r(L) ->
+ postsort_r(L, []).
+
+postsort_r([], R) ->
+ R;
+postsort_r([[_|C] | L], R) ->
+ postsort_r(L, [C | R]).
+
+
+
+%%%----------------------------------------------------------------------
+%%% Fairly generic support functions
+%%%
+
+%% Standard format and flatten.
+flat_format(F, Trailer) when is_float(F) ->
+ lists:flatten([io_lib:format("~.3f", [F]), Trailer]);
+flat_format(W, Trailer) ->
+ lists:flatten([io_lib:format("~p", [W]), Trailer]).
+
+%% Format, flatten, and pad.
+flat_format(Term, Trailer, Width) ->
+ flat_format(Term, Trailer, Width, left).
+
+flat_format(Term, Trailer, Width, left) ->
+ flat_format(Term, Trailer, Width, {left, $ });
+flat_format(Term, Trailer, Width, {left, Filler}) ->
+ pad(flat_format(Term, Trailer), Filler, Width);
+flat_format(Term, Trailer, Width, right) ->
+ flat_format(Term, Trailer, Width, {right, $ });
+flat_format(Term, Trailer, Width, {right, Filler}) ->
+ pad(Filler, flat_format(Term, Trailer), Width).
+
+
+
+%% Left pad a string using a given char.
+pad(Char, L, Size) when is_integer(Char), is_list(L), is_integer(Size) ->
+ List = lists:flatten(L),
+ Length = length(List),
+ if Length >= Size ->
+ List;
+ true ->
+ lists:append(lists:duplicate(Size - Length, Char), List)
+ end;
+%% Right pad a string using a given char.
+pad(L, Char, Size) when is_list(L), is_integer(Char), is_integer(Size) ->
+ List = lists:flatten(L),
+ Length = length(List),
+ if Length >= Size ->
+ List;
+ true ->
+ lists:append(List, lists:duplicate(Size - Length, Char))
+ end.
+
+
+
+ets_select_foreach(Table, MatchSpec, Limit, Fun) ->
+ ets:safe_fixtable(Table, true),
+ ets_select_foreach_1(ets:select(Table, MatchSpec, Limit), Fun).
+
+ets_select_foreach_1('$end_of_table', _) ->
+ ok;
+ets_select_foreach_1({Matches, Continuation}, Fun) ->
+ ?dbg(2, "Matches = ~p~n", [Matches]),
+ lists:foreach(Fun, Matches),
+ ets_select_foreach_1(ets:select(Continuation), Fun).
+
+
+
+%% Converts the parts of a deep term that are not parasable when printed
+%% with io:format() into their string representation.
+parsify([]) ->
+ [];
+parsify([Hd | Tl]) ->
+ [parsify(Hd) | parsify(Tl)];
+parsify({A, B}) ->
+ {parsify(A), parsify(B)};
+parsify({A, B, C}) ->
+ {parsify(A), parsify(B), parsify(C)};
+parsify(Tuple) when is_tuple(Tuple) ->
+ list_to_tuple(parsify(tuple_to_list(Tuple)));
+parsify(Pid) when is_pid(Pid) ->
+ erlang:pid_to_list(Pid);
+parsify(Port) when is_port(Port) ->
+ erlang:port_to_list(Port);
+parsify(Ref) when is_reference(Ref) ->
+ erlang:ref_to_list(Ref);
+parsify(Fun) when is_function(Fun) ->
+ erlang:fun_to_list(Fun);
+parsify(Term) ->
+ Term.
+
+
+
+%% A simple loop construct.
+%%
+%% Calls 'Fun' with argument 'Start' first and then repeatedly with
+%% its returned value (state) until 'Fun' returns 'Stop'. Then
+%% the last state value that was not 'Stop' is returned.
+
+% iterate(Start, Done, Fun) when is_function(Fun) ->
+% iterate(Start, Done, Fun, Start).
+
+% iterate(Done, Done, Fun, I) ->
+% I;
+% iterate(I, Done, Fun, _) ->
+% iterate(Fun(I), Done, Fun, I).