fprof.erl

OTP是开放电信平台的简称

%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved via the world wide web at http://www.erlang.org/.
%% 
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%

%%%----------------------------------------------------------------------
%%% File    : fprof.erl
%%% Author  : Raimo Niskanen <[e-mail]>
%%% Purpose : File tracing profiling tool wich accumulated times.
%%% Created : 18 Jun 2001 by Raimo Niskanen <[e-mail]>
%%%----------------------------------------------------------------------

-module(fprof).
-author('[e-mail]').

%% External exports
-export([
	 apply/2, apply/3, apply/4,
	 start/0, stop/0, stop/1,
	 trace/1, trace/2,
	 profile/0, profile/1, profile/2,
	 analyse/0, analyse/1, analyse/2]).
%% Debug functions
-export([get_state/0,
	 save_profile/0, save_profile/1, save_profile/2,
	 load_profile/0, load_profile/1, load_profile/2,
	 code_change/0]).

%% Debug exports
-export([call/1, just_call/1, reply/2]).
-export([trace_off/0, trace_on/3]).
-export([getopts/2, setopts/1]).
-export([println/5, print_callers/2, print_func/2, print_called/2]).
-export([trace_call_collapse/1]).
-export([parsify/1]).

%% Internal exports
-export(['$code_change'/1]).



-define(FNAME_WIDTH, 72).
-define(NR_WIDTH, 15).

-define(TRACE_FILE, "fprof.trace").
-define(DUMP_FILE, "fprof.dump").
-define(PROFILE_FILE, "fprof.profile").
-define(ANALYSIS_FILE, "fprof.analysis").

-define(FPROF_SERVER, fprof_server).
-define(FPROF_SERVER_TIMEOUT, infinity).



-define(debug, 9).
%-define(debug, 0).
-ifdef(debug).
dbg(Level, F, A) when Level >= ?debug ->
    io:format(F, A),
    ok;
dbg(_, _, _) ->
    ok.
-define(dbg(Level, F, A), dbg((Level), (F), (A))).
-else.
-define(dbg(Level, F, A), ok).
-endif.



%%%----------------------------------------------------------------------
%%% Higher order API functions
%%%----------------------------------------------------------------------



apply({M, F} = Function, Args) 
  when is_atom(M), is_atom(F), is_list(Args) ->
    apply_1(Function, Args, []);
apply(Fun, Args) 
  when is_function(Fun), is_list(Args) ->
    apply_1(Fun, Args, []);
apply(A, B) ->
    erlang:fault(badarg, [A, B]).

apply(M, F, Args) when is_atom(M), is_atom(F), is_list(Args) ->
    apply_1({M, F}, Args, []);
apply({M, F} = Function, Args, Options) 
  when is_atom(M), is_atom(F), is_list(Args), is_list(Options) ->
    apply_1(Function, Args, Options);
apply(Fun, Args, Options) 
  when is_function(Fun), is_list(Args), is_list(Options) ->
    apply_1(Fun, Args, Options);
apply(A, B, C) ->
    erlang:fault(badarg, [A, B, C]).

apply(Module, Function, Args, Options) 
  when is_atom(Module), is_atom(Function), is_list(Args), is_list(Options) ->
    apply_1({Module, Function}, Args, Options);
apply(A, B, C, D) ->
    erlang:fault(badarg, [A, B, C, D]).


apply_1(Function, Args, Options) ->        
    {[_, Procs, Continue], Options_1} =
	getopts(Options, [start, procs, continue]),
    Procs_1 = case Procs of
		  [{procs, P}] when is_list(P) ->
		      P;
		  _ ->
		      []
	      end,
    case Continue of
	[] ->
	    apply_start_stop(Function, Args, Procs_1, Options_1);
	[continue] ->
	    apply_continue(Function, Args, Procs_1, Options_1);
	_ ->
	    erlang:fault(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:fault(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:fault(badarg, [Options])
			   end,
	    V = case Verbose of
		       [] -> normal;
		       [verbose] -> verbose;
		       [{verbose, true}] -> verbose;
		       [{verbose, false}] -> normal;
		       _ -> erlang:fault(badarg, [Options])
		   end,
	    CT = case CpuTime of
		     [] -> wallclock;
		     [cpu_time] -> cpu_time;
		     [{cpu_time, true}] -> cpu_time;
		     [{cpu_time, false}] -> wallclock;
		     _ -> erlang:fault(badarg, [Options])
		 end,
	    call(#trace_start{procs = case Procs of
					  [] ->
					      [self()];
					  [{procs, P}] when is_list(P) ->
					      P;
					  [{procs, P}] ->
					      [P];
					  _ ->
					      erlang:fault(badarg, [Options])
				      end,
			      mode = {V, CT},
			      type = Type,
			      dest = Dest});
	_ ->
	    erlang:fault(badarg, [Options])
    end;
trace(Options) ->
    erlang:fault(badarg, [Options]).



profile() ->
    profile([]).

profile(Option, Value) when is_atom(Option) ->
    profile([{Option, Value}]);
profile(Option, Value) ->
    erlang:fault(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:fault(badarg, [Options]);
		    {[{dump, D}], [append]} ->
			{D, [append]};
		    {[{dump, D}], []} ->
			{D, []};
		    _ ->
			erlang:fault(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:fault(badarg, [Options])
			end,
		    call(#profile{src = Src,
				  group_leader = group_leader(),
				  dump = Target,
				  flags = Flags});
		_ ->
		    erlang:fault(badarg, [Options])
	    end;
	{[[], [stop], [], [], []], []} ->
	    call(#profile_stop{});
	_ ->
	    erlang:fault(badarg, [Options])
    end;
profile(Options) ->
    erlang:fault(badarg, [Options]).



analyse() ->
    analyse([]).

analyse(Option, Value) when is_atom(Option) ->
    analyse([{Option, Value}]);
analyse(Option, Value) ->
    erlang:fault(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:fault(badarg, [Options]);
		    {[{dest, F}], [append]} ->
			{F, [append]};
		    {[{dest, F}], []} ->
			{F, []};
		    _ ->
			erlang:fault(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:fault(badarg, [Options])
				 end,
			  callers = case {Callers, NoCallers} of
					{[], []} -> 
					    true;
					{[callers], []} ->
					    true;
					{[{callers, true}], []} ->
					    true;
					{[{callers, false}], []} ->
					    false;
					{[], [no_callers]} ->
					    false;
					_ ->
					    erlang:fault(badarg, [Options])