dbg_iload.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 655 行 · 第 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(dbg_iload).

%% External exports
-export([load_mod/4]).

%% Internal exports
-export([load_mod1/4]).

%%====================================================================
%% External exports
%%====================================================================

%%--------------------------------------------------------------------
%% load_mod(Mod, File, Binary, Db) -> {ok, Mod}
%%   Mod = atom()
%%   File = string() Source file (including path)
%%   Binary = binary()
%%   Db = ETS identifier
%% Load a new module into the database.
%%
%% We want the loading of a module to be syncronous  so no other
%% process tries to interpret code in a module not being completely
%% loaded. This is achieved as this function is called from
%% dbg_iserver. We are suspended until the module has been loaded.
%%--------------------------------------------------------------------
load_mod(Mod, File, Binary, Db) ->
    Flag = process_flag(trap_exit, true),
    Pid = spawn_link(?MODULE, load_mod1, [Mod, File, Binary, Db]),
    receive
	{'EXIT', Pid, What} ->
	    process_flag(trap_exit, Flag),
	    What
    end.

%%====================================================================
%% Internal exports
%%====================================================================

load_mod1(Mod, File, Binary, Db) ->
    store_module(Mod, File, Binary, Db),
    exit({ok, Mod}).


%%====================================================================
%% Internal functions
%%====================================================================

store_module(Mod, File, Binary, Db) ->
    {interpreter_module, Exp, Abst, Src, MD5} = binary_to_term(Binary),
    Forms = case abstr(Abst) of
		{abstract_v1,Forms0} -> Forms0;
		{abstract_v2,Forms0} -> Forms0;
		{raw_abstract_v1,Code0} ->
                    Code = interpret_file_attribute(Code0),
		    {_,_,Forms0,_} = sys_pre_expand:module(Code, []),
		    Forms0
	    end,
    dbg_idb:insert(Db, mod_file, File),
    dbg_idb:insert(Db, exports, Exp),
    dbg_idb:insert(Db, defs, []),

    put(vcount, 0),
    put(fun_count, 0),
    put(funs, []),
    put(mod_md5, MD5),
    Attr = store_forms(Forms, Mod, Db, Exp, []),
    erase(mod_md5),
    erase(current_function),
%    store_funs(Db, Mod),
    erase(vcount),
    erase(funs),
    erase(fun_count),
    
    dbg_idb:insert(Db, attributes, Attr),
    NewBinary = store_mod_line_no(Mod, Db, binary_to_list(Src)),
    dbg_idb:insert(Db, mod_bin, NewBinary),
    dbg_idb:insert(Db, module, Mod).
%% Adjust line numbers using the file/2 attribute. 
%% Also take the absolute value of line numbers.
%% This simple fix will make the marker point at the correct line
%% (assuming the file attributes are correct) in the source; it will
%% not point at code in included files.
interpret_file_attribute(Code) ->
    epp:interpret_file_attribute(Code).


abstr(Bin) when is_binary(Bin) -> binary_to_term(Bin);
abstr(Term) -> Term.

% store_funs(Db, Mod) ->
%     store_funs_1(get(funs), Db, Mod).

% store_funs_1([{Name,Index,Uniq,_,_,Arity,Cs}|Fs], Db, Mod) ->
%     dbg_idb:insert(Db, {Mod,Name,Arity,false}, Cs),
%     dbg_idb:insert(Db, {'fun',Mod,Index,Uniq}, {Name,Arity,Cs}),
%     store_funs_1(Fs, Db, Mod);
% store_funs_1([], _, _) -> ok.

store_forms([{function,_,module_info,0,_}|Fs], Mod, Db, Exp, Attr) ->
    Cs = [{clause,0,[],[], [{module_info_0,0,Mod}]}],
    dbg_idb:insert(Db, {Mod,module_info,0,true}, Cs),
    store_forms(Fs, Mod, Db, Exp, Attr);
store_forms([{function,_,module_info,1,_}|Fs], Mod, Db, Exp, Attr) ->
    Cs = [{clause,0,[{var,0,'What'}],[], [{module_info_1,0,Mod,[{var,0,'What'}]}]}],
    dbg_idb:insert(Db, {Mod,module_info,1,true}, Cs),
    store_forms(Fs, Mod, Db, Exp, Attr);
store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, Exp, Attr) ->
    FA = {Name,Arity},
    put(current_function, FA),
    Cs = clauses(Cs0),
    Exported = lists:member(FA, Exp),
    dbg_idb:insert(Db, {Mod,Name,Arity,Exported}, Cs),
    store_forms(Fs, Mod, Db, Exp, Attr);
