%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions 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}, Args)
when is_atom(M), is_atom(F), is_list(Args) ->
apply_1(M, F, 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}, Args, Options)
when is_atom(M), is_atom(F), is_list(Args), is_list(Options) ->
apply_1(M, F, 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(M, F, Args, Options)
when is_atom(M), is_atom(F), is_list(Args), is_list(Options) ->
apply_1(M, F, Args, Options);
apply(A, B, C, D) ->
erlang:error(badarg, [A, B, C, D]).
apply_1(M, F, Args, Options) ->
Arity = length(Args),
apply_1(fun M:F/Arity, Args, Options).
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 ->
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, [{encoding, utf8} | 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, [flush]),
FunBody(Go);
{'DOWN', MRef, _, _, _} ->
ok
end
end),
MRef = erlang:monitor(process, Child),
receive
{Child, Ref, Ack} ->
erlang:demonitor(MRef, [flush]),
try FunAck(Ack) of
{Result, Go} ->
catch Child ! {Parent, Ref, Go},
Result
catch
Class:Reason: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: ~tp 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~tp.~n", [lists:duplicate(Depth, " "), parsify(Term)]),
true.
dump(undefined, _) ->
false;
dump(Dump, Term) ->
io:format(Dump, "~tp.~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, only needed (and reliable) prior to 19.0
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;
%%
%% spawned, added in 19.0
trace_handler({trace_ts, Pid, spawned, Parent, MFArgs, TS} = Trace,
Table, _, Dump) ->
dump_stack(Dump, get(Pid), Trace),
trace_spawn(Table, Pid, MFArgs, TS, Parent),
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_minor_start, _Func, TS} = Trace, Table, _, Dump) ->
dump_stack(Dump, get(Pid), Trace),
trace_gc_start(Table, Pid, TS),
TS;
trace_handler({trace_ts, Pid, gc_major_start, _Func, TS} = Trace, Table, _, Dump) ->
dump_stack(Dump, get(Pid), Trace),
trace_gc_start(Table, Pid, TS),
TS;
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_minor_end, _Func, TS} = Trace, Table, _, Dump) ->
dump_stack(Dump, get(Pid), Trace),
trace_gc_end(Table, Pid, TS),
TS;
trace_handler({trace_ts, Pid, gc_major_end, _Func, TS} = Trace, Table, _, Dump) ->
dump_stack(Dump, get(Pid), Trace),
trace_gc_end(Table, Pid, TS),
TS;
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;
%%
%% send_to_non_existing_process
trace_handler({trace_ts, Pid, send_to_non_existing_process, _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});
_ ->
%% In 19.0 we get both a spawn and spawned event,
%% however we do not know the order so we just ignore
%% the second event that comes
ok
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]),
ok;
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(_, _, _, [], _) ->
ok.
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}), ok
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,
ok
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.
-dialyzer({no_improper_lists, do_analyse_1/2}).
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~ts~ts~n",
[pad(Head, $ , 3), Tail, Comment]);
println({Io, _}, Head,
{Tag, Term},
Tail, Comment) ->
io:format(Io, "~s~tp, ~tp~ts~ts~n",
[pad(Head, $ , 3), parsify(Tag), parsify(Term), Tail, Comment]);
println({Io, _}, Head,
Term,
Tail, Comment) ->
io:format(Io, "~s~tp~ts~ts~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 = insert_call(Clocks, 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 = insert_call(Clocks, Func0, Called)}
end).
insert_call(Clocks, Func, ClocksList) ->
insert_call(Clocks, Func, ClocksList, []).
insert_call(Clocks, Func, [#clocks{id = Func} = C | T], Acc) ->
[clocks_sum(C, Clocks, Func) | T ++ Acc];
insert_call(Clocks, Func, [H | T], Acc) ->
insert_call(Clocks, Func, T, [H | Acc]);
insert_call(Clocks, Func, [], Acc) ->
[Clocks#clocks{id = Func} | Acc].
%% 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, []).
-dialyzer({no_improper_lists, funcstat_sort_r_1/3}).
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, []).
-dialyzer({no_improper_lists, clocks_sort_r_1/3}).
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("~tp", [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).
