fprof.erl

OTP是开放电信平台的简称

		    flags = Flags} = Request, Tag, State) ->
    case get(profile_state) of
	{idle, undefined} ->
	    reply(Tag, {error, no_profile}),
	    State;
	{idle, _} ->
	    case ensure_open(Dest, [write | Flags]) of
		{error, _} = Error ->
		    reply(Tag, Error),
		    State;
		{DestState, DestPid} ->
		    ProfileTable = get(profile_table),
		    reply(Tag,
			  spawn_3step(
			    fun() ->
				    do_analyse(ProfileTable, 
					       Request#analyse{dest = DestPid})
			    end,
			    fun(Result) ->
				    {Result,finish}
			    end,
			    fun(finish) ->
				    ok
			    end)),
		    case DestState of
			already_open ->
			    ok;
			ok ->
			    file:close(DestPid)
		    end,
		    State
	    end;
	_ ->
	    reply(Tag, {error, profiling}),
	    State
    end;

handle_req(#stop{reason = Reason}, Tag, State) ->
    PendingStop = get(pending_stop),
    case PendingStop of
	[] ->
	    put(stop_reason, Reason);
	_ ->
	    ok
    end,
    put(pending_stop, [Tag | PendingStop]),
    try_pending_stop(State);

%%----------------------
%% Server debug requests
%%----------------------

handle_req(#get_state{}, Tag, State) ->
    reply(Tag, {ok, get()}),
    State;

handle_req(#save_profile{file = File}, Tag, State) ->
    case get(profile_state) of
	{idle, undefined} ->
	    reply(Tag, {error, no_profile});
	{idle, _} ->
	    reply(Tag, ets:tab2file(get(profile_table), File)),
	    State;
	_ ->
	    reply(Tag, {error, profiling}),
	    State
    end;

handle_req(#load_profile{file = File}, Tag, State) ->
    case get(profile_state) of
	{idle, Result} ->
	    case ets:file2tab(File) of
		{ok, Table} ->
		    put(profile_state, {idle, ok}),
		    case Result of
			{error, no_profile} ->
			    ets:delete(put(profile_table, Table));
			_ ->
			    put(profile_table, Table)
		    end,
		    reply(Tag, ok),
		    State;
		Error ->
		    reply(Tag, Error),
		    State
	    end;
	_ ->
	    reply(Tag, {error, profiling}),
	    State
    end;

	    

handle_req(Request, Tag, State) ->
    io:format("~n~p:handle_req, unknown request - ~p~n", 
	      [?MODULE, Request]),
    reply(Tag, {error, unknown_request}), 
    State.

%%--------------------
%% Server handle_other
%%--------------------

handle_other({'EXIT', Pid, Reason} = Other, State) when is_pid(Pid); is_port(Pid) ->
    case {get(trace_state), get(trace_pid)} of
	{running, Pid} ->
	    trace_off(),
	    io:format("~n~p:handle_other, unexpected ~p (trace_pid)~n",
		      [?MODULE, Other]),
	    put(trace_state, idle),
	    erase(trace_type),
	    erase(trace_pid),
	    try_pending_stop(State);
	{stopping, Pid} ->
	    put(trace_state, idle),
	    erase(trace_pid),
	    reply(erase(trace_tag), result(Reason)),
	    try_pending_stop(State);
	_ ->
	    case {get(profile_state), get(profile_pid)} of
		{running, Pid} ->
		    Result = result(Reason),
		    put(profile_state, {idle, Result}),
		    erase(profile_type),
		    erase(profile_pid),
		    case erase(profile_close_dump) of
			true ->
			    file:close(erase(profile_dump));
			false ->
			    erase(profile_dump)
		    end,
		    reply(erase(profile_tag), Result),
		    try_pending_stop(State);
		_ ->
		    io:format("~n~p:handle_other, unexpected ~p~n",
			      [?MODULE, Other]),
		    State
	    end
    end;

handle_other(Other, State) ->
    io:format("~p:handle_other, unknown - ~p", 
			  [?MODULE, Other]),
    State.



%%%----------------------------------------------------------------------
%%% Internal functions
%%%----------------------------------------------------------------------

result(normal) ->
    ok;
result(Reason) ->
    {error, Reason}.

ensure_open(Pid, _Options) when is_pid(Pid) ->
    {already_open, Pid};
ensure_open([], _Options) ->
    {already_open, undefined};
ensure_open(Filename, Options) when is_atom(Filename); is_list(Filename) ->
    file:open(Filename, Options).

%%%---------------------------------
%%% Fairly generic utility functions
%%%---------------------------------



%% getopts(List, Options)) -> {DecodedOptions, RestOptions}
%%
%% List           = [Option]
%% Options        = [OptionTag]
%% Option         = OptionTag | OptionTuple
%% OptionTuple    = tuple(), element(1, OptionTuple) == OptionTag
%% OptionTag      = term()
%% OptionValue    = term()
%% DecodedOptions = [OptionList]
%% OptionList     = [Option]
%% RestOptions    = [Option]
%%
%% Searches List for options with tags defined in Options.
%% Returns DecodedOptions containing one OptionList per
%% OptionTag in Options, and RestOptions which contains
%% all terms from List not matching any OptionTag.
%%
%% All returned lists preserve the order from Options and List.
%%
%% An example:
%%     getopts([{f, 1}, e, {d, 2}, {c, 3, 4}, {b, 5}, a, b],
%%             [a, b, c, d]) ->
%%         {[[a], [{b, 5}, b],[{c, 3, 4}], [{d, 2}]], 
%%          [{f, 1}, e]}
%%
getopts(List, Options) when is_list(List), is_list(Options) ->
    getopts_1(Options, List, []).

getopts_1([], List, Result) ->
    {lists:reverse(Result), List};
getopts_1([Option | Options], List, Result) ->
    {Optvals, Remaining} = getopts_2(List, Option, [], []),
    getopts_1(Options, Remaining, [Optvals | Result]).

getopts_2([], _Option, Result, Remaining) ->
    {lists:reverse(Result), lists:reverse(Remaining)};
getopts_2([Option | Tail], Option, Result, Remaining) ->
    getopts_2(Tail, Option, [Option | Result], Remaining);
getopts_2([Optval | Tail], Option, Result, Remaining) 
  when element(1, Optval) =:= Option ->
    getopts_2(Tail, Option, [Optval | Result], Remaining);
getopts_2([Other | Tail], Option, Result, Remaining) ->
    getopts_2(Tail, Option, Result, [Other | Remaining]).

%% setopts(Options) -> List
%%
%% The reverse of getopts, almost.
%% Re-creates (approximately) List from DecodedOptions in 
%% getopts/2 above. The original order is not preserved, 
%% but rather the order from Options.
%% 
%% An example:
%%     setopts([[a], [{b,5}, b], [{c, 3, 4}], [{d,2}]]) ->
%%         [a, {b, 5}, b, {c, 3, 4}, {d, 2}]
%%
%% And a more generic example:
%%     {D, R} = getopts(L, O),
%%     L2 = setopts(D) ++ R
%% L2 will contain exactly the same terms as L, but not in the same order.
%%
setopts(Options) when is_list(Options) ->
    lists:append(Options).



spawn_3step(FunPrelude, FunAck, FunBody) ->
    spawn_3step(spawn, FunPrelude, FunAck, FunBody).

spawn_link_3step(FunPrelude, FunAck, FunBody) ->
    spawn_3step(spawn_link, FunPrelude, FunAck, FunBody).

spawn_3step(Spawn, FunPrelude, FunAck, FunBody) 
  when Spawn =:= spawn; Spawn =:= spawn_link ->
    Parent = self(),
    Ref = make_ref(),
    Child = 
	erlang:Spawn(
	  fun() ->
		  Ack = FunPrelude(),
		  catch Parent ! {self(), Ref, Ack},
		  MRef = erlang:monitor(process, Parent),
		  receive
		      {Parent, Ref, Go} ->
			  erlang:demonitor(MRef),
			  receive {'DOWN', MRef, _, _, _} -> ok 
			  after 0 -> ok
			  end,
			  FunBody(Go);
		      {'DOWN', MRef, _, _, _} ->
			  ok
		  end
	  end),
    MRef = erlang:monitor(process, Child),
    receive
	{Child, Ref, Ack} ->
	    erlang:demonitor(MRef),
	    receive {'DOWN', MRef, _, _, _} -> ok after 0 -> ok end,
	    try FunAck(Ack) of
		{Result, Go} ->
		    catch Child ! {Parent, Ref, Go},
		    Result
	    catch
		Class:Reason ->
		    Stacktrace = erlang:get_stacktrace(),
		    catch exit(Child, kill),
		    erlang:raise(Class, Reason, Stacktrace)
	    end;
	{'DOWN', MRef, _, _, Reason} ->
	    receive {Child, Ref, _Ack} -> ok after 0 -> ok end,
	    case Spawn of 
		spawn_link ->
		    receive {'EXIT', Reason} -> ok after 0 -> ok end;
		spawn ->
		    ok
	    end,
	    exit(Reason)
    end.



%%%---------------------------------
%%% Trace message handling functions
%%%---------------------------------

trace_off() ->
    try erlang:trace_delivered(all) of
	Ref -> receive {trace_delivered, all, Ref} -> ok end
    catch
	error:undef -> ok
    end,
    try erlang:trace(all, false, [all, cpu_timestamp])
    catch
	error:badarg -> erlang:trace(all, false, [all])
    end,
    erlang:trace_pattern(on_load, false, [local]),
    erlang:trace_pattern({'_', '_', '_'}, false, [local]),
    ok.



trace_on(Procs, Tracer, {V, CT}) ->
    case case CT of
	     cpu_time ->
		 try erlang:trace(all, true, [cpu_timestamp]) of _ -> ok
		 catch
		     error:badarg -> {error, not_supported}
		 end;
	     wallclock -> ok
	 end
	of ok ->
	    MatchSpec = [{'_', [], [{message, {{cp, {caller}}}}]}],
	    erlang:trace_pattern(on_load, MatchSpec, [local]),
	    erlang:trace_pattern({'_', '_', '_'}, MatchSpec, [local]),
	    lists:foreach(
	      fun (P) ->
		      erlang:trace(P, true, [{tracer, Tracer} | trace_flags(V)])
	      end,
	      Procs),
	    ok;
	Error ->
	    Error
    end.



trace_flags(normal) ->
    [call, return_to, 
     running, procs, garbage_collection, 
     arity, timestamp, set_on_spawn];
trace_flags(verbose) ->
    [call, return_to, 
     send, 'receive',
     running, procs, garbage_collection, 
     timestamp, set_on_spawn].



%%%-------------------------------------
%%% Tracer process functions, for
%%% the 'dbg' tracer and for a lookalike 
%%%-------------------------------------

open_dbg_trace_port(Type, Spec) ->
    Fun = dbg:trace_port(Type, Spec),
    Fun().



spawn_link_dbg_trace_client(File, Table, GroupLeader, Dump) ->
    case dbg:trace_client(file, File, 
			  {fun handler/2, 
			   {init, GroupLeader, Table, Dump}}) of
	Pid when is_pid(Pid) ->
	    link(Pid),
	    Pid;
	Other ->
	    exit(Other)
    end.
			  



spawn_link_trace_client(Table, GroupLeader, Dump) ->
    Parent = self(),
    spawn_link_3step(
      fun() ->
	      process_flag(trap_exit, true),
	      {self(),go}
      end,
      fun(Ack) ->
	      Ack
      end,
      fun(go) ->
	      Init = {init, GroupLeader, Table, Dump},
	      tracer_loop(Parent, fun handler/2, Init)
      end).

tracer_loop(Parent, Handler, State) ->
    receive
	Trace when element(1, Trace) =:= trace ->
	    tracer_loop(Parent, Handler, Handler(Trace, State));
	Trace when element(1, Trace) =:= trace_ts ->
	    tracer_loop(Parent, Handler, Handler(Trace, State));
	{'EXIT', Parent, Reason} ->
	    handler(end_of_trace, State),
	    exit(Reason);
	_ ->
	    tracer_loop(Parent, Handler, State)
    end.



%%%---------------------------------
%%% Trace message handling functions
%%%---------------------------------

handler(end_of_trace, {init, GroupLeader, Table, Dump}) ->
    dump(Dump, start_of_trace),
    dump(Dump, end_of_trace),
    info(GroupLeader, Dump, "Empty trace!~n", []),
    end_of_trace(Table, undefined),
    done;
handler(end_of_trace, {error, Reason, _, GroupLeader, Dump}) ->
    info(GroupLeader, Dump, "~nEnd of erroneous trace!~n", []),
    exit(Reason);
handler(end_of_trace, {_, TS, GroupLeader, Table, Dump}) ->
    dump(Dump, end_of_trace),
    info(GroupLeader, Dump, "~nEnd of trace!~n", []),
    end_of_trace(Table, TS),
    done;
handler(Trace, {init, GroupLeader, Table, Dump}) ->
    dump(Dump, start_of_trace),
    info(GroupLeader, Dump, "Reading trace data...~n", []),
    try trace_handler(Trace, Table, GroupLeader, Dump) of
	TS ->
	    ets:insert(Table, #misc{id = first_ts, data = TS}),
	    ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}),
	    {1, TS, GroupLeader, Table, Dump}
    catch
	Error ->
	    dump(Dump, {error, Error}),
	    end_of_trace(Table, undefined),
	    {error, Error, 1, GroupLeader, Dump}
    end;
%%     case catch trace_handler(Trace, Table, GroupLeader, Dump) of
%% 	{'EXIT', Reason} ->
%% 	    dump(Dump, {error, Reason}),
%% 	    end_of_trace(Table, undefined),
%% 	    {error, Reason, 1, GroupLeader, Dump};
%% 	TS ->
%% 	    ets:insert(Table, #misc{id = first_ts, data = TS}),
%% 	    ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}),
%% 	    {1, TS, GroupLeader, Table, Dump}
%%     end;
handler(_, {error, Reason, M, GroupLeader, Dump}) ->
    N = M+1,
    info_dots(GroupLeader, Dump, N),
    {error, Reason, N, GroupLeader, Dump};
handler(Trace, {M, TS0, GroupLeader, Table, Dump}) ->
    N = M+1,
    info_dots(GroupLeader, Dump, N),
    try trace_handler(Trace, Table, GroupLeader, Dump) of
	TS ->
	    ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}),
	    {N, TS, GroupLeader, Table, Dump}
    catch
	Error ->
	    dump(Dump, {error, Error}),
	    end_of_trace(Table, TS0),
	    {error, Error, N, GroupLeader, Dump}
    end.
%%     case catch trace_handler(Trace, Table, GroupLeader, Dump) of
%% 	{'EXIT', Reason} ->
%% 	    dump(Dump, {error, Reason}),
%% 	    end_of_trace(Table, TS0),
%% 	    {error, Reason, N, GroupLeader, Dump};
%% 	TS ->
%% 	    ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}),
%% 	    {N, TS, GroupLeader, Table, Dump}
%%     end.



end_of_trace(Table, TS) ->
    %%
    %% Close all process stacks, as if the processes exited.
    %%
    Procs = get(),
    put(table, Table),
    ?dbg(2, "get() -> ~p~n", [Procs]),
    lists:map(
      fun ({Pid, _}) when is_pid(Pid) ->
	      trace_exit(Table, Pid, TS)
      end,
      Procs),
    erase(),
    ok.