c.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 695 行 · 第 1/2 页

%% ``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$
%%
-module(c).

%% Utilities to use from shell.

-export([help/0,lc/1,c/1,c/2,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0,
         y/1, y/2,
	 lc_batch/0, lc_batch/1,
	 i/3,pid/3,m/0,m/1,
	 bt/1, q/0,
	 erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0,
	 nregs/0,pwd/0,ls/0,ls/1,cd/1,memory/1,memory/0, xm/1]).

-export([display_info/1]).
-export([appcall/4]).

-import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysearch/3,keysort/2,
		concat/1,max/1,min/1,foreach/2,foldl/3,flatmap/2]).
-import(io, [format/1, format/2]).

help() ->
    format("bt(Pid)    -- stack backtrace for a process\n"
	   "c(File)    -- compile and load code in <File>\n"
	   "cd(Dir)    -- change working directory\n"
	   "flush()    -- flush any messages sent to the shell\n"
	   "help()     -- help info\n"
	   "i()        -- information about the system\n"
	   "ni()       -- information about the networked system\n"
	   "i(X,Y,Z)   -- information about pid <X,Y,Z>\n"
	   "l(Module)  -- load or reload module\n"
	   "lc([File]) -- compile a list of Erlang modules\n"
	   "ls()       -- list files in the current directory\n"
	   "ls(Dir)    -- list files in directory <Dir>\n"
	   "m()        -- which modules are loaded\n"
	   "m(Mod)     -- information about module <Mod>\n"
	   "memory()   -- memory allocation information\n"
	   "memory(T)  -- memory allocation information of type <T>\n"
	   "nc(File)   -- compile and load code in <File> on all nodes\n"
	   "nl(Module) -- load module on all nodes\n"
	   "pid(X,Y,Z) -- convert X,Y,Z to a Pid\n"
	   "pwd()      -- print working directory\n"
	   "q()        -- quit - shorthand for init:stop()\n"
	   "regs()     -- information about registered processes\n"
	   "nregs()    -- information about all registered processes\n"
	   "xm(M)      -- cross reference check a module\n"
           "y(File)    -- generate a Yecc parser\n").

%% c(FileName)
%%  Compile a file/module.

c(File) -> c(File, []).

c(File, Opts0) when is_list(Opts0) ->
    Opts = [report_errors,report_warnings|Opts0],
    case compile:file(File, Opts) of
	{ok,Mod} ->				%Listing file.
	    machine_load(Mod, File, Opts);
	{ok,Mod,_Ws} ->				%Warnings maybe turned on.
	    machine_load(Mod, File, Opts);
	Other ->				%Errors go here
	    Other
    end;
c(File, Opt) -> 
    c(File, [Opt]).

%%% Obtain the 'outdir' option from the argument. Return "." if no
%%% such option was given.
outdir([]) ->
    ".";
outdir([Opt|Rest]) ->
    case Opt of
	{outdir, D} ->
	    D;
	_ ->
	    outdir(Rest)
    end.

%%% We have compiled File with options Opts. Find out where the
%%% output file went to, and load it.
machine_load(Mod, File, Opts) ->
    Dir = outdir(Opts),
    File2 = filename:join(Dir, filename:basename(File, ".erl")),
    case compile:output_generated(Opts) of
	true ->
	    Base = packages:last(Mod),
	    case filename:basename(File, ".erl") of
		Base ->
		    code:purge(Mod),
		    check_load(code:load_abs(File2,Mod), Mod);
		_OtherMod ->
		    format("** Module name '~p' does not match file name '~p' **~n",
			   [Mod,File]),
		    {error, badfile}
	    end;
	false ->
	    format("** Warning: No object file created - nothing loaded **~n", []),
	    ok
    end.

%%% This function previously warned if the loaded module was
%%% loaded from some other place than current directory.
%%% Now, loading from other than current directory is supposed to work.
%%% so this function does nothing special.
check_load({error, R}, _) -> {error, R};
check_load(_, X) -> {ok, X}.

%% Compile a list of modules
%% enables the nice unix shell cmd
%% erl -s c lc f1 f2 f3 @d c1=v1 @c2 @i IDir @o ODir -s erlang halt
%% to compile files f1.erl , f2.erl ....... from a unix shell
%% with constant c2 defined, c1=v1 (v1 must be a term!), include dir
%% IDir, outdir ODir.

lc(Args) ->
    case catch split(Args, [], []) of
	error -> error;
	{Opts, Files} ->
	    COpts = [report_errors, report_warnings | reverse(Opts)],
	    foreach(fun(File) -> compile:file(File, COpts) end, reverse(Files))
    end.

%%% lc_batch/1 works like lc/1, but halts afterwards, with appropriate
%%% exit code. This is meant to be called by "erl -compile".
lc_batch() ->
    io:format("Error: no files to compile~n"),
    halt(1).

lc_batch(Args) ->
    case catch split(Args, [], []) of
	error ->
	    halt(1);
	{Opts, Files} ->
	    COpts = [report_errors, report_warnings | reverse(Opts)],
            Res = [compile:file(File, COpts) || File <- reverse(Files)],
	    case lists:member(error, Res) of
		true ->
		    halt(1);
		false ->
		    halt(0)
	    end
    end.

split(['@i', Dir | T], Opts, Files) ->
    split(T, [{i, atom_to_list(Dir)} | Opts], Files);
split(['@o', Dir | T], Opts, Files) ->
    split(T, [{outdir, atom_to_list(Dir)} | Opts], Files);
split(['@d', Def | T], Opts, Files) ->
    split(T, [split_def(atom_to_list(Def), []) | Opts], Files);
split([File | T], Opts, Files) ->
    split(T, Opts, [File | Files]);
split([], Opts, Files) ->
    {Opts, Files}.

