fprof.erl

OTP是开放电信平台的简称

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