fprof.erl

OTP是开放电信平台的简称

%% 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, [[{Func,TS}]]));
	[[{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.



%%---------------------------