gistfile1.hrl

%%%-------------------------------------------------------------------
%%% File    : rdbg.erl
%%% Author  : Mats Cronqvist <qthmacr@mwux005>
%%% Description : 
%%%
%%% Created : 16 Aug 2004 by Mats Cronqvist <qthmacr@mwux005>
%%%-------------------------------------------------------------------
-module(rdbg).
-export([rdbg/4,rdbg/0]).

rdbg(Time,Msgs,Proc,Trc) -> (rdbg())(Time,Msgs,Proc,Trc).

rdbg() ->
    Pi = 
	fun(P) when pid(P) ->
		case process_info(P, registered_name) of
		    [] -> 
			case process_info(P, initial_call) of
			    {_, {proc_lib,init_p,5}} ->
				proc_lib:translate_initial_call(P);
			    {_,MFA} -> MFA;
			    undefined -> unknown
			end;
		    {_,Nam} -> Nam;
		    undefined -> unknown
		end;
	   (P) when port(P) -> 
		{name,N} = erlang:port_info(P,name),
		[Hd|_] = string:tokens(N," "),
		Tl = lists:reverse(hd(string:tokens(lists:reverse(Hd),"/"))),
		list_to_atom(Tl);
	   (R) when atom(R) -> R;
	   ({R,Node}) when atom(R), Node == node() -> R;
	   ({R, Node}) when atom(R), atom(Node) -> {R, Node}
	end,
    Ts = 
	fun(Nw) ->
		{_,{H,M,S}} = calendar:now_to_local_time(Nw),
		{H,M,S,element(3,Nw)}
	end,
    Munge = 
	fun(I) ->
		case string:str(I, "Return addr") of
		    0 -> 
			case string:str(I, "cp = ") of
			    0 -> [];
			    _ -> 
				[_, C|_] = string:tokens(I,"()+"),
				list_to_atom(C)
			end;
		    _ ->
			case string:str(I, "erminate process normal") of
			    0 ->
				[_, C|_] = string:tokens(I,"()+"),
				list_to_atom(C);
			    _ -> []
			end
		end
	end,
    Stack =
	fun(Bin) -> 
		L = string:tokens(binary_to_list(Bin),"\n"),
		{stack,lists:flatten(lists:map(Munge,L))}
	end,
    Prc = 
	fun(all) -> all;
	   (Pd) when pid(Pd) -> Pd;
	   ({pid,P1,P2}) when integer(P1), integer(P2) -> c:pid(0,P1,P2);
	   (Reg) when atom(Reg) -> 
		case whereis(Reg) of 
		    undefined -> exit({rdbg, no_such_process, Reg});
		    Pid when pid(Pid) -> Pid
		end
	end,
    MsF = 
	fun(stack, [{Head,Cond,Body}]) -> 
		[{Head,Cond,[{message,{process_dump}}|Body]}];
	   (return, [{Head,Cond,Body}]) -> 
		[{Head,Cond,[{return_trace}|Body]}];
	   (Head, [{_,Cond,Body}]) when tuple(Head)-> 
		[{Head,Cond,Body}];
	   (X,_) -> 
		exit({rdbg,bad_match_spec,X})
	end,
    Ms = 
	fun(Mss) -> lists:foldl(MsF, [{'_',[],[]}], Mss) end,
    ChkTP =
	fun({M,F}) when atom(M), atom(F), M/='_', F/='_' -> 
		{{M,F,'_'},[],[global]};
	   ({M,F,MS}) when atom(M), atom(F), M/='_', F/='_' -> 
		{{M,F,'_'},Ms(MS),[global]};
	   ({M,F,MS,local}) when atom(M), atom(F), M/='_', F/='_' -> 
		{{M,F,'_'},Ms(MS),[local]};
	   ({M,F,MS,global}) when atom(M), atom(F), M/='_', F/='_' -> 
		{{M,F,'_'},Ms(MS),[global]};
	   (X) -> 
		exit({rdbg,unrec_trace_pattern,X})
	end,
    ChkTPs = 
	fun(TPs) when list(TPs) -> lists:map(ChkTP,TPs);
	   (TP) -> [ChkTP(TP)]
	end,
    SetTPs =
	fun({MFA,MS,Fs}) -> erlang:trace_pattern(MFA,MS,Fs) end,
    DoInitFun = 
	fun(Time) ->
		erlang:register(rdbg, self()),
		erlang:start_timer(Time,self(),{die}),
		erlang:trace_pattern({'_','_','_'},false,[local]),
		erlang:trace_pattern({'_','_','_'},false,[global])
	end,
    InitFun = 
	fun(Time,all,send) -> exit({rdbg,too_many_processes});
	   (Time,all,'receive') -> exit({rdbg,too_many_processes});
	   (Time,P, send) ->
		DoInitFun(Time),
		erlang:trace(Prc(P),true,[send,timestamp]);
	   (Time,P,'receive') ->
		DoInitFun(Time),
		erlang:trace(Prc(P),true,['receive',timestamp]);
	   (Time,P,TPs) ->
		CTPs = ChkTPs(TPs),
		DoInitFun(Time),
		erlang:trace(Prc(P),true,[call,timestamp]),
		lists:foreach(SetTPs,CTPs)
	end,
    LoopFun = 
	fun(G,N,Out) when N < 1 ->
		erlang:trace(all,false,[call,send,'receive']),
		erlang:trace_pattern({'_','_','_'},false,[local]),
		erlang:trace_pattern({'_','_','_'},false,[global]),
		io:fwrite("** rdbg, ~w msgs **~n", [length(Out)]),
		io:fwrite("~p~n",[lists:reverse(Out)]),
		io:fwrite("~p~n", [process_info(self(),message_queue_len)]);
	   (G,Cnt,Out) ->
		case process_info(self(),message_queue_len) of
		    {_,N} when N > 100 -> exit({rdbg,msg_queue,N});
		    _ -> ok
		end,
		receive
		    {timeout,_,{die}} -> 
			G(G,0,Out);
		    {trace_ts,Pid,send,Msg,To,TS} ->
			G(G,Cnt-1,[{send,Ts(TS),Pi(To),Msg}|Out]);
		    {trace_ts,Pid,'receive',Msg,TS} ->
			G(G,Cnt-1,[{'receive',Ts(TS),Msg}|Out]);
		    {trace_ts,Pid,return_from,MFA,V,TS} ->
			G(G,Cnt-1,[{return,MFA,V}|Out]);
		    {trace_ts,Pid,call,MFA,B,TS} when binary(B) ->
			G(G,Cnt-1,[{Pi(Pid),Ts(TS),{Stack(B),MFA}}|Out]);
		    {trace_ts,Pid,call,MFA,TS} -> 
			G(G,Cnt-1,[{Pi(Pid),Ts(TS),MFA}|Out])
		end
	end,
    Rdbg = 
	fun(Time,Msgs,Proc,Trc) when integer(Time), integer(Msgs) ->
		Start = 
		    fun() ->InitFun(Time,Proc,Trc),LoopFun(LoopFun,Msgs,[]) end,
		erlang:spawn_link(Start)
	end.