store_forms([{attribute,_,Name,Val}|Fs], Mod, Db, Exp, Attr) ->
    store_forms(Fs, Mod, Db, Exp, [{Name,Val}|Attr]);
store_forms([F|_], _Mod, _Db, _Exp, _Attr) ->
    exit({unknown_form,F});
store_forms([], _, _, _, Attr) ->
    lists:reverse(Attr).

store_mod_line_no(Mod, Db, Contents) ->
    store_mod_line_no(Mod, Db, Contents, 1, 0, []).

store_mod_line_no(_, _, [], _, _, NewCont) ->
    list_to_binary(lists:reverse(NewCont));
store_mod_line_no(Mod, Db, Contents, LineNo, Pos, NewCont) when is_integer(LineNo) ->
    {ContTail,Pos1,NewCont1} = store_line(Mod, Db, Contents, LineNo, Pos, NewCont),
    store_mod_line_no(Mod, Db, ContTail, LineNo+1, Pos1, NewCont1).

store_line(_, Db, Contents, LineNo, Pos, NewCont) ->
    {ContHead,ContTail,PosNL} = get_nl(Contents,Pos+8,[]),
    dbg_idb:insert(Db,LineNo,{Pos+8,PosNL}),
    {ContTail,PosNL+1,[make_lineno(LineNo, 8, ContHead)|NewCont]}.

make_lineno(N, P, Acc) ->
    S = integer_to_list(N),
    S ++ [$:|spaces(P-length(S)-1, Acc)].

spaces(P, Acc) when P > 0 ->
    spaces(P-1, [$\s|Acc]);
spaces(_, Acc) -> Acc.

get_nl([10|T],Pos,Head) -> {lists:reverse([10|Head]),T,Pos};
get_nl([H|T],Pos,Head) ->
    get_nl(T,Pos+1,[H|Head]);
get_nl([],Pos,Head) -> {lists:reverse(Head),[],Pos}.

%%% Rewrite the abstract syntax tree to that it will be easier (== faster)
%%% to interpret.

clauses([C0|Cs]) ->
    C1 = clause(C0),
    [C1|clauses(Cs)];
clauses([]) -> [].

clause({clause,Line,H0,G0,B0}) ->
    H1 = head(H0),
    G1 = guard(G0),
    B1 = exprs(B0),
    {clause,Line,H1,G1,B1}.

head(Ps) -> patterns(Ps).

%%  These patterns are processed "sequentially" for purposes of variable
%%  definition etc.

patterns([P0|Ps]) ->
    P1 = pattern(P0),
    [P1|patterns(Ps)];
patterns([]) -> [].

%%  N.B. Only valid patterns are included here.

pattern({var,Line,V}) -> {var,Line,V};
pattern({char,Line,I}) -> {value,Line,I};
pattern({integer,Line,I}) -> {value,Line,I};
pattern({match,Line,Pat1,Pat2}) ->
    {match,Line,pattern(Pat1),pattern(Pat2)};
pattern({float,Line,F}) -> {value,Line,F};
pattern({atom,Line,A}) -> {value,Line,A};
pattern({string,Line,S}) -> {value,Line,S};
pattern({nil,Line}) -> {value,Line,[]};
pattern({cons,Line,H0,T0}) ->
    H1 = pattern(H0),
    T1 = pattern(T0),
    {cons,Line,H1,T1};
pattern({tuple,Line,Ps0}) ->
    Ps1 = pattern_list(Ps0),
    {tuple,Line,Ps1};
pattern({op,_,'-',{integer,Line,I}}) ->
    {value,Line,-I};
pattern({op,_,'+',{integer,Line,I}}) ->
    {value,Line,I};
pattern({op,_,'-',{char,Line,I}}) ->
    {value,Line,-I};
pattern({op,_,'+',{char,Line,I}}) ->
    {value,Line,I};
pattern({op,_,'-',{float,Line,I}}) ->
    {value,Line,-I};
pattern({op,_,'+',{float,Line,I}}) ->
    {value,Line,I};
pattern({bin,Line,Grp}) ->
    Grp1 = pattern_list(Grp),
    {bin,Line,Grp1};
pattern({bin_element,Line,Expr,Size,Type}) ->
    Expr1 = pattern(Expr),
    Size1 = expr(Size),
    {bin_element,Line,Expr1,Size1,Type}.

