The R13B03 release.OTP_R13B03

1 files changed, 478 insertions, 0 deletions

diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl
new file mode 100644
index 0000000000..b4313d6888
--- /dev/null
+++ b/lib/tools/src/eprof.erl
@@ -0,0 +1,478 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% 
+%% 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 online 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.
+%% 
+%% %CopyrightEnd%
+%%
+%% Purpose: Profile a system in order to figure out where the 
+%% time goes.
+%%
+
+-module(eprof).
+-behaviour(gen_server).
+
+-export([start/0, stop/0, dump/0, total_analyse/0,
+	 start_profiling/1, profile/2, profile/4, profile/1,
+	 stop_profiling/0, analyse/0, log/1]).
+
+%% Internal exports 
+-export([init/1,
+	 call/4,
+	 handle_call/3,
+	 handle_cast/2,
+	 handle_info/2,
+	 terminate/2,
+	 code_change/3]).
+
+-include_lib("stdlib/include/qlc.hrl").
+
+-import(lists, [flatten/1,reverse/1,keysort/2]).
+
+
+-record(state, {table = notable,
+		proc = noproc,
+		profiling = false, 
+		pfunc = undefined,
+		pop = running,
+		ptime = 0,
+		overhead = 0,
+		rootset = []}).
+
+%%%%%%%%%%%%%%
+
+start() -> gen_server:start({local, eprof}, eprof, [], []).
+stop()  -> gen_server:call(eprof, stop, infinity).
+
+
+profile(Pids, Fun) ->
+    start(),
+    gen_server:call(eprof, {profile,Pids,erlang,apply,[Fun,[]]},infinity).
+
+profile(Pids, M, F, A) ->
+    start(),
+    gen_server:call(eprof, {profile,Pids,M,F,A},infinity).
+
+dump() -> 
+    gen_server:call(eprof, dump, infinity).
+
+analyse() ->
+    gen_server:call(eprof, analyse, infinity).
+
+log(File) ->
+    gen_server:call(eprof, {logfile, File}, infinity).
+
+total_analyse() ->
+    gen_server:call(eprof, total_analyse, infinity).
+
+start_profiling(Rootset) ->
+    start(),
+    gen_server:call(eprof, {profile, Rootset}, infinity).
+
+stop_profiling() ->
+    gen_server:call(eprof, stop_profiling, infinity).
+
+profile(Rs) ->
+    start_profiling(Rs).
+
+%%%%%%%%%%%%%%%%
+
+init(_) ->
+    process_flag(trap_exit, true),
+    process_flag(priority, max),
+    put(three_one, {3,1}),			%To avoid building garbage.
+    {ok, #state{}}.
+
+subtr({X1,Y1,Z1}, {X1,Y1,Z2}) ->
+    Z1 - Z2;
+subtr({X1,Y1,Z1}, {X2,Y2,Z2}) ->
+    (((X1-X2) * 1000000) + Y1 - Y2) * 1000000 + Z1 - Z2.
+
+update_call_statistics(Tab, Key, Time) ->
+    try ets:update_counter(Tab, Key, Time) of
+	NewTime when is_integer(NewTime) ->
+	    ets:update_counter(Tab, Key, get(three_one))
+    catch
+	error:badarg ->
+	    ets:insert(Tab, {Key,Time,1})
+    end.
+
+update_other_statistics(Tab, Key, Time) ->
+    try
+	ets:update_counter(Tab, Key, Time)
+    catch
+	error:badarg ->
+	    ets:insert(Tab, {Key,Time,0})
+    end.
+
+do_messages({trace_ts,From,Op,Mfa,Time}, Tab, undefined,_PrevOp0,_PrevTime0) ->
+    PrevFunc = [From|Mfa],
+    receive
+	{trace_ts,_,_,_,_}=Ts -> do_messages(Ts, Tab, PrevFunc, Op, Time)
+    after 0 ->
+	    {PrevFunc,Op,Time}
+    end;
+do_messages({trace_ts,From,Op,Mfa,Time}, Tab, PrevFunc0, call, PrevTime0) ->
+    update_call_statistics(Tab, PrevFunc0, subtr(Time, PrevTime0)),
+    PrevFunc = case Op of
+		   exit -> undefined;
+		   out -> undefined;
+		   _ -> [From|Mfa]
+	       end,
+    receive
+	{trace_ts,_,_,_,_}=Ts -> do_messages(Ts, Tab, PrevFunc, Op, Time)
+    after 0 ->
+	    {PrevFunc,Op,Time}
+    end;
+do_messages({trace_ts,From,Op,Mfa,Time}, Tab, PrevFunc0, _PrevOp0, PrevTime0) ->
+    update_other_statistics(Tab, PrevFunc0, subtr(Time, PrevTime0)),
+    PrevFunc = case Op of
+		   exit -> undefined;
+		   out -> undefined;
+		   _ -> [From|Mfa]
+	       end,
+    receive
+	{trace_ts,_,_,_,_}=Ts -> do_messages(Ts, Tab, PrevFunc, Op, Time)
+    after 0 ->
+	    {PrevFunc,Op,Time}
+    end.
+
+%%%%%%%%%%%%%%%%%%
+
+handle_cast(_Req, S) -> {noreply, S}.
+
+terminate(_Reason,_S) ->
+    call_trace_for_all(false),
+    normal.
+
+%%%%%%%%%%%%%%%%%%
+
+handle_call({logfile, F}, _FromTag, Status) ->
+    case file:open(F, [write]) of
+	{ok, Fd} ->
+	    case get(fd) of
+		undefined -> ok;
+		FdOld -> file:close(FdOld)
+	    end,
+	    put(fd, Fd),
+	    {reply, ok, Status};
+	{error, _} ->
+	    {reply, error, Status}
+    end;
+
+handle_call({profile, Rootset}, {From, _Tag}, S) ->
+    link(From),
+    maybe_delete(S#state.table),
+    io:format("eprof: Starting profiling ..... ~n",[]),
+    ptrac(S#state.rootset, false, all()),
+    flush_receive(),
+    Tab = ets:new(eprof, [set, public]),
+    case ptrac(Rootset, true, all()) of
+	false ->
+	    {reply, error,  #state{}};
+	true ->
+	    uni_schedule(),
+	    call_trace_for_all(true),
+	    erase(replyto),
+	    {reply, profiling, #state{table = Tab,
+				      proc = From,
+				      profiling = true,
+				      rootset = Rootset}}
+    end;
+
+handle_call(stop_profiling, _FromTag, S) when S#state.profiling ->
+    ptrac(S#state.rootset, false, all()),
+    call_trace_for_all(false),
+    multi_schedule(),
+    io:format("eprof: Stop profiling~n",[]),
+    ets:delete(S#state.table, nofunc),
+    {reply, profiling_stopped, S#state{profiling = false}};
+
+handle_call(stop_profiling, _FromTag, S) ->
+    {reply, profiling_already_stopped, S};
+
+handle_call({profile, Rootset, M, F, A}, FromTag, S) ->
+    io:format("eprof: Starting profiling..... ~n", []),
+    maybe_delete(S#state.table),
+    ptrac(S#state.rootset, false, all()),
+    flush_receive(),
+    put(replyto, FromTag),
+    Tab = ets:new(eprof, [set, public]),
+    P = spawn_link(eprof, call, [self(), M, F, A]),
+    case ptrac([P|Rootset], true, all()) of
+	true ->
+	    uni_schedule(),
+	    call_trace_for_all(true),
+	    P ! {self(),go},
+	    {noreply, #state{table     = Tab, 
+			     profiling = true,
+			     rootset   = [P|Rootset]}};
+	false ->
+	    exit(P, kill),
+	    erase(replyto),
+	    {reply, error, #state{}}
+    end;
+
+handle_call(dump, _FromTag, S) ->
+    {reply, dump(S#state.table), S};
+
+handle_call(analyse, _FromTag, S) ->
+    {reply, analyse(S), S};
+
+handle_call(total_analyse, _FromTag, S) ->
+    {reply, total_analyse(S), S};
+
+handle_call(stop, _FromTag, S) ->
+    multi_schedule(),
+    {stop, normal, stopped, S}.
+
+%%%%%%%%%%%%%%%%%%%
+
+handle_info({trace_ts,_From,_Op,_Func,_Time}=M, S0) when S0#state.profiling ->
+    Start = erlang:now(),
+    #state{table=Tab,pop=PrevOp0,ptime=PrevTime0,pfunc=PrevFunc0,
+	   overhead=Overhead0} = S0,
+    {PrevFunc,PrevOp,PrevTime} = do_messages(M, Tab, PrevFunc0, PrevOp0, PrevTime0),
+    Overhead = Overhead0 + subtr(erlang:now(), Start),
+    S = S0#state{overhead=Overhead,pfunc=PrevFunc,pop=PrevOp,ptime=PrevTime},
+    {noreply,S};
+
+handle_info({trace_ts, From, _, _, _}, S) when not S#state.profiling ->
+    ptrac([From], false, all()),
+    {noreply, S};
+
+handle_info({_P, {answer, A}}, S) ->
+    ptrac(S#state.rootset, false, all()),
+    io:format("eprof: Stop profiling~n",[]),
+    {From,_Tag} = get(replyto),
+    catch unlink(From),
+    ets:delete(S#state.table, nofunc),
+    gen_server:reply(erase(replyto), {ok, A}),
+    multi_schedule(),
+    {noreply, S#state{profiling = false,
+		      rootset = []}};
+
+handle_info({'EXIT', P, Reason},
+	    #state{profiling=true,proc=P,table=T,rootset=RootSet}) ->
+    maybe_delete(T),
+    ptrac(RootSet, false, all()),
+    multi_schedule(),
+    io:format("eprof: Profiling failed\n",[]),
+    case erase(replyto) of
+	undefined ->
+	    {noreply, #state{}};
+	FromTag ->
+	    gen_server:reply(FromTag, {error, Reason}),
+	    {noreply, #state{}}
+    end;
+
+handle_info({'EXIT',_P,_Reason}, S) ->
+    {noreply, S}.
+
+uni_schedule() ->
+    erlang:system_flag(multi_scheduling, block).
+
+multi_schedule() ->
+    erlang:system_flag(multi_scheduling, unblock).
+
+%%%%%%%%%%%%%%%%%%
+
+call(Top, M, F, A) ->
+    receive
+	{Top,go} ->
+	    Top ! {self(), {answer, apply(M,F,A)}}
+    end.
+
+call_trace_for_all(Flag) ->
+    erlang:trace_pattern(on_load, Flag, [local]),
+    erlang:trace_pattern({'_','_','_'}, Flag, [local]).
+
+ptrac([P|T], How, Flags) when is_pid(P) ->
+    case dotrace(P, How, Flags) of
+	true ->
+	    ptrac(T, How, Flags);
+	false when How ->
+	    false;
+	false ->
+	    ptrac(T, How, Flags)
+    end;
+
+ptrac([P|T], How, Flags) when is_atom(P) ->
+    case whereis(P) of
+	undefined when How ->
+	    false;
+	undefined when not How ->
+	    ptrac(T, How, Flags);
+	Pid ->
+	    ptrac([Pid|T], How, Flags)
+    end;
+
+ptrac([H|_],_How,_Flags) ->
+    io:format("** eprof bad process ~w~n",[H]),
+    false;
+
+ptrac([],_,_) -> true.
+
+dotrace(P, How, What) ->
+    case (catch erlang:trace(P, How, What)) of
+	1 ->
+	    true;
+	_Other when not How ->
+	    true;
+	_Other ->
+	    io:format("** eprof: bad process: ~p,~p,~p~n", [P,How,What]),
+	    false
+    end.
+
+all() -> [call,arity,return_to,running,timestamp,set_on_spawn].
+
+total_analyse(#state{table=notable}) ->
+    nothing_to_analyse;
+total_analyse(S) ->
+    #state{table = T, overhead = Overhead} = S,
+    QH = qlc:q([{{From,Mfa},Time,Count} ||
+		   {[From|Mfa],Time,Count} <- ets:table(T)]),
+    Pcalls = reverse(keysort(2, replicas(qlc:eval(QH)))),
+    Time = collect_times(Pcalls),
+    format("FUNCTION~44s      TIME ~n", ["CALLS"]),   
+    printit(Pcalls, Time),
+    format("\nTotal time: ~.2f\n", [Time / 1000000]),
+    format("Measurement overhead: ~.2f\n", [Overhead / 1000000]).
+
+analyse(#state{table=notable}) ->
+    nothing_to_analyse;
+analyse(S) ->
+    #state{table = T, overhead = Overhead} = S,
+    Pids = ordsets:from_list(flatten(ets:match(T, {['$1'|'_'],'_', '_'}))),
+    Times = sum(ets:match(T, {'_','$1', '_'})),
+    format("FUNCTION~44s      TIME ~n", ["CALLS"]),     
+    do_pids(Pids, T, 0, Times),
+    format("\nTotal time: ~.2f\n", [Times / 1000000]),
+    format("Measurement overhead: ~.2f\n", [Overhead / 1000000]).
+
+do_pids([Pid|Tail], T, AckTime, Total) ->
+    Pcalls = 
+     reverse(keysort(2, to_tups(ets:match(T, {[Pid|'$1'], '$2','$3'})))),
+    Time = collect_times(Pcalls),
+    PercentTotal = 100 * (divide(Time, Total)),
+    format("~n****** Process ~w    -- ~s % of profiled time *** ~n", 
+	   [Pid, fpf(PercentTotal)]),
+    printit(Pcalls, Time),
+    do_pids(Tail, T, AckTime + Time, Total);
+do_pids([], _, _, _) -> 
+    ok.
+
+printit([],_) -> ok;
+printit([{{Mod,Fun,Arity}, Time, Calls} |Tail], ProcTime)  ->
+    format("~s  ~s ~s % ~n", [ff(Mod,Fun,Arity), fint(Calls),
+			      fpf(100*(divide(Time,ProcTime)))]),
+    printit(Tail, ProcTime);
+printit([{{_,{Mod,Fun,Arity}}, Time, Calls} |Tail], ProcTime)  ->
+    format("~s  ~s ~s % ~n", [ff(Mod,Fun,Arity), fint(Calls),
+			      fpf(100*(divide(Time,ProcTime)))]),
+    printit(Tail, ProcTime); 
+printit([_|T], Time) ->
+    printit(T, Time).
+
+ff(Mod,Fun,Arity) ->
+    pad(flatten(io_lib:format("~w:~w/~w", [Mod,Fun, Arity])),45).
+
+pad(Str, Len) -> 
+    Strlen = length(Str),
+    if
+	Strlen > Len -> strip_tail(Str, 45);
+	true -> lists:append(Str, mklist(Len-Strlen))
+    end.
+
+strip_tail([_|_], 0) ->[];
+strip_tail([H|T], I) -> [H|strip_tail(T, I-1)];
+strip_tail([],_I) -> [].
+
+fpf(F) -> strip_tail(flatten(io_lib:format("~w", [round(F)])), 5).
+fint(Int) -> pad(flatten(io_lib:format("~w",[Int])), 10).
+
+mklist(0) -> [];
+mklist(I) -> [$ |mklist(I-1)].
+
+to_tups(L) -> lists:map(fun(List) -> erlang:list_to_tuple(List) end, L).
+
+divide(X,Y) -> X / Y.
+
+collect_times([]) -> 0;
+collect_times([Tup|Tail]) -> element(2, Tup) + collect_times(Tail).
+
+dump(T) ->
+    L = ets:tab2list(T),
+    format(L).
+
+format([H|T]) -> 
+    format("~p~n", [H]), format(T);
+format([]) -> ok.
+
+format(F, A) ->
+    io:format(F,A),
+    case get(fd) of
+	undefined -> ok;
+	Fd -> io:format(Fd, F,A)
+    end.
+
+maybe_delete(T) ->
+    catch ets:delete(T).
+
+sum([[H]|T]) -> H + sum(T);
+sum([]) -> 0.
+
+replicas(L) ->
+    replicas(L, []).
+
+replicas([{{Pid, {Mod,Fun,Arity}}, Ack,Calls} |Tail], Result) ->
+    case search({Mod,Fun,Arity},Result) of
+	false ->
+	    replicas(Tail, [{{Pid, {Mod,Fun,Arity}}, Ack,Calls} |Result]);
+	{Ack2, Calls2} ->
+	    Result2 = del({Mod,Fun,Arity}, Result),
+	    replicas(Tail, [{{Pid, {Mod,Fun,Arity}}, 
+			     Ack+Ack2,Calls+Calls2} |Result2])
+    end;
+
+replicas([_|T], Ack) ->  %% Whimpy
+    replicas(T, Ack);
+
+replicas([], Res) -> Res.
+
+search(Key, [{{_,Key}, Ack, Calls}|_]) -> 
+    {Ack, Calls};
+search(Key, [_|T]) -> 
+    search(Key, T);
+search(_Key,[]) -> false.
+
+del(Key, [{{_,Key},_Ack,_Calls}|T]) ->
+    T;
+del(Key, [H | Tail]) ->
+    [H|del(Key, Tail)];
+del(_Key,[]) -> [].
+
+flush_receive() ->
+    receive 
+	{trace_ts, From, _, _, _} when is_pid(From) ->
+	    ptrac([From], false, all()),
+	    flush_receive();
+	_ ->
+	    flush_receive()
+    after 0 ->
+	    ok
+    end.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok,State}.