%% Pi =  fun(P) when pid(P) -> case process_info(P, registered_name) of [] ->  case process_info(P, initial_call) of {_, {proc_lib,init_p,5}} -> proc_lib:translate_initial_call(P); {_,MFA} -> MFA; undefined -> unknown end; {_,Nam} -> Nam; undefined -> unknown end; (P) when port(P) ->  {name,N} = erlang:port_info(P,name), [Hd|_] = string:tokens(N," "), Tl = lists:reverse(hd(string:tokens(lists:reverse(Hd),"/"))), list_to_atom(Tl); (R) when atom(R) -> R; ({R,Node}) when atom(R), Node == node() -> R; ({R, Node}) when atom(R), atom(Node) -> {R, Node} end, Ts =  fun(Nw) -> {_,{H,M,S}} = calendar:now_to_local_time(Nw), {H,M,S,element(3,Nw)} end, Munge =  fun(I) -> case string:str(I, "Return addr") of 0 ->  case string:str(I, "cp = ") of 0 -> []; _ ->  [_, C|_] = string:tokens(I,"()+"), list_to_atom(C) end; _ -> case string:str(I, "erminate process normal") of 0 -> [_, C|_] = string:tokens(I,"()+"), list_to_atom(C); _ -> [] end end end, Stack = fun(Bin) ->  L = string:tokens(binary_to_list(Bin),"\n"), {stack,lists:flatten(lists:map(Munge,L))} end, Prc =  fun(all) -> all; (Pd) when pid(Pd) -> Pd; ({pid,P1,P2}) when integer(P1), integer(P2) -> c:pid(0,P1,P2); (Reg) when atom(Reg) ->  case whereis(Reg) of  undefined -> exit({rdbg, no_such_process, Reg}); Pid when pid(Pid) -> Pid end end, MsF =  fun(stack, [{Head,Cond,Body}]) ->  [{Head,Cond,[{message,{process_dump}}|Body]}]; (return, [{Head,Cond,Body}]) ->  [{Head,Cond,[{return_trace}|Body]}]; (Head, [{_,Cond,Body}]) when tuple(Head)->  [{Head,Cond,Body}]; (X,_) ->  exit({rdbg,bad_match_spec,X}) end, Ms =  fun(Mss) -> lists:foldl(MsF, [{'_',[],[]}], Mss) end, ChkTP = fun({M,F}) when atom(M), atom(F), M/='_', F/='_' ->  {{M,F,'_'},[],[global]}; ({M,F,MS}) when atom(M), atom(F), M/='_', F/='_' ->  {{M,F,'_'},Ms(MS),[global]}; ({M,F,MS,local}) when atom(M), atom(F), M/='_', F/='_' ->  {{M,F,'_'},Ms(MS),[local]}; ({M,F,MS,global}) when atom(M), atom(F), M/='_', F/='_' ->  {{M,F,'_'},Ms(MS),[global]}; (X) ->  exit({rdbg,unrec_trace_pattern,X}) end, ChkTPs =  fun(TPs) when list(TPs) -> lists:map(ChkTP,TPs); (TP) -> [ChkTP(TP)] end, SetTPs = fun({MFA,MS,Fs}) -> erlang:trace_pattern(MFA,MS,Fs) end, DoInitFun =  fun(Time) -> erlang:register(rdbg, self()), erlang:start_timer(Time,self(),{die}), erlang:trace_pattern({'_','_','_'},false,[local]), erlang:trace_pattern({'_','_','_'},false,[global]) end, InitFun =  fun(Time,all,send) -> exit({rdbg,too_many_processes}); (Time,all,'receive') -> exit({rdbg,too_many_processes}); (Time,P, send) -> DoInitFun(Time), erlang:trace(Prc(P),true,[send,timestamp]); (Time,P,'receive') -> DoInitFun(Time), erlang:trace(Prc(P),true,['receive',timestamp]); (Time,P,TPs) -> CTPs = ChkTPs(TPs), DoInitFun(Time), erlang:trace(Prc(P),true,[call,timestamp]), lists:foreach(SetTPs,CTPs) end, LoopFun =  fun(G,N,Out) when N < 1 -> erlang:trace(all,false,[call,send,'receive']), erlang:trace_pattern({'_','_','_'},false,[local]), erlang:trace_pattern({'_','_','_'},false,[global]), io:fwrite("** rdbg, ~w msgs **~n", [length(Out)]), io:fwrite("~p~n",[lists:reverse(Out)]), io:fwrite("~p~n", [process_info(self(),message_queue_len)]); (G,Cnt,Out) -> case process_info(self(),message_queue_len) of {_,N} when N > 100 -> exit({rdbg,msg_queue,N}); _ -> ok end, receive {timeout,_,{die}} ->  G(G,0,Out); {trace_ts,Pid,send,Msg,To,TS} -> G(G,Cnt-1,[{send,Ts(TS),Pi(To),Msg}|Out]); {trace_ts,Pid,'receive',Msg,TS} -> G(G,Cnt-1,[{'receive',Ts(TS),Msg}|Out]); {trace_ts,Pid,return_from,MFA,V,TS} -> G(G,Cnt-1,[{return,MFA,V}|Out]); {trace_ts,Pid,call,MFA,B,TS} when binary(B) -> G(G,Cnt-1,[{Pi(Pid),Ts(TS),{Stack(B),MFA}}|Out]); {trace_ts,Pid,call,MFA,TS} ->  G(G,Cnt-1,[{Pi(Pid),Ts(TS),MFA}|Out]) end end, Rdbg = fun(Time,Msgs,Proc,Trc) when integer(Time), integer(Msgs) -> Start =  fun() -> InitFun(Time,Proc,Trc),LoopFun(LoopFun,Msgs,[]) end, erlang:spawn_link(Start) end.