%%  These patterns are processed "in parallel" for purposes of variable
%%  definition etc.

pattern_list([P0|Ps]) ->
    P1 = pattern(P0),
    [P1|pattern_list(Ps)];
pattern_list([]) -> [].

guard([G0|Gs]) ->
    G1 = and_guard(G0),
    [G1|guard(Gs)];
guard([]) -> [].

and_guard([{atom,_,true}|Gs]) ->
    and_guard(Gs);
and_guard([G0|Gs]) ->
    G1 = guard_test(G0),
    [G1|and_guard(Gs)];
and_guard([]) -> [].

guard_test({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) ->
    As = gexpr_list(As0),
    case map_guard_bif(F, length(As0)) of
	{ok,Name} ->
	    {safe_bif,Line,erlang,Name,As};
	error ->
	    {safe_bif,Line,erlang,F,As}
    end;
guard_test({op,Line,Op,L0}) ->
    true = erl_internal:arith_op(Op, 1) orelse %Assertion.
	erl_internal:bool_op(Op, 1),
    L1 = gexpr(L0),
    {safe_bif,Line,erlang,Op,[L1]};
guard_test({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' ->
    L1 = gexpr(L0),
    R1 = gexpr(R0),				%They see the same variables
    {Op,Line,L1,R1};
guard_test({op,Line,Op,L0,R0}) ->
    true = erl_internal:comp_op(Op, 2) orelse	%Assertion.
	erl_internal:bool_op(Op, 2) orelse
        erl_internal:arith_op(Op, 2),
    L1 = gexpr(L0),
    R1 = gexpr(R0),				%They see the same variables
    {safe_bif,Line,erlang,Op,[L1,R1]};
guard_test({integer,_,_}=I) -> I;
guard_test({char,_,_}=C) -> C;
guard_test({float,_,_}=F) -> F;
guard_test({atom,_,_}=A) -> A;
guard_test({nil,_}=N) -> N;
guard_test({var,_,_}=V) ->V.    % Boolean var

map_guard_bif(integer, 1) -> {ok,is_integer};
map_guard_bif(float, 1) -> {ok,is_float};
map_guard_bif(number, 1) -> {ok,is_number};
map_guard_bif(atom, 1) -> {ok,is_atom};
map_guard_bif(constant, 1) -> {ok,is_constant};
map_guard_bif(list, 1) -> {ok,is_list};
map_guard_bif(tuple, 1) -> {ok,is_tuple};
map_guard_bif(pid, 1) -> {ok,is_pid};
map_guard_bif(reference, 1) -> {ok,is_reference};
map_guard_bif(port, 1) -> {ok,is_port};
map_guard_bif(binary, 1) -> {ok,is_binary};
map_guard_bif(function, 1) -> {ok,is_function};
map_guard_bif(_, _) -> error.

gexpr({var,Line,V}) -> {var,Line,V};
gexpr({integer,Line,I}) -> {value,Line,I};
gexpr({char,Line,I}) -> {value,Line,I};
gexpr({float,Line,F}) -> {value,Line,F};
gexpr({atom,Line,A}) -> {value,Line,A};
gexpr({string,Line,S}) -> {value,Line,S};
gexpr({nil,Line}) -> {value,Line,[]};
gexpr({cons,Line,H0,T0}) ->
    case {gexpr(H0),gexpr(T0)} of
	{{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]};
	{H1,T1} -> {cons,Line,H1,T1}
    end;
gexpr({tuple,Line,Es0}) ->
    Es1 = gexpr_list(Es0),
    {tuple,Line,Es1};
gexpr({bin,Line,Flds0}) ->
    Flds = gexpr_list(Flds0),
    {bin,Line,Flds};
gexpr({bin_element,Line,Expr0,Size0,Type}) ->
    Expr = gexpr(Expr0),
    Size = gexpr(Size0),
    {bin_element,Line,Expr,Size,Type};
%%% The previous passes have added the module name 'erlang' to
%%% all BIF calls, even in guards.
gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) ->
    {dbg, Line, self, []};
gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) ->
    As = gexpr_list(As0),
    {safe_bif,Line,erlang,F,As};
gexpr({op,Line,Op,A0}) ->
    erl_internal:arith_op(Op, 1),
    A1 = gexpr(A0),
    {safe_bif,Line,erlang,Op,[A1]};
gexpr({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' ->
    L1 = gexpr(L0),
    R1 = gexpr(R0),			%They see the same variables
    {Op,Line,L1,R1};