split_def([$= | T], Res) -> {d, list_to_atom(reverse(Res)),make_term(T)};
split_def([H | T], Res) -> split_def(T, [H | Res]);
split_def([], Res) -> {d, list_to_atom(reverse(Res))}.

make_term(Str) ->
    case erl_scan:string(Str) of
	{ok, Tokens, _} ->
	    case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
		{ok, Term} -> Term;
		{error, {_,_,Reason}} ->
		    io:format("~s: ~s~n", [Reason, Str]),
		    throw(error)
	    end;
	{error, {_,_,Reason}, _} ->
	    io:format("~s: ~s~n", [Reason, Str]),
	    throw(error)
    end.

nc(File) -> nc(File, []).

nc(File, Opts0) when is_list(Opts0) ->
    Opts = Opts0 ++ [report_errors, report_warnings],
    case compile:file(File, Opts) of
	{ok,Mod} ->
	    Fname = concat([File, code:objfile_extension()]),
	    case file:read_file(Fname) of
		{ok,Bin} ->
		    rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]),
		    {ok,Mod};
		Other ->
		    Other
	    end;
	Other ->                                %Errors go here
	    Other
    end;
nc(File, Opt) when is_atom(Opt) -> 
    nc(File, [Opt]).

%% l(Mod)
%%  Reload module Mod from file of same name

l(Mod) ->
    code:purge(Mod),
    code:load_file(Mod).

%% Network version of l/1
nl(Mod) ->
    case code:get_object_code(Mod) of
	{_Module, Bin, Fname} ->
            rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]);
	Other ->
	    Other
    end.

i() -> i(processes()).
ni() -> i(all_procs()).

i(Ps) ->
    i(Ps, length(Ps)).

i(Ps, N) when N =< 100 ->
    iformat("Pid", "Initial Call", "Heap", "Reds",
	    "Msgs"),
    iformat("Registered", "Current Function", "Stack", "",
	    ""),
    {R,M,H,S} = foldl(fun(Pid, {R0,M0,H0,S0}) ->
			      {A,B,C,D} = display_info(Pid),
			      {R0+A,M0+B,H0+C,S0+D}
		      end, {0,0,0,0}, Ps),
    iformat("Total", "", w(H), w(R), w(M)),
    iformat("", "", w(S), "", "");
i(Ps, N) ->
    iformat("Pid", "Initial Call", "Heap", "Reds",
	    "Msgs"),
    iformat("Registered", "Current Function", "Stack", "",
	    ""),
    paged_i(Ps, {0,0,0,0}, N, 50).

paged_i([], {R,M,H,S}, _, _) ->
    iformat("Total", "", w(H), w(R), w(M)),
    iformat("", "", w(S), "", "");
paged_i(Ps, Acc, N, Page) ->
    {Pids, Rest, N1} =
	if N > Page ->
		{L1,L2} = lists:split(Page, Ps),
		{L1,L2,N-Page};
	   true ->
		{Ps, [], 0}
	end,
    NewAcc = foldl(fun(Pid, {R,M,H,S}) ->
			   {A,B,C,D} = display_info(Pid),
			   {R+A,M+B,H+C,S+D}
		   end, Acc, Pids),
    case Rest of
	[_|_] ->
	    choice(fun() -> paged_i(Rest, NewAcc, N1, Page) end);
	[] ->
	    paged_i([], NewAcc, 0, Page)
    end.


choice(F) ->
    case get_line('(c)ontinue (q)uit -->', "c\n") of
	"c\n" ->
	    F();
	"q\n" ->
	    quit;
	_ ->
	    choice(F)
    end.
    

get_line(P, Default) ->
    case io:get_line(P) of
	"\n" ->
	    Default;
	L ->
	    L
    end.

mfa_string(Fun) when is_function(Fun) ->
    {module,M} = erlang:fun_info(Fun, module),
    {name,F} = erlang:fun_info(Fun, name),
    {arity,A} = erlang:fun_info(Fun, arity),
    mfa_string({M,F,A});
mfa_string({M,F,A}) ->
    io_lib:format("~w:~w/~w", [M,F,A]);
mfa_string(X) ->
    w(X).


display_info(Pid) ->
    case pinfo(Pid) of
	undefined -> {0,0,0,0};
	Info ->
	    Call = initial_call(Info),
	    Curr = case fetch(current_function, Info) of
		       {Mod,F,Args} when is_list(Args) ->
			   {Mod,F,length(Args)};
		       Other ->
			   Other
		   end,
	    Reds  = fetch(reductions, Info),
	    LM = length(fetch(messages, Info)),
	    HS = fetch(heap_size, Info),
	    SS = fetch(stack_size, Info),
	    iformat(w(Pid), mfa_string(Call),
		    w(HS),
		    w(Reds), w(LM)),
	    iformat(case fetch(registered_name, Info) of
			0 -> "";
			X -> w(X)
		    end,
		    mfa_string(Curr),
		    w(SS),
		    "",
		    ""),
	    {Reds, LM, HS, SS}
    end.

%% We have to do some assumptions about the initial call.
%% If the initial call is proc_lib:init_p/3,5 we can find more information
%% calling the function proc_lib:initial_call/1.

initial_call(Info)  ->
    case fetch(initial_call, Info) of
	{proc_lib, init_p, _} ->
	    proc_lib:translate_initial_call(Info);
	ICall ->
	    ICall
    end.

iformat(A1, A2, A3, A4, A5) ->
    format("~-21s ~-33s ~8s ~8s ~4s~n", [A1,A2,A3,A4,A5]).

all_procs() ->
    case is_alive() of
	true -> flatmap(fun (N) -> rpc:call(N,erlang,processes,[]) end,
			[node()|nodes()]);