aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tools/src
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/tools/src
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/tools/src')
-rw-r--r--lib/tools/src/Makefile112
-rw-r--r--lib/tools/src/cover.erl2178
-rw-r--r--lib/tools/src/cover_web.erl1184
-rw-r--r--lib/tools/src/cprof.erl142
-rw-r--r--lib/tools/src/eprof.erl478
-rw-r--r--lib/tools/src/fprof.erl2762
-rw-r--r--lib/tools/src/instrument.erl427
-rw-r--r--lib/tools/src/make.erl324
-rw-r--r--lib/tools/src/tags.erl344
-rw-r--r--lib/tools/src/tools.app.src60
-rw-r--r--lib/tools/src/tools.appup.src19
-rw-r--r--lib/tools/src/xref.erl607
-rw-r--r--lib/tools/src/xref.hrl106
-rw-r--r--lib/tools/src/xref_base.erl1804
-rw-r--r--lib/tools/src/xref_compiler.erl928
-rw-r--r--lib/tools/src/xref_parser.yrl303
-rw-r--r--lib/tools/src/xref_reader.erl352
-rw-r--r--lib/tools/src/xref_scanner.erl91
-rw-r--r--lib/tools/src/xref_utils.erl725
19 files changed, 12946 insertions, 0 deletions
diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile
new file mode 100644
index 0000000000..81933cda14
--- /dev/null
+++ b/lib/tools/src/Makefile
@@ -0,0 +1,112 @@
+#
+# %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%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(TOOLS_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN)
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+MODULES= cover \
+ cover_web \
+ eprof \
+ fprof \
+ cprof \
+ instrument \
+ make \
+ tags \
+ xref \
+ xref_base \
+ xref_compiler \
+ xref_parser \
+ xref_reader \
+ xref_scanner \
+ xref_utils
+
+
+HRL_FILES= \
+ xref.hrl
+
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+YRL_FILE = xref_parser.yrl
+
+APP_FILE = tools.app
+APPUP_FILE = tools.appup
+
+APP_SRC = $(APP_FILE).src
+APP_TARGET = $(EBIN)/$(APP_FILE)
+
+APPUP_SRC = $(APPUP_FILE).src
+APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS +=
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+
+clean:
+ rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f errs core *~
+
+docs:
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(HRL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \
+ $(RELSYSDIR)/ebin
+
+release_docs_spec:
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
new file mode 100644
index 0000000000..aff3927db3
--- /dev/null
+++ b/lib/tools/src/cover.erl
@@ -0,0 +1,2178 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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%
+%%
+-module(cover).
+
+%%
+%% This module implements the Erlang coverage tool. The module named
+%% cover_web implements a user interface for the coverage tool to run
+%% under webtool.
+%%
+%% ARCHITECTURE
+%% The coverage tool consists of one process on each node involved in
+%% coverage analysis. The process is registered as 'cover_server'
+%% (?SERVER). All cover_servers in the distributed system are linked
+%% together. The cover_server on the 'main' node is in charge, and it
+%% traps exits so it can detect nodedown or process crashes on the
+%% remote nodes. This process is implemented by the functions
+%% init_main/1 and main_process_loop/1. The cover_server on the remote
+%% nodes are implemented by the functions init_remote/2 and
+%% remote_process_loop/1.
+%%
+%% TABLES
+%% Each nodes has an ets table named 'cover_internal_data_table'
+%% (?COVER_TABLE). This table contains the coverage data and is
+%% continously updated when cover compiled code is executed.
+%%
+%% The main node owns a table named
+%% 'cover_collected_remote_data_table' (?COLLECTION_TABLE). This table
+%% contains data which is collected from remote nodes (either when a
+%% remote node is stopped with cover:stop/1 or when analysing. When
+%% analysing, data is even moved from the ?COVER_TABLE on the main
+%% node to the ?COLLECTION_TABLE.
+%%
+%% The main node also has a table named 'cover_binary_code_table'
+%% (?BINARY_TABLE). This table contains the binary code for each cover
+%% compiled module. This is necessary so that the code can be loaded
+%% on remote nodes that are started after the compilation.
+%%
+
+
+%% External exports
+-export([start/0, start/1,
+ compile/1, compile/2, compile_module/1, compile_module/2,
+ compile_directory/0, compile_directory/1, compile_directory/2,
+ compile_beam/1, compile_beam_directory/0, compile_beam_directory/1,
+ analyse/1, analyse/2, analyse/3, analyze/1, analyze/2, analyze/3,
+ analyse_to_file/1, analyse_to_file/2, analyse_to_file/3,
+ analyze_to_file/1, analyze_to_file/2, analyze_to_file/3,
+ export/1, export/2, import/1,
+ modules/0, imported/0, imported_modules/0, which_nodes/0, is_compiled/1,
+ reset/1, reset/0,
+ stop/0, stop/1]).
+-export([remote_start/1]).
+%-export([bump/5]).
+-export([transform/4]). % for test purposes
+
+-record(main_state, {compiled=[], % [{Module,File}]
+ imported=[], % [{Module,File,ImportFile}]
+ stopper, % undefined | pid()
+ nodes=[]}). % [Node]
+
+-record(remote_state, {compiled=[], % [{Module,File}]
+ main_node}). % atom()
+
+-record(bump, {module = '_', % atom()
+ function = '_', % atom()
+ arity = '_', % integer()
+ clause = '_', % integer()
+ line = '_' % integer()
+ }).
+-define(BUMP_REC_NAME,bump).
+
+-record(vars, {module, % atom() Module name
+ vsn, % atom()
+
+ init_info=[], % [{M,F,A,C,L}]
+
+ function, % atom()
+ arity, % int()
+ clause, % int()
+ lines, % [int()]
+ no_bump_lines, % [int()]
+ depth, % int()
+ is_guard=false % boolean
+ }).
+
+-define(COVER_TABLE, 'cover_internal_data_table').
+-define(BINARY_TABLE, 'cover_binary_code_table').
+-define(COLLECTION_TABLE, 'cover_collected_remote_data_table').
+-define(TAG, cover_compiled).
+-define(SERVER, cover_server).
+
+%% Line doesn't matter.
+-define(BLOCK(Expr), {block,0,[Expr]}).
+-define(BLOCK1(Expr),
+ if
+ element(1, Expr) =:= block ->
+ Expr;
+ true -> ?BLOCK(Expr)
+ end).
+
+-include_lib("stdlib/include/ms_transform.hrl").
+
+%%%----------------------------------------------------------------------
+%%% External exports
+%%%----------------------------------------------------------------------
+
+%% start() -> {ok,Pid} | {error,Reason}
+%% Pid = pid()
+%% Reason = {already_started,Pid} | term()
+start() ->
+ case whereis(?SERVER) of
+ undefined ->
+ Starter = self(),
+ Pid = spawn(fun() -> init_main(Starter) end),
+ Ref = erlang:monitor(process,Pid),
+ Return =
+ receive
+ {?SERVER,started} ->
+ {ok,Pid};
+ {'DOWN', Ref, _Type, _Object, Info} ->
+ {error,Info}
+ end,
+ erlang:demonitor(Ref),
+ Return;
+ Pid ->
+ {error,{already_started,Pid}}
+ end.
+
+%% start(Nodes) -> {ok,StartedNodes}
+%% Nodes = Node | [Node,...]
+%% Node = atom()
+start(Node) when is_atom(Node) ->
+ start([Node]);
+start(Nodes) ->
+ call({start_nodes,remove_myself(Nodes,[])}).
+
+%% compile(ModFile) ->
+%% compile(ModFile, Options) ->
+%% compile_module(ModFile) -> Result
+%% compile_module(ModFile, Options) -> Result
+%% ModFile = Module | File
+%% Module = atom()
+%% File = string()
+%% Options = [Option]
+%% Option = {i,Dir} | {d,Macro} | {d,Macro,Value}
+%% Result = {ok,Module} | {error,File}
+compile(ModFile) ->
+ compile_module(ModFile, []).
+compile(ModFile, Options) ->
+ compile_module(ModFile, Options).
+compile_module(ModFile) when is_atom(ModFile);
+ is_list(ModFile) ->
+ compile_module(ModFile, []).
+compile_module(Module, Options) when is_atom(Module), is_list(Options) ->
+ compile_module(atom_to_list(Module), Options);
+compile_module(File, Options) when is_list(File), is_list(Options) ->
+ WithExt = case filename:extension(File) of
+ ".erl" ->
+ File;
+ _ ->
+ File++".erl"
+ end,
+ AbsFile = filename:absname(WithExt),
+ [R] = compile_modules([AbsFile], Options),
+ R.
+
+%% compile_directory() ->
+%% compile_directory(Dir) ->
+%% compile_directory(Dir, Options) -> [Result] | {error,Reason}
+%% Dir = string()
+%% Options - see compile/1
+%% Result - see compile/1
+%% Reason = eacces | enoent
+compile_directory() ->
+ case file:get_cwd() of
+ {ok, Dir} ->
+ compile_directory(Dir, []);
+ Error ->
+ Error
+ end.
+compile_directory(Dir) when is_list(Dir) ->
+ compile_directory(Dir, []).
+compile_directory(Dir, Options) when is_list(Dir), is_list(Options) ->
+ case file:list_dir(Dir) of
+ {ok, Files} ->
+
+ %% Filter out all erl files (except cover.erl)
+ ErlFileNames =
+ lists:filter(fun("cover.erl") ->
+ false;
+ (File) ->
+ case filename:extension(File) of
+ ".erl" -> true;
+ _ -> false
+ end
+ end,
+ Files),
+
+ %% Create a list of .erl file names (incl path) and call
+ %% compile_modules/2 with the list of file names.
+ ErlFiles = lists:map(fun(ErlFileName) ->
+ filename:join(Dir, ErlFileName)
+ end,
+ ErlFileNames),
+ compile_modules(ErlFiles, Options);
+ Error ->
+ Error
+ end.
+
+compile_modules(Files,Options) ->
+ Options2 = lists:filter(fun(Option) ->
+ case Option of
+ {i, Dir} when is_list(Dir) -> true;
+ {d, _Macro} -> true;
+ {d, _Macro, _Value} -> true;
+ _ -> false
+ end
+ end,
+ Options),
+ compile_modules(Files,Options2,[]).
+
+compile_modules([File|Files], Options, Result) ->
+ R = call({compile, File, Options}),
+ compile_modules(Files,Options,[R|Result]);
+compile_modules([],_Opts,Result) ->
+ reverse(Result).
+
+
+%% compile_beam(ModFile) -> Result | {error,Reason}
+%% ModFile - see compile/1
+%% Result - see compile/1
+%% Reason = non_existing | already_cover_compiled
+compile_beam(Module) when is_atom(Module) ->
+ case code:which(Module) of
+ non_existing ->
+ {error,non_existing};
+ ?TAG ->
+ compile_beam(Module,?TAG);
+ File ->
+ compile_beam(Module,File)
+ end;
+compile_beam(File) when is_list(File) ->
+ {WithExt,WithoutExt}
+ = case filename:rootname(File,".beam") of
+ File ->
+ {File++".beam",File};
+ Rootname ->
+ {File,Rootname}
+ end,
+ AbsFile = filename:absname(WithExt),
+ Module = list_to_atom(filename:basename(WithoutExt)),
+ compile_beam(Module,AbsFile).
+
+compile_beam(Module,File) ->
+ call({compile_beam,Module,File}).
+
+
+
+%% compile_beam_directory(Dir) -> [Result] | {error,Reason}
+%% Dir - see compile_directory/1
+%% Result - see compile/1
+%% Reason = eacces | enoent
+compile_beam_directory() ->
+ case file:get_cwd() of
+ {ok, Dir} ->
+ compile_beam_directory(Dir);
+ Error ->
+ Error
+ end.
+compile_beam_directory(Dir) when is_list(Dir) ->
+ case file:list_dir(Dir) of
+ {ok, Files} ->
+
+ %% Filter out all beam files (except cover.beam)
+ BeamFileNames =
+ lists:filter(fun("cover.beam") ->
+ false;
+ (File) ->
+ case filename:extension(File) of
+ ".beam" -> true;
+ _ -> false
+ end
+ end,
+ Files),
+
+ %% Create a list of .beam file names (incl path) and call
+ %% compile_beam/1 for each such file name
+ BeamFiles = lists:map(fun(BeamFileName) ->
+ filename:join(Dir, BeamFileName)
+ end,
+ BeamFileNames),
+ compile_beams(BeamFiles);
+ Error ->
+ Error
+ end.
+
+compile_beams(Files) ->
+ compile_beams(Files,[]).
+compile_beams([File|Files],Result) ->
+ R = compile_beam(File),
+ compile_beams(Files,[R|Result]);
+compile_beams([],Result) ->
+ reverse(Result).
+
+
+%% analyse(Module) ->
+%% analyse(Module, Analysis) ->
+%% analyse(Module, Level) ->
+%% analyse(Module, Analysis, Level) -> {ok,Answer} | {error,Error}
+%% Module = atom()
+%% Analysis = coverage | calls
+%% Level = line | clause | function | module
+%% Answer = {Module,Value} | [{Item,Value}]
+%% Item = Line | Clause | Function
+%% Line = {M,N}
+%% Clause = {M,F,A,C}
+%% Function = {M,F,A}
+%% M = F = atom()
+%% N = A = C = integer()
+%% Value = {Cov,NotCov} | Calls
+%% Cov = NotCov = Calls = integer()
+%% Error = {not_cover_compiled,Module}
+analyse(Module) ->
+ analyse(Module, coverage).
+analyse(Module, Analysis) when Analysis=:=coverage; Analysis=:=calls ->
+ analyse(Module, Analysis, function);
+analyse(Module, Level) when Level=:=line; Level=:=clause; Level=:=function;
+ Level=:=module ->
+ analyse(Module, coverage, Level).
+analyse(Module, Analysis, Level) when is_atom(Module),
+ Analysis=:=coverage; Analysis=:=calls,
+ Level=:=line; Level=:=clause;
+ Level=:=function; Level=:=module ->
+ call({{analyse, Analysis, Level}, Module}).
+
+analyze(Module) -> analyse(Module).
+analyze(Module, Analysis) -> analyse(Module, Analysis).
+analyze(Module, Analysis, Level) -> analyse(Module, Analysis, Level).
+
+%% analyse_to_file(Module) ->
+%% analyse_to_file(Module, Options) ->
+%% analyse_to_file(Module, OutFile) ->
+%% analyse_to_file(Module, OutFile, Options) -> {ok,OutFile} | {error,Error}
+%% Module = atom()
+%% OutFile = string()
+%% Options = [Option]
+%% Option = html
+%% Error = {not_cover_compiled,Module} | no_source_code_found |
+%% {file,File,Reason}
+%% File = string()
+%% Reason = term()
+analyse_to_file(Module) when is_atom(Module) ->
+ analyse_to_file(Module, outfilename(Module,[]), []).
+analyse_to_file(Module, []) when is_atom(Module) ->
+ analyse_to_file(Module, outfilename(Module,[]), []);
+analyse_to_file(Module, Options) when is_atom(Module),
+ is_list(Options), is_atom(hd(Options)) ->
+ analyse_to_file(Module, outfilename(Module,Options), Options);
+analyse_to_file(Module, OutFile) when is_atom(Module), is_list(OutFile) ->
+ analyse_to_file(Module, OutFile, []).
+analyse_to_file(Module, OutFile, Options) when is_atom(Module), is_list(OutFile) ->
+ call({{analyse_to_file, OutFile, Options}, Module}).
+
+analyze_to_file(Module) -> analyse_to_file(Module).
+analyze_to_file(Module, OptOrOut) -> analyse_to_file(Module, OptOrOut).
+analyze_to_file(Module, OutFile, Options) ->
+ analyse_to_file(Module, OutFile, Options).
+
+outfilename(Module,Opts) ->
+ case lists:member(html,Opts) of
+ true ->
+ atom_to_list(Module)++".COVER.html";
+ false ->
+ atom_to_list(Module)++".COVER.out"
+ end.
+
+%% export(File)
+%% export(File,Module) -> ok | {error,Reason}
+%% File = string(); file to write the exported data to
+%% Module = atom()
+export(File) ->
+ export(File, '_').
+export(File, Module) ->
+ call({export,File,Module}).
+
+%% import(File) -> ok | {error, Reason}
+%% File = string(); file created with cover:export/1,2
+import(File) ->
+ call({import,File}).
+
+%% modules() -> [Module]
+%% Module = atom()
+modules() ->
+ call(modules).
+
+%% imported_modules() -> [Module]
+%% Module = atom()
+imported_modules() ->
+ call(imported_modules).
+
+%% imported() -> [ImportFile]
+%% ImportFile = string()
+imported() ->
+ call(imported).
+
+%% which_nodes() -> [Node]
+%% Node = atom()
+which_nodes() ->
+ call(which_nodes).
+
+%% is_compiled(Module) -> {file,File} | false
+%% Module = atom()
+%% File = string()
+is_compiled(Module) when is_atom(Module) ->
+ call({is_compiled, Module}).
+
+%% reset(Module) -> ok | {error,Error}
+%% reset() -> ok
+%% Module = atom()
+%% Error = {not_cover_compiled,Module}
+reset(Module) when is_atom(Module) ->
+ call({reset, Module}).
+reset() ->
+ call(reset).
+
+%% stop() -> ok
+stop() ->
+ call(stop).
+
+stop(Node) when is_atom(Node) ->
+ stop([Node]);
+stop(Nodes) ->
+ call({stop,remove_myself(Nodes,[])}).
+
+%% bump(Module, Function, Arity, Clause, Line)
+%% Module = Function = atom()
+%% Arity = Clause = Line = integer()
+%% This function is inserted into Cover compiled modules, once for each
+%% executable line.
+%bump(Module, Function, Arity, Clause, Line) ->
+% Key = #bump{module=Module, function=Function, arity=Arity, clause=Clause,
+% line=Line},
+% ets:update_counter(?COVER_TABLE, Key, 1).
+
+call(Request) ->
+ Ref = erlang:monitor(process,?SERVER),
+ receive {'DOWN', Ref, _Type, _Object, noproc} ->
+ erlang:demonitor(Ref),
+ start(),
+ call(Request)
+ after 0 ->
+ ?SERVER ! {self(),Request},
+ Return =
+ receive
+ {'DOWN', Ref, _Type, _Object, Info} ->
+ exit(Info);
+ {?SERVER,Reply} ->
+ Reply
+ end,
+ erlang:demonitor(Ref),
+ Return
+ end.
+
+reply(From, Reply) ->
+ From ! {?SERVER,Reply}.
+is_from(From) ->
+ is_pid(From).
+
+remote_call(Node,Request) ->
+ Ref = erlang:monitor(process,{?SERVER,Node}),
+ receive {'DOWN', Ref, _Type, _Object, noproc} ->
+ erlang:demonitor(Ref),
+ {error,node_dead}
+ after 0 ->
+ {?SERVER,Node} ! Request,
+ Return =
+ receive
+ {'DOWN', Ref, _Type, _Object, _Info} ->
+ {error,node_dead};
+ {?SERVER,Reply} ->
+ Reply
+ end,
+ erlang:demonitor(Ref),
+ Return
+ end.
+
+remote_reply(MainNode,Reply) ->
+ {?SERVER,MainNode} ! {?SERVER,Reply}.
+
+%%%----------------------------------------------------------------------
+%%% cover_server on main node
+%%%----------------------------------------------------------------------
+
+init_main(Starter) ->
+ register(?SERVER,self()),
+ ets:new(?COVER_TABLE, [set, public, named_table]),
+ ets:new(?BINARY_TABLE, [set, named_table]),
+ ets:new(?COLLECTION_TABLE, [set, public, named_table]),
+ process_flag(trap_exit,true),
+ Starter ! {?SERVER,started},
+ main_process_loop(#main_state{}).
+
+main_process_loop(State) ->
+ receive
+ {From, {start_nodes,Nodes}} ->
+ ThisNode = node(),
+ StartedNodes =
+ lists:foldl(
+ fun(Node,Acc) ->
+ case rpc:call(Node,cover,remote_start,[ThisNode]) of
+ {ok,RPid} ->
+ link(RPid),
+ [Node|Acc];
+ Error ->
+ io:format("Could not start cover on ~w: ~p\n",
+ [Node,Error]),
+ Acc
+ end
+ end,
+ [],
+ Nodes),
+
+ %% In case some of the compiled modules have been unloaded they
+ %% should not be loaded on the new node.
+ {_LoadedModules,Compiled} =
+ get_compiled_still_loaded(State#main_state.nodes,
+ State#main_state.compiled),
+ remote_load_compiled(StartedNodes,Compiled),
+
+ State1 =
+ State#main_state{nodes = State#main_state.nodes ++ StartedNodes,
+ compiled = Compiled},
+ reply(From, {ok,StartedNodes}),
+ main_process_loop(State1);
+
+ {From, {compile, File, Options}} ->
+ case do_compile(File, Options) of
+ {ok, Module} ->
+ remote_load_compiled(State#main_state.nodes,[{Module,File}]),
+ reply(From, {ok, Module}),
+ Compiled = add_compiled(Module, File,
+ State#main_state.compiled),
+ Imported = remove_imported(Module,State#main_state.imported),
+ main_process_loop(State#main_state{compiled = Compiled,
+ imported = Imported});
+ error ->
+ reply(From, {error, File}),
+ main_process_loop(State)
+ end;
+
+ {From, {compile_beam, Module, BeamFile0}} ->
+ Compiled0 = State#main_state.compiled,
+ case get_beam_file(Module,BeamFile0,Compiled0) of
+ {ok,BeamFile} ->
+ {Reply,Compiled} =
+ case do_compile_beam(Module,BeamFile) of
+ {ok, Module} ->
+ remote_load_compiled(State#main_state.nodes,
+ [{Module,BeamFile}]),
+ C = add_compiled(Module,BeamFile,Compiled0),
+ {{ok,Module},C};
+ error ->
+ {{error, BeamFile}, Compiled0};
+ {error,Reason} -> % no abstract code
+ {{error, {Reason, BeamFile}}, Compiled0}
+ end,
+ reply(From,Reply),
+ Imported = remove_imported(Module,State#main_state.imported),
+ main_process_loop(State#main_state{compiled = Compiled,
+ imported = Imported});
+ {error,no_beam} ->
+ %% The module has first been compiled from .erl, and now
+ %% someone tries to compile it from .beam
+ reply(From,
+ {error,{already_cover_compiled,no_beam_found,Module}}),
+ main_process_loop(State)
+ end;
+
+ {From, {export,OutFile,Module}} ->
+ case file:open(OutFile,[write,binary,raw]) of
+ {ok,Fd} ->
+ Reply =
+ case Module of
+ '_' ->
+ export_info(State#main_state.imported),
+ collect(State#main_state.nodes),
+ do_export_table(State#main_state.compiled,
+ State#main_state.imported,
+ Fd);
+ _ ->
+ export_info(Module,State#main_state.imported),
+ case is_loaded(Module, State) of
+ {loaded, File} ->
+ [{Module,Clauses}] =
+ ets:lookup(?COVER_TABLE,Module),
+ collect(Module, Clauses,
+ State#main_state.nodes),
+ do_export_table([{Module,File}],[],Fd);
+ {imported, File, ImportFiles} ->
+ %% don't know if I should allow this -
+ %% export a module which is only imported
+ Imported = [{Module,File,ImportFiles}],
+ do_export_table([],Imported,Fd);
+ _NotLoaded ->
+ {error,{not_cover_compiled,Module}}
+ end
+ end,
+ file:close(Fd),
+ reply(From, Reply);
+ {error,Reason} ->
+ reply(From, {error, {cant_open_file,OutFile,Reason}})
+
+ end,
+ main_process_loop(State);
+
+ {From, {import,File}} ->
+ case file:open(File,[read,binary,raw]) of
+ {ok,Fd} ->
+ Imported = do_import_to_table(Fd,File,
+ State#main_state.imported),
+ reply(From, ok),
+ main_process_loop(State#main_state{imported=Imported});
+ {error,Reason} ->
+ reply(From, {error, {cant_open_file,File,Reason}}),
+ main_process_loop(State)
+ end;
+
+ {From, modules} ->
+ %% Get all compiled modules which are still loaded
+ {LoadedModules,Compiled} =
+ get_compiled_still_loaded(State#main_state.nodes,
+ State#main_state.compiled),
+
+ reply(From, LoadedModules),
+ main_process_loop(State#main_state{compiled=Compiled});
+
+ {From, imported_modules} ->
+ %% Get all modules with imported data
+ ImportedModules = lists:map(fun({Mod,_File,_ImportFile}) -> Mod end,
+ State#main_state.imported),
+ reply(From, ImportedModules),
+ main_process_loop(State);
+
+ {From, imported} ->
+ %% List all imported files
+ reply(From, get_all_importfiles(State#main_state.imported,[])),
+ main_process_loop(State);
+
+ {From, which_nodes} ->
+ %% List all imported files
+ reply(From, State#main_state.nodes),
+ main_process_loop(State);
+
+ {From, reset} ->
+ lists:foreach(
+ fun({Module,_File}) ->
+ do_reset_main_node(Module,State#main_state.nodes)
+ end,
+ State#main_state.compiled),
+ reply(From, ok),
+ main_process_loop(State#main_state{imported=[]});
+
+ {From, {stop,Nodes}} ->
+ remote_collect('_',Nodes,true),
+ reply(From, ok),
+ State1 = State#main_state{nodes=State#main_state.nodes--Nodes},
+ main_process_loop(State1);
+
+ {From, stop} ->
+ lists:foreach(
+ fun(Node) ->
+ remote_call(Node,{remote,stop})
+ end,
+ State#main_state.nodes),
+ reload_originals(State#main_state.compiled),
+ reply(From, ok);
+
+ {From, {Request, Module}} ->
+ case is_loaded(Module, State) of
+ {loaded, File} ->
+ {Reply,State1} =
+ case Request of
+ {analyse, Analysis, Level} ->
+ analyse_info(Module,State#main_state.imported),
+ [{Module,Clauses}] =
+ ets:lookup(?COVER_TABLE,Module),
+ collect(Module,Clauses,State#main_state.nodes),
+ R = do_analyse(Module, Analysis, Level, Clauses),
+ {R,State};
+
+ {analyse_to_file, OutFile, Opts} ->
+ R = case find_source(File) of
+ {beam,_BeamFile} ->
+ {error,no_source_code_found};
+ ErlFile ->
+ Imported = State#main_state.imported,
+ analyse_info(Module,Imported),
+ [{Module,Clauses}] =
+ ets:lookup(?COVER_TABLE,Module),
+ collect(Module, Clauses,
+ State#main_state.nodes),
+ HTML = lists:member(html,Opts),
+ do_analyse_to_file(Module,OutFile,
+ ErlFile,HTML)
+ end,
+ {R,State};
+
+ is_compiled ->
+ {{file, File},State};
+
+ reset ->
+ R = do_reset_main_node(Module,
+ State#main_state.nodes),
+ Imported =
+ remove_imported(Module,
+ State#main_state.imported),
+ {R,State#main_state{imported=Imported}}
+ end,
+ reply(From, Reply),
+ main_process_loop(State1);
+
+ {imported,File,_ImportFiles} ->
+ {Reply,State1} =
+ case Request of
+ {analyse, Analysis, Level} ->
+ analyse_info(Module,State#main_state.imported),
+ [{Module,Clauses}] =
+ ets:lookup(?COLLECTION_TABLE,Module),
+ R = do_analyse(Module, Analysis, Level, Clauses),
+ {R,State};
+
+ {analyse_to_file, OutFile, Opts} ->
+ R = case find_source(File) of
+ {beam,_BeamFile} ->
+ {error,no_source_code_found};
+ ErlFile ->
+ Imported = State#main_state.imported,
+ analyse_info(Module,Imported),
+ HTML = lists:member(html,Opts),
+ do_analyse_to_file(Module,OutFile,
+ ErlFile,HTML)
+ end,
+ {R,State};
+
+ is_compiled ->
+ {false,State};
+
+ reset ->
+ R = do_reset_collection_table(Module),
+ Imported =
+ remove_imported(Module,
+ State#main_state.imported),
+ {R,State#main_state{imported=Imported}}
+ end,
+ reply(From, Reply),
+ main_process_loop(State1);
+
+ NotLoaded ->
+ Reply =
+ case Request of
+ is_compiled ->
+ false;
+ _ ->
+ {error, {not_cover_compiled,Module}}
+ end,
+ Compiled =
+ case NotLoaded of
+ unloaded ->
+ do_clear(Module),
+ remote_unload(State#main_state.nodes,[Module]),
+ update_compiled([Module],
+ State#main_state.compiled);
+ false ->
+ State#main_state.compiled
+ end,
+ reply(From, Reply),
+ main_process_loop(State#main_state{compiled=Compiled})
+ end;
+
+ {'EXIT',Pid,_Reason} ->
+ %% Exit is trapped on the main node only, so this will only happen
+ %% there. I assume that I'm only linked to cover_servers on remote
+ %% nodes, so this must be one of them crashing.
+ %% Remove node from list!
+ State1 = State#main_state{nodes=State#main_state.nodes--[node(Pid)]},
+ main_process_loop(State1);
+
+ get_status ->
+ io:format("~p~n",[State]),
+ main_process_loop(State)
+ end.
+
+
+
+
+
+%%%----------------------------------------------------------------------
+%%% cover_server on remote node
+%%%----------------------------------------------------------------------
+
+init_remote(Starter,MainNode) ->
+ register(?SERVER,self()),
+ ets:new(?COVER_TABLE, [set, public, named_table]),
+ Starter ! {self(),started},
+ remote_process_loop(#remote_state{main_node=MainNode}).
+
+
+
+remote_process_loop(State) ->
+ receive
+ {remote,load_compiled,Compiled} ->
+ Compiled1 = load_compiled(Compiled,State#remote_state.compiled),
+ remote_reply(State#remote_state.main_node, ok),
+ remote_process_loop(State#remote_state{compiled=Compiled1});
+
+ {remote,unload,UnloadedModules} ->
+ unload(UnloadedModules),
+ Compiled =
+ update_compiled(UnloadedModules, State#remote_state.compiled),
+ remote_reply(State#remote_state.main_node, ok),
+ remote_process_loop(State#remote_state{compiled=Compiled});
+
+ {remote,reset,Module} ->
+ do_reset(Module),
+ remote_reply(State#remote_state.main_node, ok),
+ remote_process_loop(State);
+
+ {remote,collect,Module,CollectorPid} ->
+ MS =
+ case Module of
+ '_' -> ets:fun2ms(fun({M,C}) when is_atom(M) -> C end);
+ _ -> ets:fun2ms(fun({M,C}) when M=:=Module -> C end)
+ end,
+ AllClauses = lists:flatten(ets:select(?COVER_TABLE,MS)),
+
+ %% Sending clause by clause in order to avoid large lists
+ lists:foreach(
+ fun({M,F,A,C,_L}) ->
+ Pattern =
+ {#bump{module=M, function=F, arity=A, clause=C}, '_'},
+ Bumps = ets:match_object(?COVER_TABLE, Pattern),
+ %% Reset
+ lists:foreach(fun({Bump,_N}) ->
+ ets:insert(?COVER_TABLE, {Bump,0})
+ end,
+ Bumps),
+ CollectorPid ! {chunk,Bumps}
+ end,
+ AllClauses),
+ CollectorPid ! done,
+ remote_reply(State#remote_state.main_node, ok),
+ remote_process_loop(State);
+
+ {remote,stop} ->
+ reload_originals(State#remote_state.compiled),
+ remote_reply(State#remote_state.main_node, ok);
+
+ get_status ->
+ io:format("~p~n",[State]),
+ remote_process_loop(State);
+
+ M ->
+ io:format("WARNING: remote cover_server received\n~p\n",[M]),
+ case M of
+ {From,_} ->
+ case is_from(From) of
+ true ->
+ reply(From,{error,not_main_node});
+ false ->
+ ok
+ end;
+ _ ->
+ ok
+ end,
+ remote_process_loop(State)
+
+ end.
+
+
+reload_originals([{Module,_File}|Compiled]) ->
+ do_reload_original(Module),
+ reload_originals(Compiled);
+reload_originals([]) ->
+ ok.
+
+do_reload_original(Module) ->
+ case code:which(Module) of
+ ?TAG ->
+ code:purge(Module), % remove code marked as 'old'
+ code:delete(Module), % mark cover compiled code as 'old'
+ %% Note: original beam code must be loaded before the cover
+ %% compiled code is purged, in order to for references to
+ %% 'fun M:F/A' and %% 'fun F/A' funs to be correct (they
+ %% refer to (M:)F/A in the *latest* version of the module)
+ code:load_file(Module), % load original code
+ code:purge(Module); % remove cover compiled code
+ _ ->
+ ignore
+ end.
+
+load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) ->
+ %% Make sure the #bump{} records are available *before* the
+ %% module is loaded.
+ insert_initial_data(InitialTable),
+ NewAcc =
+ case code:load_binary(Module, ?TAG, Binary) of
+ {module,Module} ->
+ add_compiled(Module, File, Acc);
+ _ ->
+ do_clear(Module),
+ Acc
+ end,
+ load_compiled(Compiled,NewAcc);
+load_compiled([],Acc) ->
+ Acc.
+
+insert_initial_data([Item|Items]) ->
+ ets:insert(?COVER_TABLE, Item),
+ insert_initial_data(Items);
+insert_initial_data([]) ->
+ ok.
+
+
+unload([Module|Modules]) ->
+ do_clear(Module),
+ do_reload_original(Module),
+ unload(Modules);
+unload([]) ->
+ ok.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+%%%--Handling of remote nodes--------------------------------------------
+
+%% start the cover_server on a remote node
+remote_start(MainNode) ->
+ case whereis(?SERVER) of
+ undefined ->
+ Starter = self(),
+ Pid = spawn(fun() -> init_remote(Starter,MainNode) end),
+ Ref = erlang:monitor(process,Pid),
+ Return =
+ receive
+ {Pid,started} ->
+ {ok,Pid};
+ {'DOWN', Ref, _Type, _Object, Info} ->
+ {error,Info}
+ end,
+ erlang:demonitor(Ref),
+ Return;
+ Pid ->
+ {error,{already_started,Pid}}
+ end.
+
+%% Load a set of cover compiled modules on remote nodes
+remote_load_compiled(Nodes,Compiled0) ->
+ Compiled = lists:map(fun get_data_for_remote_loading/1,Compiled0),
+ lists:foreach(
+ fun(Node) ->
+ remote_call(Node,{remote,load_compiled,Compiled})
+ end,
+ Nodes).
+
+%% Read all data needed for loading a cover compiled module on a remote node
+%% Binary is the beam code for the module and InitialTable is the initial
+%% data to insert in ?COVER_TABLE.
+get_data_for_remote_loading({Module,File}) ->
+ [{Module,Binary}] = ets:lookup(?BINARY_TABLE,Module),
+ %%! The InitialTable list will be long if the module is big - what to do??
+ InitialTable = ets:select(?COVER_TABLE,ms(Module)),
+ {Module,File,Binary,InitialTable}.
+
+%% Create a match spec which returns the clause info {Module,InitInfo} and
+%% all #bump keys for the given module with 0 number of calls.
+ms(Module) ->
+ ets:fun2ms(fun({Module,InitInfo}) ->
+ {Module,InitInfo};
+ ({Key,_}) when is_record(Key,bump),Key#bump.module=:=Module ->
+ {Key,0}
+ end).
+
+%% Unload modules on remote nodes
+remote_unload(Nodes,UnloadedModules) ->
+ lists:foreach(
+ fun(Node) ->
+ remote_call(Node,{remote,unload,UnloadedModules})
+ end,
+ Nodes).
+
+%% Reset one or all modules on remote nodes
+remote_reset(Module,Nodes) ->
+ lists:foreach(
+ fun(Node) ->
+ remote_call(Node,{remote,reset,Module})
+ end,
+ Nodes).
+
+%% Collect data from remote nodes - used for analyse or stop(Node)
+remote_collect(Module,Nodes,Stop) ->
+ CollectorPid = spawn(fun() -> collector_proc(length(Nodes)) end),
+ lists:foreach(
+ fun(Node) ->
+ remote_call(Node,{remote,collect,Module,CollectorPid}),
+ if Stop -> remote_call(Node,{remote,stop});
+ true -> ok
+ end
+ end,
+ Nodes).
+
+%% Process which receives chunks of data from remote nodes - either when
+%% analysing or when stopping cover on the remote nodes.
+collector_proc(0) ->
+ ok;
+collector_proc(N) ->
+ receive
+ {chunk,Chunk} ->
+ insert_in_collection_table(Chunk),
+ collector_proc(N);
+ done ->
+ collector_proc(N-1)
+ end.
+
+insert_in_collection_table([{Key,Val}|Chunk]) ->
+ insert_in_collection_table(Key,Val),
+ insert_in_collection_table(Chunk);
+insert_in_collection_table([]) ->
+ ok.
+
+insert_in_collection_table(Key,Val) ->
+ case ets:member(?COLLECTION_TABLE,Key) of
+ true ->
+ ets:update_counter(?COLLECTION_TABLE,
+ Key,Val);
+ false ->
+ ets:insert(?COLLECTION_TABLE,{Key,Val})
+ end.
+
+
+remove_myself([Node|Nodes],Acc) when Node=:=node() ->
+ remove_myself(Nodes,Acc);
+remove_myself([Node|Nodes],Acc) ->
+ remove_myself(Nodes,[Node|Acc]);
+remove_myself([],Acc) ->
+ Acc.
+
+
+%%%--Handling of modules state data--------------------------------------
+
+analyse_info(_Module,[]) ->
+ ok;
+analyse_info(Module,Imported) ->
+ imported_info("Analysis",Module,Imported).
+
+export_info(_Module,[]) ->
+ ok;
+export_info(Module,Imported) ->
+ imported_info("Export",Module,Imported).
+
+export_info([]) ->
+ ok;
+export_info(Imported) ->
+ AllImportFiles = get_all_importfiles(Imported,[]),
+ io:format("Export includes data from imported files\n~p\n",[AllImportFiles]).
+
+get_all_importfiles([{_M,_F,ImportFiles}|Imported],Acc) ->
+ NewAcc = do_get_all_importfiles(ImportFiles,Acc),
+ get_all_importfiles(Imported,NewAcc);
+get_all_importfiles([],Acc) ->
+ Acc.
+
+do_get_all_importfiles([ImportFile|ImportFiles],Acc) ->
+ case lists:member(ImportFile,Acc) of
+ true ->
+ do_get_all_importfiles(ImportFiles,Acc);
+ false ->
+ do_get_all_importfiles(ImportFiles,[ImportFile|Acc])
+ end;
+do_get_all_importfiles([],Acc) ->
+ Acc.
+
+imported_info(Text,Module,Imported) ->
+ case lists:keysearch(Module,1,Imported) of
+ {value,{Module,_File,ImportFiles}} ->
+ io:format("~s includes data from imported files\n~p\n",
+ [Text,ImportFiles]);
+ false ->
+ ok
+ end.
+
+
+
+add_imported(Module, File, ImportFile, Imported) ->
+ add_imported(Module, File, filename:absname(ImportFile), Imported, []).
+
+add_imported(M, F1, ImportFile, [{M,_F2,ImportFiles}|Imported], Acc) ->
+ case lists:member(ImportFile,ImportFiles) of
+ true ->
+ io:fwrite("WARNING: Module ~w already imported from ~p~n"
+ "Not importing again!~n",[M,ImportFile]),
+ dont_import;
+ false ->
+ NewEntry = {M, F1, [ImportFile | ImportFiles]},
+ {ok, reverse([NewEntry | Acc]) ++ Imported}
+ end;
+add_imported(M, F, ImportFile, [H|Imported], Acc) ->
+ add_imported(M, F, ImportFile, Imported, [H|Acc]);
+add_imported(M, F, ImportFile, [], Acc) ->
+ {ok, reverse([{M, F, [ImportFile]} | Acc])}.
+
+%% Removes a module from the list of imported modules and writes a warning
+%% This is done when a module is compiled.
+remove_imported(Module,Imported) ->
+ case lists:keysearch(Module,1,Imported) of
+ {value,{Module,_,ImportFiles}} ->
+ io:fwrite("WARNING: Deleting data for module ~w imported from~n"
+ "~p~n",[Module,ImportFiles]),
+ lists:keydelete(Module,1,Imported);
+ false ->
+ Imported
+ end.
+
+%% Adds information to the list of compiled modules, preserving time order
+%% and without adding duplicate entries.
+add_compiled(Module, File1, [{Module,_File2}|Compiled]) ->
+ [{Module,File1}|Compiled];
+add_compiled(Module, File, [H|Compiled]) ->
+ [H|add_compiled(Module, File, Compiled)];
+add_compiled(Module, File, []) ->
+ [{Module,File}].
+
+is_loaded(Module, State) ->
+ case get_file(Module, State#main_state.compiled) of
+ {ok, File} ->
+ case code:which(Module) of
+ ?TAG -> {loaded, File};
+ _ -> unloaded
+ end;
+ false ->
+ case get_file(Module,State#main_state.imported) of
+ {ok,File,ImportFiles} ->
+ {imported, File, ImportFiles};
+ false ->
+ false
+ end
+ end.
+
+get_file(Module, [{Module, File}|_T]) ->
+ {ok, File};
+get_file(Module, [{Module, File, ImportFiles}|_T]) ->
+ {ok, File, ImportFiles};
+get_file(Module, [_H|T]) ->
+ get_file(Module, T);
+get_file(_Module, []) ->
+ false.
+
+get_beam_file(Module,?TAG,Compiled) ->
+ {value,{Module,File}} = lists:keysearch(Module,1,Compiled),
+ case filename:extension(File) of
+ ".erl" -> {error,no_beam};
+ ".beam" -> {ok,File}
+ end;
+get_beam_file(_Module,BeamFile,_Compiled) ->
+ {ok,BeamFile}.
+
+get_modules(Compiled) ->
+ lists:map(fun({Module, _File}) -> Module end, Compiled).
+
+update_compiled([Module|Modules], [{Module,_File}|Compiled]) ->
+ update_compiled(Modules, Compiled);
+update_compiled(Modules, [H|Compiled]) ->
+ [H|update_compiled(Modules, Compiled)];
+update_compiled(_Modules, []) ->
+ [].
+
+%% Get all compiled modules which are still loaded, and possibly an
+%% updated version of the Compiled list.
+get_compiled_still_loaded(Nodes,Compiled0) ->
+ %% Find all Cover compiled modules which are still loaded
+ CompiledModules = get_modules(Compiled0),
+ LoadedModules = lists:filter(fun(Module) ->
+ case code:which(Module) of
+ ?TAG -> true;
+ _ -> false
+ end
+ end,
+ CompiledModules),
+
+ %% If some Cover compiled modules have been unloaded, update the database.
+ UnloadedModules = CompiledModules--LoadedModules,
+ Compiled =
+ case UnloadedModules of
+ [] ->
+ Compiled0;
+ _ ->
+ lists:foreach(fun(Module) -> do_clear(Module) end,
+ UnloadedModules),
+ remote_unload(Nodes,UnloadedModules),
+ update_compiled(UnloadedModules, Compiled0)
+ end,
+ {LoadedModules,Compiled}.
+
+
+%%%--Compilation---------------------------------------------------------
+
+%% do_compile(File, Options) -> {ok,Module} | {error,Error}
+do_compile(File, UserOptions) ->
+ Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions,
+ case compile:file(File, Options) of
+ {ok, Module, Binary} ->
+ do_compile_beam(Module,Binary);
+ error ->
+ error
+ end.
+
+%% Beam is a binary or a .beam file name
+do_compile_beam(Module,Beam) ->
+ %% Clear database
+ do_clear(Module),
+
+ %% Extract the abstract format and insert calls to bump/6 at
+ %% every executable line and, as a side effect, initiate
+ %% the database
+
+ case get_abstract_code(Module, Beam) of
+ no_abstract_code=E ->
+ {error,E};
+ encrypted_abstract_code=E ->
+ {error,E};
+ {Vsn,Code} ->
+ Forms0 = epp:interpret_file_attribute(Code),
+ {Forms,Vars} = transform(Vsn, Forms0, Module, Beam),
+
+ %% Compile and load the result
+ %% It's necessary to check the result of loading since it may
+ %% fail, for example if Module resides in a sticky directory
+ {ok, Module, Binary} = compile:forms(Forms, []),
+ case code:load_binary(Module, ?TAG, Binary) of
+ {module, Module} ->
+
+ %% Store info about all function clauses in database
+ InitInfo = reverse(Vars#vars.init_info),
+ ets:insert(?COVER_TABLE, {Module, InitInfo}),
+
+ %% Store binary code so it can be loaded on remote nodes
+ ets:insert(?BINARY_TABLE, {Module, Binary}),
+
+ {ok, Module};
+
+ _Error ->
+ do_clear(Module),
+ error
+ end
+ end.
+
+get_abstract_code(Module, Beam) ->
+ case beam_lib:chunks(Beam, [abstract_code]) of
+ {ok, {Module, [{abstract_code, AbstractCode}]}} ->
+ AbstractCode;
+ {error,beam_lib,{key_missing_or_invalid,_,_}} ->
+ encrypted_abstract_code;
+ Error -> Error
+ end.
+
+transform(Vsn, Code, Module, Beam) when Vsn=:=abstract_v1; Vsn=:=abstract_v2 ->
+ Vars0 = #vars{module=Module, vsn=Vsn},
+ MainFile=find_main_filename(Code),
+ {ok, MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on),
+
+ %% Add module and export information to the munged forms
+ %% Information about module_info must be removed as this function
+ %% is added at compilation
+ {ok, {Module, [{exports,Exports1}]}} = beam_lib:chunks(Beam, [exports]),
+ Exports2 = lists:filter(fun(Export) ->
+ case Export of
+ {module_info,_} -> false;
+ _ -> true
+ end
+ end,
+ Exports1),
+ Forms = [{attribute,1,module,Module},
+ {attribute,2,export,Exports2}]++ MungedForms,
+ {Forms,Vars};
+transform(Vsn=raw_abstract_v1, Code, Module, _Beam) ->
+ MainFile=find_main_filename(Code),
+ Vars0 = #vars{module=Module, vsn=Vsn},
+ {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on),
+ {MungedForms,Vars}.
+
+%% Helpfunction which returns the first found file-attribute, which can
+%% be interpreted as the name of the main erlang source file.
+find_main_filename([{attribute,_,file,{MainFile,_}}|_]) ->
+ MainFile;
+find_main_filename([_|Rest]) ->
+ find_main_filename(Rest).
+
+transform_2([Form0|Forms],MungedForms,Vars,MainFile,Switch) ->
+ Form = expand(Form0),
+ case munge(Form,Vars,MainFile,Switch) of
+ ignore ->
+ transform_2(Forms,MungedForms,Vars,MainFile,Switch);
+ {MungedForm,Vars2,NewSwitch} ->
+ transform_2(Forms,[MungedForm|MungedForms],Vars2,MainFile,NewSwitch)
+ end;
+transform_2([],MungedForms,Vars,_,_) ->
+ {ok, reverse(MungedForms), Vars}.
+
+%% Expand short-circuit Boolean expressions.
+expand(Expr) ->
+ AllVars = sets:from_list(ordsets:to_list(vars([], Expr))),
+ {Expr1,_} = expand(Expr, AllVars, 1),
+ Expr1.
+
+expand({clause,Line,Pattern,Guards,Body}, Vs, N) ->
+ {ExpandedBody,N2} = expand(Body, Vs, N),
+ {{clause,Line,Pattern,Guards,ExpandedBody},N2};
+expand({op,_Line,'andalso',ExprL,ExprR}, Vs, N) ->
+ {ExpandedExprL,N2} = expand(ExprL, Vs, N),
+ {ExpandedExprR,N3} = expand(ExprR, Vs, N2),
+ LineL = element(2, ExpandedExprL),
+ {bool_switch(ExpandedExprL,
+ ExpandedExprR,
+ {atom,LineL,false},
+ Vs, N3),
+ N3 + 1};
+expand({op,_Line,'orelse',ExprL,ExprR}, Vs, N) ->
+ {ExpandedExprL,N2} = expand(ExprL, Vs, N),
+ {ExpandedExprR,N3} = expand(ExprR, Vs, N2),
+ LineL = element(2, ExpandedExprL),
+ {bool_switch(ExpandedExprL,
+ {atom,LineL,true},
+ ExpandedExprR,
+ Vs, N3),
+ N3 + 1};
+expand(T, Vs, N) when is_tuple(T) ->
+ {TL,N2} = expand(tuple_to_list(T), Vs, N),
+ {list_to_tuple(TL),N2};
+expand([E|Es], Vs, N) ->
+ {E2,N2} = expand(E, Vs, N),
+ {Es2,N3} = expand(Es, Vs, N2),
+ {[E2|Es2],N3};
+expand(T, _Vs, N) ->
+ {T,N}.
+
+vars(A, {var,_,V}) when V =/= '_' ->
+ [V|A];
+vars(A, T) when is_tuple(T) ->
+ vars(A, tuple_to_list(T));
+vars(A, [E|Es]) ->
+ vars(vars(A, E), Es);
+vars(A, _T) ->
+ A.
+
+bool_switch(E, T, F, AllVars, AuxVarN) ->
+ Line = element(2, E),
+ AuxVar = {var,Line,aux_var(AllVars, AuxVarN)},
+ {'case',Line,E,
+ [{clause,Line,[{atom,Line,true}],[],[T]},
+ {clause,Line,[{atom,Line,false}],[],[F]},
+ {clause,Line,[AuxVar],[],
+ [{call,Line,
+ {remote,Line,{atom,Line,erlang},{atom,Line,error}},
+ [{tuple,Line,[{atom,Line,badarg},AuxVar]}]}]}]}.
+
+aux_var(Vars, N) ->
+ Name = list_to_atom(lists:concat(['_', N])),
+ case sets:is_element(Name, Vars) of
+ true -> aux_var(Vars, N + 1);
+ false -> Name
+ end.
+
+%% This code traverses the abstract code, stored as the abstract_code
+%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B
+%% (Vsn=abstract_v2).
+%% The abstract format after preprocessing differs slightly from the abstract
+%% format given eg using epp:parse_form, this has been noted in comments.
+%% The switch is turned off when we encounter other files then the main file.
+%% This way we will be able to exclude functions defined in include files.
+munge({function,0,module_info,_Arity,_Clauses},_Vars,_MainFile,_Switch) ->
+ ignore; % module_info will be added again when the forms are recompiled
+munge(Form={function,_,'MNEMOSYNE QUERY',_,_},Vars,_MainFile,Switch) ->
+ {Form,Vars,Switch}; % No bumps in Mnemosyne code.
+munge(Form={function,_,'MNEMOSYNE RULE',_,_},Vars,_MainFile,Switch) ->
+ {Form,Vars,Switch};
+munge(Form={function,_,'MNEMOSYNE RECFUNDEF',_,_},Vars,_MainFile,Switch) ->
+ {Form,Vars,Switch};
+munge({function,Line,Function,Arity,Clauses},Vars,_MainFile,on) ->
+ Vars2 = Vars#vars{function=Function,
+ arity=Arity,
+ clause=1,
+ lines=[],
+ no_bump_lines=[],
+ depth=1},
+ {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2),
+ {{function,Line,Function,Arity,MungedClauses},Vars3,on};
+munge(Form={attribute,_,file,{MainFile,_}},Vars,MainFile,_Switch) ->
+ {Form,Vars,on}; % Switch on tranformation!
+munge(Form={attribute,_,file,{_InclFile,_}},Vars,_MainFile,_Switch) ->
+ {Form,Vars,off}; % Switch off transformation!
+munge({attribute,_,compile,{parse_transform,_}},_Vars,_MainFile,_Switch) ->
+ %% Don't want to run parse transforms more than once.
+ ignore;
+munge(Form,Vars,_MainFile,Switch) -> % Other attributes and skipped includes.
+ {Form,Vars,Switch}.
+
+munge_clauses(Clauses, Vars) ->
+ munge_clauses(Clauses, Vars, Vars#vars.lines, []).
+
+munge_clauses([Clause|Clauses], Vars, Lines, MClauses) ->
+ {clause,Line,Pattern,Guards,Body} = Clause,
+ {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]),
+
+ case Vars#vars.depth of
+ 1 -> % function clause
+ {MungedBody, Vars2} = munge_body(Body, Vars#vars{depth=2}),
+ ClauseInfo = {Vars2#vars.module,
+ Vars2#vars.function,
+ Vars2#vars.arity,
+ Vars2#vars.clause,
+ length(Vars2#vars.lines)}, % Not used?
+ InitInfo = [ClauseInfo | Vars2#vars.init_info],
+ Vars3 = Vars2#vars{init_info=InitInfo,
+ clause=(Vars2#vars.clause)+1,
+ lines=[],
+ no_bump_lines=[],
+ depth=1},
+ NewBumps = Vars2#vars.lines,
+ NewLines = NewBumps ++ Lines,
+ munge_clauses(Clauses, Vars3, NewLines,
+ [{clause,Line,Pattern,MungedGuards,MungedBody}|
+ MClauses]);
+
+ 2 -> % receive-, case-, if-, or try-clause
+ Lines0 = Vars#vars.lines,
+ {MungedBody, Vars2} = munge_body(Body, Vars),
+ NewBumps = new_bumps(Vars2, Vars),
+ NewLines = NewBumps ++ Lines,
+ munge_clauses(Clauses, Vars2#vars{lines=Lines0},
+ NewLines,
+ [{clause,Line,Pattern,MungedGuards,MungedBody}|
+ MClauses])
+ end;
+munge_clauses([], Vars, Lines, MungedClauses) ->
+ {reverse(MungedClauses), Vars#vars{lines = Lines}}.
+
+munge_body(Expr, Vars) ->
+ munge_body(Expr, Vars, [], []).
+
+munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) ->
+ %% Here is the place to add a call to cover:bump/6!
+ Line = element(2, Expr),
+ Lines = Vars#vars.lines,
+ case lists:member(Line,Lines) of
+ true -> % already a bump at this line
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ NewBumps = new_bumps(Vars2, Vars),
+ NoBumpLines = [Line|Vars#vars.no_bump_lines],
+ Vars3 = Vars2#vars{no_bump_lines = NoBumpLines},
+ MungedBody1 =
+ maybe_fix_last_expr(MungedBody, Vars3, LastExprBumpLines),
+ MungedExprs1 = [MungedExpr|MungedBody1],
+ munge_body(Body, Vars3, MungedExprs1, NewBumps);
+ false ->
+ ets:insert(?COVER_TABLE, {#bump{module = Vars#vars.module,
+ function = Vars#vars.function,
+ arity = Vars#vars.arity,
+ clause = Vars#vars.clause,
+ line = Line},
+ 0}),
+ Bump = bump_call(Vars, Line),
+% Bump = {call, 0, {remote, 0, {atom,0,cover}, {atom,0,bump}},
+% [{atom, 0, Vars#vars.module},
+% {atom, 0, Vars#vars.function},
+% {integer, 0, Vars#vars.arity},
+% {integer, 0, Vars#vars.clause},
+% {integer, 0, Line}]},
+ Lines2 = [Line|Lines],
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}),
+ NewBumps = new_bumps(Vars2, Vars),
+ NoBumpLines = subtract(Vars2#vars.no_bump_lines, NewBumps),
+ Vars3 = Vars2#vars{no_bump_lines = NoBumpLines},
+ MungedBody1 =
+ maybe_fix_last_expr(MungedBody, Vars3, LastExprBumpLines),
+ MungedExprs1 = [MungedExpr,Bump|MungedBody1],
+ munge_body(Body, Vars3, MungedExprs1, NewBumps)
+ end;
+munge_body([], Vars, MungedBody, _LastExprBumpLines) ->
+ {reverse(MungedBody), Vars}.
+
+%%% Fix last expression (OTP-8188). A typical example:
+%%%
+%%% 3: case X of
+%%% 4: 1 -> a; % Bump line 5 after "a" has been evaluated!
+%%% 5: 2 -> b; 3 -> c end, F()
+%%%
+%%% Line 5 wasn't bumped just before "F()" since it was already bumped
+%%% before "b" (and before "c") (one mustn't bump a line more than
+%%% once in a single "evaluation"). The expression "case X ... end" is
+%%% now traversed again ("fixed"), this time adding bumps of line 5
+%%% where appropriate, in this case when X matches 1.
+%%%
+%%% This doesn't solve all problems with expressions on the same line,
+%%% though. 'case' and 'try' are tricky. An example:
+%%%
+%%% 7: case case X of 1 -> foo(); % ?
+%%% 8: 2 -> bar() end of a -> 1;
+%%% 9: b -> 2 end.
+%%%
+%%% If X matches 1 and foo() evaluates to a then line 8 should be
+%%% bumped, but not if foo() evaluates to b. In other words, line 8
+%%% cannot be bumped after "foo()" on line 7, so one has to bump line
+%%% 8 before "begin 1 end". But if X matches 2 and bar evaluates to a
+%%% then line 8 would be bumped twice (there has to be a bump before
+%%% "bar()". It is like one would have to have two copies of the inner
+%%% clauses, one for each outer clause. Maybe the munging should be
+%%% done on some of the compiler's "lower level" format.
+%%%
+%%% 'fun' is also problematic since a bump inside the body "shadows"
+%%% the rest of the line.
+
+maybe_fix_last_expr(MungedExprs, Vars, LastExprBumpLines) ->
+ case last_expr_needs_fixing(Vars, LastExprBumpLines) of
+ {yes, Line} ->
+ fix_last_expr(MungedExprs, Line, Vars);
+ no ->
+ MungedExprs
+ end.
+
+last_expr_needs_fixing(Vars, LastExprBumpLines) ->
+ case common_elems(Vars#vars.no_bump_lines, LastExprBumpLines) of
+ [Line] -> {yes, Line};
+ _ -> no
+ end.
+
+fix_last_expr([MungedExpr|MungedExprs], Line, Vars) ->
+ %% No need to update ?COVER_TABLE.
+ Bump = bump_call(Vars, Line),
+ [fix_expr(MungedExpr, Line, Bump)|MungedExprs].
+
+fix_expr({'if',L,Clauses}, Line, Bump) ->
+ FixedClauses = fix_clauses(Clauses, Line, Bump),
+ {'if',L,FixedClauses};
+fix_expr({'case',L,Expr,Clauses}, Line, Bump) ->
+ FixedExpr = fix_expr(Expr, Line, Bump),
+ FixedClauses = fix_clauses(Clauses, Line, Bump),
+ {'case',L,FixedExpr,FixedClauses};
+fix_expr({'receive',L,Clauses}, Line, Bump) ->
+ FixedClauses = fix_clauses(Clauses, Line, Bump),
+ {'receive',L,FixedClauses};
+fix_expr({'receive',L,Clauses,Expr,Body}, Line, Bump) ->
+ FixedClauses = fix_clauses(Clauses, Line, Bump),
+ FixedExpr = fix_expr(Expr, Line, Bump),
+ FixedBody = fix_expr(Body, Line, Bump),
+ {'receive',L,FixedClauses,FixedExpr,FixedBody};
+fix_expr({'try',L,Exprs,Clauses,CatchClauses,After}, Line, Bump) ->
+ FixedExprs = fix_expr(Exprs, Line, Bump),
+ FixedClauses = fix_clauses(Clauses, Line, Bump),
+ FixedCatchClauses = fix_clauses(CatchClauses, Line, Bump),
+ FixedAfter = fix_expr(After, Line, Bump),
+ {'try',L,FixedExprs,FixedClauses,FixedCatchClauses,FixedAfter};
+fix_expr([E | Es], Line, Bump) ->
+ [fix_expr(E, Line, Bump) | fix_expr(Es, Line, Bump)];
+fix_expr(T, Line, Bump) when is_tuple(T) ->
+ list_to_tuple(fix_expr(tuple_to_list(T), Line, Bump));
+fix_expr(E, _Line, _Bump) ->
+ E.
+
+fix_clauses(Cs, Line, Bump) ->
+ case bumps_line(lists:last(Cs), Line) of
+ true ->
+ fix_cls(Cs, Line, Bump);
+ false ->
+ Cs
+ end.
+
+fix_cls([], _Line, _Bump) ->
+ [];
+fix_cls([Cl | Cls], Line, Bump) ->
+ case bumps_line(Cl, Line) of
+ true ->
+ [fix_expr(C, Line, Bump) || C <- [Cl | Cls]];
+ false ->
+ {clause,CL,P,G,Body} = Cl,
+ UniqueVarName = list_to_atom(lists:concat(["$cover$ ",Line])),
+ V = {var,0,UniqueVarName},
+ [Last|Rest] = lists:reverse(Body),
+ Body1 = lists:reverse(Rest, [{match,0,V,Last},Bump,V]),
+ [{clause,CL,P,G,Body1} | fix_cls(Cls, Line, Bump)]
+ end.
+
+bumps_line(E, L) ->
+ try bumps_line1(E, L) catch true -> true end.
+
+bumps_line1({call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}},
+ [{atom,0,?COVER_TABLE},{tuple,0,[_,_,_,_,_,{integer,0,Line}]},_]},
+ Line) ->
+ throw(true);
+bumps_line1([E | Es], Line) ->
+ bumps_line1(E, Line),
+ bumps_line1(Es, Line);
+bumps_line1(T, Line) when is_tuple(T) ->
+ bumps_line1(tuple_to_list(T), Line);
+bumps_line1(_, _) ->
+ false.
+
+%%% End of fix of last expression.
+
+bump_call(Vars, Line) ->
+ {call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}},
+ [{atom,0,?COVER_TABLE},
+ {tuple,0,[{atom,0,?BUMP_REC_NAME},
+ {atom,0,Vars#vars.module},
+ {atom,0,Vars#vars.function},
+ {integer,0,Vars#vars.arity},
+ {integer,0,Vars#vars.clause},
+ {integer,0,Line}]},
+ {integer,0,1}]}.
+
+munge_expr({match,Line,ExprL,ExprR}, Vars) ->
+ {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
+ {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
+ {{match,Line,MungedExprL,MungedExprR}, Vars3};
+munge_expr({tuple,Line,Exprs}, Vars) ->
+ {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []),
+ {{tuple,Line,MungedExprs}, Vars2};
+munge_expr({record,Line,Expr,Exprs}, Vars) ->
+ %% Only for Vsn=raw_abstract_v1
+ {MungedExprName, Vars2} = munge_expr(Expr, Vars),
+ {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []),
+ {{record,Line,MungedExprName,MungedExprFields}, Vars3};
+munge_expr({record_field,Line,ExprL,ExprR}, Vars) ->
+ %% Only for Vsn=raw_abstract_v1
+ {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
+ {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
+ {{record_field,Line,MungedExprL,MungedExprR}, Vars3};
+munge_expr({cons,Line,ExprH,ExprT}, Vars) ->
+ {MungedExprH, Vars2} = munge_expr(ExprH, Vars),
+ {MungedExprT, Vars3} = munge_expr(ExprT, Vars2),
+ {{cons,Line,MungedExprH,MungedExprT}, Vars3};
+munge_expr({op,Line,Op,ExprL,ExprR}, Vars) ->
+ {MungedExprL, Vars2} = munge_expr(ExprL, Vars),
+ {MungedExprR, Vars3} = munge_expr(ExprR, Vars2),
+ {{op,Line,Op,MungedExprL,MungedExprR}, Vars3};
+munge_expr({op,Line,Op,Expr}, Vars) ->
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ {{op,Line,Op,MungedExpr}, Vars2};
+munge_expr({'catch',Line,Expr}, Vars) ->
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ {{'catch',Line,MungedExpr}, Vars2};
+munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs},
+ Vars) when Vars#vars.is_guard=:=false->
+ {MungedExprM, Vars2} = munge_expr(ExprM, Vars),
+ {MungedExprF, Vars3} = munge_expr(ExprF, Vars2),
+ {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []),
+ {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4};
+munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs},
+ Vars) when Vars#vars.is_guard=:=true ->
+ %% Difference in abstract format after preprocessing: BIF calls in guards
+ %% are translated to {remote,...} (which is not allowed as source form)
+ %% NOT NECESSARY FOR Vsn=raw_abstract_v1
+ munge_expr({call,Line1,ExprF,Exprs}, Vars);
+munge_expr({call,Line,Expr,Exprs}, Vars) ->
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []),
+ {{call,Line,MungedExpr,MungedExprs}, Vars3};
+munge_expr({lc,Line,Expr,Qs}, Vars) ->
+ {MungedExpr, Vars2} = munge_expr(?BLOCK1(Expr), Vars),
+ {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2),
+ {{lc,Line,MungedExpr,MungedQs}, Vars3};
+munge_expr({bc,Line,Expr,Qs}, Vars) ->
+ {bin,BLine,[{bin_element,EL,Val,Sz,TSL}]} = Expr,
+ Expr2 = {bin,BLine,[{bin_element,EL,?BLOCK1(Val),Sz,TSL}]},
+ {MungedExpr,Vars2} = munge_expr(Expr2, Vars),
+ {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2),
+ {{bc,Line,MungedExpr,MungedQs}, Vars3};
+munge_expr({block,Line,Body}, Vars) ->
+ {MungedBody, Vars2} = munge_body(Body, Vars),
+ {{block,Line,MungedBody}, Vars2};
+munge_expr({'if',Line,Clauses}, Vars) ->
+ {MungedClauses,Vars2} = munge_clauses(Clauses, Vars),
+ {{'if',Line,MungedClauses}, Vars2};
+munge_expr({'case',Line,Expr,Clauses}, Vars) ->
+ {MungedExpr,Vars2} = munge_expr(Expr, Vars),
+ {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2),
+ {{'case',Line,MungedExpr,MungedClauses}, Vars3};
+munge_expr({'receive',Line,Clauses}, Vars) ->
+ {MungedClauses,Vars2} = munge_clauses(Clauses, Vars),
+ {{'receive',Line,MungedClauses}, Vars2};
+munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) ->
+ {MungedExpr, Vars1} = munge_expr(Expr, Vars),
+ {MungedClauses,Vars2} = munge_clauses(Clauses, Vars1),
+ {MungedBody,Vars3} =
+ munge_body(Body, Vars2#vars{lines = Vars1#vars.lines}),
+ Vars4 = Vars3#vars{lines = Vars2#vars.lines ++ new_bumps(Vars3, Vars2)},
+ {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4};
+munge_expr({'try',Line,Body,Clauses,CatchClauses,After}, Vars) ->
+ {MungedBody, Vars1} = munge_body(Body, Vars),
+ {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1),
+ {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2),
+ {MungedAfter, Vars4} = munge_body(After, Vars3),
+ {{'try',Line,MungedBody,MungedClauses,MungedCatchClauses,MungedAfter},
+ Vars4};
+%% Difference in abstract format after preprocessing: Funs get an extra
+%% element Extra.
+%% NOT NECESSARY FOR Vsn=raw_abstract_v1
+munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) ->
+ {{'fun',Line,{function,Name,Arity}}, Vars};
+munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) ->
+ {MungedClauses,Vars2}=munge_clauses(Clauses, Vars),
+ {{'fun',Line,{clauses,MungedClauses}}, Vars2};
+munge_expr({'fun',Line,{clauses,Clauses}}, Vars) ->
+ %% Only for Vsn=raw_abstract_v1
+ {MungedClauses,Vars2}=munge_clauses(Clauses, Vars),
+ {{'fun',Line,{clauses,MungedClauses}}, Vars2};
+munge_expr({bin,Line,BinElements}, Vars) ->
+ {MungedBinElements,Vars2} = munge_exprs(BinElements, Vars, []),
+ {{bin,Line,MungedBinElements}, Vars2};
+munge_expr({bin_element,Line,Value,Size,TypeSpecifierList}, Vars) ->
+ {MungedValue,Vars2} = munge_expr(Value, Vars),
+ {MungedSize,Vars3} = munge_expr(Size, Vars2),
+ {{bin_element,Line,MungedValue,MungedSize,TypeSpecifierList},Vars3};
+munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|eof|default
+ {Form, Vars}.
+
+munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard=:=true,
+ is_list(Expr) ->
+ {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []),
+ munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]);
+munge_exprs([Expr|Exprs], Vars, MungedExprs) ->
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]);
+munge_exprs([], Vars, MungedExprs) ->
+ {reverse(MungedExprs), Vars}.
+
+%% Every qualifier is decorated with a counter.
+munge_qualifiers(Qualifiers, Vars) ->
+ munge_qs(Qualifiers, Vars, []).
+
+munge_qs([{generate,Line,Pattern,Expr}|Qs], Vars, MQs) ->
+ L = element(2, Expr),
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ munge_qs1(Qs, L, {generate,Line,Pattern,MungedExpr}, Vars, Vars2, MQs);
+munge_qs([{b_generate,Line,Pattern,Expr}|Qs], Vars, MQs) ->
+ L = element(2, Expr),
+ {MExpr, Vars2} = munge_expr(Expr, Vars),
+ munge_qs1(Qs, L, {b_generate,Line,Pattern,MExpr}, Vars, Vars2, MQs);
+munge_qs([Expr|Qs], Vars, MQs) ->
+ L = element(2, Expr),
+ {MungedExpr, Vars2} = munge_expr(Expr, Vars),
+ munge_qs1(Qs, L, MungedExpr, Vars, Vars2, MQs);
+munge_qs([], Vars, MQs) ->
+ {reverse(MQs), Vars}.
+
+munge_qs1(Qs, Line, NQ, Vars, Vars2, MQs) ->
+ case new_bumps(Vars2, Vars) of
+ [_] ->
+ munge_qs(Qs, Vars2, [NQ | MQs]);
+ _ ->
+ {MungedTrue, Vars3} = munge_expr(?BLOCK({atom,Line,true}), Vars2),
+ munge_qs(Qs, Vars3, [NQ, MungedTrue | MQs])
+ end.
+
+new_bumps(#vars{lines = New}, #vars{lines = Old}) ->
+ subtract(New, Old).
+
+subtract(L1, L2) ->
+ [E || E <- L1, not lists:member(E, L2)].
+
+common_elems(L1, L2) ->
+ [E || E <- L1, lists:member(E, L2)].
+
+%%%--Analysis------------------------------------------------------------
+
+%% Collect data for all modules
+collect(Nodes) ->
+ %% local node
+ MS = ets:fun2ms(fun({M,C}) when is_atom(M) -> {M,C} end),
+ AllClauses = ets:select(?COVER_TABLE,MS),
+ move_modules(AllClauses),
+
+ %% remote nodes
+ remote_collect('_',Nodes,false).
+
+%% Collect data for one module
+collect(Module,Clauses,Nodes) ->
+ %% local node
+ move_modules([{Module,Clauses}]),
+
+ %% remote nodes
+ remote_collect(Module,Nodes,false).
+
+
+%% When analysing, the data from the local ?COVER_TABLE is moved to the
+%% ?COLLECTION_TABLE. Resetting data in ?COVER_TABLE
+move_modules([{Module,Clauses}|AllClauses]) ->
+ ets:insert(?COLLECTION_TABLE,{Module,Clauses}),
+ move_clauses(Clauses),
+ move_modules(AllClauses);
+move_modules([]) ->
+ ok.
+
+move_clauses([{M,F,A,C,_L}|Clauses]) ->
+ Pattern = {#bump{module=M, function=F, arity=A, clause=C}, '_'},
+ Bumps = ets:match_object(?COVER_TABLE,Pattern),
+ lists:foreach(fun({Key,Val}) ->
+ ets:insert(?COVER_TABLE, {Key,0}),
+ insert_in_collection_table(Key,Val)
+ end,
+ Bumps),
+ move_clauses(Clauses);
+move_clauses([]) ->
+ ok.
+
+
+%% Given a .beam file, find the .erl file. Look first in same directory as
+%% the .beam file, then in <beamdir>/../src
+find_source(File0) ->
+ case filename:rootname(File0,".beam") of
+ File0 ->
+ File0;
+ File ->
+ InSameDir = File++".erl",
+ case filelib:is_file(InSameDir) of
+ true ->
+ InSameDir;
+ false ->
+ Dir = filename:dirname(File),
+ Mod = filename:basename(File),
+ InDotDotSrc = filename:join([Dir,"..","src",Mod++".erl"]),
+ case filelib:is_file(InDotDotSrc) of
+ true ->
+ InDotDotSrc;
+ false ->
+ {beam,File0}
+ end
+ end
+ end.
+
+%% do_analyse(Module, Analysis, Level, Clauses)-> {ok,Answer} | {error,Error}
+%% Clauses = [{Module,Function,Arity,Clause,Lines}]
+do_analyse(Module, Analysis, line, _Clauses) ->
+ Pattern = {#bump{module=Module},'_'},
+ Bumps = ets:match_object(?COLLECTION_TABLE, Pattern),
+ Fun = case Analysis of
+ coverage ->
+ fun({#bump{line=L}, 0}) ->
+ {{Module,L}, {0,1}};
+ ({#bump{line=L}, _N}) ->
+ {{Module,L}, {1,0}}
+ end;
+ calls ->
+ fun({#bump{line=L}, N}) ->
+ {{Module,L}, N}
+ end
+ end,
+ Answer = lists:keysort(1, lists:map(Fun, Bumps)),
+ {ok, Answer};
+do_analyse(_Module, Analysis, clause, Clauses) ->
+ Fun = case Analysis of
+ coverage ->
+ fun({M,F,A,C,Ls}) ->
+ Pattern = {#bump{module=M,function=F,arity=A,
+ clause=C},0},
+ Bumps = ets:match_object(?COLLECTION_TABLE, Pattern),
+ NotCov = length(Bumps),
+ {{M,F,A,C}, {Ls-NotCov, NotCov}}
+ end;
+ calls ->
+ fun({M,F,A,C,_Ls}) ->
+ Pattern = {#bump{module=M,function=F,arity=A,
+ clause=C},'_'},
+ Bumps = ets:match_object(?COLLECTION_TABLE, Pattern),
+ {_Bump, Calls} = hd(lists:keysort(1, Bumps)),
+ {{M,F,A,C}, Calls}
+ end
+ end,
+ Answer = lists:map(Fun, Clauses),
+ {ok, Answer};
+do_analyse(Module, Analysis, function, Clauses) ->
+ {ok, ClauseResult} = do_analyse(Module, Analysis, clause, Clauses),
+ Result = merge_clauses(ClauseResult, merge_fun(Analysis)),
+ {ok, Result};
+do_analyse(Module, Analysis, module, Clauses) ->
+ {ok, FunctionResult} = do_analyse(Module, Analysis, function, Clauses),
+ Result = merge_functions(FunctionResult, merge_fun(Analysis)),
+ {ok, {Module,Result}}.
+
+merge_fun(coverage) ->
+ fun({Cov1,NotCov1}, {Cov2,NotCov2}) ->
+ {Cov1+Cov2, NotCov1+NotCov2}
+ end;
+merge_fun(calls) ->
+ fun(Calls1, Calls2) ->
+ Calls1+Calls2
+ end.
+
+merge_clauses(Clauses, MFun) -> merge_clauses(Clauses, MFun, []).
+merge_clauses([{{M,F,A,_C1},R1},{{M,F,A,C2},R2}|Clauses], MFun, Result) ->
+ merge_clauses([{{M,F,A,C2},MFun(R1,R2)}|Clauses], MFun, Result);
+merge_clauses([{{M,F,A,_C},R}|Clauses], MFun, Result) ->
+ merge_clauses(Clauses, MFun, [{{M,F,A},R}|Result]);
+merge_clauses([], _Fun, Result) ->
+ reverse(Result).
+
+merge_functions([{_MFA,R}|Functions], MFun) ->
+ merge_functions(Functions, MFun, R);
+merge_functions([],_MFun) -> % There are no clauses.
+ {0,0}. % No function can be covered or notcov.
+
+merge_functions([{_MFA,R}|Functions], MFun, Result) ->
+ merge_functions(Functions, MFun, MFun(Result, R));
+merge_functions([], _MFun, Result) ->
+ Result.
+
+%% do_analyse_to_file(Module,OutFile,ErlFile) -> {ok,OutFile} | {error,Error}
+%% Module = atom()
+%% OutFile = ErlFile = string()
+do_analyse_to_file(Module, OutFile, ErlFile, HTML) ->
+ case file:open(ErlFile, [read]) of
+ {ok, InFd} ->
+ case file:open(OutFile, [write]) of
+ {ok, OutFd} ->
+ if HTML ->
+ io:format(OutFd,
+ "<html>\n"
+ "<head><title>~s</title></head>"
+ "<body bgcolor=white text=black>\n"
+ "<pre>\n",
+ [OutFile]);
+ true -> ok
+ end,
+
+ %% Write some initial information to the output file
+ {{Y,Mo,D},{H,Mi,S}} = calendar:local_time(),
+ io:format(OutFd, "File generated from ~s by COVER "
+ "~p-~s-~s at ~s:~s:~s~n",
+ [ErlFile,
+ Y,
+ string:right(integer_to_list(Mo), 2, $0),
+ string:right(integer_to_list(D), 2, $0),
+ string:right(integer_to_list(H), 2, $0),
+ string:right(integer_to_list(Mi), 2, $0),
+ string:right(integer_to_list(S), 2, $0)]),
+ io:format(OutFd, "~n"
+ "**************************************"
+ "**************************************"
+ "~n~n", []),
+
+ print_lines(Module, InFd, OutFd, 1, HTML),
+
+ if HTML -> io:format(OutFd,"</pre>\n</body>\n</html>\n",[]);
+ true -> ok
+ end,
+
+ file:close(OutFd),
+ file:close(InFd),
+
+ {ok, OutFile};
+
+ {error, Reason} ->
+ {error, {file, OutFile, Reason}}
+ end;
+
+ {error, Reason} ->
+ {error, {file, ErlFile, Reason}}
+ end.
+
+print_lines(Module, InFd, OutFd, L, HTML) ->
+ case io:get_line(InFd, '') of
+ eof ->
+ ignore;
+ "%"++_=Line -> %Comment line - not executed.
+ io:put_chars(OutFd, [tab(),escape_lt_and_gt(Line, HTML)]),
+ print_lines(Module, InFd, OutFd, L+1, HTML);
+ RawLine ->
+ Line = escape_lt_and_gt(RawLine,HTML),
+ Pattern = {#bump{module=Module,line=L},'$1'},
+ case ets:match(?COLLECTION_TABLE, Pattern) of
+ [] ->
+ io:put_chars(OutFd, [tab(),Line]);
+ Ns ->
+ N = lists:foldl(fun([Ni], Nacc) -> Nacc+Ni end, 0, Ns),
+ if
+ N=:=0, HTML=:=true ->
+ LineNoNL = Line -- "\n",
+ Str = " 0",
+ %%Str = string:right("0", 6, 32),
+ RedLine = ["<font color=red>",Str,fill1(),
+ LineNoNL,"</font>\n"],
+ io:put_chars(OutFd, RedLine);
+ N<1000000 ->
+ Str = string:right(integer_to_list(N), 6, 32),
+ io:put_chars(OutFd, [Str,fill1(),Line]);
+ N<10000000 ->
+ Str = integer_to_list(N),
+ io:put_chars(OutFd, [Str,fill2(),Line]);
+ true ->
+ Str = integer_to_list(N),
+ io:put_chars(OutFd, [Str,fill3(),Line])
+ end
+ end,
+ print_lines(Module, InFd, OutFd, L+1, HTML)
+ end.
+
+tab() -> " | ".
+fill1() -> "..| ".
+fill2() -> ".| ".
+fill3() -> "| ".
+
+%%%--Export--------------------------------------------------------------
+do_export_table(Compiled, Imported, Fd) ->
+ ModList = merge(Imported,Compiled),
+ write_module_data(ModList,Fd).
+
+merge([{Module,File,_ImportFiles}|Imported],ModuleList) ->
+ case lists:keymember(Module,1,ModuleList) of
+ true ->
+ merge(Imported,ModuleList);
+ false ->
+ merge(Imported,[{Module,File}|ModuleList])
+ end;
+merge([],ModuleList) ->
+ ModuleList.
+
+write_module_data([{Module,File}|ModList],Fd) ->
+ write({file,Module,File},Fd),
+ [Clauses] = ets:lookup(?COLLECTION_TABLE,Module),
+ write(Clauses,Fd),
+ ModuleData = ets:match_object(?COLLECTION_TABLE,{#bump{module=Module},'_'}),
+ do_write_module_data(ModuleData,Fd),
+ write_module_data(ModList,Fd);
+write_module_data([],_Fd) ->
+ ok.
+
+do_write_module_data([H|T],Fd) ->
+ write(H,Fd),
+ do_write_module_data(T,Fd);
+do_write_module_data([],_Fd) ->
+ ok.
+
+write(Element,Fd) ->
+ Bin = term_to_binary(Element,[compressed]),
+ case byte_size(Bin) of
+ Size when Size > 255 ->
+ SizeBin = term_to_binary({'$size',Size}),
+ file:write(Fd,
+ <<(byte_size(SizeBin)):8,SizeBin/binary,Bin/binary>>);
+ Size ->
+ file:write(Fd,<<Size:8,Bin/binary>>)
+ end,
+ ok.
+
+%%%--Import--------------------------------------------------------------
+do_import_to_table(Fd,ImportFile,Imported) ->
+ do_import_to_table(Fd,ImportFile,Imported,[]).
+do_import_to_table(Fd,ImportFile,Imported,DontImport) ->
+ case get_term(Fd) of
+ {file,Module,File} ->
+ case add_imported(Module, File, ImportFile, Imported) of
+ {ok,NewImported} ->
+ do_import_to_table(Fd,ImportFile,NewImported,DontImport);
+ dont_import ->
+ do_import_to_table(Fd,ImportFile,Imported,
+ [Module|DontImport])
+ end;
+ {Key=#bump{module=Module},Val} ->
+ case lists:member(Module,DontImport) of
+ false ->
+ insert_in_collection_table(Key,Val);
+ true ->
+ ok
+ end,
+ do_import_to_table(Fd,ImportFile,Imported,DontImport);
+ {Module,Clauses} ->
+ case lists:member(Module,DontImport) of
+ false ->
+ ets:insert(?COLLECTION_TABLE,{Module,Clauses});
+ true ->
+ ok
+ end,
+ do_import_to_table(Fd,ImportFile,Imported,DontImport);
+ eof ->
+ Imported
+ end.
+
+
+get_term(Fd) ->
+ case file:read(Fd,1) of
+ {ok,<<Size1:8>>} ->
+ {ok,Bin1} = file:read(Fd,Size1),
+ case binary_to_term(Bin1) of
+ {'$size',Size2} ->
+ {ok,Bin2} = file:read(Fd,Size2),
+ binary_to_term(Bin2);
+ Term ->
+ Term
+ end;
+ eof ->
+ eof
+ end.
+
+%%%--Reset---------------------------------------------------------------
+
+%% Reset main node and all remote nodes
+do_reset_main_node(Module,Nodes) ->
+ do_reset(Module),
+ do_reset_collection_table(Module),
+ remote_reset(Module,Nodes).
+
+do_reset_collection_table(Module) ->
+ ets:delete(?COLLECTION_TABLE,Module),
+ ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}).
+
+%% do_reset(Module) -> ok
+%% The reset is done on a per-clause basis to avoid building
+%% long lists in the case of very large modules
+do_reset(Module) ->
+ [{Module,Clauses}] = ets:lookup(?COVER_TABLE, Module),
+ do_reset2(Clauses).
+
+do_reset2([{M,F,A,C,_L}|Clauses]) ->
+ Pattern = {#bump{module=M, function=F, arity=A, clause=C}, '_'},
+ Bumps = ets:match_object(?COVER_TABLE, Pattern),
+ lists:foreach(fun({Bump,_N}) ->
+ ets:insert(?COVER_TABLE, {Bump,0})
+ end,
+ Bumps),
+ do_reset2(Clauses);
+do_reset2([]) ->
+ ok.
+
+do_clear(Module) ->
+ ets:match_delete(?COVER_TABLE, {Module,'_'}),
+ ets:match_delete(?COVER_TABLE, {#bump{module=Module},'_'}),
+ ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}).
+
+
+
+%%%--Div-----------------------------------------------------------------
+
+reverse(List) ->
+ reverse(List,[]).
+reverse([H|T],Acc) ->
+ reverse(T,[H|Acc]);
+reverse([],Acc) ->
+ Acc.
+
+
+escape_lt_and_gt(Rawline,HTML) when HTML =/= true ->
+ Rawline;
+escape_lt_and_gt(Rawline,_HTML) ->
+ escape_lt_and_gt1(Rawline,[]).
+
+escape_lt_and_gt1([$<|T],Acc) ->
+ escape_lt_and_gt1(T,[$;,$t,$l,$&|Acc]);
+escape_lt_and_gt1([$>|T],Acc) ->
+ escape_lt_and_gt1(T,[$;,$t,$g,$&|Acc]);
+escape_lt_and_gt1([],Acc) ->
+ lists:reverse(Acc);
+escape_lt_and_gt1([H|T],Acc) ->
+ escape_lt_and_gt1(T,[H|Acc]).
diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl
new file mode 100644
index 0000000000..69f2f3b1aa
--- /dev/null
+++ b/lib/tools/src/cover_web.erl
@@ -0,0 +1,1184 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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%
+%%
+
+-module(cover_web).
+-author('[email protected]').
+-behaviour(gen_server).
+
+%%Export of configuration function
+-export([configData/0]).
+%% External exports
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-export([start_link/0,start/0,stop/0]).
+-export([menu_frame/2,nodes_frame/2,import_frame/2,
+ compile_frame/2,result_frame/2]).
+-export([list_dir/2,compile/2,add_node/2,remove_node/2,result/2,
+ calls/2,coverage/2,import/2]).
+
+-record(state,{dir}).
+
+-include_lib("kernel/include/file.hrl").
+
+%% Timeouts
+-define(DEFAULT_TIME,10000).
+-define(MAX_COMPILE_TIME,60000).
+-define(MAX_ANALYSE_TIME,30000).
+
+%% Colors
+-define(INFO_BG_COLOR,"#C0C0EA").
+
+%%%----------------------------------------------------------------------
+%%% API - called from erlang shell
+%%%----------------------------------------------------------------------
+%% Start webtool and webcover from erlang shell
+start() ->
+ webtool:start(),
+ webtool:start_tools([],"app=webcover"),
+ ok.
+
+%% Stop webtool and webcover from erlang shell
+stop() ->
+ webtool:stop_tools([],"app=webcover"),
+ webtool:stop().
+
+
+
+%%%----------------------------------------------------------------------
+%%% API - called from webtool
+%%%----------------------------------------------------------------------
+start_link() ->
+ gen_server:start_link({local, webcover_server},cover_web, [], []).
+
+
+nodes_frame(Env,Input)->
+ call({nodes_frame,Env,Input}).
+
+add_node(Env,Input)->
+ call({add_node,Env,Input}).
+
+remove_node(Env,Input)->
+ call({remove_node,Env,Input}).
+
+compile_frame(Env,Input)->
+ call({compile_frame,Env,Input}).
+
+list_dir(Env,Input) ->
+ call({list_dir,Env,Input}).
+
+compile(Env,Input)->
+ call({compile,Env,Input},?MAX_COMPILE_TIME).
+
+result_frame(Env,Input)->
+ call({result_frame,Env,Input}).
+
+result(Env,Input) ->
+ call({result,Env,Input},?MAX_ANALYSE_TIME).
+
+calls(Env,Input) ->
+ call({calls,Env,Input}).
+
+coverage(Env,Input) ->
+ call({coverage,Env,Input}).
+
+import_frame(Env,Input)->
+ call({import_frame,Env,Input}).
+
+import(Env,Input)->
+ call({import,Env,Input}).
+
+menu_frame(Env,Input)->
+ call({menu_frame,Env,Input}).
+
+call(Msg) ->
+ call(Msg,?DEFAULT_TIME).
+call(Msg,Time) ->
+ gen_server:call(webcover_server,Msg,Time).
+
+
+
+configData()->
+ {webcover,[{web_data,{"WebCover","/webcover"}},
+ {alias,{"/webcover",code:priv_dir(tools)}},
+ {alias,{erl_alias,"/webcover/erl",[cover_web]}},
+ {start,{child,{{local,webcover_server},
+ {cover_web,start_link,[]},
+ permanent,100,worker,[cover_web]}}}
+ ]}.
+
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%----------------------------------------------------------------------
+init([]) ->
+ cover:start(),
+ CS = whereis(cover_server),
+ link(CS),
+ GL = spawn_link(fun group_leader_proc/0),
+ group_leader(GL,CS),
+
+ %% Must trap exists in order to have terminate/2 executed when
+ %% crashing because of a linked process crash.
+ process_flag(trap_exit,true),
+ {ok,Cwd} = file:get_cwd(),
+ {ok, #state{dir=Cwd}}.
+
+group_leader_proc() ->
+ register(cover_group_leader_proc,self()),
+ group_leader_loop([]).
+group_leader_loop(Warnings) ->
+ receive
+ {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} ->
+ Msg = (catch io_lib:Func(Format,Args)),
+ From ! {io_reply,ReplyAs,ok},
+ case lists:member(Msg,Warnings) of
+ true -> group_leader_loop(Warnings);
+ false -> group_leader_loop([Msg|Warnings])
+ end;
+ {io_request,From,ReplyAs,{put_chars,_Encoding,io_lib,Func,[Format,Args]}} ->
+ Msg = (catch io_lib:Func(Format,Args)),
+ From ! {io_reply,ReplyAs,ok},
+ case lists:member(Msg,Warnings) of
+ true -> group_leader_loop(Warnings);
+ false -> group_leader_loop([Msg|Warnings])
+ end;
+ IoReq when element(1,IoReq)=:= io_request ->
+ group_leader() ! IoReq,
+ group_leader_loop(Warnings);
+ {From,get_warnings} ->
+ Warnings1 =
+ receive
+ {io_request,From,ReplyAs,
+ {put_chars,io_lib,Func,[Format,Args]}} ->
+ Msg = (catch io_lib:Func(Format,Args)),
+ From ! {io_reply,ReplyAs,ok},
+ case lists:member(Msg,Warnings) of
+ true -> Warnings;
+ false -> [Msg|Warnings]
+ end
+ after 0 ->
+ Warnings
+ end,
+ From ! {warnings,Warnings1},
+ group_leader_loop([])
+ end.
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_call({nodes_frame,_Env,_Input},_From,State)->
+ {reply,nodes_frame1(),State};
+
+handle_call({add_node,_Env,Input},_From,State)->
+ {reply,do_add_node(Input),State};
+
+handle_call({remove_node,_Env,Input},_From,State)->
+ {reply,do_remove_node(Input),State};
+
+handle_call({compile_frame,_Env,_Input},_From,State)->
+ {reply,compile_frame1(State#state.dir),State};
+
+handle_call({list_dir,_Env,Input},_From,State)->
+ Dir = get_input_data(Input,"path"),
+ case filelib:is_dir(Dir) of
+ true ->
+ {reply,compile_frame1(Dir),State#state{dir=Dir}};
+ false ->
+ Err = Dir ++ " is not a directory",
+ {reply,compile_frame1(State#state.dir,Err),State}
+ end;
+handle_call({compile,_Env,Input},_From,State)->
+ {reply,do_compile(Input,State#state.dir),State};
+
+handle_call({result_frame,_Env,_Input},_From,State)->
+ {reply,result_frame1(),State};
+
+handle_call({result,_Env,Input},_From,State)->
+ {reply,handle_result(Input),State};
+
+handle_call({calls,_Env,Input},_From,State)->
+ {reply,call_page(Input),State};
+
+handle_call({coverage,_Env,Input},_From,State)->
+ {reply,coverage_page(Input),State};
+
+handle_call({import_frame,_Env,_Input},_From,State)->
+ {ok,Cwd} = file:get_cwd(),
+ {reply,import_frame1(Cwd),State};
+
+handle_call({import,_Env,Input},_From,State)->
+ {reply,do_import(Input),State};
+
+handle_call({menu_frame,_Env,_Input},_From,State)->
+ {reply,menu_frame1(),State};
+
+handle_call(_Request, _From, State) ->
+ Reply = bad_request,
+ {reply, Reply, State}.
+
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_info({'EXIT',_Pid,Reason}, State) ->
+ {stop, Reason, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ cover:stop(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that creates the whole pages by collecting all the %%
+%% neccessary data for each page. These functions are the public %%
+%% interface. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%----------------------------------------------------------------------
+%% Returns the page to the left frame
+%%----------------------------------------------------------------------
+menu_frame1()->
+ [header(),html_header(""),menu_body(),html_end()].
+
+%%----------------------------------------------------------------------
+%% Creates the page where the user can add and remove nodes
+%%----------------------------------------------------------------------
+
+nodes_frame1()->
+ nodes_frame1([]).
+nodes_frame1(Err)->
+ [header(),html_header("Add/remove nodes"),nodes_body(Err),html_end()].
+
+%%----------------------------------------------------------------------
+%% Creates the page where the user can cover compile modules
+%%----------------------------------------------------------------------
+
+compile_frame1(Dir)->
+ compile_frame1(Dir,[]).
+compile_frame1(Dir,Err) ->
+ [header(),html_header("Cover compile"),compile_body(Dir,Err),html_end()].
+
+%%----------------------------------------------------------------------
+%% Creates the page where the user can handle results
+%%----------------------------------------------------------------------
+
+result_frame1()->
+ result_frame1([]).
+result_frame1(Err) ->
+ [header(),html_header("Show cover results"),result_body(Err),html_end()].
+
+%%----------------------------------------------------------------------
+%%The beginning of the page that clear the cover information on a cover
+%%compiled module
+%%----------------------------------------------------------------------
+call_page(Input)->
+ [header(),html_header("Code coverage"),call_result(Input),html_end()].
+
+coverage_page(Input)->
+ [header(),html_header("Code coverage"),coverage_result(Input),html_end()].
+
+%%----------------------------------------------------------------------
+%% Creates the page where the user an import files
+%%----------------------------------------------------------------------
+import_frame1(Dir) ->
+ import_frame1(Dir,"").
+import_frame1(Dir,Err) ->
+ [header(),html_header("Import coverdata"),import_body(Dir,Err),html_end()].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that build the body of the menu frame %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+menu_body() ->
+ Nodes = cover:which_nodes(),
+ Modules = cover:modules(),
+ Imported = cover:imported(),
+ ["<A HREF=\"./nodes_frame\" TARGET=\"main\">Nodes</A><BR>\n",
+ "<A HREF=\"./compile_frame\" TARGET=\"main\">Compile</A><BR>\n",
+ "<A HREF=\"./import_frame\" TARGET=\"main\">Import</A><BR>\n",
+ "<A HREF=\"./result_frame\" TARGET=\"main\">Result</A>\n",
+ "<P><B>Nodes:</B>\n",
+ "<UL>\n",
+ lists:map(fun(N) -> "<LI>"++atom_to_list(N)++"</LI>\n" end,[node()|Nodes]),
+ "</UL>\n",
+ "<P><B>Compiled modules:</B>\n",
+ "<UL>\n",
+ lists:map(fun(M) -> "<LI>"++atom_to_list(M)++"</LI>\n" end,Modules),
+ "</UL>\n",
+ "<P><B>Imported files:</B>\n",
+ "<UL>\n",
+ "<FONT SIZE=-1>\n",
+ lists:map(fun(F) ->
+ Short = filename:basename(F),
+ "<LI TITLE=\""++F++"\">"++Short++"</LI>\n" end,Imported),
+ "</FONT>\n",
+ "</UL>\n"].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The functions that build the body of the nodes frame %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+nodes_body(Err) ->
+ CN = cover:which_nodes(),
+ Fun = fun(N) ->
+ NStr = atom_to_list(N),
+ ["<OPTION VALUE=",NStr,
+ " onClick=\"node.value=selected_node.value\">",NStr,
+ "</OPTION>\n"]
+ end,
+ AllNodes = lists:append(lists:map(Fun,nodes()--CN)),
+ CoverNodes = lists:append(lists:map(Fun,CN)),
+
+ [reload_menu_script(Err),
+ "<H1 ALIGN=center>Nodes</H1>\n",
+ "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n",
+ "<TR><TD BGCOLOR=",?INFO_BG_COLOR," COLSPAN=2>\n",
+ "<P>You can run cover over several nodes simultaneously. Coverage data\n",
+ "from all involved nodes will be merged during analysis.\n",
+ "<P>Select or enter node names to add or remove here.\n",
+ "</TD></TR>\n",
+ "<TR><TD COLSPAN=2><BR><BR></TD></TR>\n",
+ "<FORM ACTION=\"./add_node\" NAME=add_node>\n",
+ "<TR><TD VALIGN=top>Add node:</TD>\n",
+ "<TD><INPUT TYPE=text NAME=\"node\" SIZE=40 >",
+ "<INPUT TYPE=submit\n",
+ " onClick=\"if(!node.value){node.value=selected_node.value};\" VALUE=Add>"
+ "<BR><SELECT NAME=selected_node TITLE=\"Select node\">\n",
+ AllNodes ++
+ "</SELECT>\n",
+ "</TD></TR>\n"
+ "</FORM>\n",
+ "<TR><TD COLSPAN=2><BR><BR></TD></TR>\n",
+ "<FORM ACTION=\"./remove_node\" NAME=remove_node>\n",
+ "<TR><TD>Remove node:</TD>\n",
+ "<TD><SELECT NAME=node TITLE=\"Select node\">\n",
+ CoverNodes ++
+ "</SELECT>\n",
+ "<INPUT TYPE=submit VALUE=Remove>"
+ "</TD></TR>\n",
+ "</FORM>",
+ "</TABLE>"].
+
+
+do_add_node(Input) ->
+ NodeStr = get_input_data(Input, "node"),
+ Node = list_to_atom(NodeStr),
+ case net_adm:ping(Node) of
+ pong ->
+ cover:start(Node),
+ nodes_frame1();
+ pang ->
+ nodes_frame1("Node \\\'" ++ NodeStr ++ "\\\' is not alive")
+ end.
+
+do_remove_node(Input) ->
+ Node = list_to_atom(get_input_data(Input, "node")),
+ cover:stop(Node),
+ nodes_frame1().
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% The functions that is used when the user wants to compile something %
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+compile_body(Dir,Err) ->
+ Erls = filelib:wildcard(filename:join(Dir,"*.erl")),
+ Beams = filelib:wildcard(filename:join(Dir,"*.beam")),
+
+ [reload_menu_script(Err),
+ "<H1 ALIGN=center>Compile</H1>\n",
+ "<TABLE WIDTH=600 ALIGN=center BORDER=0>\n",
+ "<TR><TD COLSPAN=3 BGCOLOR=",?INFO_BG_COLOR,">\n",
+ "Each module which shall be part of the cover analysis must be prepared\n",
+ "or 'cover compiled'. On this page you can select .erl files and/or\n",
+ ".beam files to include in the analysis. If you select a .erl file it\n",
+ "will first be compiled with the Erlang compiler and then prepared for\n",
+ "coverage analysis. If you select a .beam file it will be prepared for\n",
+ "coverage analysis directly.\n",
+ "</TD></TR>\n",
+ "<FORM ACTION=\"./list_dir\" NAME=list_dir>\n",
+ "<TR><TD WIDTH=30% BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n",
+ "To list a different directory, enter the directory name here.\n",
+ "</TD>\n",
+ "<TH COLSPAN=2><BR>List directory:<BR></TH>\n",
+ "</TR>\n",
+ "<TR><TD ALIGN=center COLSPAN=2>\n",
+ "<INPUT TYPE=text NAME=\"path\" SIZE=40 VALUE=",Dir,">",
+ "<INPUT TYPE=submit VALUE=Ok>",
+ "<BR><BR></TD></TR>\n",
+ "</FORM>\n",
+ "<FORM ACTION=\"./compile\" NAME=compile_selection>\n",
+ "<TR><TD BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n",
+ "<P>Select one or more .erl or .beam files to prepare for coverage\n"
+ "analysis, and click the \"Compile\" button.\n",
+ "<P>To reload the original file after coverage analysis is complete,\n"
+ "select one or more files and click the \"Uncompile\" button, or\n",
+ "simply click the \"Uncompile all\" button to reload all originals.\n"
+ "</TD>\n",
+ "<TH>.erl files</TH><TH>.beam files</TH></TR>\n",
+ "<TR><TD ALIGN=center VALIGN=top>\n",
+ "<SELECT NAME=erl TITLE=\"Select .erl files to compile\" MULTIPLE=true",
+ " SIZE=15>\n",
+ list_modules(Erls) ++
+ "</SELECT></TD>\n",
+ "<TD ALIGN=center VALIGN=top>\n",
+ "<SELECT NAME=beam TITLE=\"Select .beam files to compile\"MULTIPLE=true",
+ " SIZE=15>\n",
+ list_modules(Beams) ++
+ "</SELECT></TD></TR>\n"
+ "<TR><TD BGCOLOR=",?INFO_BG_COLOR," ROWSPAN=2>\n",
+ "Compile options are only needed for .erl files. The options must be\n"
+ "given e.g. like this: \n"
+ "<FONT SIZE=-1>[{i,\"/my/path/include\"},{i,\"/other/path/\"}]</FONT>\n"
+ "</TD>\n",
+ "<TH COLSPAN=2><BR>Compile options:<BR></TH>\n",
+ "</TR>\n",
+ "<TR><TD COLSPAN=2 ALIGN=center>\n",
+ "<INPUT TYPE=text NAME=\"options\" SIZE=40>\n",
+ "<INPUT TYPE=hidden NAME=\"action\"></TD></TR>\n",
+ "<TR><TD></TD><TD ALIGN=center COLSPAN=2>\n",
+ "<INPUT TYPE=submit onClick=\"action.value=\'compile\';\"VALUE=Compile>",
+ "<INPUT TYPE=submit onClick=\"action.value=\'uncompile\';\" ",
+ "VALUE=Uncompile>",
+ "<INPUT TYPE=submit onClick=\"action.value=\'uncompile_all\';\" ",
+ "VALUE=\"Uncompile all\">",
+ "<BR><INPUT TYPE=reset VALUE=\"Reset form\"></TD></TR>\n",
+ "</FORM>\n",
+ "</TABLE>\n"].
+
+list_modules([File|Files]) ->
+ Mod = filename:basename(File),
+ ["<OPTION VALUE=",File," onDblClick=\"action.value=\'compile\';submit();\">",
+ Mod,"</OPTION>\n" | list_modules(Files)];
+list_modules([]) ->
+ [].
+
+do_compile(Input,Dir) ->
+ {Erls,Beams,Opts,Action} = get_compile_input(parse(Input),[],[]),
+ Errs =
+ case Action of
+ "compile" ->
+ do_compile(Erls,Beams,Opts,[]);
+ "uncompile" ->
+ do_uncompile(Erls++Beams);
+ "uncompile_all" ->
+ do_uncompile(cover:modules())
+ end,
+ compile_frame1(Dir,Errs).
+
+get_compile_input([{"erl",File}|Input],Erl,Beam) ->
+ get_compile_input(Input,[File|Erl],Beam);
+get_compile_input([{"beam",File}|Input],Erl,Beam) ->
+ get_compile_input(Input,Erl,[File|Beam]);
+get_compile_input([{"options",Opts0},{"action",Action}],Erl,Beam) ->
+ Opts = parse_options(Opts0),
+ {Erl,Beam,Opts,Action}.
+
+do_compile([Erl|Erls],Beams,Opts,Errs) ->
+ case cover:compile_module(Erl,Opts) of
+ {ok,_} ->
+ do_compile(Erls,Beams,Opts,Errs);
+ {error,File} ->
+ do_compile(Erls,Beams,Opts,["\\n"++File|Errs])
+ end;
+do_compile([],[Beam|Beams],Opts,Errs) ->
+ case cover:compile_beam(Beam) of
+ {ok,_} ->
+ do_compile([],Beams,Opts,Errs);
+ {error,{no_abstract_code,File}} ->
+ do_compile([],Beams,Opts,["\\n"++File++" (no_abstract_code)"|Errs])
+ end;
+do_compile([],[],_,[]) ->
+ [];
+do_compile([],[],_,Errs) ->
+ "Compilation failed for the following files:" ++ Errs.
+
+parse_options(Options)->
+ case erl_scan:string(Options ++".") of
+ {ok,Tokens,_Line} ->
+ case erl_parse:parse_exprs(Tokens) of
+ {ok,X}->
+ case lists:map(fun erl_parse:normalise/1, X) of
+ [List] when is_list(List) -> List;
+ List -> List
+ end;
+ _ ->
+ []
+ end;
+ _ ->
+ []
+ end.
+
+
+do_uncompile(Files) ->
+ lists:foreach(
+ fun(File) ->
+ Module =
+ if is_atom(File) ->
+ File;
+ true ->
+ ModStr = filename:basename(filename:rootname(File)),
+ list_to_atom(ModStr)
+ end,
+ case code:which(Module) of
+ cover_compiled ->
+ code:purge(Module),
+ case code:load_file(Module) of
+ {module, Module} ->
+ ok;
+ {error, _Reason2} ->
+ code:delete(Module)
+ end;
+ _ ->
+ ok
+ end
+ end,
+ Files),
+ [].
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% The functions that builds the body of the page for coverage analysis%
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+result_body(Err) ->
+ [reload_menu_script(Err),
+ "<H1 ALIGN=center>Result</H1>\n",
+ "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n",
+ "<TR><TD BGCOLOR=",?INFO_BG_COLOR,">\n",
+ "<P>After executing all your tests you can view the result of the\n",
+ "coverage analysis here. For each module you can\n",
+ "<DL>\n",
+ "<DT><B>Analyse to file</B></DT>\n",
+ "<DD>The source code of the module is shown with the number of calls\n",
+ "to each line stated in the left margin. Lines which are never called\n",
+ "are colored red.</DD>\n",
+ "<DT><B>Analyse coverage</B></DT>\n",
+ "<DD>Show the number of covered and uncovered lines in the module.</DD>\n",
+ "<DT><B>Analyse calls</B></DT>\n",
+ "<DD>Show the number of calls in the module.</DD>\n",
+ "<DT><B>Reset module</B></DT>\n",
+ "<DD>Delete all coverage data for the module.</DD>\n",
+ "<DT><B>Export module</B></DT>\n",
+ "<DD>Write all coverage data for the module to a file. The data can\n",
+ "later be imported from the \"Import\" page.</DD>\n",
+ "</DL>\n",
+ "<P>You can also reset or export data for all modules with the\n",
+ "<B>Reset all</B> and <B>Export all</B> actions respectively. For these\n",
+ "two actions there is no need to select a module.\n",
+ "<P>Select module and action from the drop down menus below, and click\n",
+ "the \"Execute\" button.\n",
+ "</TD></TR>\n",
+ "<TR><TD><BR><BR>\n",
+ result_selections(),
+ "</TD></TR></TABLE>"].
+
+result_selections() ->
+ ModList = filter_modlist(cover:modules()++cover:imported_modules(),[]),
+
+ ["<FORM ACTION=\"./result\" NAME=result_selection>\n",
+ "<TABLE WIDTH=\"300\" BORDER=0 ALIGN=center>\n",
+ "<TR><TD ALIGN=left>\n",
+ "Module:\n",
+ "<BR><SELECT NAME=module TITLE=\"Select module\">\n",
+ ModList ++
+ "</SELECT>\n",
+ "</TD>\n",
+ "<TD ALIGN=left>\n",
+ "Action:\n",
+ "<BR><SELECT NAME=action TITLE=\"Select action\">\n",
+ "<OPTION VALUE=\"analyse_to_file\">Analyse to file</OPTION>\n"
+ "<OPTION VALUE=\"coverage\">Analyse coverage</OPTION>\n"
+ "<OPTION VALUE=\"calls\">Analyse calls</OPTION>\n"
+ "<OPTION VALUE=\"reset\">Reset module</OPTION>\n"
+ "<OPTION VALUE=\"reset_all\">Reset all</OPTION>\n"
+ "<OPTION VALUE=\"export\">Export module</OPTION>\n"
+ "<OPTION VALUE=\"export_all\">Export all</OPTION>\n"
+ "</SELECT>\n",
+ "</TD>\n",
+ "<TD ALIGN=center VALIGN=bottom><INPUT TYPE=submit VALUE=Execute>\n"
+ "</TD></TR>\n"
+ "</TABLE>\n",
+ "</FORM>\n"].
+
+filter_modlist([M|Ms],Already) ->
+ case lists:member(M,Already) of
+ true ->
+ filter_modlist(Ms,Already);
+ false ->
+ MStr = atom_to_list(M),
+ ["<OPTION VALUE=",MStr,">",MStr,"</OPTION>\n" |
+ filter_modlist(Ms,[M|Already])]
+ end;
+filter_modlist([],_Already) ->
+ [].
+
+
+
+handle_result(Input) ->
+ case parse(Input) of
+ [{"module",M},{"action",A}] ->
+ case A of
+ "analyse_to_file" ->
+ case cover:analyse_to_file(list_to_atom(M),[html]) of
+ {ok,File} ->
+ case file:read_file(File) of
+ {ok,HTML}->
+ file:delete(File),
+ [header(),
+ reload_menu_script(""),
+ binary_to_list(HTML)];
+ _ ->
+ result_frame1("Can not read file" ++ File)
+ end;
+ {error,no_source_code_found} ->
+ result_frame1("No source code found for \\\'" ++
+ M ++ "\\\'")
+ end;
+ "calls" ->
+ call_page(Input);
+ "coverage" ->
+ coverage_page(Input);
+ "reset" ->
+ cover:reset(list_to_atom(M)),
+ result_frame1("Coverage data for \\\'" ++ M ++
+ "\\\' is now reset");
+ "reset_all" ->
+ cover:reset(),
+ result_frame1("All coverage data is now reset");
+ "export" ->
+ ExportFile = generate_filename(M),
+ cover:export(ExportFile,list_to_atom(M)),
+ result_frame1("Coverage data for \\\'" ++ M ++
+ "\\\' is now exported to file \\\"" ++
+ ExportFile ++ "\\\"");
+ "export_all" ->
+ ExportFile = generate_filename("COVER"),
+ cover:export(ExportFile),
+ result_frame1(
+ "All coverage data is now exported to file \\\"" ++
+ ExportFile ++ "\\\"")
+ end;
+ [{"action",_A}] ->
+ result_frame1("No module is selected")
+ end.
+
+generate_filename(Prefix) ->
+ {ok,Cwd} = file:get_cwd(),
+ filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata").
+
+ts() ->
+ {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()),
+ io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w",
+ [Y,M,D,H,Min,S]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% The functions that builds the body of the page that shows the calls %
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+call_result(Input)->
+ Mod = list_to_atom(get_input_data(Input, "module")),
+ case cover:analyse(Mod,calls) of
+ {error,_}->
+ error_body();
+ {ok,_} ->
+ call_result2(Mod,Input)
+ end.
+
+call_result2(Mod,Input)->
+ Result =
+ case get_input_data(Input,"what") of
+ "mod" ->
+ call_result(mod,Mod);
+ "func" ->
+ call_result(func,Mod);
+ "clause" ->
+ call_result(clause,Mod);
+ _->
+ call_result(all,Mod)
+ end,
+ result_choice("calls",Mod) ++ Result.
+
+result_choice(Level,Mod)->
+ ModStr=atom_to_list(Mod),
+ [reload_menu_script(""),
+ "<TABLE WIDTH=100%><TR>\n",
+ "<TD><A HREF=./",Level,"?module=",ModStr,"&what=all>All Data</A></TD>\n",
+ "<TD><A HREF=./",Level,"?module=",ModStr,"&what=mod>Module</A></TD>\n",
+ "<TD><A HREF=./",Level,"?module=",ModStr,"&what=func>Function</A></TD>\n",
+ "<TD><A HREF=./",Level,"?module=",ModStr,"&what=clause>Clause</A></TD>\n",
+ "</TR></TABLE><BR>\n"].
+
+call_result(Mode,Module)->
+ Content =
+ case Mode of
+ mod->
+ format_cover_call(cover:analyse(Module,calls,module),mod);
+ func->
+ format_cover_call(cover:analyse(Module,calls,function),func);
+ clause->
+ format_cover_call(cover:analyse(Module,calls,clause),clause);
+ _->
+ format_cover_call(cover:analyse(Module,calls,module),mod) ++
+ format_cover_call(cover:analyse(Module,calls,function),func)++
+ format_cover_call(cover:analyse(Module,calls,clause),clause)
+ end,
+ getModDate(Module,date())++"<BR>"++
+ "<TABLE WIDTH=\"100%\" BORDER=1>"
+ ++ Content ++"</TABLE>".
+
+
+format_cover_call({error,_},_)->
+ ["<TR><TD>\n",
+ "<BR><BR><BR><BR>\n",
+ "<FONT SIZE=5>The selected module is not Cover Compiled</FONT>\n",
+ "<BR>\n",
+ "</TD></TR>\n"];
+
+format_cover_call({ok,{Mod,Calls}},mod)->
+ ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Module calls</B></TD></TR>\n",
+ "<TR><TD COLSPAN=4><I>Module</I></TD>",
+ "<TD ALIGN=\"right\"><I>Number of calls</I></TD></TR>\n",
+ "<TR><TD COLSPAN=4>" ++ atom_to_list(Mod) ++"</TD>"
+ "<TD ALIGN=\"right\">" ++ integer_to_list(Calls)++"</TD></TR>\n"];
+
+format_cover_call({ok,Calls},func)->
+ ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Function calls</B></TD></TR>\n",
+ "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>",
+ "<TD COLSPAN=2 ALIGN=\"right\"><I>Arity</I></TD>",
+ "<TD ALIGN=\"right\"><I>Number of calls </I></TD></TR>\n",
+ lists:append(
+ lists:map(
+ fun({{Mod,Func,Arity},Nr_of_calls})->
+ ["<TR><TD WIDTH=\"20%\">"++ atom_to_list(Mod)++"</TD>\n",
+ "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++" </TD>\n",
+ "<TD COLSPAN=2 WIDTH=\"40%\" ALIGN=\"right\">",
+ integer_to_list(Arity),
+ "</TD>\n",
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Nr_of_calls),
+ "</TD></TR>\n"]
+ end,
+ Calls))];
+
+format_cover_call({ok,Calls},clause)->
+ ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=5><B>Clause calls</B></TD></TR>\n",
+ "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>",
+ "<TD ALIGN=\"right\"><I>Arity</I></TD>",
+ "<TD ALIGN=\"right\"><I>Ordinal</I></TD>",
+ "<TD ALIGN=\"right\"><I>Number of calls</I></TD></TR>\n",
+ lists:append(
+ lists:map(
+ fun({{Mod,Func,Arity,Ord},Nr_of_calls})->
+ ["<TR><TD WIDTH=\"20%\" >", atom_to_list(Mod), "</TD>\n",
+ "<TD WIDTH=\"20%\" >", atom_to_list(Func), "</TD>\n",
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Arity),
+ "</TD>\n",
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Ord),
+ "</TD>\n",
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Nr_of_calls),
+ "</TD></TR>\n"]
+ end,
+ Calls))].
+
+
+error_body()->
+ ["<TABLE WIDTH=\"100%\" BORDER=1>\n",
+ "<TR ALIGN=\"center\">\n",
+ "<TD>\n",
+ "<BR><BR><BR><BR><BR><BR>\n",
+ "<FONT SIZE=5>The selected module is not Cover Compiled</FONT>\n",
+ "<BR>\n",
+ "</TD>\n",
+ "</TR>\n",
+ "</TABLE>\n"].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% The functions that builds the body of the page that shows coverage %
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+coverage_result(Input)->
+ Mod = list_to_atom(get_input_data(Input, "module")),
+ case cover:analyse(Mod,coverage) of
+ {error,_}->
+ error_body();
+ {ok,_} ->
+ coverage_result2(Mod,Input)
+ end.
+
+coverage_result2(Mod,Input)->
+ Result =
+ case get_input_data(Input,"what") of
+ "mod" ->
+ coverage_result(mod,Mod);
+ "func" ->
+ coverage_result(func,Mod);
+ "clause" ->
+ coverage_result(clause,Mod);
+ _->
+ coverage_result(all,Mod)
+ end,
+ result_choice("coverage",Mod) ++ Result.
+
+coverage_result(Mode,Module)->
+ Content =
+ case Mode of
+ mod->
+ format_cover_coverage(cover:analyse(Module,coverage,module),
+ mod);
+ func->
+ format_cover_coverage(cover:analyse(Module,coverage,function),
+ func);
+ clause->
+ format_cover_coverage(cover:analyse(Module,coverage,clause),
+ clause);
+ _->
+ format_cover_coverage(cover:analyse(Module,coverage,module),
+ mod) ++
+ format_cover_coverage(cover:analyse(Module,coverage,function),
+ func)++
+ format_cover_coverage(cover:analyse(Module,coverage,clause),
+ clause)
+ end,
+ getModDate(Module,date())++"<BR>"++
+ "<TABLE WIDTH=\"100%\" BORDER=1>"
+ ++ Content ++"</TABLE>".
+
+getModDate(Module,{Year,Mon,Day})->
+ "<TABLE>
+ <TR>
+ <TD>Module:</TD>
+ <TD>" ++ atom_to_list(Module) ++ "</TD>
+ </TR>
+ <TR>
+ <TD>Date:</TD>
+ <TD>" ++ integer_to_list(Day) ++ "/" ++
+ integer_to_list(Mon) ++"&nbsp;-&nbsp;"++
+ integer_to_list(Year) ++
+ "</TD>
+ </TR>
+ </TABLE>".
+
+
+format_cover_coverage({error,_},_)->
+ "<TR><TD>
+ <BR><BR><BR><BR>
+ <FONT SIZE=5>The selected module is not Cover Compiled</FONT>
+ <BR>
+ </TD></TR>";
+
+
+format_cover_coverage({ok,{Mod,{Cov,Not_cov}}},mod)->
+ ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Module coverage</B></TD></TR>\n",
+ "<TR><TD COLSPAN=4><I>Module</I></TD>\n",
+ "<TD ALIGN=\"right\"><I>Covered</I></TD>\n"
+ "<TD ALIGN=\"RIGHT\" NOWRAP=\"true\"><I>Not Covered</I></TD>\n",
+ "</TR>\n",
+ "<TR><TD COLSPAN=4>", atom_to_list(Mod), "</TD>\n"
+ "<TD ALIGN=\"right\">", integer_to_list(Cov), "</TD>\n"
+ "<TD ALIGN=\"right\" >", integer_to_list(Not_cov), "</TD></TR>\n"];
+
+format_cover_coverage({ok,Cov_res},func)->
+ ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Function coverage</B></TD>\n",
+ "</TR>\n",
+ "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>",
+ "<TD ALIGN=\"right\"><I>Arity</I></TD>",
+ "<TD COLSPAN=2 ALIGN=\"right\"><I>Covered</I></TD>",
+ "<TD ALIGN=\"right\" STYLE=\"white-space:nowrap\"><I>Not Covered</I></TD>",
+ "</TR>\n",
+ lists:append(
+ lists:map(
+ fun({{Mod,Func,Arity},{Cov,Not_cov}})->
+ ["<TR><TD WIDTH=\"20%\" >"++ atom_to_list(Mod) ++" </TD>\n",
+ "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++"</TD>\n",
+ "<TD WIDTH=\"40%\" ALIGN=\"right\">",
+ integer_to_list(Arity),
+ "</TD>\n",
+ "<TD WIDTH=\"40%\" ALIGN=\"right\" COLSPAN=2>",
+ integer_to_list(Cov),
+ "</TD>\n"
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Not_cov),
+ "</TD></TR>\n"]
+ end,
+ Cov_res))];
+
+format_cover_coverage({ok,Cov_res},clause)->
+ ["<TR BGCOLOR=\"#8899AA\"><TD COLSPAN=6><B>Clause coverage</B></TD></TR>\n",
+ "<TR><TD><I>Module</I></TD><TD><I>Function</I></TD>\n",
+ "<TD ALIGN=\"right\"><I>Arity</I></TD>\n",
+ "<TD ALIGN=\"right\"><I>Ordinal<I></TD>\n",
+ "<TD ALIGN=\"right\">Covered</TD>\n",
+ "<TD ALIGN=\"right\" STYLE=\"white-space:nowrap\">Not Covered</TD></TR>\n",
+ lists:append(
+ lists:map(
+ fun({{Mod,Func,Arity,Ord},{Cov,Not_cov}})->
+ ["<TR><TD WIDTH=\"20%\" >"++ atom_to_list(Mod) ++"</TD>\n",
+ "<TD WIDTH=\"20%\" >" ++ atom_to_list(Func) ++" </TD>\n",
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Arity),
+ "</TD>\n"
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Ord),
+ "</TD>\n"
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Cov),
+ "</TD>\n"
+ "<TD WIDTH=\"20%\" ALIGN=\"right\">",
+ integer_to_list(Not_cov),
+ "</TD></TR>\n"]
+ end,
+ Cov_res))].
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% The functions that builds the body of the import page %
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+import_body(Dir,Err) ->
+ [reload_menu_script(Err),
+ "<H1 ALIGN=center>Import</H1>\n",
+ "<TABLE BORDER=0 WIDTH=600 ALIGN=center>\n",
+ "<TR><TD BGCOLOR=",?INFO_BG_COLOR,">\n",
+ "<P>You can import coverage data from a previous analysis. If you do so\n",
+ "the imported data will be merged with the current coverage data.\n",
+ "<P>You can export data from the current analysis from the \"Result\"\n",
+ "page.\n",
+ "<P>Select the file to import here.\n",
+ "</TD></TR>\n",
+ "<TR><TD ALIGN=center><BR><BR>\n",
+ "<FORM NAME=change_import_dir METHOD=post ACTION=\"./import\">\n",
+ "<B>Change directory:</B><BR>\n",
+ "<INPUT TYPE=text NAME=\"file\" SIZE=30 VALUE=",Dir,">",
+ "<INPUT TYPE=hidden NAME=dir VALUE=",Dir,">\n",
+ "<INPUT TYPE=submit VALUE=Ok><BR>\n",
+ "</FORM>\n",
+ browse_import(Dir),
+ "</TABLE>"].
+
+browse_import(Dir) ->
+ {ok,List} = file:list_dir(Dir),
+ Sorted = lists:reverse(lists:sort(List)),
+ {Dirs,Files} = filter_files(Dir,Sorted,[],[]),
+ ["<FORM NAME=browse_import METHOD=post ACTION=\"./import\">\n"
+ "<SELECT NAME=file TITLE=\"Select import file\" SIZE=10>\n",
+ "<OPTION VALUE=\"..\" onDblClick=submit()>../</OPTION>\n",
+ Dirs,
+ Files,
+ "</SELECT>\n",
+ "<INPUT TYPE=hidden NAME=dir VALUE=",Dir,">\n",
+ "<BR><INPUT TYPE=submit VALUE=Ok>\n"
+ "</FORM>\n"].
+
+filter_files(Dir,[File|Files],Ds,Fs) ->
+ case filename:extension(File) of
+ ".coverdata" ->
+ Fs1 = ["<OPTION VALUE=",File," onDblClick=submit()>",
+ File,"</OPTION>\n" | Fs],
+ filter_files(Dir,Files,Ds,Fs1);
+ _ ->
+ FullName = filename:join(Dir,File),
+ case filelib:is_dir(FullName) of
+ true ->
+ Ds1 = ["<OPTION VALUE=",File," onDblClick=submit()>",
+ File,"/</OPTION>\n" | Ds],
+ filter_files(Dir,Files,Ds1,Fs);
+ false ->
+ filter_files(Dir,Files,Ds,Fs)
+ end
+ end;
+filter_files(_Dir,[],Ds,Fs) ->
+ {Ds,Fs}.
+
+
+
+
+do_import(Input) ->
+ case parse(Input) of
+ [{"file",File0},{"dir",Dir}] ->
+ File = filename:join(Dir,File0),
+ case filelib:is_dir(File) of
+ true ->
+ import_frame1(File);
+ false ->
+ case filelib:is_file(File) of
+ true ->
+ case cover:import(File) of
+ ok ->
+ import_frame1(Dir);
+ {error,{cant_open_file,ExportFile,_Reason}} ->
+ import_frame1(Dir,
+ "Error importing file\\n\\\""
+ ++ ExportFile ++ "\\\"")
+ end;
+ false ->
+ import_frame1(Dir,
+ "Error importing file\\n\\\"" ++
+ File ++ "\\\"")
+ end
+ end;
+ [{"dir",Dir}] ->
+ import_frame1(Dir,"No file is selected")
+ end.
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% Different private helper functions %
+% %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%Create the Header for the page If we now the mimetype use that type %%
+%%otherwise use text %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+header() ->
+ header("text/html").
+header(MimeType) ->
+ "Pragma:no-cache\r\n" ++
+ "Content-type: " ++ MimeType ++ "\r\n\r\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%Create the Htmlheader set the title of the page %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+html_header(Title) ->
+ "<HTML>\n" ++
+ "<HEAD>\n" ++
+ "<TITLE>" ++ Title ++ "</TITLE>\n" ++
+ "</HEAD>\n"
+ "<BODY BGCOLOR=\"#FFFFFF\">\n".
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Close the body- and Html tags %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+html_end()->
+ "</BODY></HTML>".
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% A script which reloads the menu frame and possibly pops up an alert%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+reload_menu_script(Err) ->
+ ["<SCRIPT>\n",
+ "function reloadMenu()\n",
+ " {\n",
+ " parent.menu.document.location.href=\"./menu_frame\";\n",
+ case Err of
+ "" -> "";
+ _ -> " alert(\""++Err++"\");\n"
+ end,
+ case get_warnings() of
+ [] ->
+ "";
+ Warnings ->
+ " alert(\""++fix_newline(lists:flatten(Warnings))++"\");\n"
+ end,
+ " }\n",
+ "</SCRIPT>\n",
+ "<BODY onLoad=reloadMenu() BGCOLOR=\"#FFFFFF\">"].
+
+fix_newline([$\n|Rest]) ->
+ [$\\,$n|fix_newline(Rest)];
+fix_newline([$"|Rest]) ->
+ [$\\,$"|fix_newline(Rest)];
+fix_newline([Char|Rest]) ->
+ [Char|fix_newline(Rest)];
+fix_newline([]) ->
+ [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Control the input data and return the intresting values or error %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_input_data(Input,Key)->
+ case lists:keysearch(Key,1,parse(Input)) of
+ {value,{Key,Value}} ->
+ Value;
+ false ->
+ undefined
+ end.
+
+parse(Input) ->
+ httpd:parse_query(Input).
+
+
+get_warnings() ->
+ cover_group_leader_proc ! {self(), get_warnings},
+ receive {warnings,Warnings} ->
+ Warnings
+ end.
diff --git a/lib/tools/src/cprof.erl b/lib/tools/src/cprof.erl
new file mode 100644
index 0000000000..b0c3341efa
--- /dev/null
+++ b/lib/tools/src/cprof.erl
@@ -0,0 +1,142 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-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%
+%%
+-module(cprof).
+
+%% Call count profiling tool.
+
+-export ([start/0, start/1, start/2, start/3,
+ stop/0, stop/1, stop/2, stop/3,
+ restart/0, restart/1, restart/2, restart/3,
+ pause/0, pause/1, pause/2, pause/3,
+ analyse/0, analyse/1, analyse/2,
+ analyze/0, analyze/1, analyze/2]).
+
+
+
+start() ->
+ tr({'_','_','_'}, true) + tr(on_load, true).
+
+start({_,_,_} = MFA) ->
+ tr(MFA, true);
+start({FuncSpec}) ->
+ tr(FuncSpec, true);
+start(M) ->
+ tr({M,'_','_'}, true).
+
+start(M,F) ->
+ tr({M,F,'_'}, true).
+
+start(M,F,A) ->
+ tr({M,F,A}, true).
+
+
+
+stop() ->
+ tr({'_','_','_'}, false) + tr(on_load, false).
+
+stop({_,_,_} = MFA) ->
+ tr(MFA, false);
+stop({FuncSpec}) ->
+ tr(FuncSpec, false);
+stop(M) ->
+ tr({M,'_','_'}, false).
+
+stop(M,F) ->
+ tr({M,F,'_'}, false).
+
+stop(M,F,A) ->
+ tr({M,F,A}, false).
+
+
+
+restart() ->
+ tr({'_','_','_'}, restart).
+
+restart({_,_,_} = MFA) ->
+ tr(MFA, restart);
+restart({FuncSpec}) ->
+ tr(FuncSpec, restart);
+restart(M) ->
+ tr({M,'_','_'}, restart).
+
+restart(M,F) ->
+ tr({M,F,'_'}, restart).
+
+restart(M,F,A) ->
+ tr({M,F,A}, restart).
+
+
+
+pause() ->
+ tr({'_','_','_'}, pause) + tr(on_load, false).
+
+pause({_,_,_} = MFA) ->
+ tr(MFA, pause);
+pause({FuncSpec}) ->
+ tr(FuncSpec, pause);
+pause(M) ->
+ tr({M,'_','_'}, pause).
+
+pause(M,F) ->
+ tr({M,F,'_'}, pause).
+
+pause(M,F,A) ->
+ tr({M,F,A}, pause).
+
+
+
+analyse() ->
+ analyse(1).
+
+analyse(Limit) when is_integer(Limit) ->
+ L0 = [analyse(element(1, Mod), Limit) || Mod <- code:all_loaded()],
+ L1 = [{C,M,Lm} || {M,C,Lm} <- L0, C > 0, M =/= ?MODULE],
+ N = lists:foldl(fun ({C,_,_}, Q) -> Q+C end, 0, L1),
+ L = [{M,C,Lm} || {C,M,Lm} <- lists:reverse(lists:sort(L1))],
+ {N,L};
+analyse(M) when is_atom(M) ->
+ analyse(M, 1).
+
+analyse(M, Limit) when is_atom(M), is_integer(Limit) ->
+ L0 = [begin
+ MFA = {M,F,A},
+ {_,C} = erlang:trace_info(MFA, call_count),
+ [C|MFA]
+ end || {F,A} <- M:module_info(functions)],
+ L1 = [X || [C|_]=X <- L0, is_integer(C)],
+ N = lists:foldl(fun ([C|_], Q) -> Q+C end, 0, L1),
+ L2 = [X || [C|_]=X <- L1, C >= Limit],
+ L = [{MFA,C} || [C|MFA] <- lists:reverse(lists:sort(L2))],
+ {M,N,L}.
+
+
+
+analyze() ->
+ analyse().
+
+analyze(X) ->
+ analyse(X).
+
+analyze(X, Y) ->
+ analyse(X, Y).
+
+
+
+tr(FuncSpec, State) ->
+ erlang:trace_pattern(FuncSpec, State, [call_count]).
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}.
diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl
new file mode 100644
index 0000000000..155965a65a
--- /dev/null
+++ b/lib/tools/src/fprof.erl
@@ -0,0 +1,2762 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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%
+%%
+
+%%%----------------------------------------------------------------------
+%%% File : fprof.erl
+%%% Author : Raimo Niskanen <[email protected]>
+%%% Purpose : File tracing profiling tool wich accumulated times.
+%%% Created : 18 Jun 2001 by Raimo Niskanen <[email protected]>
+%%%----------------------------------------------------------------------
+
+-module(fprof).
+-author('[email protected]').
+
+%% External exports
+-export([
+ apply/2, apply/3, apply/4,
+ start/0, stop/0, stop/1,
+ trace/1, trace/2,
+ profile/0, profile/1, profile/2,
+ analyse/0, analyse/1, analyse/2]).
+%% Debug functions
+-export([get_state/0,
+ save_profile/0, save_profile/1, save_profile/2,
+ load_profile/0, load_profile/1, load_profile/2,
+ code_change/0]).
+
+%% Debug exports
+-export([call/1, just_call/1, reply/2]).
+-export([trace_off/0, trace_on/3]).
+-export([getopts/2, setopts/1]).
+-export([println/5, print_callers/2, print_func/2, print_called/2]).
+-export([trace_call_collapse/1]).
+-export([parsify/1]).
+
+%% Internal exports
+-export(['$code_change'/1]).
+
+
+
+-define(FNAME_WIDTH, 72).
+-define(NR_WIDTH, 15).
+
+-define(TRACE_FILE, "fprof.trace").
+-define(DUMP_FILE, "fprof.dump").
+-define(PROFILE_FILE, "fprof.profile").
+-define(ANALYSIS_FILE, "fprof.analysis").
+
+-define(FPROF_SERVER, fprof_server).
+-define(FPROF_SERVER_TIMEOUT, infinity).
+
+
+
+-define(debug, 9).
+%-define(debug, 0).
+-ifdef(debug).
+dbg(Level, F, A) when Level >= ?debug ->
+ io:format(F, A),
+ ok;
+dbg(_, _, _) ->
+ ok.
+-define(dbg(Level, F, A), dbg((Level), (F), (A))).
+-else.
+-define(dbg(Level, F, A), ok).
+-endif.
+
+
+
+%%%----------------------------------------------------------------------
+%%% Higher order API functions
+%%%----------------------------------------------------------------------
+
+
+
+apply({M, F} = Function, Args)
+ when is_atom(M), is_atom(F), is_list(Args) ->
+ apply_1(Function, Args, []);
+apply(Fun, Args)
+ when is_function(Fun), is_list(Args) ->
+ apply_1(Fun, Args, []);
+apply(A, B) ->
+ erlang:error(badarg, [A, B]).
+
+apply(M, F, Args) when is_atom(M), is_atom(F), is_list(Args) ->
+ apply_1({M, F}, Args, []);
+apply({M, F} = Function, Args, Options)
+ when is_atom(M), is_atom(F), is_list(Args), is_list(Options) ->
+ apply_1(Function, Args, Options);
+apply(Fun, Args, Options)
+ when is_function(Fun), is_list(Args), is_list(Options) ->
+ apply_1(Fun, Args, Options);
+apply(A, B, C) ->
+ erlang:error(badarg, [A, B, C]).
+
+apply(Module, Function, Args, Options)
+ when is_atom(Module), is_atom(Function), is_list(Args), is_list(Options) ->
+ apply_1({Module, Function}, Args, Options);
+apply(A, B, C, D) ->
+ erlang:error(badarg, [A, B, C, D]).
+
+
+apply_1(Function, Args, Options) ->
+ {[_, Procs, Continue], Options_1} =
+ getopts(Options, [start, procs, continue]),
+ Procs_1 = case Procs of
+ [{procs, P}] when is_list(P) ->
+ P;
+ _ ->
+ []
+ end,
+ case Continue of
+ [] ->
+ apply_start_stop(Function, Args, Procs_1, Options_1);
+ [continue] ->
+ apply_continue(Function, Args, Procs_1, Options_1);
+ _ ->
+ erlang:error(badarg, [Function, Args, Options])
+ end.
+
+
+
+apply_start_stop(Function, Args, Procs, Options) ->
+ Ref = make_ref(),
+ Parent = self(),
+ Child =
+ spawn(
+ fun() ->
+ MRef = erlang:monitor(process, Parent),
+ receive
+ {Parent, Ref, start_trace} ->
+ case trace([start,
+ {procs, [Parent | Procs]}
+ | Options]) of
+ ok ->
+ catch Parent ! {self(), Ref, trace_started},
+ receive
+ {Parent, Ref, stop_trace} ->
+ trace([stop]),
+ catch Parent
+ ! {self(), Ref, trace_stopped},
+ done;
+ {'DOWN', MRef, _, _, _} ->
+ trace([stop])
+ end;
+ {error, Reason} ->
+ exit(Reason)
+ end;
+ {'DOWN', MRef, _, _, _} ->
+ done
+ end
+ end),
+ MRef = erlang:monitor(process, Child),
+ catch Child ! {self(), Ref, start_trace},
+ receive
+ {Child, Ref, trace_started} ->
+ try erlang:apply(Function, Args)
+ after
+ catch Child ! {self(), Ref, stop_trace},
+ receive
+ {Child, Ref, trace_stopped} ->
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ end;
+ {'DOWN', MRef, _, _, _} ->
+ trace([stop])
+ end
+ end;
+ {'DOWN', MRef, _, _, Reason} ->
+ exit(Reason)
+ end.
+
+apply_continue(Function, Args, Procs, Options) ->
+ Ref = make_ref(),
+ Parent = self(),
+ Child =
+ spawn(
+ fun() ->
+ MRef = erlang:monitor(process, Parent),
+ receive
+ {Parent, Ref, start_trace} ->
+ case trace([start,
+ {procs, [Parent | Procs]}
+ | Options]) of
+ ok ->
+ exit({Ref, trace_started});
+ {error, Reason} ->
+ exit(Reason)
+ end;
+ {'DOWN', MRef, _, _, _} ->
+ done
+ end
+ end),
+ MRef = erlang:monitor(process, Child),
+ catch Child ! {self(), Ref, start_trace},
+ receive
+ {'DOWN', MRef, _, _, {Ref, trace_started}} ->
+ erlang:apply(Function, Args);
+ {'DOWN', MRef, _, _, Reason} ->
+ exit(Reason)
+ end.
+
+
+
+%%%----------------------------------------------------------------------
+%%% Requests to ?FPROF_SERVER
+%%%----------------------------------------------------------------------
+
+-record(trace_start, {procs, % List of processes
+ mode, % normal | verbose
+ type, % file | tracer
+ dest}). % Filename | Pid/Port
+
+-record(trace_stop, {}).
+
+% -record(open_out, {file}).
+
+% -record(close_out, {}).
+
+-record(profile, {src, % Filename
+ group_leader, % IoPid
+ dump, % Filename | IoPid
+ flags}). % List
+
+-record(profile_start, {group_leader, % IoPid
+ dump, % Filename | IoPid
+ flags}). % List
+
+-record(profile_stop, {}).
+
+-record(analyse, {group_leader, % IoPid
+ dest, % Filename | IoPid
+ flags, % List
+ cols, % Integer
+ callers, % Boolean
+ sort, % acc_r | own_r
+ totals, % Boolean
+ details}). % Boolean
+
+-record(stop, {
+ reason}).
+
+
+
+%%---------------
+%% Debug requests
+%%---------------
+
+-record(get_state, {}).
+
+-record(save_profile, {file}).
+
+-record(load_profile, {file}).
+
+
+
+%%%----------------------------------------------------------------------
+%%% Basic API functions
+%%%----------------------------------------------------------------------
+
+
+
+trace(start, Filename) ->
+ trace([start, {file, Filename}]);
+trace(verbose, Filename) ->
+ trace([start, verbose, {file, Filename}]);
+trace(Option, Value) when is_atom(Option) ->
+ trace([{Option, Value}]);
+trace(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+trace(stop) ->
+ %% This shortcut is present to minimize the number of undesired
+ %% function calls at the end of the trace.
+ call(#trace_stop{});
+trace(verbose) ->
+ trace([start, verbose]);
+trace([stop]) ->
+ %% This shortcut is present to minimize the number of undesired
+ %% function calls at the end of the trace.
+ call(#trace_stop{});
+trace({Opt, _Val} = Option) when is_atom(Opt) ->
+ trace([Option]);
+trace(Option) when is_atom(Option) ->
+ trace([Option]);
+trace(Options) when is_list(Options) ->
+ case getopts(Options,
+ [start, stop, procs, verbose, file, tracer, cpu_time]) of
+ {[[], [stop], [], [], [], [], []], []} ->
+ call(#trace_stop{});
+ {[[start], [], Procs, Verbose, File, Tracer, CpuTime], []} ->
+ {Type, Dest} = case {File, Tracer} of
+ {[], [{tracer, Pid} = T]}
+ when is_pid(Pid); is_port(Pid) ->
+ T;
+ {[file], []} ->
+ {file, ?TRACE_FILE};
+ {[{file, []}], []} ->
+ {file, ?TRACE_FILE};
+ {[{file, _} = F], []} ->
+ F;
+ {[], []} ->
+ {file, ?TRACE_FILE};
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ V = case Verbose of
+ [] -> normal;
+ [verbose] -> verbose;
+ [{verbose, true}] -> verbose;
+ [{verbose, false}] -> normal;
+ _ -> erlang:error(badarg, [Options])
+ end,
+ CT = case CpuTime of
+ [] -> wallclock;
+ [cpu_time] -> cpu_time;
+ [{cpu_time, true}] -> cpu_time;
+ [{cpu_time, false}] -> wallclock;
+ _ -> erlang:error(badarg, [Options])
+ end,
+ call(#trace_start{procs = case Procs of
+ [] ->
+ [self()];
+ [{procs, P}] when is_list(P) ->
+ P;
+ [{procs, P}] ->
+ [P];
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ mode = {V, CT},
+ type = Type,
+ dest = Dest});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+trace(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+profile() ->
+ profile([]).
+
+profile(Option, Value) when is_atom(Option) ->
+ profile([{Option, Value}]);
+profile(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+profile(Option) when is_atom(Option) ->
+ profile([Option]);
+profile({Opt, _Val} = Option) when is_atom(Opt) ->
+ profile([Option]);
+profile(Options) when is_list(Options) ->
+ case getopts(Options, [start, stop, file, dump, append]) of
+ {[Start, [], File, Dump, Append], []} ->
+ {Target, Flags} =
+ case {Dump, Append} of
+ {[], []} ->
+ {[], []};
+ {[dump], []} ->
+ {group_leader(), []};
+ {[{dump, []}], []} ->
+ {?DUMP_FILE, []};
+ {[{dump, []}], [append]} ->
+ {?DUMP_FILE, [append]};
+ {[{dump, D}], [append]} when is_pid(D) ->
+ erlang:error(badarg, [Options]);
+ {[{dump, D}], [append]} ->
+ {D, [append]};
+ {[{dump, D}], []} ->
+ {D, []};
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ case {Start, File} of
+ {[start], []} ->
+ call(#profile_start{group_leader = group_leader(),
+ dump = Target,
+ flags = Flags});
+ {[], _} ->
+ Src =
+ case File of
+ [] ->
+ ?TRACE_FILE;
+ [file] ->
+ ?TRACE_FILE;
+ [{file, []}] ->
+ ?TRACE_FILE;
+ [{file, F}] ->
+ F;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ call(#profile{src = Src,
+ group_leader = group_leader(),
+ dump = Target,
+ flags = Flags});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+ {[[], [stop], [], [], []], []} ->
+ call(#profile_stop{});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+profile(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+analyse() ->
+ analyse([]).
+
+analyse(Option, Value) when is_atom(Option) ->
+ analyse([{Option, Value}]);
+analyse(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+analyse(Option) when is_atom(Option) ->
+ analyse([Option]);
+analyse({Opt, _Val} = Option) when is_atom(Opt) ->
+ analyse([Option]);
+analyse(Options) when is_list(Options) ->
+ case getopts(Options,
+ [dest, append, cols, callers, no_callers,
+ sort, totals, details, no_details]) of
+ {[Dest, Append, Cols, Callers, NoCallers,
+ Sort, Totals, Details, NoDetails], []} ->
+ {Target, Flags} =
+ case {Dest, Append} of
+ {[], []} ->
+ {group_leader(), []};
+ {[dest], []} ->
+ {group_leader(), []};
+ {[{dest, []}], []} ->
+ {?ANALYSIS_FILE, []};
+ {[{dest, []}], [append]} ->
+ {?ANALYSIS_FILE, [append]};
+ {[{dest, F}], [append]} when is_pid(F) ->
+ erlang:error(badarg, [Options]);
+ {[{dest, F}], [append]} ->
+ {F, [append]};
+ {[{dest, F}], []} ->
+ {F, []};
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ call(#analyse{group_leader = group_leader(),
+ dest = Target,
+ flags = Flags,
+ cols = case Cols of
+ [] ->
+ 80;
+ [{cols, C}] when is_integer(C), C > 0 ->
+ C;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ callers = case {Callers, NoCallers} of
+ {[], []} ->
+ true;
+ {[callers], []} ->
+ true;
+ {[{callers, true}], []} ->
+ true;
+ {[{callers, false}], []} ->
+ false;
+ {[], [no_callers]} ->
+ false;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ sort = case Sort of
+ [] ->
+ acc;
+ [{sort, acc}] ->
+ acc;
+ [{sort, own}] ->
+ own;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ totals = case Totals of
+ [] ->
+ false;
+ [totals] ->
+ true;
+ [{totals, true}] ->
+ true;
+ [{totals, false}] ->
+ false;
+ _ ->
+ erlang:error(badarg, [Options])
+ end,
+ details = case {Details, NoDetails} of
+ {[], []} ->
+ true;
+ {[details], []} ->
+ true;
+ {[{details, true}], []} ->
+ true;
+ {[{details, false}], []} ->
+ false;
+ {[], [no_details]} ->
+ false;
+ _ ->
+ erlang:error(badarg, [Options])
+ end});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+analyse(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+%%----------------
+%% Debug functions
+%%----------------
+
+
+
+get_state() ->
+ just_call(#get_state{}).
+
+
+
+save_profile() ->
+ save_profile([]).
+
+save_profile(Option, Value) when is_atom(Option) ->
+ save_profile([{Option, Value}]);
+save_profile(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+save_profile(Option) when is_atom(Option) ->
+ save_profile([Option]);
+save_profile(Options) when is_list(Options) ->
+ case getopts(Options, [file]) of
+ {[File], []} ->
+ call(#save_profile{file = case File of
+ [] ->
+ ?PROFILE_FILE;
+ [{file, F}] ->
+ F;
+ _ ->
+ erlang:error(badarg, [Options])
+ end});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+save_profile(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+load_profile() ->
+ load_profile([]).
+
+load_profile(Option, Value) when is_atom(Option) ->
+ load_profile([{Option, Value}]);
+load_profile(Option, Value) ->
+ erlang:error(badarg, [Option, Value]).
+
+load_profile(Option) when is_atom(Option) ->
+ load_profile([Option]);
+load_profile(Options) when is_list(Options) ->
+ case getopts(Options, [file]) of
+ {[File], []} ->
+ call(#load_profile{file = case File of
+ [] ->
+ ?PROFILE_FILE;
+ [{file, F}] ->
+ F;
+ _ ->
+ erlang:error(badarg, [Options])
+ end});
+ _ ->
+ erlang:error(badarg, [Options])
+ end;
+load_profile(Options) ->
+ erlang:error(badarg, [Options]).
+
+
+
+code_change() ->
+ just_call('$code_change').
+
+
+
+%%%----------------------------------------------------------------------
+%%% ETS table record definitions
+%%% The field 'id' must be first in these records;
+%%% it is the common ets table index field.
+%%%----------------------------------------------------------------------
+
+-record(clocks, {
+ id,
+ cnt = 0, % Number of calls
+ own = 0, % Own time (wall clock)
+ acc = 0}). % Accumulated time : own + subfunctions (wall clock)
+
+-record(proc, {
+ id,
+ parent,
+ spawned_as, % Spawned MFArgs
+ init_log = [], % List of first calls, head is newest
+ init_cnt = 2}). % First calls counter, counts down to 0
+
+-record(misc, {id,
+ data}).
+
+
+
+%% Analysis summary record
+-record(funcstat, {
+ callers_sum, % #clocks{id = {Pid, Caller, Func}}
+ called_sum, % #clocks{id = {Pid, Caller, Func}}
+ callers = [], % [#clocks{}, ...]
+ called = []}). % [#clocks{}, ...]
+
+
+
+%%%----------------------------------------------------------------------
+%%% ?FPROF_SERVER
+%%%----------------------------------------------------------------------
+
+%%%-------------------
+%%% Exported functions
+%%%-------------------
+
+%% Start server process
+start() ->
+ spawn_3step(
+ fun () ->
+ try register(?FPROF_SERVER, self()) of
+ true ->
+ process_flag(trap_exit, true),
+ {{ok, self()}, loop}
+ catch
+ error:badarg ->
+ {{error, {already_started, whereis(?FPROF_SERVER)}},
+ already_started}
+ end
+ end,
+ fun (X) ->
+ X
+ end,
+ fun (loop) ->
+ put(trace_state, idle),
+ put(profile_state, {idle, undefined}),
+ put(pending_stop, []),
+ server_loop([]);
+ (already_started) ->
+ ok
+ end).
+
+
+
+%% Stop server process
+
+stop() ->
+ stop(normal).
+
+stop(kill) ->
+ case whereis(?FPROF_SERVER) of
+ undefined ->
+ ok;
+ Pid ->
+ exit(Pid, kill),
+ ok
+ end;
+stop(Reason) ->
+ just_call(#stop{reason = Reason}),
+ ok.
+
+
+
+%%%------------------------
+%%% Client helper functions
+%%%------------------------
+
+%% Send request to server process and return the server's reply.
+%% First start server if it ain't started.
+call(Request) ->
+ case whereis(?FPROF_SERVER) of
+ undefined ->
+ start(),
+ just_call(Request);
+ Server ->
+ just_call(Server, Request)
+ end.
+
+%% Send request to server process, and return the server's reply.
+%% Returns {'EXIT', Pid, Reason} if the server dies during the
+%% call, or if it wasn't started.
+just_call(Request) ->
+ just_call(whereis(?FPROF_SERVER), Request).
+
+just_call(undefined, _) ->
+ {'EXIT', ?FPROF_SERVER, noproc};
+just_call(Pid, Request) ->
+ Mref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Mref, _, _, Reason} ->
+ {'EXIT', Pid, Reason}
+ after 0 ->
+ Tag = {Mref, self()},
+ {T, Demonitor} = case Request of
+ #stop{} ->
+ {?FPROF_SERVER_TIMEOUT, false};
+ _ ->
+ {0, true}
+ end,
+ %% io:format("~p request: ~p~n", [?MODULE, Request]),
+ catch Pid ! {?FPROF_SERVER, Tag, Request},
+ receive
+ {?FPROF_SERVER, Mref, Reply} ->
+ case Demonitor of
+ true -> erlang:demonitor(Mref);
+ false -> ok
+ end,
+ receive {'DOWN', Mref, _, _, _} -> ok after T -> ok end,
+ Reply;
+ {'DOWN', Mref, _, _, Reason} ->
+ receive {?FPROF_SERVER, Mref, _} -> ok after T -> ok end,
+ {'EXIT', Pid, Reason}
+ after ?FPROF_SERVER_TIMEOUT ->
+ timeout
+ end
+ end.
+
+
+
+%%%------------------------
+%%% Server helper functions
+%%%------------------------
+
+%% Return the reply to the client's request.
+reply({Mref, Pid}, Reply) when is_reference(Mref), is_pid(Pid) ->
+ catch Pid ! {?FPROF_SERVER, Mref, Reply},
+ ok.
+
+
+
+server_loop(State) ->
+ receive
+ {?FPROF_SERVER, {Mref, Pid} = Tag, '$code_change'}
+ when is_reference(Mref), is_pid(Pid) ->
+ reply(Tag, ok),
+ ?MODULE:'$code_change'(State);
+ {?FPROF_SERVER, {Mref, Pid} = Tag, Request}
+ when is_reference(Mref), is_pid(Pid) ->
+ server_loop(handle_req(Request, Tag, State));
+ Other ->
+ server_loop(handle_other(Other, State))
+ end.
+
+%-export.
+'$code_change'(State) ->
+ case lists:keysearch(time, 1, module_info(compile)) of
+ {value, {time, {Y, M, D, HH, MM, SS}}} ->
+ io:format("~n~w: code change to compile time "
+ ++"~4..0w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w~n",
+ [?MODULE, Y, M, D, HH, MM, SS]);
+ false ->
+ ok
+ end,
+ server_loop(State).
+
+
+
+%% Server help function that stops the server iff the
+%% sub state machines are in proper states. Sends the reply
+%% to all waiting clients.
+try_pending_stop(State) ->
+ case {get(trace_state), get(profile_state), get(pending_stop)} of
+ {idle, {idle, _}, [_|_] = PendingStop} ->
+ Reason = get(stop_reason),
+ Reply = result(Reason),
+ lists:foreach(
+ fun (Tag) ->
+ reply(Tag, Reply)
+ end,
+ PendingStop),
+ exit(Reason);
+ _ ->
+ State
+ end.
+
+%%------------------
+%% Server handle_req
+%%------------------
+
+handle_req(#trace_start{procs = Procs,
+ mode = Mode,
+ type = file,
+ dest = Filename}, Tag, State) ->
+ case {get(trace_state), get(pending_stop)} of
+ {idle, []} ->
+ trace_off(),
+ Port = open_dbg_trace_port(file, Filename),
+ case trace_on(Procs, Port, Mode) of
+ ok ->
+ put(trace_state, running),
+ put(trace_type, file),
+ put(trace_pid, Port),
+ reply(Tag, ok),
+ State;
+ Error ->
+ reply(Tag, Error),
+ State
+ end;
+ _ ->
+ reply(Tag, {error, already_tracing}),
+ State
+ end;
+handle_req(#trace_start{procs = Procs,
+ mode = Mode,
+ type = tracer,
+ dest = Tracer}, Tag, State) ->
+ case {get(trace_state), get(pending_stop)} of
+ {idle, []} ->
+ trace_off(),
+ case trace_on(Procs, Tracer, Mode) of
+ ok ->
+ put(trace_state, running),
+ put(trace_type, tracer),
+ put(trace_pid, Tracer),
+ reply(Tag, ok),
+ State;
+ Error ->
+ reply(Tag, Error),
+ State
+ end;
+ _ ->
+ reply(Tag, {error, already_tracing}),
+ State
+ end;
+
+handle_req(#trace_stop{}, Tag, State) ->
+ case get(trace_state) of
+ running ->
+ TracePid = get(trace_pid),
+ trace_off(),
+ case erase(trace_type) of
+ file ->
+ catch erlang:port_close(TracePid),
+ put(trace_state, stopping),
+ put(trace_tag, Tag),
+ State;
+ tracer ->
+ erase(trace_pid),
+ put(trace_state, idle),
+ case {get(profile_state), get(profile_type),
+ get(profile_pid)} of
+ {running, tracer, TracePid} ->
+ exit(TracePid, normal),
+ put(profile_tag, Tag),
+ State;
+ _ ->
+ reply(Tag, ok),
+ try_pending_stop(State)
+ end
+ end;
+ _ ->
+ reply(Tag, {error, not_tracing}),
+ State
+ end;
+
+handle_req(#profile{src = Filename,
+ group_leader = GroupLeader,
+ dump = Dump,
+ flags = Flags}, Tag, State) ->
+ case {get(profile_state), get(pending_stop)} of
+ {{idle, _}, []} ->
+ case ensure_open(Dump, [write | Flags]) of
+ {already_open, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, false);
+ {ok, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, true);
+ {error, _} = Error ->
+ reply(Tag, Error),
+ State
+ end,
+ Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]),
+ Pid = spawn_link_dbg_trace_client(Filename, Table,
+ GroupLeader,
+ get(profile_dump)),
+ put(profile_state, running),
+ put(profile_type, file),
+ put(profile_pid, Pid),
+ put(profile_tag, Tag),
+ put(profile_table, Table),
+ State;
+ _ ->
+ reply(Tag, {error, already_profiling}),
+ State
+ end;
+
+handle_req(#profile_start{group_leader = GroupLeader,
+ dump = Dump,
+ flags = Flags}, Tag, State) ->
+ case {get(profile_state), get(pending_stop)} of
+ {{idle, _}, []} ->
+ case ensure_open(Dump, [write | Flags]) of
+ {already_open, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, false);
+ {ok, DumpPid} ->
+ put(profile_dump, DumpPid),
+ put(profile_close_dump, true);
+ {error, _} = Error ->
+ reply(Tag, Error),
+ State
+ end,
+ Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]),
+ Pid = spawn_link_trace_client(Table, GroupLeader,
+ get(profile_dump)),
+ put(profile_state, running),
+ put(profile_type, tracer),
+ put(profile_pid, Pid),
+ put(profile_table, Table),
+ reply(Tag, {ok, Pid}),
+ State;
+ _ ->
+ reply(Tag, {error, already_profiling}),
+ State
+ end;
+
+handle_req(#profile_stop{}, Tag, State) ->
+ case {get(profile_state), get(profile_type)} of
+ {running, tracer} ->
+ ProfilePid = get(profile_pid),
+ case {get(trace_state), get(trace_type), get(trace_pid)} of
+ {running, tracer, ProfilePid} ->
+ trace_off(),
+ erase(trace_type),
+ erase(trace_pid),
+ put(trace_state, idle);
+ _ ->
+ ok
+ end,
+ exit(ProfilePid, normal),
+ put(profile_tag, Tag),
+ State;
+ {running, file} ->
+ reply(Tag, {error, profiling_file}),
+ State;
+ {_, _} ->
+ reply(Tag, {error, not_profiling}),
+ State
+ end;
+
+handle_req(#analyse{dest = Dest,
+ 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.
+
+
+
+info_dots(GroupLeader, GroupLeader, _) ->
+ ok;
+info_dots(GroupLeader, _, N) ->
+ if (N rem 100000) =:= 0 ->
+ io:format(GroupLeader, ",~n", []);
+ (N rem 50000) =:= 0 ->
+ io:format(GroupLeader, ".~n", []);
+ (N rem 1000) =:= 0 ->
+ io:put_chars(GroupLeader, ".");
+ true ->
+ ok
+ end.
+
+info_suspect_call(GroupLeader, GroupLeader, _, _) ->
+ ok;
+info_suspect_call(GroupLeader, _, Func, Pid) ->
+ io:format(GroupLeader,
+ "~nWarning: ~p called in ~p - trace may become corrupt!~n",
+ parsify([Func, Pid])).
+
+info(GroupLeader, GroupLeader, _, _) ->
+ ok;
+info(GroupLeader, _, Format, List) ->
+ io:format(GroupLeader, Format, List).
+
+dump_stack(undefined, _, _) ->
+ false;
+dump_stack(Dump, Stack, Term) ->
+ {Depth, _D} =
+ case Stack of
+ undefined ->
+ {0, 0};
+ _ ->
+ case length(Stack) of
+ 0 ->
+ {0, 0};
+ N ->
+ {N, length(hd(Stack))}
+ end
+ end,
+ io:format(Dump, "~s~p.~n", [lists:duplicate(Depth, " "), parsify(Term)]),
+ true.
+
+dump(undefined, _) ->
+ false;
+dump(Dump, Term) ->
+ io:format(Dump, "~p.~n", [parsify(Term)]),
+ true.
+
+
+
+%%%----------------------------------
+%%% Profiling state machine functions
+%%%----------------------------------
+
+
+
+trace_handler({trace_ts, Pid, call, _MFA, _TS} = Trace,
+ _Table, _, Dump) ->
+ Stack = get(Pid),
+ dump_stack(Dump, Stack, Trace),
+ throw({incorrect_trace_data, ?MODULE, ?LINE,
+ [Trace, Stack]});
+trace_handler({trace_ts, Pid, call, {_M, _F, Arity} = Func,
+ {cp, CP}, TS} = Trace,
+ Table, GroupLeader, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ case Func of
+ {erlang, trace, 3} ->
+ info_suspect_call(GroupLeader, Dump, Func, Pid);
+ {erlang, trace_pattern, 3} ->
+ info_suspect_call(GroupLeader, Dump, Func, Pid);
+ _ ->
+ ok
+ end,
+ trace_call(Table, Pid, Func, TS, CP),
+ TS;
+trace_handler({trace_ts, Pid, call, {_M, _F, Args} = MFArgs,
+ {cp, CP}, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_call(Table, Pid, Func, TS, CP),
+ TS;
+%%
+%% return_to
+trace_handler({trace_ts, Pid, return_to, undefined, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_return_to(Table, Pid, undefined, TS),
+ TS;
+trace_handler({trace_ts, Pid, return_to, {_M, _F, Arity} = Func, TS} = Trace,
+ Table, _, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_return_to(Table, Pid, Func, TS),
+ TS;
+trace_handler({trace_ts, Pid, return_to, {_M, _F, Args} = MFArgs, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_return_to(Table, Pid, Func, TS),
+ TS;
+%%
+%% spawn
+trace_handler({trace_ts, Pid, spawn, Child, MFArgs, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_spawn(Table, Child, MFArgs, TS, Pid),
+ TS;
+%%
+%% exit
+trace_handler({trace_ts, Pid, exit, _Reason, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_exit(Table, Pid, TS),
+ TS;
+%%
+%% out
+trace_handler({trace_ts, Pid, out, 0, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_out(Table, Pid, undefined, TS),
+ TS;
+trace_handler({trace_ts, Pid, out, {_M, _F, Arity} = Func, TS} = Trace,
+ Table, _, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_out(Table, Pid, Func, TS),
+ TS;
+trace_handler({trace_ts, Pid, out, {_M, _F, Args} = MFArgs, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_out(Table, Pid, Func, TS),
+ TS;
+%%
+%% in
+trace_handler({trace_ts, Pid, in, 0, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_in(Table, Pid, undefined, TS),
+ TS;
+trace_handler({trace_ts, Pid, in, {_M, _F, Arity} = Func, TS} = Trace,
+ Table, _, Dump)
+ when is_integer(Arity) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_in(Table, Pid, Func, TS),
+ TS;
+trace_handler({trace_ts, Pid, in, {_M, _F, Args} = MFArgs, TS} = Trace,
+ Table, _, Dump)
+ when is_list(Args) ->
+ dump_stack(Dump, get(Pid), Trace),
+ Func = mfarity(MFArgs),
+ trace_in(Table, Pid, Func, TS),
+ TS;
+%%
+%% gc_start
+trace_handler({trace_ts, Pid, gc_start, _Func, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_gc_start(Table, Pid, TS),
+ TS;
+%%
+%% gc_end
+trace_handler({trace_ts, Pid, gc_end, _Func, TS} = Trace,
+ Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ trace_gc_end(Table, Pid, TS),
+ TS;
+%%
+%% link
+trace_handler({trace_ts, Pid, link, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% unlink
+trace_handler({trace_ts, Pid, unlink, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% getting_linked
+trace_handler({trace_ts, Pid, getting_linked, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% getting_unlinked
+trace_handler({trace_ts, Pid, getting_unlinked, _OtherPid, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% register
+trace_handler({trace_ts, Pid, register, _Name, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% unregister
+trace_handler({trace_ts, Pid, unregister, _Name, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% send
+trace_handler({trace_ts, Pid, send, _OtherPid, _Msg, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% 'receive'
+trace_handler({trace_ts, Pid, 'receive', _Msg, TS} = Trace,
+ _Table, _, Dump) ->
+ dump_stack(Dump, get(Pid), Trace),
+ TS;
+%%
+%% Others
+trace_handler(Trace, _Table, _, Dump) ->
+ dump(Dump, Trace),
+ throw({incorrect_trace_data, ?MODULE, ?LINE, [Trace]}).
+
+
+
+%% The call stack
+%% --------------
+%%
+%% The call stack can be modeled as a tree, with each level in the tree
+%% corresponding to a real (non-tail recursive) stack entry,
+%% and the nodes within a level corresponding to tail recursive
+%% calls on that real stack depth.
+%%
+%% Example:
+%% a() ->
+%% b().
+%% b() ->
+%% c(),
+%% d().
+%% c() -> ok.
+%% d() ->
+%% e(),
+%% c().
+%% e() ->
+%% f().
+%% f() -> ok.
+%%
+%% During the execution the call tree would be, for each call and return_to:
+%%
+%% a() b() c() ->b d() e() f() ->d c() ->a
+%%
+%% a a a a a a a a a a
+%% | | | |\ |\ |\ |\ /|\
+%% b b b b d b d b d b d b d c
+%% | | /|
+%% c e e f
+%%
+%% The call tree is in this code represented as a two level list,
+%% which for the biggest tree (5 nodes) in the example above would be:
+%% [[{f, _}, {e, _}], [{d, _}, {b, _}], [{a, _}]]
+%% where the undefined fields are timestamps of the calls to the
+%% functions, and the function name fields are really
+%% {Module, Function, Arity} tuples.
+%%
+%% Since tail recursive calls can form an infinite loop, cycles
+%% within a tail recursive level must be collapsed or else the
+%% stack (tree) size may grow towards infinity.
+
+
+
+trace_call(Table, Pid, Func, TS, CP) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_call(~p, ~p, ~p, ~p)~n~p~n",
+ [Pid, Func, TS, CP, Stack]),
+ {Proc,InitCnt} =
+ case ets:lookup(Table, Pid) of
+ [#proc{init_cnt = N} = P] ->
+ {P,N};
+ [] ->
+ {undefined,0}
+ end,
+ case Stack of
+ [] ->
+ init_log(Table, Proc, Func),
+ OldStack =
+ if CP =:= undefined ->
+ Stack;
+ true ->
+ [[{CP, TS}]]
+ end,
+ put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack));
+ [[{Func, FirstInTS}]] when InitCnt=:=2 ->
+ %% First call on this process. Take the timestamp for first
+ %% time the process was scheduled in.
+ init_log(Table, Proc, Func),
+ OldStack =
+ if CP =:= undefined ->
+ [];
+ true ->
+ [[{CP, FirstInTS}]]
+ end,
+ put(Pid, trace_call_push(Table, Pid, Func, FirstInTS, OldStack));
+ [[{suspend, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, CP, Stack]});
+ [[{garbage_collect, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, CP, Stack]});
+ [[{CP, _} | _], [{CP, _} | _] | _] ->
+ %% This is a difficult case - current function becomes
+ %% new stack top but is already pushed. It might be that
+ %% this call is actually tail recursive, or maybe not.
+ %% Assume tail recursive to not build the stack infinitely
+ %% and fix the problem at the next call after a return to
+ %% this level.
+ %%
+ %% This can be viewed as collapsing a very short stack
+ %% recursive stack cykle.
+ init_log(Table, Proc, Func),
+ put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack));
+ [[{CP, _} | _] | _] ->
+ %% Current function becomes new stack top -> stack push
+ init_log(Table, Proc, Func),
+ put(Pid, trace_call_push(Table, Pid, Func, TS, Stack));
+ [_, [{CP, _} | _] | _] ->
+ %% Stack top unchanged -> no push == tail recursive call
+ init_log(Table, Proc, Func),
+ put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack));
+ [[{Func0, _} | _], [{Func0, _} | _], [{CP, _} | _] | _] ->
+ %% Artificial case that only should happen when
+ %% stack recursive short cycle collapsing has been done,
+ %% otherwise CP should not occur so far from the stack front.
+ %%
+ %% It is a tail recursive call but fix the stack first.
+ init_log(Table, Proc, Func),
+ put(Pid,
+ trace_call_shove(Table, Pid, Func, TS,
+ trace_return_to_int(Table, Pid, Func0, TS,
+ Stack)));
+ [[{_, TS0} | _] = Level0] ->
+ %% Current function known, but not stack top
+ %% -> assume tail recursive call
+ init_log(Table, Proc, Func),
+ OldStack =
+ if CP =:= undefined ->
+ Stack;
+ true ->
+ [Level0, [{CP, TS0}]]
+ end,
+ put(Pid, trace_call_shove(Table, Pid, Func, TS, OldStack));
+ [_ | _] ->
+ %% Weird case when the stack is seriously f***ed up.
+ %% CP is not at stack top nor at previous stack top,
+ %% which is impossible, if we had a correct stack view.
+ OldStack =
+ if CP =:= undefined ->
+ %% Assume that CP is unknown because it is
+ %% the stack bottom for the process, and that
+ %% the whole call stack is invalid. Waste it.
+ trace_return_to_int(Table, Pid, CP, TS, Stack);
+ true ->
+ %% Assume that we have collapsed a tail recursive
+ %% call stack cykle too many. Introduce CP in
+ %% the current tail recursive level so it at least
+ %% gets charged for something.
+ init_log(Table, Proc, CP),
+ trace_call_shove(Table, Pid, CP, TS, Stack)
+ end,
+ %% Regard this call as a stack push.
+ init_log(Table, Pid, Func), % will lookup Pid in Table
+ put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack))
+ end,
+ ok.
+
+%% Normal stack push
+trace_call_push(Table, Pid, Func, TS, Stack) ->
+ case Stack of
+ [] ->
+ ok;
+ [_ | _] ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.own)
+ end,
+ NewStack = [[{Func, TS}] | Stack],
+ trace_clock(Table, Pid, 1, NewStack, #clocks.cnt),
+ NewStack.
+
+%% Tail recursive stack push
+trace_call_shove(Table, Pid, Func, TS, Stack) ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.own),
+ [[_ | NewLevel0] | NewStack1] =
+ case Stack of
+ [] ->
+ [[{Func, TS}]];
+ [Level0 | Stack1] ->
+ [trace_call_collapse([{Func, TS} | Level0]) | Stack1]
+ end,
+ NewStack = [[{Func, TS} | NewLevel0] | NewStack1],
+ trace_clock(Table, Pid, 1, NewStack, #clocks.cnt),
+ NewStack.
+
+%% Collapse tail recursive call stack cycles to prevent them from
+%% growing to infinite length.
+trace_call_collapse([]) ->
+ [];
+trace_call_collapse([_] = Stack) ->
+ Stack;
+trace_call_collapse([_, _] = Stack) ->
+ Stack;
+trace_call_collapse([_ | Stack1] = Stack) ->
+ trace_call_collapse_1(Stack, Stack1, 1).
+
+%% Find some other instance of the current function in the call stack
+%% and try if that instance may be used as stack top instead.
+trace_call_collapse_1(Stack, [], _) ->
+ Stack;
+trace_call_collapse_1([{Func0, _} | _] = Stack, [{Func0, _} | S1] = S, N) ->
+ case trace_call_collapse_2(Stack, S, N) of
+ true ->
+ S;
+ false ->
+ trace_call_collapse_1(Stack, S1, N+1)
+ end;
+trace_call_collapse_1(Stack, [_ | S1], N) ->
+ trace_call_collapse_1(Stack, S1, N+1).
+
+%% Check if all caller/called pairs in the perhaps to be collapsed
+%% stack segment (at the front) are present in the rest of the stack,
+%% and also in the same order.
+trace_call_collapse_2(_, _, 0) ->
+ true;
+trace_call_collapse_2([{Func1, _} | [{Func2, _} | _] = Stack2],
+ [{Func1, _} | [{Func2, _} | _] = S2],
+ N) ->
+ trace_call_collapse_2(Stack2, S2, N-1);
+trace_call_collapse_2([{Func1, _} | _], [{Func1, _} | _], _N) ->
+ false;
+trace_call_collapse_2(_Stack, [_], _N) ->
+ false;
+trace_call_collapse_2(Stack, [_ | S], N) ->
+ trace_call_collapse_2(Stack, S, N);
+trace_call_collapse_2(_Stack, [], _N) ->
+ false.
+
+
+
+trace_return_to(Table, Pid, Func, TS) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_return_to(~p, ~p, ~p)~n~p~n",
+ [Pid, Func, TS, Stack]),
+ case Stack of
+ [[{suspend, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, Stack]});
+ [[{garbage_collect, _} | _] | _] ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, Stack]});
+ [_ | _] ->
+ put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack));
+ [] ->
+ put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack))
+ end,
+ ok.
+
+trace_return_to_int(Table, Pid, Func, TS, Stack) ->
+ %% The old stack must be sent to trace_clock, so
+ %% the function we just returned from is charged with
+ %% own time.
+ trace_clock(Table, Pid, TS, Stack, #clocks.own),
+ case trace_return_to_2(Table, Pid, Func, TS, Stack) of
+ {undefined, _} ->
+ [[{Func, TS}] | Stack];
+ {[[{Func, _} | Level0] | Stack1], _} ->
+ [[{Func, TS} | Level0] | Stack1];
+ {NewStack, _} ->
+ NewStack
+ end.
+
+%% A list of charged functions is passed around to assure that
+%% any function is charged with ACC time only once - the first time
+%% it is encountered. The function trace_return_to_1 is called only
+%% for the front of a tail recursive level, and if the front
+%% does not match the returned-to function, trace_return_to_2
+%% is called for all functions within the tail recursive level.
+%%
+%% Charging is done in reverse order, i.e from stack rear to front.
+
+%% Search the call stack until the returned-to function is found at
+%% a tail recursive level's front, and charge it with ACC time.
+trace_return_to_1(_, _, undefined, _, []) ->
+ {[], []};
+trace_return_to_1(_, _, _, _, []) ->
+ {undefined, []};
+trace_return_to_1(Table, Pid, Func, TS,
+ [[{Func, _} | Level0] | Stack1] = Stack) ->
+ %% Match at front of tail recursive level
+ Charged = trace_return_to_3([Level0 | Stack1], []),
+ case lists:member(Func, Charged) of
+ false ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.acc),
+ {Stack, [Func | Charged]};
+ true ->
+ {Stack, Charged}
+ end;
+trace_return_to_1(Table, Pid, Func, TS, Stack) ->
+ trace_return_to_2(Table, Pid, Func, TS, Stack).
+
+%% Charge all functions within one tail recursive level,
+%% from rear to front, with ACC time.
+trace_return_to_2(Table, Pid, Func, TS, [] = Stack) ->
+ trace_return_to_1(Table, Pid, Func, TS, Stack);
+trace_return_to_2(Table, Pid, Func, TS, [[] | Stack1]) ->
+ trace_return_to_1(Table, Pid, Func, TS, Stack1);
+trace_return_to_2(Table, Pid, Func, TS,
+ [[{Func0, _} | Level1] | Stack1] = Stack) ->
+ case trace_return_to_2(Table, Pid, Func, TS, [Level1 | Stack1]) of
+ {undefined, _} = R ->
+ R;
+ {NewStack, Charged} = R ->
+ case lists:member(Func0, Charged) of
+ false ->
+ trace_clock(Table, Pid, TS, Stack, #clocks.acc),
+ {NewStack, [Func0 | Charged]};
+ true ->
+ R
+ end
+ end.
+
+%% Return a flat list of all function names in the given stack
+trace_return_to_3([], R) ->
+ R;
+trace_return_to_3([[] | Stack1], R) ->
+ trace_return_to_3(Stack1, R);
+trace_return_to_3([[{Func0, _} | Level0] | Stack1], R) ->
+ trace_return_to_3([Level0 | Stack1], [Func0 | R]).
+
+
+
+trace_spawn(Table, Pid, MFArgs, TS, Parent) ->
+ Stack = get(Pid),
+ ?dbg(0, "trace_spawn(~p, ~p, ~p, ~p)~n~p~n",
+ [Pid, MFArgs, TS, Parent, Stack]),
+ case Stack of
+ undefined ->
+ {M,F,Args} = MFArgs,
+ OldStack = [[{{M,F,length(Args)},TS}]],
+ put(Pid, trace_call_push(Table, Pid, suspend, TS, OldStack)),
+ ets:insert(Table, #proc{id = Pid, parent = Parent,
+ spawned_as = MFArgs});
+ _ ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, MFArgs, TS, Parent, Stack]})
+ end.
+
+
+
+trace_exit(Table, Pid, TS) ->
+ Stack = erase(Pid),
+ ?dbg(0, "trace_exit(~p, ~p)~n~p~n", [Pid, TS, Stack]),
+ case Stack of
+ undefined ->
+ ok;
+ [] ->
+ ok;
+ [_ | _] = Stack ->
+ trace_return_to_int(Table, Pid, undefined, TS, Stack),
+ ok
+ end,
+ ok.
+
+
+
+trace_out(Table, Pid, Func, TS) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_out(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]),
+ case Stack of
+ [] ->
+ put(Pid, trace_call_push(Table, Pid, suspend, TS,
+ case Func of
+ undefined -> [];
+ _ ->
+ [[{Func,TS}]]
+ end));
+ [[{suspend,_}] | _] ->
+ %% No stats update for a suspend on suspend
+ put(Pid, [[{suspend,TS}] | Stack]);
+ [_ | _] ->
+ put(Pid, trace_call_push(Table, Pid, suspend, TS, Stack))
+ end.
+
+
+
+trace_in(Table, Pid, Func, TS) ->
+ Stack = get(Pid),
+ ?dbg(0, "trace_in(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]),
+ case Stack of
+ undefined ->
+ %% First activity on a process which existed at the time
+ %% the fprof trace was started.
+ put(Pid, [[{Func,TS}]]);
+ [] ->
+ put(Pid, [[{Func,TS}]]);
+ [[{suspend, _}]] ->
+ put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack));
+ [[{suspend,_}] | [[{suspend,_}] | _]=NewStack] ->
+ %% No stats update for a suspend on suspend
+ put(Pid, NewStack);
+ [[{suspend, _}] | [[{Func1, _} | _] | _]] ->
+ %% This is a new process (suspend and Func1 was inserted
+ %% by trace_spawn) or any process that has just been
+ %% scheduled out and now back in.
+ put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack));
+ _ ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, Func, TS, Stack]})
+ end.
+
+
+
+trace_gc_start(Table, Pid, TS) ->
+ Stack = get_stack(Pid),
+ ?dbg(0, "trace_gc_start(~p, ~p)~n~p~n", [Pid, TS, Stack]),
+ put(Pid, trace_call_push(Table, Pid, garbage_collect, TS, Stack)).
+
+
+
+trace_gc_end(Table, Pid, TS) ->
+ Stack = get(Pid),
+ ?dbg(0, "trace_gc_end(~p, ~p)~n~p~n", [Pid, TS, Stack]),
+ case Stack of
+ undefined ->
+ put(Pid, []);
+ [] ->
+ ok;
+ [[{garbage_collect, _}]] ->
+ put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack));
+ [[{garbage_collect, _}], [{Func1, _} | _] | _] ->
+ put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack));
+ _ ->
+ throw({inconsistent_trace_data, ?MODULE, ?LINE,
+ [Pid, TS, Stack]})
+ end.
+
+
+
+%%%-----------------------------------------
+%%% Statistics calculating support functions
+%%%-----------------------------------------
+
+
+
+get_stack(Id) ->
+ case get(Id) of
+ undefined ->
+ [];
+ Stack ->
+ Stack
+ end.
+
+
+
+mfarity({M, F, Args}) when is_list(Args) ->
+ {M, F, length(Args)};
+mfarity(MFA) ->
+ MFA.
+
+
+
+init_log(_Table, _Proc, suspend) ->
+ ok;
+init_log(_Table, _Proc, void) ->
+ ok;
+init_log(_Table, undefined, _Entry) ->
+ ok;
+init_log(_Table, #proc{init_cnt = 0}, _Entry) ->
+ ok;
+init_log(Table, #proc{init_cnt = N, init_log = L} = Proc, Entry) ->
+ ets:insert(Table, Proc#proc{init_cnt = N-1, init_log = [Entry | L]});
+init_log(Table, Id, Entry) ->
+ Proc =
+ case ets:lookup(Table, Id) of
+ [P] -> P;
+ [] -> undefined
+ end,
+ init_log(Table,Proc,Entry).
+
+
+trace_clock(_Table, _Pid, _T,
+ [[{suspend, _}], [{suspend, _}] | _]=_Stack, _Clock) ->
+ ?dbg(9, "trace_clock(Table, ~w, ~w, ~w, ~w)~n",
+ [_Pid, _T, _Stack, _Clock]),
+ void;
+trace_clock(Table, Pid, T,
+ [[{garbage_collect, TS0}], [{suspend, _}]], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, undefined, garbage_collect, Clock);
+trace_clock(Table, Pid, T,
+ [[{garbage_collect, TS0}], [{suspend, _}], [{Func2, _} | _] | _],
+ Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, Func2, garbage_collect, Clock);
+trace_clock(Table, Pid, T, [[{Func0, TS0}, {Func1, _} | _] | _], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock);
+trace_clock(Table, Pid, T, [[{Func0, TS0}], [{Func1, _} | _] | _], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock);
+trace_clock(Table, Pid, T, [[{Func0, TS0}]], Clock) ->
+ trace_clock_1(Table, Pid, T, TS0, undefined, Func0, Clock);
+trace_clock(_, _, _, [], _) ->
+ void.
+
+trace_clock_1(Table, Pid, _, _, Caller, suspend, #clocks.own) ->
+ clock_add(Table, {Pid, Caller, suspend}, #clocks.own, 0);
+trace_clock_1(Table, Pid, T, TS, Caller, Func, Clock) ->
+ clock_add(Table, {Pid, Caller, Func}, Clock,
+ if is_integer(T) ->
+ T;
+ true ->
+ ts_sub(T, TS)
+ end).
+
+clock_add(Table, Id, Clock, T) ->
+ ?dbg(1, "clock_add(Table, ~w, ~w, ~w)~n", [Id, Clock, T]),
+ try ets:update_counter(Table, Id, {Clock, T})
+ catch
+ error:badarg ->
+ ets:insert(Table, #clocks{id = Id}),
+ X = ets:update_counter(Table, Id, {Clock, T}),
+ if X >= 0 -> ok;
+ true -> ?dbg(0, "Negative counter value ~p ~p ~p ~p~n",
+ [X, Id, Clock, T])
+ end,
+ X
+ end.
+
+clocks_add(Table, #clocks{id = Id} = Clocks) ->
+ ?dbg(1, "clocks_add(Table, ~w)~n", [Clocks]),
+ case ets:lookup(Table, Id) of
+ [Clocks0] ->
+ ets:insert(Table, clocks_sum(Clocks, Clocks0, Id));
+ [] ->
+ ets:insert(Table, Clocks)
+ end.
+
+
+
+clocks_sum(#clocks{id = _Id1,
+ cnt = Cnt1,
+ own = Own1,
+ acc = Acc1},
+ #clocks{id = _Id2,
+ cnt = Cnt2,
+ own = Own2,
+ acc = Acc2},
+ Id) ->
+ #clocks{id = Id,
+ cnt = Cnt1 + Cnt2,
+ own = Own1 + Own2,
+ acc = Acc1 + Acc2}.
+
+
+
+ts_sub({A, B, C} = _T, {A0, B0, C0} = _T0) ->
+ X = ((((A-A0)*1000000) + (B-B0))*1000000) + C - C0,
+ if X >= 0 -> ok;
+ true -> ?dbg(9, "Negative counter value ~p ~p ~p~n",
+ [X, _T, _T0])
+ end,
+ X;
+ts_sub(_, _) ->
+ undefined.
+
+
+
+%%%--------------------------------
+%%% Profile data analysis functions
+%%%--------------------------------
+
+
+
+do_analyse(Table, Analyse) ->
+ ?dbg(5, "do_analyse_1(~p, ~p)~n", [Table, Analyse]),
+ Result =
+ try do_analyse_1(Table, Analyse)
+ catch
+ Error -> Error
+ end,
+ ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]),
+ Result.
+
+do_analyse_1(Table,
+ #analyse{group_leader = GroupLeader,
+ dest = Io,
+ cols = Cols0,
+ callers = PrintCallers,
+ sort = Sort,
+ totals = PrintTotals,
+ details = PrintDetails} = _Analyse) ->
+ Waste = 11,
+ MinCols = Waste + 12, %% We need Width >= 1
+ Cols = if Cols0 < MinCols -> MinCols; true -> Cols0 end,
+ Width = (Cols-Waste) div 12,
+ FnameWidth = Cols - Waste - 5*Width,
+ Dest = {Io, [FnameWidth, Width, 2*Width, 2*Width]},
+ SortElement = case Sort of
+ own ->
+ #clocks.own;
+ acc ->
+ #clocks.acc
+ end,
+ %%
+ %% Clean out the process dictionary before the next step
+ %%
+ _Erase = erase(),
+ ?dbg(2, "erase() -> ~p~n", [_Erase]),
+ %%
+ %% Process the collected data and spread it to 3 places:
+ %% * Per {process, caller, func}. Stored in the process dictionary.
+ %% * Sum per process. Stored in an ets table.
+ %% * Extra info per process. Stored in another ets table.
+ %%
+ io:format(GroupLeader, "Processing data...~n", []),
+ PidTable = ets:new(?MODULE, [set, private, {keypos, #clocks.id}]),
+ ProcTable = ets:new(?MODULE, [set, private, {keypos, #proc.id}]),
+ ets_select_foreach(
+ Table, [{'_', [], ['$_']}], 100,
+ fun (#clocks{id = {Pid, Caller, Func}} = Clocks) ->
+ case PrintDetails of
+ true ->
+ funcstat_pd(Pid, Caller, Func, Clocks),
+ clocks_add(PidTable, Clocks#clocks{id = Pid});
+ false ->
+ ok
+ end,
+ clocks_add(PidTable, Clocks#clocks{id = totals}),
+ case PrintTotals of
+ true ->
+ funcstat_pd(totals, Caller, Func, Clocks);
+ false ->
+ ok
+ end;
+ (#proc{} = Proc) ->
+ ets:insert(ProcTable, Proc);
+ (#misc{} = Misc) ->
+ ets:insert(ProcTable, Misc)
+ end),
+ ?dbg(3, "get() -> ~p~n", [get()]),
+ {FirstTS, LastTS, _TraceCnt} =
+ case {ets:lookup(ProcTable, first_ts),
+ ets:lookup(ProcTable, last_ts_n)} of
+ {[#misc{data = FTS}], [#misc{data = {LTS, TC}}]}
+ when FTS =/= undefined, LTS =/= undefined ->
+ {FTS, LTS, TC};
+ _ ->
+ throw({error,empty_trace})
+ end,
+ Totals0 =
+ case ets:lookup(PidTable, totals) of
+ [T0] ->
+ ets:delete(PidTable, totals),
+ T0;
+ _ ->
+ throw({error,empty_trace})
+ end,
+ Totals = Totals0#clocks{acc = ts_sub(LastTS, FirstTS)},
+ ?dbg(3, "Totals0 = ~p~n", [Totals0]),
+ ?dbg(3, "PidTable = ~p~n", [ets:tab2list(PidTable)]),
+ ?dbg(3, "ProcTable = ~p~n", [ets:tab2list(ProcTable)]),
+ ?dbg(4, "Totals = ~p~n", [Totals]),
+ %%
+ %% Reorganize the process dictionary by Pid.
+ %%
+ lists:foreach(
+ fun ({{Pid, _Func}, Funcstat}) ->
+ put(Pid, [Funcstat | case get(Pid) of
+ undefined -> [];
+ Other -> Other
+ end])
+ end,
+ erase()),
+ ?dbg(4, "get() -> ~p~n", [get()]),
+ %%
+ %% Sort the processes
+ %%
+ PidSorted =
+ postsort_r(
+ lists:sort(
+ ets:select(PidTable,
+ [{'_', [], [[{element, #clocks.own, '$_'} | '$_']]}]))),
+ ?dbg(4, "PidSorted = ~p~n", [PidSorted]),
+ %%
+ %% Print the functions per process
+ %%
+ io:format(GroupLeader, "Creating output...~n", []),
+ println(Dest, "%% ", [], "Analysis results:", ""),
+ println(Dest, "{ ", analysis_options, ",", ""),
+ println(Dest, " [{", {callers, PrintCallers}, "},", ""),
+ println(Dest, " {", {sort, Sort}, "},", ""),
+ println(Dest, " {", {totals, PrintTotals}, "},", ""),
+ println(Dest, " {", {details, PrintDetails}, "}]}.", ""),
+ println(Dest),
+ lists:foreach(
+ fun ({#clocks{} = Clocks, ProcOrPid, FuncstatList}) ->
+ println(Dest, "% ", head, "", ""),
+ case ProcOrPid of
+ #proc{} ->
+ println(Dest, "[{ ", Clocks, "},", "%%"),
+ print_proc(Dest, ProcOrPid);
+ totals ->
+ println(Dest, "[{ ", Clocks, "}].", "%%%");
+ _ when is_pid(ProcOrPid) ->
+ println(Dest, "[{ ", Clocks, "}].", "%%")
+ end,
+ println(Dest),
+ lists:foreach(
+ fun (#funcstat{callers_sum = CallersSum,
+% called_sum = CalledSum,
+ callers = Callers,
+ called = Called}) ->
+ case {PrintCallers, Callers} of
+% {true, []} ->
+% ok;
+ {true, _} ->
+ print_callers(Dest, Callers),
+ println(Dest, " { ", CallersSum, "},", "%"),
+ print_called(Dest, Called),
+ println(Dest);
+ {false, _} ->
+ println(Dest, "{ ", CallersSum, "}.", "")
+ end,
+ ok
+ end,
+ %% Sort the functions within the process,
+ %% and the callers and called within the function.
+ funcstat_sort_r(FuncstatList, SortElement)),
+ println(Dest)
+ end,
+ %% Look up the processes in sorted order
+ lists:map(
+ fun (#clocks{id = Pid} = Clocks) ->
+ Proc = case ets:lookup(ProcTable, Pid) of
+ [] -> Pid;
+ [ProcX] -> ProcX
+ end,
+ FuncstatList =
+ case get(Pid) of
+ undefined ->
+ [];
+ FL ->
+ FL
+ end,
+ {Clocks, Proc, FuncstatList}
+ end,
+ case PrintDetails of
+ true ->
+ [Totals | PidSorted];
+ false ->
+ [Totals]
+ end)),
+ %%
+ %% Cleanup
+ %%
+ ets:delete(PidTable),
+ ets:delete(ProcTable),
+ io:format(GroupLeader, "Done!~n", []),
+ ok.
+
+
+
+%%----------------------------
+%% Analysis printout functions
+%%----------------------------
+
+
+
+print_proc({undefined, _}, _) ->
+ ok;
+print_proc(Dest,
+ #proc{id = _Pid,
+ parent = Parent,
+ spawned_as = SpawnedAs,
+ init_log = InitLog}) ->
+ case {Parent, SpawnedAs, InitLog} of
+ {undefined, undefined, []} ->
+ println(Dest, " ", [], "].", "");
+ {_, undefined, []} ->
+ println(Dest, " { ", {spawned_by, parsify(Parent)}, "}].", "");
+ _ ->
+ println(Dest, " { ", {spawned_by, parsify(Parent)}, "},", ""),
+ case {SpawnedAs, InitLog} of
+ {_, []} ->
+ println(Dest, " { ",
+ {spawned_as, SpawnedAs},
+ "}].", "");
+ {undefined, _} ->
+ println(Dest, " { ",
+ {initial_calls, lists:reverse(InitLog)},
+ "}].", "");
+ _ ->
+ println(Dest, " { ",
+ {spawned_as, SpawnedAs},
+ "},", ""),
+ println(Dest, " { ",
+ {initial_calls, lists:reverse(InitLog)},
+ "}].", "")
+ end
+ end.
+
+
+
+print_callers(Dest, []) ->
+ println(Dest, "{[", [], "],", "");
+print_callers(Dest, [Clocks]) ->
+ println(Dest, "{[{", Clocks, "}],", "");
+print_callers(Dest, [Clocks | Tail]) ->
+ println(Dest, "{[{", Clocks, "},", ""),
+ print_callers_1(Dest, Tail).
+
+print_callers_1(Dest, [Clocks]) ->
+ println(Dest, " {", Clocks, "}],", "");
+print_callers_1(Dest, [Clocks | Tail]) ->
+ println(Dest, " {", Clocks, "},", ""),
+ print_callers_1(Dest, Tail).
+
+
+
+print_func(Dest, Clocks) ->
+ println(Dest, " { ", Clocks, "},", "%").
+
+
+
+print_called(Dest, []) ->
+ println(Dest, " [", [], "]}.", "");
+print_called(Dest, [Clocks]) ->
+ println(Dest, " [{", Clocks, "}]}.", "");
+print_called(Dest, [Clocks | Tail]) ->
+ println(Dest, " [{", Clocks, "},", ""),
+ print_called_1(Dest, Tail).
+
+print_called_1(Dest, [Clocks]) ->
+ println(Dest, " {", Clocks, "}]}.", "");
+print_called_1(Dest, [Clocks | Tail]) ->
+ println(Dest, " {", Clocks, "},", ""),
+ print_called_1(Dest, Tail).
+
+
+
+println({undefined, _}) ->
+ ok;
+println({Io, _}) ->
+ io:nl(Io).
+
+println({undefined, _}, _Head,
+ _,
+ _Tail, _Comment) ->
+ ok;
+println({Io, [W1, W2, W3, W4]}, Head,
+ #clocks{id = Pid, cnt = Cnt, acc = _, own = Own},
+ Tail, Comment) when is_pid(Pid) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ flat_format(parsify(Pid), $,, W1),
+ flat_format(Cnt, $,, W2, right),
+ flat_format(undefined, $,, W3, right),
+ flat_format(Own*0.001, [], W4-1, right),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, [W1, W2, W3, W4]}, Head,
+ #clocks{id = {_M, _F, _A} = Func, cnt = Cnt, acc = Acc, own = Own},
+ Tail, Comment) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ flat_format(Func, $,, W1),
+ flat_format(Cnt, $,, W2, right),
+ flat_format(Acc*0.001, $,, W3, right),
+ flat_format(Own*0.001, [], W4-1, right),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, [W1, W2, W3, W4]}, Head,
+ #clocks{id = Id, cnt = Cnt, acc = Acc, own = Own},
+ Tail, Comment) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ flat_format(parsify(Id), $,, W1),
+ flat_format(Cnt, $,, W2, right),
+ flat_format(Acc*0.001, $,, W3, right),
+ flat_format(Own*0.001, [], W4-1, right),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, [W1, W2, W3, W4]}, Head,
+ head,
+ Tail, Comment) ->
+ io:put_chars(Io,
+ [pad(Head, $ , 3),
+ pad(" ", $ , W1),
+ pad($ , " CNT ", W2),
+ pad($ , " ACC ", W3),
+ pad($ , " OWN", W4-1),
+ pad(Tail, $ , 4),
+ pad($ , Comment, 4),
+ io_lib:nl()]);
+println({Io, _}, Head,
+ [],
+ Tail, Comment) ->
+ io:format(Io, "~s~s~s~n",
+ [pad(Head, $ , 3), Tail, Comment]);
+println({Io, _}, Head,
+ {Tag, Term},
+ Tail, Comment) ->
+ io:format(Io, "~s~p, ~p~s~s~n",
+ [pad(Head, $ , 3), parsify(Tag), parsify(Term), Tail, Comment]);
+println({Io, _}, Head,
+ Term,
+ Tail, Comment) ->
+ io:format(Io, "~s~p~s~s~n",
+ [pad(Head, $ , 3), parsify(Term), Tail, Comment]).
+
+
+
+%%%--------------------------
+%%% Sorting support functions
+%%%--------------------------
+
+
+%% Add a Clocks record to the callers and called funcstat records
+%% in the process dictionary.
+%%
+funcstat_pd(Pid, Func1, Func0, Clocks) ->
+ put({Pid, Func0},
+ case get({Pid, Func0}) of
+ undefined ->
+ #funcstat{callers_sum = Clocks#clocks{id = Func0},
+ called_sum = #clocks{id = Func0},
+ callers = [Clocks#clocks{id = Func1}]};
+ #funcstat{callers_sum = CallersSum,
+ callers = Callers} = FuncstatCallers ->
+ FuncstatCallers#funcstat{
+ callers_sum = clocks_sum(CallersSum, Clocks, Func0),
+ callers = [Clocks#clocks{id = Func1} | Callers]}
+ end),
+ put({Pid, Func1},
+ case get({Pid, Func1}) of
+ undefined ->
+ #funcstat{callers_sum = #clocks{id = Func1},
+ called_sum = Clocks#clocks{id = Func1},
+ called = [Clocks#clocks{id = Func0}]};
+ #funcstat{called_sum = CalledSum,
+ called = Called} = FuncstatCalled ->
+ FuncstatCalled#funcstat{
+ called_sum = clocks_sum(CalledSum, Clocks, Func1),
+ called = [Clocks#clocks{id = Func0} | Called]}
+ end).
+
+
+
+%% Sort a list of funcstat records,
+%% and sort the callers and called lists within the funcstat record.
+funcstat_sort_r(FuncstatList, Element) ->
+ funcstat_sort_r_1(FuncstatList, Element, []).
+
+funcstat_sort_r_1([], _, R) ->
+ postsort_r(lists:sort(R));
+funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks,
+ callers = Callers,
+ called = Called} = Funcstat
+ | L],
+ Element,
+ R) ->
+ funcstat_sort_r_1(L,
+ Element,
+ [[element(Element, Clocks)
+ |Funcstat#funcstat{
+ callers = clocks_sort_r(Callers, Element),
+ called = clocks_sort_r(Called, Element)}]
+ | R]).
+
+
+
+%% Sort a list of clocks records.
+clocks_sort_r(L, E) ->
+ clocks_sort_r_1(L, E, []).
+
+clocks_sort_r_1([], _, R) ->
+ postsort_r(lists:sort(R));
+clocks_sort_r_1([#clocks{} = C | L], E, R) ->
+ clocks_sort_r_1(L, E, [[element(E, C)|C] | R]).
+
+
+%% Take a list of terms with sort headers and strip the headers.
+postsort_r(L) ->
+ postsort_r(L, []).
+
+postsort_r([], R) ->
+ R;
+postsort_r([[_|C] | L], R) ->
+ postsort_r(L, [C | R]).
+
+
+
+%%%----------------------------------------------------------------------
+%%% Fairly generic support functions
+%%%
+
+%% Standard format and flatten.
+flat_format(F, Trailer) when is_float(F) ->
+ lists:flatten([io_lib:format("~.3f", [F]), Trailer]);
+flat_format(W, Trailer) ->
+ lists:flatten([io_lib:format("~p", [W]), Trailer]).
+
+%% Format, flatten, and pad.
+flat_format(Term, Trailer, Width) ->
+ flat_format(Term, Trailer, Width, left).
+
+flat_format(Term, Trailer, Width, left) ->
+ flat_format(Term, Trailer, Width, {left, $ });
+flat_format(Term, Trailer, Width, {left, Filler}) ->
+ pad(flat_format(Term, Trailer), Filler, Width);
+flat_format(Term, Trailer, Width, right) ->
+ flat_format(Term, Trailer, Width, {right, $ });
+flat_format(Term, Trailer, Width, {right, Filler}) ->
+ pad(Filler, flat_format(Term, Trailer), Width).
+
+
+
+%% Left pad a string using a given char.
+pad(Char, L, Size) when is_integer(Char), is_list(L), is_integer(Size) ->
+ List = lists:flatten(L),
+ Length = length(List),
+ if Length >= Size ->
+ List;
+ true ->
+ lists:append(lists:duplicate(Size - Length, Char), List)
+ end;
+%% Right pad a string using a given char.
+pad(L, Char, Size) when is_list(L), is_integer(Char), is_integer(Size) ->
+ List = lists:flatten(L),
+ Length = length(List),
+ if Length >= Size ->
+ List;
+ true ->
+ lists:append(List, lists:duplicate(Size - Length, Char))
+ end.
+
+
+
+ets_select_foreach(Table, MatchSpec, Limit, Fun) ->
+ ets:safe_fixtable(Table, true),
+ ets_select_foreach_1(ets:select(Table, MatchSpec, Limit), Fun).
+
+ets_select_foreach_1('$end_of_table', _) ->
+ ok;
+ets_select_foreach_1({Matches, Continuation}, Fun) ->
+ ?dbg(2, "Matches = ~p~n", [Matches]),
+ lists:foreach(Fun, Matches),
+ ets_select_foreach_1(ets:select(Continuation), Fun).
+
+
+
+%% Converts the parts of a deep term that are not parasable when printed
+%% with io:format() into their string representation.
+parsify([]) ->
+ [];
+parsify([Hd | Tl]) ->
+ [parsify(Hd) | parsify(Tl)];
+parsify({A, B}) ->
+ {parsify(A), parsify(B)};
+parsify({A, B, C}) ->
+ {parsify(A), parsify(B), parsify(C)};
+parsify(Tuple) when is_tuple(Tuple) ->
+ list_to_tuple(parsify(tuple_to_list(Tuple)));
+parsify(Pid) when is_pid(Pid) ->
+ erlang:pid_to_list(Pid);
+parsify(Port) when is_port(Port) ->
+ erlang:port_to_list(Port);
+parsify(Ref) when is_reference(Ref) ->
+ erlang:ref_to_list(Ref);
+parsify(Fun) when is_function(Fun) ->
+ erlang:fun_to_list(Fun);
+parsify(Term) ->
+ Term.
+
+
+
+%% A simple loop construct.
+%%
+%% Calls 'Fun' with argument 'Start' first and then repeatedly with
+%% its returned value (state) until 'Fun' returns 'Stop'. Then
+%% the last state value that was not 'Stop' is returned.
+
+% iterate(Start, Done, Fun) when is_function(Fun) ->
+% iterate(Start, Done, Fun, Start).
+
+% iterate(Done, Done, Fun, I) ->
+% I;
+% iterate(I, Done, Fun, _) ->
+% iterate(Fun(I), Done, Fun, I).
diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl
new file mode 100644
index 0000000000..fa8a4a4867
--- /dev/null
+++ b/lib/tools/src/instrument.erl
@@ -0,0 +1,427 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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%
+%%
+-module(instrument).
+
+-export([holes/1, mem_limits/1, memory_data/0, read_memory_data/1,
+ sort/1, store_memory_data/1, sum_blocks/1,
+ descr/1, type_descr/2, allocator_descr/2, class_descr/2,
+ type_no_range/1, block_header_size/1, store_memory_status/1,
+ read_memory_status/1, memory_status/1]).
+
+
+-define(OLD_INFO_SIZE, 32). %% (sizeof(mem_link) in pre R9C utils.c)
+
+-define(IHMARKER(H), element(1, H)).
+-define(VSN(H), element(2, H)).
+-define(INFO_SIZE(H), element(3, H)).
+-define(TYPEMAP(H), element(4, H)).
+
+-define(IHDR(H), is_tuple(H), ?IHMARKER(H) =:= instr_hdr).
+-define(IHDRVSN(H, V), ?IHDR(H), ?VSN(H) =:= V).
+
+memory_data() ->
+ case catch erlang:system_info(allocated) of
+ {'EXIT',{Error,_}} ->
+ erlang:error(Error, []);
+ {'EXIT',Error} ->
+ erlang:error(Error, []);
+ Res ->
+ Res
+ end.
+
+store_memory_data(File) ->
+ case catch erlang:system_info({allocated, File}) of
+ {'EXIT',{Error,_}} ->
+ erlang:error(Error, [File]);
+ {'EXIT',Error} ->
+ erlang:error(Error, [File]);
+ Res ->
+ Res
+ end.
+
+memory_status(Type) when is_atom(Type) ->
+ case catch erlang:system_info({allocated, status, Type}) of
+ {'EXIT',{Error,_}} ->
+ erlang:error(Error, [Type]);
+ {'EXIT',Error} ->
+ erlang:error(Error, [Type]);
+ Res ->
+ Res
+ end;
+memory_status(Type) ->
+ erlang:error(badarg, [Type]).
+
+store_memory_status(File) when is_list(File) ->
+ case catch erlang:system_info({allocated, status, File}) of
+ {'EXIT',{Error,_}} ->
+ erlang:error(Error, [File]);
+ {'EXIT',Error} ->
+ erlang:error(Error, [File]);
+ Res ->
+ Res
+ end;
+store_memory_status(File) ->
+ erlang:error(badarg, [File]).
+
+read_memory_data(File) when is_list(File) ->
+ case file:consult(File) of
+ {ok, [Hdr|MD]} when ?IHDR(Hdr) ->
+ {Hdr, MD};
+ {ok, [{T,A,S,undefined}|_] = MD} when is_integer(T),
+ is_integer(A),
+ is_integer(S) ->
+ {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD};
+ {ok, [{T,A,S,{X,Y,Z}}|_] = MD} when is_integer(T),
+ is_integer(A),
+ is_integer(S),
+ is_integer(X),
+ is_integer(Y),
+ is_integer(Z) ->
+ {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD};
+ {ok, _} ->
+ {error, eio};
+ Error ->
+ Error
+ end;
+read_memory_data(File) ->
+ erlang:error(badarg, [File]).
+
+read_memory_status(File) when is_list(File) ->
+ case file:consult(File) of
+ {ok, [{instr_vsn, _}|Stat]} ->
+ Stat;
+ {ok, _} ->
+ {error, eio};
+ Error ->
+ Error
+ end;
+read_memory_status(File) ->
+ erlang:error(badarg, [File]).
+
+holes({Hdr, MD}) when ?IHDR(Hdr) ->
+ check_holes(?INFO_SIZE(Hdr), MD).
+
+check_holes(_ISz, []) ->
+ ok;
+check_holes(ISz, [E | L]) ->
+ check_holes(ISz, E, L).
+
+check_holes(_ISz, _E1, []) ->
+ io:format("~n");
+check_holes(ISz, E1, [E2 | Rest]) ->
+ check_hole(ISz, E1, E2),
+ check_holes(ISz, E2, Rest).
+
+check_hole(ISz, {_,P1,S1,_}, {_,P2,_,_}) ->
+ End = P1+S1,
+ Hole = P2 - (End + ISz),
+ if
+ Hole =< 7 ->
+ ok;
+ true ->
+ io:format(" ~p", [Hole])
+ end.
+
+sum_blocks({Hdr, L}) when ?IHDR(Hdr) ->
+ lists:foldl(fun({_,_,S,_}, Sum) -> S+Sum end,
+ 0,
+ L).
+
+mem_limits({Hdr, L}) when ?IHDR(Hdr) ->
+ {_, P1, _, _} = hd(L),
+ {_, P2, S2, _} = lists:last(L),
+ {P1, P2+S2}.
+
+sort({Hdr, MD}) when ?IHDR(Hdr) ->
+ {Hdr, lists:keysort(2, MD)}.
+
+descr({Hdr, MD} = ID) when ?IHDR(Hdr) ->
+ {Hdr, lists:map(fun ({TN, Addr, Sz, {0, N, S}}) ->
+ {type_descr(ID, TN),
+ Addr,
+ Sz,
+ list_to_pid("<0."
+ ++ integer_to_list(N)
+ ++ "."
+ ++ integer_to_list(S)
+ ++ ">")};
+ ({TN, Addr, Sz, undefined}) ->
+ {type_descr(ID, TN),
+ Addr,
+ Sz,
+ undefined}
+ end,
+ MD)}.
+
+block_header_size({Hdr, _}) when ?IHDR(Hdr) ->
+ ?INFO_SIZE(Hdr).
+
+type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2),
+ is_integer(TypeNo) ->
+ case catch element(1, element(TypeNo, ?TYPEMAP(Hdr))) of
+ {'EXIT', _} -> invalid_type;
+ Type -> Type
+ end;
+type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1),
+ is_integer(TypeNo) ->
+ type_string(TypeNo).
+
+
+allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) ->
+ case catch element(2, element(TypeNo, ?TYPEMAP(Hdr))) of
+ {'EXIT', _} -> invalid_type;
+ Type -> Type
+ end;
+allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) ->
+ "unknown".
+
+class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) ->
+ case catch element(3, element(TypeNo, ?TYPEMAP(Hdr))) of
+ {'EXIT', _} -> invalid_type;
+ Type -> Type
+ end;
+class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) ->
+ "unknown".
+
+type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 2) ->
+ {1, tuple_size(?TYPEMAP(Hdr))};
+type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 1) ->
+ {-1, 1000}.
+
+type_string(-1) ->
+ "unknown";
+type_string(1) ->
+ "atom text";
+type_string(11) ->
+ "atom desc";
+type_string(2) ->
+ "bignum (big_to_list)";
+type_string(31) ->
+ "fixalloc";
+type_string(32) ->
+ "unknown fixalloc block";
+type_string(33) ->
+ "message buffer";
+type_string(34) ->
+ "message link";
+type_string(4) ->
+ "estack";
+type_string(40) ->
+ "db table vec";
+type_string(41) ->
+ "db tree select buffer";
+type_string(43) ->
+ "db hash select buffer";
+type_string(44) ->
+ "db hash select list";
+type_string(45) ->
+ "db match prog stack";
+type_string(46) ->
+ "db match prog heap data";
+type_string(47) ->
+ "db temp buffer";
+type_string(48) ->
+ "db error";
+type_string(49) ->
+ "db error info";
+type_string(50) ->
+ "db trans tab";
+type_string(51) ->
+ "db segment";
+type_string(52) ->
+ "db term";
+type_string(53) ->
+ "db add_counter";
+type_string(54) ->
+ "db segment table";
+type_string(55) ->
+ "db table (fix)";
+type_string(56) ->
+ "db bindings";
+type_string(57) ->
+ "db counter";
+type_string(58) ->
+ "db trace vec";
+type_string(59) ->
+ "db fixed deletion";
+type_string(60) ->
+ "binary (external.c)";
+type_string(61) ->
+ "binary";
+type_string(62) ->
+ "procbin (fix)";
+type_string(70) ->
+ "driver alloc (io.c)";
+type_string(71) ->
+ "binary (io.c)";
+type_string(72) ->
+ "binary vec (io.c)";
+type_string(73) ->
+ "binary vec 2 (io.c)";
+type_string(74) ->
+ "io vec (io.c)";
+type_string(75) ->
+ "io vec 2 (io.c)";
+type_string(76) ->
+ "temp io buffer (io.c)";
+type_string(77) ->
+ "temp io buffer 2 (io.c)";
+type_string(78) ->
+ "line buffer (io.c)";
+type_string(8) ->
+ "heap";
+type_string(801) ->
+ "heap (1)";
+type_string(802) ->
+ "heap (2)";
+type_string(803) ->
+ "heap (3)";
+type_string(804) ->
+ "heap (4)";
+type_string(805) ->
+ "heap (5)";
+type_string(821) ->
+ "heap fragment (1)";
+type_string(822) ->
+ "heap fragment (2)";
+type_string(830) ->
+ "sequential store buffer (for vectors)";
+type_string(91) ->
+ "process table";
+type_string(92) ->
+ "process desc";
+type_string(110) ->
+ "hash buckets";
+type_string(111) ->
+ "hash table";
+type_string(120) ->
+ "index init";
+type_string(121) ->
+ "index table";
+type_string(130) ->
+ "temp buffer";
+type_string(140) ->
+ "timer wheel";
+type_string(150) ->
+ "distribution cache";
+type_string(151) ->
+ "dmem";
+type_string(152) ->
+ "distribution table";
+type_string(153) ->
+ "distribution table buckets";
+type_string(154) ->
+ "distribution table entry";
+type_string(155) ->
+ "node table";
+type_string(156) ->
+ "node table buckets";
+type_string(157) ->
+ "node table entry";
+type_string(160) ->
+ "port table";
+type_string(161) ->
+ "driver entry";
+type_string(162) ->
+ "port setup";
+type_string(163) ->
+ "port wait";
+type_string(170) ->
+ "module";
+type_string(171) ->
+ "fundef";
+type_string(180) ->
+ "file table";
+type_string(181) ->
+ "driver table";
+type_string(182) ->
+ "poll struct";
+type_string(190) ->
+ "inet driver";
+type_string(200) ->
+ "efile driver";
+type_string(210) ->
+ "gc root set";
+type_string(220) ->
+ "breakpoint data";
+type_string(230) ->
+ "async queue";
+type_string(231) ->
+ "async (exit)";
+type_string(232) ->
+ "async (driver)";
+type_string(240) ->
+ "bits buffer";
+type_string(241) ->
+ "bits temp buffer";
+type_string(250) ->
+ "modules (loader)";
+type_string(251) ->
+ "code (loader)";
+type_string(252) ->
+ "atom tab (loader)";
+type_string(253) ->
+ "import tab (loader)";
+type_string(254) ->
+ "export tab (loader)";
+type_string(255) ->
+ "lable tab (loader)";
+type_string(256) ->
+ "gen op (loader)";
+type_string(257) ->
+ "gen op args (loader)";
+type_string(258) ->
+ "gen op args 2 (loader)";
+type_string(259) ->
+ "gen op args 3 (loader)";
+type_string(260) ->
+ "lambdas (loader)";
+type_string(261) ->
+ "temp int buffer (loader)";
+type_string(262) ->
+ "temp heap (loader)";
+type_string(280) ->
+ "dist ctrl msg buffer";
+type_string(281) ->
+ "dist_buf";
+type_string(290) ->
+ "call trace buffer";
+type_string(300) ->
+ "bif timer rec";
+type_string(310) ->
+ "argument registers";
+type_string(320) ->
+ "compressed binary temp buffer";
+type_string(330) ->
+ "term_to_binary temp buffer";
+type_string(340) ->
+ "proc dict";
+type_string(350) ->
+ "trace to port temp buffer";
+type_string(360) ->
+ "lists subtract temp buffer";
+type_string(370) ->
+ "link (lh)";
+type_string(380) ->
+ "port call buffer";
+type_string(400) ->
+ "definite_alloc block";
+type_string(_) ->
+ invalid_type.
+
diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl
new file mode 100644
index 0000000000..77c354651b
--- /dev/null
+++ b/lib/tools/src/make.erl
@@ -0,0 +1,324 @@
+%%
+%% %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 : Basic make facility
+
+%% Compares date stamps of .erl and Object files - recompiles when
+%% necessary.
+%% Files to be checked are contained in a file 'Emakefile'
+%% If Emakefile is missing the current directory is used.
+-module(make).
+
+-export([all/0,all/1,files/1,files/2]).
+
+-include_lib("kernel/include/file.hrl").
+
+-define(MakeOpts,[noexec,load,netload,noload]).
+
+all() ->
+ all([]).
+
+all(Options) ->
+ {MakeOpts,CompileOpts} = sort_options(Options,[],[]),
+ case read_emakefile('Emakefile',CompileOpts) of
+ Files when is_list(Files) ->
+ do_make_files(Files,MakeOpts);
+ error ->
+ error
+ end.
+
+files(Fs) ->
+ files(Fs, []).
+
+files(Fs0, Options) ->
+ Fs = [filename:rootname(F,".erl") || F <- Fs0],
+ {MakeOpts,CompileOpts} = sort_options(Options,[],[]),
+ case get_opts_from_emakefile(Fs,'Emakefile',CompileOpts) of
+ Files when is_list(Files) ->
+ do_make_files(Files,MakeOpts);
+ error -> error
+ end.
+
+do_make_files(Fs, Opts) ->
+ process(Fs, lists:member(noexec, Opts), load_opt(Opts)).
+
+
+sort_options([H|T],Make,Comp) ->
+ case lists:member(H,?MakeOpts) of
+ true ->
+ sort_options(T,[H|Make],Comp);
+ false ->
+ sort_options(T,Make,[H|Comp])
+ end;
+sort_options([],Make,Comp) ->
+ {Make,lists:reverse(Comp)}.
+
+%%% Reads the given Emakefile and returns a list of tuples: {Mods,Opts}
+%%% Mods is a list of module names (strings)
+%%% Opts is a list of options to be used when compiling Mods
+%%%
+%%% Emakefile can contain elements like this:
+%%% Mod.
+%%% {Mod,Opts}.
+%%% Mod is a module name which might include '*' as wildcard
+%%% or a list of such module names
+%%%
+%%% These elements are converted to [{ModList,OptList},...]
+%%% ModList is a list of modulenames (strings)
+read_emakefile(Emakefile,Opts) ->
+ case file:consult(Emakefile) of
+ {ok,Emake} ->
+ transform(Emake,Opts,[],[]);
+ {error,enoent} ->
+ %% No Emakefile found - return all modules in current
+ %% directory and the options given at command line
+ Mods = [filename:rootname(F) || F <- filelib:wildcard("*.erl")],
+ [{Mods, Opts}];
+ {error,Other} ->
+ io:format("make: Trouble reading 'Emakefile':~n~p~n",[Other]),
+ error
+ end.
+
+transform([{Mod,ModOpts}|Emake],Opts,Files,Already) ->
+ case expand(Mod,Already) of
+ [] ->
+ transform(Emake,Opts,Files,Already);
+ Mods ->
+ transform(Emake,Opts,[{Mods,ModOpts++Opts}|Files],Mods++Already)
+ end;
+transform([Mod|Emake],Opts,Files,Already) ->
+ case expand(Mod,Already) of
+ [] ->
+ transform(Emake,Opts,Files,Already);
+ Mods ->
+ transform(Emake,Opts,[{Mods,Opts}|Files],Mods++Already)
+ end;
+transform([],_Opts,Files,_Already) ->
+ lists:reverse(Files).
+
+expand(Mod,Already) when is_atom(Mod) ->
+ expand(atom_to_list(Mod),Already);
+expand(Mods,Already) when is_list(Mods), not is_integer(hd(Mods)) ->
+ lists:concat([expand(Mod,Already) || Mod <- Mods]);
+expand(Mod,Already) ->
+ case lists:member($*,Mod) of
+ true ->
+ Fun = fun(F,Acc) ->
+ M = filename:rootname(F),
+ case lists:member(M,Already) of
+ true -> Acc;
+ false -> [M|Acc]
+ end
+ end,
+ lists:foldl(Fun, [], filelib:wildcard(Mod++".erl"));
+ false ->
+ Mod2 = filename:rootname(Mod, ".erl"),
+ case lists:member(Mod2,Already) of
+ true -> [];
+ false -> [Mod2]
+ end
+ end.
+
+%%% Reads the given Emakefile to see if there are any specific compile
+%%% options given for the modules.
+get_opts_from_emakefile(Mods,Emakefile,Opts) ->
+ case file:consult(Emakefile) of
+ {ok,Emake} ->
+ Modsandopts = transform(Emake,Opts,[],[]),
+ ModStrings = [coerce_2_list(M) || M <- Mods],
+ get_opts_from_emakefile2(Modsandopts,ModStrings,Opts,[]);
+ {error,enoent} ->
+ [{Mods, Opts}];
+ {error,Other} ->
+ io:format("make: Trouble reading 'Emakefile':~n~p~n",[Other]),
+ error
+ end.
+
+get_opts_from_emakefile2([{MakefileMods,O}|Rest],Mods,Opts,Result) ->
+ case members(Mods,MakefileMods,[],Mods) of
+ {[],_} ->
+ get_opts_from_emakefile2(Rest,Mods,Opts,Result);
+ {I,RestOfMods} ->
+ get_opts_from_emakefile2(Rest,RestOfMods,Opts,[{I,O}|Result])
+ end;
+get_opts_from_emakefile2([],[],_Opts,Result) ->
+ Result;
+get_opts_from_emakefile2([],RestOfMods,Opts,Result) ->
+ [{RestOfMods,Opts}|Result].
+
+members([H|T],MakefileMods,I,Rest) ->
+ case lists:member(H,MakefileMods) of
+ true ->
+ members(T,MakefileMods,[H|I],lists:delete(H,Rest));
+ false ->
+ members(T,MakefileMods,I,Rest)
+ end;
+members([],_MakefileMods,I,Rest) ->
+ {I,Rest}.
+
+
+%% Any flags that are not recognixed as make flags are passed directly
+%% to the compiler.
+%% So for example make:all([load,debug_info]) will make everything
+%% with the debug_info flag and load it.
+
+load_opt(Opts) ->
+ case lists:member(netload,Opts) of
+ true ->
+ netload;
+ false ->
+ case lists:member(load,Opts) of
+ true ->
+ load;
+ _ ->
+ noload
+ end
+ end.
+
+
+process([{[],_Opts}|Rest], NoExec, Load) ->
+ process(Rest, NoExec, Load);
+process([{[H|T],Opts}|Rest], NoExec, Load) ->
+ case recompilep(coerce_2_list(H), NoExec, Load, Opts) of
+ error ->
+ error;
+ _ ->
+ process([{T,Opts}|Rest], NoExec, Load)
+ end;
+process([], _NoExec, _Load) ->
+ up_to_date.
+
+recompilep(File, NoExec, Load, Opts) ->
+ ObjName = lists:append(filename:basename(File),
+ code:objfile_extension()),
+ ObjFile = case lists:keysearch(outdir,1,Opts) of
+ {value,{outdir,OutDir}} ->
+ filename:join(coerce_2_list(OutDir),ObjName);
+ false ->
+ ObjName
+ end,
+ case exists(ObjFile) of
+ true ->
+ recompilep1(File, NoExec, Load, Opts, ObjFile);
+ false ->
+ recompile(File, NoExec, Load, Opts)
+ end.
+
+recompilep1(File, NoExec, Load, Opts, ObjFile) ->
+ {ok, Erl} = file:read_file_info(lists:append(File, ".erl")),
+ {ok, Obj} = file:read_file_info(ObjFile),
+ case {readable(Erl), writable(Obj)} of
+ {true, true} ->
+ recompilep1(Erl, Obj, File, NoExec, Load, Opts);
+ _ ->
+ error
+ end.
+
+recompilep1(#file_info{mtime=Te},
+ #file_info{mtime=To}, File, NoExec, Load, Opts) when Te>To ->
+ recompile(File, NoExec, Load, Opts);
+recompilep1(_Erl, #file_info{mtime=To}, File, NoExec, Load, Opts) ->
+ recompile2(To, File, NoExec, Load, Opts).
+
+%% recompile2(ObjMTime, File, NoExec, Load, Opts)
+%% Check if file is of a later date than include files.
+recompile2(ObjMTime, File, NoExec, Load, Opts) ->
+ IncludePath = include_opt(Opts),
+ case check_includes(lists:append(File, ".erl"), IncludePath, ObjMTime) of
+ true ->
+ recompile(File, NoExec, Load, Opts);
+ false ->
+ false
+ end.
+
+include_opt([{i,Path}|Rest]) ->
+ [Path|include_opt(Rest)];
+include_opt([_First|Rest]) ->
+ include_opt(Rest);
+include_opt([]) ->
+ [].
+
+%% recompile(File, NoExec, Load, Opts)
+%% Actually recompile and load the file, depending on the flags.
+%% Where load can be netload | load | noload
+
+recompile(File, true, _Load, _Opts) ->
+ io:format("Out of date: ~s\n",[File]);
+recompile(File, false, noload, Opts) ->
+ io:format("Recompile: ~s\n",[File]),
+ compile:file(File, [report_errors, report_warnings, error_summary |Opts]);
+recompile(File, false, load, Opts) ->
+ io:format("Recompile: ~s\n",[File]),
+ c:c(File, Opts);
+recompile(File, false, netload, Opts) ->
+ io:format("Recompile: ~s\n",[File]),
+ c:nc(File, Opts).
+
+exists(File) ->
+ case file:read_file_info(File) of
+ {ok, _} ->
+ true;
+ _ ->
+ false
+ end.
+
+readable(#file_info{access=read_write}) -> true;
+readable(#file_info{access=read}) -> true;
+readable(_) -> false.
+
+writable(#file_info{access=read_write}) -> true;
+writable(#file_info{access=write}) -> true;
+writable(_) -> false.
+
+coerce_2_list(X) when is_atom(X) ->
+ atom_to_list(X);
+coerce_2_list(X) ->
+ X.
+
+%%% If you an include file is found with a modification
+%%% time larger than the modification time of the object
+%%% file, return true. Otherwise return false.
+check_includes(File, IncludePath, ObjMTime) ->
+ Path = [filename:dirname(File)|IncludePath],
+ case epp:open(File, Path, []) of
+ {ok, Epp} ->
+ check_includes2(Epp, File, ObjMTime);
+ _Error ->
+ false
+ end.
+
+check_includes2(Epp, File, ObjMTime) ->
+ case epp:parse_erl_form(Epp) of
+ {ok, {attribute, 1, file, {File, 1}}} ->
+ check_includes2(Epp, File, ObjMTime);
+ {ok, {attribute, 1, file, {IncFile, 1}}} ->
+ case file:read_file_info(IncFile) of
+ {ok, #file_info{mtime=MTime}} when MTime>ObjMTime ->
+ epp:close(Epp),
+ true;
+ _ ->
+ check_includes2(Epp, File, ObjMTime)
+ end;
+ {ok, _} ->
+ check_includes2(Epp, File, ObjMTime);
+ {eof, _} ->
+ epp:close(Epp),
+ false;
+ {error, _Error} ->
+ check_includes2(Epp, File, ObjMTime)
+ end.
diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl
new file mode 100644
index 0000000000..e740d38c91
--- /dev/null
+++ b/lib/tools/src/tags.erl
@@ -0,0 +1,344 @@
+%%
+%% %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%
+%%
+%%%----------------------------------------------------------------------
+%%% File : tags.erl
+%%% Author : Anders Lindgren
+%%% Purpose : Generate an Emacs TAGS file from programs written in Erlang.
+%%% Date : 1998-03-16
+%%% Version : 1.1
+%%%----------------------------------------------------------------------
+
+-module(tags).
+
+-export([file/1, file/2, files/1, files/2, dir/1, dir/2,
+ dirs/1, dirs/2, subdir/1, subdir/2, subdirs/1, subdirs/2,
+ root/0, root/1]).
+
+
+%% `Tags' is a part of the editor Emacs. It is used for warp-speed
+%% jumps between different source files in a project. When Using
+%% `Tags', a function in any source file can be found by few a simple
+%% keystrokes, just press M-. (in normal terms: Press Escape and dot).
+%%
+%% In order to work, the `Tags' system needs a list of all functions
+%% in all source files in the project. This list is denoted the "TAGS
+%% file". This purpose of this module is to create the TAGS file for
+%% programs written in Erlang.
+%%
+%% In addition to functions, both records and macros (`define's) are
+%% added to the TAGS file.
+
+
+%% Usage:
+%% root([Options]) -- Create a TAGS file covering all files in
+%% the Erlang distribution.
+%%
+%% file(File [, Options]) -- Create a TAGS file for the file `File'.
+%% files(FileList [, Options])
+%% -- Dito for all files in `FileList'.
+%%
+%% dir(Dir [, Options]) -- Create a TAGS file for all files in `Dir'.
+%% dirs(DirList [, Options]) -- Dito for all files in all
+%% directories in `DirList'.
+%%
+%% subdir(Dir [, Options]) -- Descend recursively down `Dir' and create
+%% a TAGS file convering all files found.
+%% subdirs(DirList [, Options])
+%% -- Dito, for all directories in `DirList'.
+%%
+%% The default is to create a file named "TAGS" in the current directory.
+%%
+%% Options is a list of tuples, where the following tuples are
+%% recognised:
+%% {outfile, NameOfTAGSFile}
+%% {outdir, NameOfDirectory}
+%%
+%% Note, should both `outfile' and `outdir' options be given, `outfile'
+%% take precedence.
+
+
+%%% External interface
+
+root() -> root([]).
+root(Options) -> subdir(code:root_dir(), Options).
+
+dir(Dir) -> dir(Dir, []).
+dir(Dir, Options) -> dirs([Dir], Options).
+
+dirs(Dirs) -> dirs(Dirs, []).
+dirs(Dirs, Options) ->
+ files(collect_dirs(Dirs, false), Options).
+
+subdir(Dir) -> subdir(Dir, []).
+subdir(Dir, Options) -> subdirs([Dir], Options).
+
+subdirs(Dirs) -> subdirs(Dirs, []).
+subdirs(Dirs, Options) ->
+ files(collect_dirs(Dirs, true), Options).
+
+file(Name) -> file(Name, []).
+file(Name, Options) -> files([Name], Options).
+
+files(Files) -> files(Files, []).
+files(Files, Options) ->
+ case open_out(Options) of
+ {ok, Os} ->
+ files_loop(Files, Os),
+ close_out(Os),
+ ok;
+ _ ->
+ error
+ end.
+
+
+
+%%% Internal functions.
+
+%% Find all files in a directory list. Should the second argument be
+%% the atom `true' the functions will descend into subdirectories.
+collect_dirs(Dirs, Recursive) ->
+ collect_dirs(Dirs, Recursive, []).
+
+collect_dirs([], _Recursive, Acc) -> Acc;
+collect_dirs([Dir | Dirs], Recursive, Acc) ->
+ NewAcc = case file:list_dir(Dir) of
+ {ok, Entries} ->
+ collect_files(Dir, Entries, Recursive, Acc);
+ _ ->
+ Acc
+ end,
+ collect_dirs(Dirs, Recursive, NewAcc).
+
+collect_files(_Dir,[],_Recursive, Acc) -> Acc;
+collect_files(Dir, [File | Files], Recursive, Acc) ->
+ FullFile = filename:join(Dir, File),
+ NewAcc = case filelib:is_dir(FullFile) of
+ true when Recursive ->
+ collect_dirs([FullFile], Recursive, Acc);
+ true ->
+ Acc;
+ false ->
+ case filelib:is_regular(FullFile) of
+ true ->
+ case filename:extension(File) of
+ ".erl" ->
+ [FullFile | Acc];
+ ".hrl" ->
+ [FullFile | Acc];
+ _ ->
+ Acc
+ end;
+ false ->
+ Acc
+ end
+ end,
+ collect_files(Dir, Files, Recursive, NewAcc).
+
+
+files_loop([],_Os) -> true;
+files_loop([F | Fs], Os) ->
+ case filename(F, Os) of
+ ok ->
+ ok;
+ error ->
+ %% io:format("Could not open ~s~n", [F]),
+ error
+ end,
+ files_loop(Fs, Os).
+
+
+%% Generate tags for one file.
+filename(Name, Os) ->
+ case file:open(Name, [read]) of
+ {ok, Desc} ->
+ Acc = module(Desc, [], [], {1, 0}),
+ file:close(Desc),
+ genout(Os, Name, Acc),
+ ok;
+ _ ->
+ error
+ end.
+
+
+module(In, Last, Acc, {LineNo, CharNo}) ->
+ case io:get_line(In, []) of
+ eof ->
+ Acc;
+ Line ->
+ {NewLast, NewAcc} = line(Line, Last, Acc, {LineNo, CharNo}),
+ module(In, NewLast, NewAcc, {LineNo+1, CharNo+length(Line)})
+ end.
+
+
+%% Handle one line. Return the last added function name.
+line([], Last, Acc, _) -> {Last, Acc};
+line(Line, _, Acc, Nos) when hd(Line) =:= $- ->
+ case attribute(Line, Nos) of
+ false -> {[], Acc};
+ New -> {[], [New | Acc]}
+ end;
+line(Line, Last, Acc, Nos) ->
+ %% to be OR not to be?
+ case case {hd(Line), word_char(hd(Line))} of
+ {$', _} -> true;
+ {_, true} -> true;
+ _ -> false
+ end of
+ true ->
+ case func(Line, Last, Nos) of
+ false ->
+ {Last, Acc};
+ {NewLast, NewEntry} ->
+ {NewLast, [NewEntry | Acc]}
+ end;
+ false ->
+ {Last, Acc}
+ end.
+
+%% Handle one function. Will only add the first clause. (i.e.
+%% if the function name doesn't match `Last').
+%% Return `false' or {NewLast, GeneratedLine}.
+func(Line, Last, Nos) ->
+ {Name, Line1} = word(Line),
+ case Name of
+ [] -> false;
+ Last -> false;
+ _ ->
+ {Space, Line2} = white(Line1),
+ case Line2 of
+ [$( | _] ->
+ {Name, pfnote([$(, Space, Name], Nos)};
+ _ ->
+ false
+ end
+ end.
+
+
+%% Return `false' or generated line.
+attribute([$- | Line], Nos) ->
+ {Attr, Line1} = word(Line),
+ case case Attr of
+ "drocer" -> true;
+ "enifed" -> true;
+ _ -> false
+ end of
+ false ->
+ false;
+ true ->
+ {Space2, Line2} = white(Line1),
+ case Line2 of
+ [$( | Line3] ->
+ {Space4, Line4} = white(Line3),
+ {Name,_Line5} = word(Line4),
+ case Name of
+ [] -> false;
+ _ ->
+ pfnote([Name, Space4, $(, Space2, Attr, $-], Nos)
+ end;
+ _ ->
+ false
+ end
+ end.
+
+
+%% Removes whitespace from the head of the line.
+%% Returns {ReveredSpace, Rest}
+white(Line) -> white(Line, []).
+
+white([], Acc) -> {Acc, []};
+white([32 | Rest], Acc) -> white(Rest, [32 | Acc]);
+white([9 | Rest], Acc) -> white(Rest, [9 | Acc]);
+white(Line, Acc) -> {Acc, Line}.
+
+
+%% Returns {ReversedWord, Rest}
+word([$' | Rest]) ->
+ quoted(Rest, [$']);
+word(Line) ->
+ unquoted(Line, []).
+
+quoted([$' | Rest], Acc) -> {[$' | Acc], Rest};
+quoted([$\\ , C | Rest], Acc) ->
+ quoted(Rest, [C, $\\ | Acc]);
+quoted([C | Rest], Acc) ->
+ quoted(Rest, [C | Acc]).
+
+unquoted([], Word) -> {Word, []};
+unquoted([C | Cs], Acc) ->
+ case word_char(C) of
+ true -> unquoted(Cs, [C | Acc]);
+ false -> {Acc, [C | Cs]}
+ end.
+
+word_char(C) when C >= $a, C =< $z -> true;
+word_char(C) when C >= $A, C =< $Z -> true;
+word_char(C) when C >= $0, C =< $9 -> true;
+word_char($_) -> true;
+word_char(_) -> false.
+
+
+%%% Output routines
+
+%% Check the options `outfile' and `outdir'.
+open_out(Options) ->
+ case lists:keysearch(outfile, 1, Options) of
+ {value, {outfile, File}} ->
+ file:open(File, [write]);
+ _ ->
+ case lists:keysearch(outdir, 1, Options) of
+ {value, {outdir, Dir}} ->
+ file:open(filename:join(Dir, "TAGS"), [write]);
+ _ ->
+ file:open("TAGS", [write])
+ end
+ end.
+
+
+close_out(Os) ->
+ file:close(Os).
+
+
+pfnote(Str, {LineNo, CharNo}) ->
+ io_lib:format("~s\177~w,~w~n", [flatrev(Str), LineNo, CharNo]).
+
+
+genout(Os, Name, Entries) ->
+ io:format(Os, "\^l~n~s,~w~n", [Name, reclength(Entries)]),
+ io:put_chars(Os, lists:reverse(Entries)).
+
+
+
+%%% help routines
+
+%% Flatten and reverse a nested list.
+flatrev(Ls) -> flatrev(Ls, []).
+
+flatrev([C | Ls], Acc) when is_integer(C) -> flatrev(Ls, [C | Acc]);
+flatrev([L | Ls], Acc) -> flatrev(Ls, flatrev(L, Acc));
+flatrev([], Acc) -> Acc.
+
+
+%% Count the number of elements in a nested list.
+reclength([L | Ls]) when is_list(L) ->
+ reclength(L) + reclength(Ls);
+reclength([_ | Ls]) ->
+ reclength(Ls) + 1;
+reclength([]) -> 0.
+
+%%% tags.erl ends here.
diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src
new file mode 100644
index 0000000000..cd9b622f15
--- /dev/null
+++ b/lib/tools/src/tools.app.src
@@ -0,0 +1,60 @@
+%%
+%% %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%
+%%
+{application, tools,
+ [{description, "DEVTOOLS CXC 138 16"},
+ {vsn, "%VSN%"},
+ {modules, [cover,
+ cover_web,
+ eprof,
+ fprof,
+ instrument,
+ make,
+ xref,
+ xref_base,
+ xref_compiler,
+ xref_parser,
+ xref_reader,
+ xref_scanner,
+ xref_utils
+ ]
+ },
+ {registered,[webcover_server]},
+ {applications, [kernel, stdlib]},
+ {env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]}
+ ]
+ }
+ ]
+}.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/tools/src/tools.appup.src b/lib/tools/src/tools.appup.src
new file mode 100644
index 0000000000..8de1ec76c9
--- /dev/null
+++ b/lib/tools/src/tools.appup.src
@@ -0,0 +1,19 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-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%
+#
+{"%VSN%",[],[]}.
diff --git a/lib/tools/src/xref.erl b/lib/tools/src/xref.erl
new file mode 100644
index 0000000000..0693bec019
--- /dev/null
+++ b/lib/tools/src/xref.erl
@@ -0,0 +1,607 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+
+-module(xref).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start/1, start/2, stop/1]).
+
+-export([m/1, d/1,
+ add_release/2, add_release/3,
+ add_application/2, add_application/3,
+ add_module/2, add_module/3,
+ add_directory/2, add_directory/3,
+ replace_module/3, replace_module/4,
+ replace_application/3, replace_application/4,
+ remove_module/2, remove_application/2, remove_release/2,
+ get_library_path/1, set_library_path/2, set_library_path/3,
+ q/2, q/3, info/1, info/2, info/3,
+ update/1, update/2,
+ forget/1, forget/2, variables/1, variables/2,
+ analyze/2, analyze/3, analyse/2, analyse/3,
+ get_default/1, get_default/2,
+ set_default/2, set_default/3]).
+
+-export([format_error/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-import(lists, [keydelete/3, keysearch/3]).
+
+-import(sofs, [to_external/1, is_sofs_set/1]).
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+
+%% add_release(Servername, Directory) ->
+%% {ok, ReleaseName} | Error
+%% add_release(Servername, Directory, Options) ->
+%% {ok, ReleaseName} | Error
+%% add_application(Servername, Directory) ->
+%% {ok, AppName} | Error
+%% add_application(Servername, Directory, Options) ->
+%% {ok, AppName} | Error
+%% add_module(ServerName, Filename) ->
+%% {ok, ModuleName} | Error
+%% add_module(ServerName, Filename, Options) ->
+%% {ok, ModuleName} | Error
+%% add_directory(ServerName, Directory) ->
+%% {ok, [ModuleName]} | Error
+%% add_directory(ServerName, Directory, Options) ->
+%% {ok, [ModuleName]} | Error
+%% replace_module(ServerName, Module, Filename) ->
+%% {ok, Module} | Error
+%% replace_module(ServerName, Module, Filename, Options) ->
+%% {ok, Module} | Error
+%% replace_application(ServerName, Application, Directory) ->
+%% {ok, AppName} | Error
+%% replace_application(ServerName, Application, Directory, Options) ->
+%% {ok, AppName} | Error
+%% remove_module(ServerName, Module) -> ok | Error
+%% remove_application(ServerName, Application) -> ok | Error
+%% remove_release(ServerName, Release) -> ok | Error
+%% get_library_path(Servername) -> {ok, Path}
+%% set_library_path(Servername, Path) -> ok | Error
+%% set_library_path(Servername, Path, Options) -> ok | Error
+%% info(Servername) -> InfoList
+%% info(Servername, What) -> [{what(), InfoList}] | Error
+%% info(Servername, What, Qual) -> [{what(), InfoList}] | Error
+%% update(Servername) -> {ok, [Module]} | Error
+%% update(Servername, Options) -> {ok, [Module]} | Error
+%% forget(Servername) -> ok
+%% forget(Servername, VariableName) -> ok | Error
+%% variables(Servername) -> {ok, [{VarType, [VariableName]}]} | Error
+%% variables(Servername, [VarType]) -> {ok, [{VarType, [VariableName]}]}
+%% analyze(ServerName, What) -> {ok, Answer} | Error
+%% analyze(ServerName, What, Options) -> {ok, Answer} | Error
+%% q(Servername, Query) -> {ok, Answer} | Error
+%% q(Servername, Query, Options) -> {ok, Answer} | Error
+%% get_default(ServerName, Option) -> {ok, Value} | Error
+%% set_default(ServerName, Option, Value) -> {ok, OldValue} | Error
+%% get_default(ServerName) -> [{Option, Value}]
+%% set_default(ServerName, [{Option, Value}]) -> ok | Error
+%% format_error(Error) -> io_string()
+%% m(Module) -> [Result] | Error
+%% m(File) -> [Result] | Error
+%% d(Directory) -> [Result] | Error
+
+%% -> [Faulty] | Error; Faulty = {undefined, Calls} | {unused, Funs}
+%% No user variables have been assigned digraphs, so there is no
+%% need to call xref_base:delete/1.
+m(Module) when is_atom(Module) ->
+ case xref_utils:find_beam(Module) of
+ {ok, File} ->
+ Fun = fun(S) ->
+ xref_base:add_module(S, File, {builtins,true})
+ end,
+ case catch do_functions_analysis(Fun) of
+ {error, _, {no_debug_info, _}} ->
+ catch do_modules_analysis(Fun);
+ Result ->
+ Result
+ end;
+ Error -> Error
+ end;
+m(File) ->
+ case xref_utils:split_filename(File, ".beam") of
+ false ->
+ {error, xref_base, {invalid_filename, File}};
+ {Dir, BaseName} ->
+ BeamFile = filename:join(Dir, BaseName),
+ Fun = fun(S) ->
+ xref_base:add_module(S, BeamFile, {builtins, true})
+ end,
+ case catch do_functions_analysis(Fun) of
+ {error, _, {no_debug_info, _}} ->
+ catch do_modules_analysis(Fun);
+ Result ->
+ Result
+ end
+ end.
+
+%% -> [Faulty] | Error; Faulty = {undefined, Calls} | {unused, Funs}
+d(Directory) ->
+ Fun = fun(S) ->
+ xref_base:add_directory(S, Directory, {builtins, true})
+ end,
+ Fun1 = fun(S) ->
+ case Fun(S) of
+ {ok, [], _S} ->
+ no_modules;
+ Reply ->
+ Reply
+ end
+ end,
+ case catch do_functions_analysis(Fun1) of
+ no_modules ->
+ catch do_modules_analysis(Fun);
+ Result ->
+ Result
+ end.
+
+start(Name) when is_atom(Name) ->
+ start(Name, []);
+start(Opts0) when is_list(Opts0) ->
+ {Args, Opts} = split_args(Opts0),
+ gen_server:start(xref, Args, Opts).
+
+start(Name, Opts0) when is_list(Opts0) ->
+ {Args, Opts} = split_args(Opts0),
+ gen_server:start({local, Name}, xref, Args, Opts);
+start(Name, Opt) ->
+ start(Name, [Opt]).
+
+split_args(Opts) ->
+ case keysearch(xref_mode, 1, Opts) of
+ {value, Mode} ->
+ {[Mode], keydelete(xref_mode, 1, Opts)};
+ false ->
+ {[], Opts}
+ end.
+
+stop(Name) ->
+ gen_server:call(Name, stop, infinity).
+
+add_release(Name, Dir) ->
+ gen_server:call(Name, {add_release, Dir}, infinity).
+
+add_release(Name, Dir, Options) ->
+ gen_server:call(Name, {add_release, Dir, Options}, infinity).
+
+add_application(Name, Dir) ->
+ gen_server:call(Name, {add_application, Dir}, infinity).
+
+add_application(Name, Dir, Options) ->
+ gen_server:call(Name, {add_application, Dir, Options}, infinity).
+
+add_module(Name, File) ->
+ gen_server:call(Name, {add_module, File}, infinity).
+
+add_module(Name, File, Options) ->
+ gen_server:call(Name, {add_module, File, Options}, infinity).
+
+add_directory(Name, Dir) ->
+ gen_server:call(Name, {add_directory, Dir}, infinity).
+
+add_directory(Name, Dir, Options) ->
+ gen_server:call(Name, {add_directory, Dir, Options}, infinity).
+
+replace_module(Name, Module, File) ->
+ gen_server:call(Name, {replace_module, Module, File}, infinity).
+
+replace_module(Name, Module, File, Options) ->
+ gen_server:call(Name, {replace_module, Module, File, Options}, infinity).
+
+replace_application(Name, App, Dir) ->
+ gen_server:call(Name, {replace_application, App, Dir}, infinity).
+
+replace_application(Name, App, Dir, Options) ->
+ gen_server:call(Name, {replace_application, App, Dir, Options}, infinity).
+
+remove_module(Name, Mod) ->
+ gen_server:call(Name, {remove_module, Mod}, infinity).
+
+remove_application(Name, App) ->
+ gen_server:call(Name, {remove_application, App}, infinity).
+
+remove_release(Name, Rel) ->
+ gen_server:call(Name, {remove_release, Rel}, infinity).
+
+get_library_path(Name) ->
+ gen_server:call(Name, get_library_path, infinity).
+
+set_library_path(Name, Path) ->
+ gen_server:call(Name, {set_library_path, Path}, infinity).
+
+set_library_path(Name, Path, Options) ->
+ gen_server:call(Name, {set_library_path, Path, Options}, infinity).
+
+info(Name) ->
+ gen_server:call(Name, info, infinity).
+
+info(Name, What) ->
+ gen_server:call(Name, {info, What}, infinity).
+
+info(Name, What, Qual) ->
+ gen_server:call(Name, {info, What, Qual}, infinity).
+
+update(Name) ->
+ gen_server:call(Name, update, infinity).
+
+update(Name, Options) ->
+ gen_server:call(Name, {update, Options}, infinity).
+
+forget(Name) ->
+ gen_server:call(Name, forget, infinity).
+
+forget(Name, Variable) ->
+ gen_server:call(Name, {forget, Variable}, infinity).
+
+variables(Name) ->
+ gen_server:call(Name, variables, infinity).
+
+variables(Name, Options) ->
+ gen_server:call(Name, {variables, Options}, infinity).
+
+analyse(Name, What) ->
+ gen_server:call(Name, {analyze, What}, infinity).
+
+analyse(Name, What, Options) ->
+ gen_server:call(Name, {analyze, What, Options}, infinity).
+
+analyze(Name, What) ->
+ gen_server:call(Name, {analyze, What}, infinity).
+
+analyze(Name, What, Options) ->
+ gen_server:call(Name, {analyze, What, Options}, infinity).
+
+q(Name, Q) ->
+ gen_server:call(Name, {qry, Q}, infinity).
+
+q(Name, Q, Options) ->
+ gen_server:call(Name, {qry, Q, Options}, infinity).
+
+get_default(Name) ->
+ gen_server:call(Name, get_default, infinity).
+
+get_default(Name, Option) ->
+ gen_server:call(Name, {get_default, Option}, infinity).
+
+set_default(Name, OptionValues) ->
+ gen_server:call(Name, {set_default, OptionValues}, infinity).
+
+set_default(Name, Option, Value) ->
+ gen_server:call(Name, {set_default, Option, Value}, infinity).
+
+format_error({error, Module, Error}) ->
+ Module:format_error(Error);
+format_error(E) ->
+ io_lib:format("~p~n", [E]).
+
+%%%----------------------------------------------------------------------
+%%%Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%----------------------------------------------------------------------
+init(Args) ->
+ case xref_base:new(Args) of
+ {ok, S} ->
+ {ok, S};
+ {error, _Module, Reason} ->
+ {stop, Reason}
+ end.
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_call(stop, _From, State) ->
+ {stop, normal, stopped, State};
+handle_call({add_release, Dir}, _From, State) ->
+ case xref_base:add_release(State, Dir) of
+ {ok, ReleaseName, NewState} ->
+ {reply, {ok, ReleaseName}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_release, Dir, Options}, _From, State) ->
+ case xref_base:add_release(State, Dir, Options) of
+ {ok, ReleaseName, NewState} ->
+ {reply, {ok, ReleaseName}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_application, Dir}, _From, State) ->
+ case xref_base:add_application(State, Dir) of
+ {ok, AppName, NewState} ->
+ {reply, {ok, AppName}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_application, Dir, Options}, _From, State) ->
+ case xref_base:add_application(State, Dir, Options) of
+ {ok, AppName, NewState} ->
+ {reply, {ok, AppName}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_module, File}, _From, State) ->
+ case xref_base:add_module(State, File) of
+ {ok, Module, NewState} ->
+ {reply, {ok, Module}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_module, File, Options}, _From, State) ->
+ case xref_base:add_module(State, File, Options) of
+ {ok, Module, NewState} ->
+ {reply, {ok, Module}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({replace_application, Appl, Dir}, _From, State) ->
+ case xref_base:replace_application(State, Appl, Dir) of
+ {ok, AppName, NewState} ->
+ {reply, {ok, AppName}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({replace_application, Appl, Dir, Opts}, _From, State) ->
+ case xref_base:replace_application(State, Appl, Dir, Opts) of
+ {ok, AppName, NewState} ->
+ {reply, {ok, AppName}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({remove_module, Mod}, _From, State) ->
+ case xref_base:remove_module(State, Mod) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({remove_application, Appl}, _From, State) ->
+ case xref_base:remove_application(State, Appl) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({remove_release, Rel}, _From, State) ->
+ case xref_base:remove_release(State, Rel) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_directory, Dir}, _From, State) ->
+ case xref_base:add_directory(State, Dir) of
+ {ok, Modules, NewState} ->
+ {reply, {ok, Modules}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({add_directory, Dir, Options}, _From, State) ->
+ case xref_base:add_directory(State, Dir, Options) of
+ {ok, Modules, NewState} ->
+ {reply, {ok, Modules}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call(get_library_path, _From, State) ->
+ Path = xref_base:get_library_path(State),
+ {reply, Path, State};
+handle_call({set_library_path, Path}, _From, State) ->
+ case xref_base:set_library_path(State, Path) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({set_library_path, Path, Options}, _From, State) ->
+ case xref_base:set_library_path(State, Path, Options) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({replace_module, Module, File}, _From, State) ->
+ case xref_base:replace_module(State, Module, File) of
+ {ok, Module, NewState} ->
+ {reply, {ok, Module}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({replace_module, Module, File, Options}, _From, State) ->
+ case xref_base:replace_module(State, Module, File, Options) of
+ {ok, Module, NewState} ->
+ {reply, {ok, Module}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call(info, _From, State) ->
+ {reply, xref_base:info(State), State};
+handle_call({info, What}, _From, State) ->
+ {reply, xref_base:info(State, What), State};
+handle_call({info, What, Qual}, _From, State) ->
+ {reply, xref_base:info(State, What, Qual), State};
+handle_call(update, _From, State) ->
+ case xref_base:update(State) of
+ {ok, NewState, Modules} ->
+ {reply, {ok, Modules}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({update, Options}, _From, State) ->
+ case xref_base:update(State, Options) of
+ {ok, NewState, Modules} ->
+ {reply, {ok, Modules}, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call(forget, _From, State) ->
+ {ok, NewState} = xref_base:forget(State),
+ {reply, ok, NewState};
+handle_call({forget, Variable}, _From, State) ->
+ case xref_base:forget(State, Variable) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call(variables, _From, State) ->
+ %% The reason the ok-Error pattern is broken for variables, q and
+ %% analyze is that the state may have been updated even if an
+ %% error occurs.
+ {Reply, NewState} = xref_base:variables(State),
+ {reply, Reply, NewState};
+handle_call({variables, Options}, _From, State) ->
+ {Reply, NewState} = xref_base:variables(State, Options),
+ {reply, Reply, NewState};
+handle_call({analyze, What}, _From, State) ->
+ {Reply, NewState} = xref_base:analyze(State, What),
+ {reply, unsetify(Reply), NewState};
+handle_call({analyze, What, Options}, _From, State) ->
+ {Reply, NewState} = xref_base:analyze(State, What, Options),
+ {reply, unsetify(Reply), NewState};
+handle_call({qry, Q}, _From, State) ->
+ {Reply, NewState} = xref_base:q(State, Q),
+ {reply, unsetify(Reply), NewState};
+handle_call({qry, Q, Options}, _From, State) ->
+ {Reply, NewState} = xref_base:q(State, Q, Options),
+ {reply, unsetify(Reply), NewState};
+handle_call(get_default, _From, State) ->
+ Reply = xref_base:get_default(State),
+ {reply, Reply, State};
+handle_call({get_default, Option}, _From, State) ->
+ Reply = xref_base:get_default(State, Option),
+ {reply, Reply, State};
+handle_call({set_default, OptionValues}, _From, State) ->
+ case xref_base:set_default(State, OptionValues) of
+ {ok, NewState} ->
+ {reply, ok, NewState};
+ Error ->
+ {reply, Error, State}
+ end;
+handle_call({set_default, Option, Value}, _From, State) ->
+ case xref_base:set_default(State, Option, Value) of
+ {ok, OldValue, NewState} ->
+ {reply, {ok, OldValue}, NewState};
+ Error ->
+ {reply, Error, State}
+ end.
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(_Msg, State) -> {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%----------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%----------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+do_functions_analysis(FFun) ->
+ {ok, State} = xref_base:new(),
+ {ok, State1} = xref_base:set_library_path(State, code_path),
+ {ok, State2} = xref_base:set_default(State1,
+ [{verbose,false},{warnings,false}]),
+ State3 = case FFun(State2) of
+ {ok, _, S} -> S;
+ Error2 -> throw(Error2)
+ end,
+ {Undef, State4} = do_analysis(State3, undefined_function_calls),
+ {Unused, State5} = do_analysis(State4, locals_not_used),
+ {Deprecated, _} = do_analysis(State5, deprecated_function_calls),
+ [{deprecated,to_external(Deprecated)},
+ {undefined,to_external(Undef)},
+ {unused,to_external(Unused)}].
+
+do_modules_analysis(FFun) ->
+ {ok, State} = xref_base:new({xref_mode, modules}),
+ {ok, State1} = xref_base:set_library_path(State, code_path),
+ {ok, State2} = xref_base:set_default(State1,
+ [{verbose,false},{warnings,false}]),
+ State3 = case FFun(State2) of
+ {ok, _, S} -> S;
+ Error2 -> throw(Error2)
+ end,
+ {Undef, State4} = do_analysis(State3, undefined_functions),
+ {Deprecated, _} = do_analysis(State4, deprecated_functions),
+ [{deprecated,to_external(Deprecated)},
+ {undefined,to_external(Undef)}].
+
+do_analysis(State, Analysis) ->
+ case xref_base:analyze(State, Analysis) of
+ {{ok, Reply}, NewState} ->
+ {Reply, NewState};
+ {Error, _} ->
+ throw(Error)
+ end.
+
+unsetify(Reply={ok, X}) ->
+ case is_sofs_set(X) of
+ true -> {ok, to_external(X)};
+ false -> Reply
+ end;
+unsetify(Reply) ->
+ Reply.
diff --git a/lib/tools/src/xref.hrl b/lib/tools/src/xref.hrl
new file mode 100644
index 0000000000..fa8c5c746d
--- /dev/null
+++ b/lib/tools/src/xref.hrl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+
+%%% This file is meant to be included by xref_* only.
+
+-define(VAR_EXPR, '$F_EXPR').
+-define(MOD_EXPR, '$M_EXPR').
+
+%%% Filenames are stored as directory and basename. A lot of heap can
+%%% be saved by keeping only one (or few) copy of the directory name.
+
+%% 'data' in xref_mod holds "raw" data (as sets) for each module. The
+%% data in 'variables' is derived from raw data.
+-record(xref, {
+ version = 1, % version of the xref record
+ mode = functions,
+ variables = not_set_up, % table of variables
+
+ modules = dict:new(), % dict-of(xref_mod())
+ applications = dict:new(), % dict-of(xref_app())
+ releases = dict:new(), % dict-of(xref_rel())
+
+ library_path = [], % [string()] | code_path
+ libraries = dict:new(), % dict-of(xref_lib())
+
+ builtins_default = false, % Default value of the 'builtins' option.
+ recurse_default = false, % Default value of the 'recurse' option.
+ verbose_default = false, % Default value of the 'verbose' option.
+ warnings_default = true % Default value of the 'warnings' option.
+ }).
+
+-record(xref_mod, {
+ name = '',
+ app_name = [], % [] or [AppName]
+ dir = "", % string(), directory where the BEAM file resides
+ mtime, % modification time for file
+ builtins, % whether calls to built-in functions are included
+ info, % number of exports, locals etc.
+ no_unresolved = 0, % number of unresolved calls
+ data
+ %% Data has been read from the BEAM file, and is represented here
+ %% as a list of sets.
+ %% If xref.mode = functions:
+ %% [
+ %% DefAt, M -> P(V * N)
+ %% L, M -> P(V)
+ %% X, M -> P(V)
+ %% LCallAt, M -> P(V * V -> P(N))
+ %% XCallAt, M -> P(V * V -> P(N))
+ %% CallAt, M -> P(V * V -> P(N))
+ %% LC, M -> P(V * V)
+ %% XC, M -> P(V * V)
+ %% LU, M -> P(V)
+ %% EE, M -> P(EV * EV)
+ %% ECallAt, M -> P(EV * EV -> P(N))
+ %% Unres, M -> P(V * V)
+ %% LPredefined M -> P(V)
+ %% ]
+ %%
+ %% If xref.mode = modules:
+ %% [
+ %% X, M -> P(V)
+ %% I M -> P(V)
+ %% ]
+ }).
+
+-record(xref_app, {
+ name = '',
+ rel_name = [], % [] or [RelName]
+ vsn = [],
+ dir = "" % where BEAM files are read from
+ }).
+
+-record(xref_rel, {
+ name = '',
+ dir = "" % where application directories reside
+ }).
+
+-record(xref_lib, {
+ name = '', % atom(), module name
+ dir = "" % string(), directory where the file resides
+ }).
+
+-record(xref_var, {
+ name = '', % atom(), variable name
+ value, % set or pair of sets, variable value
+ vtype, % VarType (predef, tmp, user)
+ otype, % ObjectType (vertex, edge, etc.)
+ type % Type (function, module, etc.)
+ }).
diff --git a/lib/tools/src/xref_base.erl b/lib/tools/src/xref_base.erl
new file mode 100644
index 0000000000..d0dbf4a2b4
--- /dev/null
+++ b/lib/tools/src/xref_base.erl
@@ -0,0 +1,1804 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+
+-module(xref_base).
+
+-export([new/0, new/1, delete/1,
+ add_directory/2, add_directory/3,
+ add_module/2, add_module/3,
+ add_application/2, add_application/3,
+ replace_module/3, replace_module/4,
+ replace_application/3, replace_application/4,
+ remove_module/2, remove_application/2, remove_release/2,
+ add_release/2, add_release/3,
+ get_library_path/1, set_library_path/2, set_library_path/3,
+ set_up/1, set_up/2,
+ q/2, q/3, info/1, info/2, info/3, update/1, update/2,
+ forget/1, forget/2, variables/1, variables/2,
+ analyze/2, analyze/3, analysis/1,
+ get_default/2, set_default/3,
+ get_default/1, set_default/2]).
+
+-export([format_error/1]).
+
+%% The following functions are exported for testing purposes only:
+-export([do_add_module/4, do_add_application/2, do_add_release/2,
+ do_remove_module/2]).
+
+-import(lists,
+ [filter/2, flatten/1, foldl/3, keysearch/3, map/2, mapfoldl/3,
+ member/2, reverse/1, sort/1, usort/1]).
+
+-import(sofs,
+ [constant_function/2, converse/1, difference/2, domain/1,
+ empty_set/0, family/1, family_difference/2, intersection/2,
+ family_projection/2, family_to_relation/1, family_union/1,
+ family_union/2, from_sets/1, from_term/1, a_function/1,
+ image/2, family_intersection/2, inverse/1, is_empty_set/1,
+ multiple_relative_product/2, no_elements/1,
+ partition_family/2, projection/2, range/1, relation/1,
+ relation_to_family/1, relative_product1/2, restriction/2,
+ restriction/3, set/1, specification/2, substitution/2,
+ to_external/1, union/1, union/2, union_of_family/1]).
+
+-include("xref.hrl").
+
+-define(Suffix, ".beam").
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(FORMAT(P, A), io:format(P, A)).
+-else.
+-define(FORMAT(P, A), ok).
+-endif.
+
+%%
+%% Exported functions
+%%
+
+new() ->
+ new([]).
+
+%% -> {ok, InitialState}
+new(Options) ->
+ Modes = [functions,modules,function,module],
+ case xref_utils:options(Options, [{xref_mode,Modes}]) of
+ {[[function]], []} ->
+ {ok, #xref{mode = functions}};
+ {[[module]], []} ->
+ {ok, #xref{mode = modules}};
+ {[[OM]], []} ->
+ {ok, #xref{mode = OM}};
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+%% -> ok
+%% Need not be called by the server.
+delete(State) when State#xref.variables =:= not_set_up ->
+ ok;
+delete(State) ->
+ Fun = fun({X, _}) ->
+ case catch digraph:info(X) of
+ Info when is_list(Info) ->
+ true = digraph:delete(X);
+ _Else ->
+ ok
+ end
+ end,
+ map(Fun, dict:to_list(State#xref.variables)),
+ ok.
+
+add_directory(State, Dir) ->
+ add_directory(State, Dir, []).
+
+%% -> {ok, Modules, NewState} | Error
+add_directory(State, Dir, Options) ->
+ ValOptions = option_values([builtins, recurse, verbose, warnings], State),
+ case xref_utils:options(Options, ValOptions) of
+ {[[OB], [OR], [OV], [OW]], []} ->
+ catch do_add_directory(Dir, [], OB, OR, OV, OW, State);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+add_module(State, File) ->
+ add_module(State, File, []).
+
+%% -> {ok, Module, NewState} | Error
+add_module(State, File, Options) ->
+ ValOptions = option_values([builtins, verbose, warnings], State),
+ case xref_utils:options(Options, ValOptions) of
+ {[[OB], [OV], [OW]], []} ->
+ case catch do_add_a_module(File, [], OB, OV, OW, State) of
+ {ok, [Module], NewState} ->
+ {ok, Module, NewState};
+ {ok, [], _NewState} ->
+ error({no_debug_info, File});
+ Error ->
+ Error
+ end;
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+add_application(State, AppDir) ->
+ add_application(State, AppDir, []).
+
+%% -> {ok, AppName, NewState} | Error
+add_application(State, AppDir, Options) ->
+ OptVals = option_values([builtins, verbose, warnings], State),
+ ValidOptions = [{name, ["", fun check_name/1]} | OptVals],
+ case xref_utils:options(Options, ValidOptions) of
+ {[ApplName, [OB], [OV], [OW]], []} ->
+ catch do_add_application(AppDir, [], ApplName, OB, OV, OW, State);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+replace_module(State, Module, File) ->
+ replace_module(State, Module, File, []).
+
+%% -> {ok, Module, NewState} | Error
+replace_module(State, Module, File, Options) ->
+ ValidOptions = option_values([verbose, warnings], State),
+ case xref_utils:options(Options, ValidOptions) of
+ {[[OV], [OW]], []} ->
+ catch do_replace_module(Module, File, OV, OW, State);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+replace_application(State, Appl, Dir) ->
+ replace_application(State, Appl, Dir, []).
+
+%% -> {ok, AppName, NewState} | Error
+replace_application(State, Appl, Dir, Options) ->
+ ValidOptions = option_values([builtins, verbose, warnings], State),
+ case xref_utils:options(Options, ValidOptions) of
+ {[[OB], [OV], [OW]], []} ->
+ catch do_replace_application(Appl, Dir, OB, OV, OW, State);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+%% -> {ok, NewState} | Error
+remove_module(State, Mod) when is_atom(Mod) ->
+ remove_module(State, [Mod]);
+remove_module(State, [Mod | Mods]) ->
+ case catch do_remove_module(State, Mod) of
+ {ok, _OldXMod, NewState} ->
+ remove_module(NewState, Mods);
+ Error ->
+ Error
+ end;
+remove_module(State, []) ->
+ {ok, State}.
+
+%% -> {ok, NewState} | Error
+remove_application(State, Appl) when is_atom(Appl) ->
+ remove_application(State, [Appl]);
+remove_application(State, [Appl | Appls]) ->
+ case catch do_remove_application(State, Appl) of
+ {ok, _OldXApp, NewState} ->
+ remove_application(NewState, Appls);
+ Error ->
+ Error
+ end;
+remove_application(State, []) ->
+ {ok, State}.
+
+%% -> {ok, NewState} | Error
+remove_release(State, Rel) when is_atom(Rel) ->
+ remove_release(State, [Rel]);
+remove_release(State, [Rel | Rels]) ->
+ case catch do_remove_release(State, Rel) of
+ {ok, _OldXRel, NewState} ->
+ remove_release(NewState, Rels);
+ Error ->
+ Error
+ end;
+remove_release(State, []) ->
+ {ok, State}.
+
+add_release(State, RelDir) ->
+ add_release(State, RelDir, []).
+
+%% -> {ok, ReleaseName, NewState} | Error
+add_release(State, RelDir, Options) ->
+ ValidOptions0 = option_values([builtins, verbose, warnings], State),
+ ValidOptions = [{name, ["", fun check_name/1]} | ValidOptions0],
+ case xref_utils:options(Options, ValidOptions) of
+ {[RelName, [OB], [OV], [OW]], []} ->
+ catch do_add_release(RelDir, RelName, OB, OV, OW, State);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+get_library_path(State) ->
+ {ok, State#xref.library_path}.
+
+set_library_path(State, Path) ->
+ set_library_path(State, Path, []).
+
+%% -> {ok, NewState} | Error
+set_library_path(State, code_path, _Options) ->
+ S1 = State#xref{library_path = code_path, libraries = dict:new()},
+ {ok, take_down(S1)};
+set_library_path(State, Path, Options) ->
+ case xref_utils:is_path(Path) of
+ true ->
+ ValidOptions = option_values([verbose], State),
+ case xref_utils:options(Options, ValidOptions) of
+ {[[OV]], []} ->
+ do_add_libraries(Path, OV, State);
+ _ ->
+ error({invalid_options, Options})
+ end;
+ false ->
+ error({invalid_path, Path})
+ end.
+
+set_up(State) ->
+ set_up(State, []).
+
+%% -> {ok, NewState} | Error
+set_up(State, Options) ->
+ ValidOptions = option_values([verbose], State),
+ case xref_utils:options(Options, ValidOptions) of
+ {[[Verbose]], []} ->
+ do_set_up(State, Verbose);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+q(S, Q) ->
+ q(S, Q, []).
+
+%% -> {{ok, Answer}, NewState} | {Error, NewState}
+q(S, Q, Options) when is_atom(Q) ->
+ q(S, atom_to_list(Q), Options);
+q(S, Q, Options) ->
+ case xref_utils:is_string(Q, 1) of
+ true ->
+ case set_up(S, Options) of
+ {ok, S1} ->
+ case xref_compiler:compile(Q, S1#xref.variables) of
+ {NewT, Ans} ->
+ {{ok, Ans}, S1#xref{variables = NewT}};
+ Error ->
+ {Error, S1}
+ end;
+ Error ->
+ {Error, S}
+ end;
+ false ->
+ {error({invalid_query, Q}), S}
+ end.
+
+%% -> InfoList
+info(State) ->
+ D0 = sort(dict:to_list(State#xref.modules)),
+ D = map(fun({_M, XMod}) -> XMod end, D0),
+ NoApps = length(dict:to_list(State#xref.applications)),
+ NoRels = length(dict:to_list(State#xref.releases)),
+ No = no_sum(State, D),
+ [{library_path, State#xref.library_path}, {mode, State#xref.mode},
+ {no_releases, NoRels}, {no_applications, NoApps}] ++ No.
+
+info(State, What) ->
+ do_info(State, What).
+
+%% -> [{what(), InfoList}]
+info(State, What, Qual) ->
+ catch do_info(State, What, Qual).
+
+update(State) ->
+ update(State, []).
+
+%% -> {ok, NewState, Modules} | Error
+update(State, Options) ->
+ ValidOptions = option_values([verbose, warnings], State),
+ case xref_utils:options(Options, ValidOptions) of
+ {[[OV],[OW]], []} ->
+ catch do_update(OV, OW, State);
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+%% -> {ok, NewState}
+forget(State) ->
+ {U, _P} = do_variables(State),
+ {ok, foldl(fun(V, S) -> {ok, NS} = forget(S, V), NS end, State, U)}.
+
+%% -> {ok, NewState} | Error
+forget(State, Variable) when State#xref.variables =:= not_set_up ->
+ error({not_user_variable, Variable});
+forget(State, Variable) when is_atom(Variable) ->
+ forget(State, [Variable]);
+forget(State, Variables) ->
+ Vars = State#xref.variables,
+ do_forget(Variables, Vars, Variables, State).
+
+variables(State) ->
+ variables(State, [user]).
+
+%% -> {{ok, Answer}, NewState} | {Error, NewState}
+%% Answer = [{vartype(), [VariableName]}]
+variables(State, Options) ->
+ ValidOptions = option_values([verbose], State),
+ case xref_utils:options(Options, [user, predefined | ValidOptions]) of
+ {[User,Predef,[OV]],[]} ->
+ case do_set_up(State, OV) of
+ {ok, NewState} ->
+ {U, P} = do_variables(NewState),
+ R1 = if User -> [{user, U}]; true -> [] end,
+ R = if
+ Predef -> [{predefined,P} | R1];
+ true -> R1
+ end,
+ {{ok, R}, NewState};
+ Error ->
+ {Error, State}
+ end;
+ _ ->
+ {error({invalid_options, Options}), State}
+ end.
+
+analyze(State, Analysis) ->
+ analyze(State, Analysis, []).
+
+%% -> {{ok, Answer}, NewState} | {Error, NewState}
+analyze(State, Analysis, Options) ->
+ case analysis(Analysis, State#xref.mode) of
+ P when is_list(P) ->
+ q(State, P, Options);
+ error ->
+ R = case analysis(Analysis, functions) of
+ error -> unknown_analysis;
+ P when is_list(P) -> unavailable_analysis
+ end,
+ Error = error({R, Analysis}),
+ {Error, State}
+ end.
+
+analysis(Analysis) ->
+ analysis(Analysis, functions).
+
+%% -> string() | Error
+analysis(undefined_function_calls, functions) ->
+ "(XC - UC) || (XU - X - B)";
+analysis(undefined_functions, modules) ->
+ %% "XU * (L + U)" is equivalent, but the following works when L is
+ %% not available.
+ "XU - X - B";
+analysis(undefined_functions, functions) ->
+ %% "XU * ((L + U) - range UC)" is equivalent.
+ "XU - range UC - X - B";
+analysis(locals_not_used, functions) ->
+ %% The Inter Call Graph is used to get local functions that are not
+ %% used (indirectly) from any export: "(domain EE + range EE) * L".
+ %% But then we only get locals that make some calls, so we add
+ %% locals that are not used at all: "L * (UU + XU - LU)".
+ "L * ((UU + XU - LU) + domain EE + range EE)";
+analysis(exports_not_used, _) ->
+ %% Local calls are not considered here. "X * UU" would do otherwise.
+ "X - XU";
+analysis({call, F}, functions) ->
+ make_query("range (E | ~w : Fun)", [F]);
+analysis({use, F}, functions) ->
+ make_query("domain (E || ~w : Fun)", [F]);
+analysis({module_call, M}, _) ->
+ make_query("range (ME | ~w : Mod)", [M]);
+analysis({module_use, M}, _) ->
+ make_query("domain (ME || ~w : Mod)", [M]);
+analysis({application_call, A}, _) ->
+ make_query("range (AE | ~w : App)", [A]);
+analysis({application_use, A}, _) ->
+ make_query("domain (AE || ~w : App)", [A]);
+analysis({release_call, R}, _) ->
+ make_query("range (RE | ~w : Rel)", [R]);
+analysis({release_use, R}, _) ->
+ make_query("domain (RE || ~w : Rel)", [R]);
+analysis(deprecated_function_calls, functions) ->
+ "XC || DF";
+analysis({deprecated_function_calls,Flag}, functions) ->
+ case deprecated_flag(Flag) of
+ undefined -> error;
+ I -> make_query("XC || DF_~w", [I])
+ end;
+analysis(deprecated_functions, _) ->
+ "XU * DF";
+analysis({deprecated_functions,Flag}, _) ->
+ case deprecated_flag(Flag) of
+ undefined -> error;
+ I -> make_query("XU * DF_~w", [I])
+ end;
+analysis(_, _) ->
+ error.
+
+%% -> {ok, OldValue, NewState} | Error
+set_default(State, Option, Value) ->
+ case get_default(State, Option) of
+ {ok, OldValue} ->
+ Values = option_values([Option], State),
+ case xref_utils:options([{Option,Value}], Values) of
+ {_, []} ->
+ NewState = set_def(Option, Value, State),
+ {ok, OldValue, NewState};
+ {_, Unknown} ->
+ error({invalid_options, Unknown})
+ end;
+ Error ->
+ Error
+ end.
+
+%% -> {ok, Value} | Error
+get_default(State, Option) ->
+ case catch current_default(State, Option) of
+ {'EXIT', _} ->
+ error({invalid_options, [Option]});
+ Value ->
+ {ok, Value}
+ end.
+
+%% -> [{Option, Value}]
+get_default(State) ->
+ Fun = fun(O) -> V = current_default(State, O), {O, V} end,
+ map(Fun, [builtins, recurse, verbose, warnings]).
+
+%% -> {ok, NewState} -> Error
+set_default(State, Options) ->
+ Opts = [builtins, recurse, verbose, warnings],
+ ValidOptions = option_values(Opts, State),
+ case xref_utils:options(Options, ValidOptions) of
+ {Values = [[_], [_], [_], [_]], []} ->
+ {ok, set_defaults(Opts, Values, State)};
+ _ ->
+ error({invalid_options, Options})
+ end.
+
+format_error({error, Module, Error}) ->
+ Module:format_error(Error);
+format_error({invalid_options, Options}) ->
+ io_lib:format("Unknown option(s) or invalid option value(s): ~p~n",
+ [Options]);
+format_error({invalid_filename, Term}) ->
+ io_lib:format("A file name (a string) was expected: ~p~n", [Term]);
+format_error({no_debug_info, FileName}) ->
+ io_lib:format("The BEAM file ~p has no debug info~n", [FileName]);
+format_error({invalid_path, Term}) ->
+ io_lib:format("A path (a list of strings) was expected: ~p~n", [Term]);
+format_error({invalid_query, Term}) ->
+ io_lib:format("A query (a string or an atom) was expected: ~p~n", [Term]);
+format_error({not_user_variable, Variable}) ->
+ io_lib:format("~p is not a user variable~n", [Variable]);
+format_error({unknown_analysis, Term}) ->
+ io_lib:format("~p is not a predefined analysis~n", [Term]);
+format_error({module_mismatch, Module, ReadModule}) ->
+ io_lib:format("Name of read module ~p does not match analyzed module ~p~n",
+ [ReadModule, Module]);
+format_error({release_clash, {Release, Dir, OldDir}}) ->
+ io_lib:format("The release ~p read from ~p clashes with release "
+ "already read from ~p~n", [Release, Dir, OldDir]);
+format_error({application_clash, {Application, Dir, OldDir}}) ->
+ io_lib:format("The application ~p read from ~p clashes with application "
+ "already read from ~p~n", [Application, Dir, OldDir]);
+format_error({module_clash, {Module, Dir, OldDir}}) ->
+ io_lib:format("The module ~p read from ~p clashes with module "
+ "already read from ~p~n", [Module, Dir, OldDir]);
+format_error({no_such_release, Name}) ->
+ io_lib:format("There is no analyzed release ~p~n", [Name]);
+format_error({no_such_application, Name}) ->
+ io_lib:format("There is no analyzed application ~p~n", [Name]);
+format_error({no_such_module, Name}) ->
+ io_lib:format("There is no analyzed module ~p~n", [Name]);
+format_error({no_such_info, Term}) ->
+ io_lib:format("~p is not one of 'modules', 'applications', "
+ "'releases' and 'libraries'~n", [Term]);
+format_error(E) ->
+ io_lib:format("~p~n", [E]).
+
+%%
+%% Local functions
+%%
+
+check_name([N]) when is_atom(N) -> true;
+check_name(_) -> false.
+
+do_update(OV, OW, State) ->
+ Changed = updated_modules(State),
+ Fun = fun({Mod,File}, S) ->
+ {ok, _M, NS} = do_replace_module(Mod, File, OV, OW, S),
+ NS
+ end,
+ NewState = foldl(Fun, State, Changed),
+ {ok, NewState, to_external(domain(a_function(Changed)))}.
+
+%% -> [{Module, File}]
+updated_modules(State) ->
+ Fun = fun({M,XMod}, L) ->
+ RTime = XMod#xref_mod.mtime,
+ File = module_file(XMod),
+ case xref_utils:file_info(File) of
+ {ok, {_, file, readable, MTime}} when MTime =/= RTime ->
+ [{M,File} | L];
+ _Else ->
+ L
+ end
+ end,
+ foldl(Fun, [], dict:to_list(State#xref.modules)).
+
+do_forget([Variable | Variables], Vars, Vs, State) ->
+ case dict:find(Variable, Vars) of
+ {ok, #xref_var{vtype = user}} ->
+ do_forget(Variables, Vars, Vs, State);
+ _ ->
+ error({not_user_variable, Variable})
+ end;
+do_forget([], Vars, Vs, State) ->
+ Fun = fun(V, VT) ->
+ {ok, #xref_var{value = Value}} = dict:find(V, VT),
+ VT1 = xref_compiler:update_graph_counter(Value, -1, VT),
+ dict:erase(V, VT1)
+ end,
+ NewVars = foldl(Fun, Vars, Vs),
+ NewState = State#xref{variables = NewVars},
+ {ok, NewState}.
+
+%% -> {ok, Module, State} | throw(Error)
+do_replace_module(Module, File, OV, OW, State) ->
+ {ok, OldXMod, State1} = do_remove_module(State, Module),
+ OldApp = OldXMod#xref_mod.app_name,
+ OB = OldXMod#xref_mod.builtins,
+ case do_add_a_module(File, OldApp, OB, OV, OW, State1) of
+ {ok, [Module], NewState} ->
+ {ok, Module, NewState};
+ {ok, [ReadModule], _State} ->
+ throw_error({module_mismatch, Module, ReadModule});
+ {ok, [], _NewState} ->
+ throw_error({no_debug_info, File})
+ end.
+
+do_replace_application(Appl, Dir, OB, OV, OW, State) ->
+ {ok, OldXApp, State1} = do_remove_application(State, Appl),
+ Rel = OldXApp#xref_app.rel_name,
+ N = OldXApp#xref_app.name,
+ %% The application name is kept; the name of Dir is not used
+ %% as source for a "new" application name.
+ do_add_application(Dir, Rel, [N], OB, OV, OW, State1).
+
+%% -> {ok, ReleaseName, NewState} | throw(Error)
+do_add_release(Dir, RelName, OB, OV, OW, State) ->
+ ok = is_filename(Dir),
+ case xref_utils:release_directory(Dir, true, "ebin") of
+ {ok, ReleaseDirName, ApplDir, Dirs} ->
+ ApplDirs = xref_utils:select_last_application_version(Dirs),
+ Release = case RelName of
+ [[]] -> ReleaseDirName;
+ [Name] -> Name
+ end,
+ XRel = #xref_rel{name = Release, dir = ApplDir},
+ NewState = do_add_release(State, XRel),
+ add_rel_appls(ApplDirs, [Release], OB, OV, OW, NewState);
+ Error ->
+ throw(Error)
+ end.
+
+do_add_release(S, XRel) ->
+ Release = XRel#xref_rel.name,
+ case dict:find(Release, S#xref.releases) of
+ {ok, OldXRel} ->
+ Dir = XRel#xref_rel.dir,
+ OldDir = OldXRel#xref_rel.dir,
+ throw_error({release_clash, {Release, Dir, OldDir}});
+ error ->
+ D1 = dict:store(Release, XRel, S#xref.releases),
+ S#xref{releases = D1}
+ end.
+
+add_rel_appls([ApplDir | ApplDirs], Release, OB, OV, OW, State) ->
+ {ok, _AppName, NewState} =
+ add_appldir(ApplDir, Release, [[]], OB, OV, OW, State),
+ add_rel_appls(ApplDirs, Release, OB, OV, OW, NewState);
+add_rel_appls([], [Release], _OB, _OV, _OW, NewState) ->
+ {ok, Release, NewState}.
+
+do_add_application(Dir0, Release, Name, OB, OV, OW, State) ->
+ ok = is_filename(Dir0),
+ case xref_utils:select_application_directories([Dir0], "ebin") of
+ {ok, [ApplD]} ->
+ add_appldir(ApplD, Release, Name, OB, OV, OW, State);
+ Error ->
+ throw(Error)
+ end.
+
+%% -> {ok, AppName, NewState} | throw(Error)
+add_appldir(ApplDir, Release, Name, OB, OV, OW, OldState) ->
+ {AppName0, Vsn, Dir} = ApplDir,
+ AppName = case Name of
+ [[]] -> AppName0;
+ [N] -> N
+ end,
+ AppInfo = #xref_app{name = AppName, rel_name = Release,
+ vsn = Vsn, dir = Dir},
+ State1 = do_add_application(OldState, AppInfo),
+ {ok, _Modules, NewState} =
+ do_add_directory(Dir, [AppName], OB, false, OV, OW, State1),
+ {ok, AppName, NewState}.
+
+%% -> State | throw(Error)
+do_add_application(S, XApp) ->
+ Application = XApp#xref_app.name,
+ case dict:find(Application, S#xref.applications) of
+ {ok, OldXApp} ->
+ Dir = XApp#xref_app.dir,
+ OldDir = OldXApp#xref_app.dir,
+ throw_error({application_clash, {Application, Dir, OldDir}});
+ error ->
+ D1 = dict:store(Application, XApp, S#xref.applications),
+ S#xref{applications = D1}
+ end.
+
+%% -> {ok, Modules, NewState} | throw(Error)
+do_add_directory(Dir, AppName, Bui, Rec, Ver, War, State) ->
+ ok = is_filename(Dir),
+ {FileNames, Errors, Jams, Unreadable} =
+ xref_utils:scan_directory(Dir, Rec, [?Suffix], [".jam"]),
+ warnings(War, jam, Jams),
+ warnings(War, unreadable, Unreadable),
+ case Errors of
+ [] ->
+ do_add_modules(FileNames, AppName, Bui, Ver, War, State, []);
+ [Error | _] ->
+ throw(Error)
+ end.
+
+do_add_modules([], _AppName, _OB, _OV, _OW, State, Modules) ->
+ {ok, sort(Modules), State};
+do_add_modules([File | Files], AppName, OB, OV, OW, State, Modules) ->
+ {ok, M, NewState} = do_add_module(File, AppName, OB, OV, OW, State),
+ do_add_modules(Files, AppName, OB, OV, OW, NewState, M ++ Modules).
+
+%% -> {ok, Module, State} | throw(Error)
+do_add_a_module(File, AppName, Builtins, Verbose, Warnings, State) ->
+ case xref_utils:split_filename(File, ?Suffix) of
+ false ->
+ throw_error({invalid_filename, File});
+ Splitname ->
+ do_add_module(Splitname, AppName, Builtins, Verbose,
+ Warnings, State)
+ end.
+
+%% -> {ok, Module, State} | throw(Error)
+%% Options: verbose, warnings, builtins
+do_add_module({Dir, Basename}, AppName, Builtins, Verbose, Warnings, State) ->
+ File = filename:join(Dir, Basename),
+ {ok, M, Bad, NewState} =
+ do_add_module1(Dir, File, AppName, Builtins, Verbose, Warnings, State),
+ filter(fun({Tag,B}) -> warnings(Warnings, Tag, [[File,B]]) end, Bad),
+ {ok, M, NewState}.
+
+do_add_module1(Dir, File, AppName, Builtins, Verbose, Warnings, State) ->
+ message(Verbose, reading_beam, [File]),
+ Mode = State#xref.mode,
+ Me = self(),
+ Fun = fun() -> Me ! {self(), abst(File, Builtins, Mode)} end,
+ case xref_utils:subprocess(Fun, [link, {min_heap_size,100000}]) of
+ {ok, _M, no_abstract_code} when Verbose ->
+ message(Verbose, skipped_beam, []),
+ {ok, [], [], State};
+ {ok, _M, no_abstract_code} when not Verbose ->
+ message(Warnings, no_debug_info, [File]),
+ {ok, [], [], State};
+ {ok, M, Data, UnresCalls0} ->
+ %% Remove duplicates. Identical unresolved calls on the
+ %% same line are counted as _one_ unresolved call.
+ UnresCalls = usort(UnresCalls0),
+ message(Verbose, done, []),
+ NoUnresCalls = length(UnresCalls),
+ case NoUnresCalls of
+ 0 -> ok;
+ 1 -> warnings(Warnings, unresolved_summary1, [[M]]);
+ N -> warnings(Warnings, unresolved_summary, [[M, N]])
+ end,
+ T = case xref_utils:file_info(File) of
+ {ok, {_, _, _, Time}} -> Time;
+ Error -> throw(Error)
+ end,
+ XMod = #xref_mod{name = M, app_name = AppName, dir = Dir,
+ mtime = T, builtins = Builtins,
+ no_unresolved = NoUnresCalls},
+ do_add_module(State, XMod, UnresCalls, Data);
+ Error ->
+ message(Verbose, error, []),
+ throw(Error)
+ end.
+
+abst(File, Builtins, Mode) when Mode =:= functions ->
+ case beam_lib:chunks(File, [abstract_code, exports, attributes]) of
+ {ok, {M,[{abstract_code,NoA},_X,_A]}} when NoA =:= no_abstract_code ->
+ {ok, M, NoA};
+ {ok, {M, [{abstract_code, {abstract_v1, Forms}},
+ {exports,X0}, {attributes,A}]}} ->
+ %% R7.
+ X = xref_utils:fa_to_mfa(X0, M),
+ D = deprecated(A, X, M),
+ xref_reader:module(M, Forms, Builtins, X, D);
+ {ok, {M, [{abstract_code, {abstract_v2, Forms}},
+ {exports,X0}, {attributes,A}]}} ->
+ %% R8-R9B.
+ X = xref_utils:fa_to_mfa(X0, M),
+ D = deprecated(A, X, M),
+ xref_reader:module(M, Forms, Builtins, X, D);
+ {ok, {M, [{abstract_code, {raw_abstract_v1, Code}},
+ {exports,X0}, {attributes,A}]}} ->
+ %% R9C-
+ Forms0 = epp:interpret_file_attribute(Code),
+ {_,_,Forms,_} = sys_pre_expand:module(Forms0, []),
+ X = mfa_exports(X0, A, M),
+ D = deprecated(A, X, M),
+ xref_reader:module(M, Forms, Builtins, X, D);
+ Error when element(1, Error) =:= error ->
+ Error
+ end;
+abst(File, Builtins, Mode) when Mode =:= modules ->
+ case beam_lib:chunks(File, [exports, imports, attributes]) of
+ {ok, {Mod, [{exports,X0}, {imports,I0}, {attributes,At}]}} ->
+ X1 = mfa_exports(X0, At, Mod),
+ X = filter(fun(MFA) -> not (predef_fun())(MFA) end, X1),
+ D = deprecated(At, X, Mod),
+ I = case Builtins of
+ true ->
+ I0;
+ false ->
+ Fun = fun({M,F,A}) ->
+ not xref_utils:is_builtin(M, F, A)
+ end,
+ filter(Fun, I0)
+ end,
+ {ok, Mod, {X, I, D}, []};
+ Error when element(1, Error) =:= error ->
+ Error
+ end.
+
+mfa_exports(X0, Attributes, M) ->
+ %% Adjust arities for abstract modules.
+ X1 = case xref_utils:is_abstract_module(Attributes) of
+ true ->
+ [{F,adjust_arity(F,A)} || {F,A} <- X0];
+ false ->
+ X0
+ end,
+ xref_utils:fa_to_mfa(X1, M).
+
+adjust_arity(F, A) ->
+ case xref_utils:is_static_function(F, A) of
+ true -> A;
+ false -> A - 1
+ end.
+
+deprecated(A, X, M) ->
+ DF = {[],[],[],[]},
+ case keysearch(deprecated, 1, A) of
+ {value, {deprecated, D0}} ->
+ depr(D0, M, DF, X, []);
+ false ->
+ {DF,[]}
+ end.
+
+depr([D | Depr], M, DF, X, Bad) ->
+ case depr_cat(D, M, X) of
+ {I,Dt} ->
+ NDF = setelement(I, DF, Dt ++ element(I, DF)),
+ depr(Depr, M, NDF, X, Bad);
+ undefined ->
+ depr(Depr, M, DF, X, [D | Bad])
+ end;
+depr([], _M, DF, _X, Bad) ->
+ {DF, reverse(Bad)}.
+
+depr_cat({F, A, Flg}, M, X) ->
+ case deprecated_flag(Flg) of
+ undefined -> undefined;
+ I -> depr_fa(F, A, X, M, I)
+ end;
+depr_cat({F, A}, M, X) ->
+ depr_fa(F, A, X, M, 4);
+depr_cat(module, M, X) ->
+ depr_fa('_', '_', X, M, 4);
+depr_cat(_D, _M, _X) ->
+ undefined.
+
+depr_fa('_', '_', X, _M, I) ->
+ {I, X};
+depr_fa(F, '_', X, _M, I) when is_atom(F) ->
+ {I, filter(fun({_,F1,_}) -> F1 =:= F end, X)};
+depr_fa(F, A, _X, M, I) when is_atom(F), is_integer(A), A >= 0 ->
+ {I, [{M,F,A}]};
+depr_fa(_F, _A, _X, _M, _I) ->
+ undefined.
+
+%% deprecated_flag(Flag) -> integer() | undefined
+%% Maps symbolic flags for deprecated functions to integers.
+
+%deprecated_flag(1) -> 1;
+%deprecated_flag(2) -> 2;
+%deprecated_flag(3) -> 3;
+deprecated_flag(next_version) -> 1;
+deprecated_flag(next_major_release) -> 2;
+deprecated_flag(eventually) -> 3;
+deprecated_flag(_) -> undefined.
+
+%% -> {ok, Module, Bad, State} | throw(Error)
+%% Assumes:
+%% L U X is a subset of dom DefAt
+%% dom CallAt = LC U XC
+%% Attrs is collected from the attribute 'xref' (experimental).
+do_add_module(S, XMod, Unres, Data) ->
+ M = XMod#xref_mod.name,
+ case dict:find(M, S#xref.modules) of
+ {ok, OldXMod} ->
+ BF2 = module_file(XMod),
+ BF1 = module_file(OldXMod),
+ throw_error({module_clash, {M, BF1, BF2}});
+ error ->
+ do_add_module(S, M, XMod, Unres, Data)
+ end.
+
+%%do_add_module(S, M, _XMod, _Unres, Data)->
+%% {ok, M, [], S};
+do_add_module(S, M, XMod, Unres0, Data) when S#xref.mode =:= functions ->
+ {DefAt0, LPreCAt0, XPreCAt0, LC0, XC0, X0, Attrs, Depr} = Data,
+ %% Bad is a list of bad values of 'xref' attributes.
+ {ALC0,AXC0,Bad0} = Attrs,
+ FT = [tspec(func)],
+ FET = [tspec(fun_edge)],
+ PCA = [tspec(pre_call_at)],
+
+ XPreCAt1 = xref_utils:xset(XPreCAt0, PCA),
+ LPreCAt1 = xref_utils:xset(LPreCAt0, PCA),
+ DefAt = xref_utils:xset(DefAt0, [tspec(def_at)]),
+ X1 = xref_utils:xset(X0, FT),
+ XC1 = xref_utils:xset(XC0, FET),
+ LC1 = xref_utils:xset(LC0, FET),
+ AXC1 = xref_utils:xset(AXC0, PCA),
+ ALC1 = xref_utils:xset(ALC0, PCA),
+ UnresCalls = xref_utils:xset(Unres0, PCA),
+ Unres = domain(UnresCalls),
+
+ DefinedFuns = domain(DefAt),
+ {AXC, ALC, Bad1, LPreCAt2, XPreCAt2} =
+ extra_edges(AXC1, ALC1, Bad0, DefinedFuns),
+ Bad = map(fun(B) -> {xref_attr, B} end, Bad1),
+ LPreCAt = union(LPreCAt1, LPreCAt2),
+ XPreCAt = union(XPreCAt1, XPreCAt2),
+ NoCalls = no_elements(LPreCAt) + no_elements(XPreCAt),
+ LCallAt = relation_to_family(LPreCAt),
+ XCallAt = relation_to_family(XPreCAt),
+ CallAt = family_union(LCallAt, XCallAt),
+ %% Local and exported functions with no definitions are removed.
+ L = difference(DefinedFuns, X1),
+ X = difference(DefinedFuns, L),
+ XC = union(XC1, AXC),
+ LC = union(LC1, ALC),
+
+ {DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X),
+
+ %% {EE, ECallAt} = inter_graph(X, L, LC, XC, LCallAt, XCallAt),
+ Self = self(),
+ Fun = fun() -> inter_graph(Self, X, L, LC, XC, CallAt) end,
+ {EE, ECallAt} =
+ xref_utils:subprocess(Fun, [link, {min_heap_size,100000}]),
+
+ [DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,LC2,XC2,EE2,ECallAt2,
+ DF2,DF_12,DF_22,DF_32] =
+ pack([DefAt,L,X,LCallAt,XCallAt,CallAt,LC,XC,EE,ECallAt,
+ DF1,DF_11,DF_21,DF_31]),
+
+ %% Foo = [DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,LC2,XC2,EE2,ECallAt2,
+ %% DF2,DF_12,DF_22,DF_32],
+ %% io:format("{~p, ~p, ~p},~n", [M, pack:lsize(Foo), pack:usize(Foo)]),
+
+ LU = range(LC2),
+
+ LPredefined = predefined_funs(LU),
+
+ MS = xref_utils:xset(M, atom),
+ T = from_sets({MS,DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,
+ LC2,XC2,LU,EE2,ECallAt2,Unres,LPredefined,
+ DF2,DF_12,DF_22,DF_32}),
+
+ NoUnres = XMod#xref_mod.no_unresolved,
+ Info = no_info(X2, L2, LC2, XC2, EE2, Unres, NoCalls, NoUnres),
+
+ XMod1 = XMod#xref_mod{data = T, info = Info},
+ S1 = S#xref{modules = dict:store(M, XMod1, S#xref.modules)},
+ {ok, [M], DBad++Bad, take_down(S1)};
+do_add_module(S, M, XMod, _Unres, Data) when S#xref.mode =:= modules ->
+ {X0, I0, Depr} = Data,
+ X1 = xref_utils:xset(X0, [tspec(func)]),
+ I1 = xref_utils:xset(I0, [tspec(func)]),
+ {DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X1),
+ [X2,I2,DF2,DF_12,DF_22,DF_32] = pack([X1,I1,DF1,DF_11,DF_21,DF_31]),
+ MS = xref_utils:xset(M, atom),
+ T = from_sets({MS, X2, I2, DF2, DF_12, DF_22, DF_32}),
+ Info = [],
+ XMod1 = XMod#xref_mod{data = T, info = Info},
+ S1 = S#xref{modules = dict:store(M, XMod1, S#xref.modules)},
+ {ok, [M], DBad, take_down(S1)}.
+
+depr_mod({Depr,Bad0}, X) ->
+ %% Bad0 are badly formed deprecated attributes.
+ %% Here deprecated functions that are neither BIFs nor exported
+ %% are deemed bad. do_set_up filters away BIFs if necessary.
+ {DF_10,DF_20,DF_30,DF0} = Depr,
+ FT = [tspec(func)],
+ DF1 = xref_utils:xset(DF0, FT),
+ DF_11 = xref_utils:xset(DF_10, FT),
+ DF_21 = xref_utils:xset(DF_20, FT),
+ DF_31 = xref_utils:xset(DF_30, FT),
+
+ All = union(from_sets([DF1,DF_11,DF_21,DF_31])),
+ Fun = {external, fun({M,F,A}) -> xref_utils:is_builtin(M, F, A) end},
+ XB = union(X, specification(Fun, All)),
+ DF_1 = intersection(DF_11, XB),
+ DF_2 = union(intersection(DF_21, XB), DF_1),
+ DF_3 = union(intersection(DF_31, XB), DF_2),
+ DF = union(intersection(DF1, XB), DF_3),
+
+ Bad1 = difference(All, XB),
+ Bad2 = to_external(difference(Bad1, predefined_funs(Bad1))),
+ Bad = map(fun(B) -> {depr_attr, B} end, usort(Bad2++Bad0)),
+ {DF,DF_1,DF_2,DF_3,Bad}.
+
+%% Extra edges gathered from the attribute 'xref' (experimental)
+extra_edges(CAX, CAL, Bad0, F) ->
+ AXC0 = domain(CAX),
+ ALC0 = domain(CAL),
+ AXC = restriction(AXC0, F),
+ ALC = restriction(2, restriction(ALC0, F), F),
+ LPreCAt2 = restriction(CAL, ALC),
+ XPreCAt2 = restriction(CAX, AXC),
+ Bad = Bad0 ++ to_external(difference(AXC0, AXC))
+ ++ to_external(difference(ALC0, ALC)),
+ {AXC, ALC, Bad, LPreCAt2, XPreCAt2}.
+
+no_info(X, L, LC, XC, EE, Unres, NoCalls, NoUnresCalls) ->
+ NoUnres = no_elements(Unres),
+ [{no_calls, {NoCalls-NoUnresCalls, NoUnresCalls}},
+ {no_function_calls, {no_elements(LC), no_elements(XC)-NoUnres, NoUnres}},
+ {no_functions, {no_elements(L), no_elements(X)}},
+ %% Note: this is overwritten in do_set_up():
+ {no_inter_function_calls, no_elements(EE)}].
+
+inter_graph(Pid, X, L, LC, XC, CallAt) ->
+ Pid ! {self(), inter_graph(X, L, LC, XC, CallAt)}.
+
+%% Inter Call Graph.
+%inter_graph(_X, _L, _LC, _XC, _CallAt) ->
+% {empty_set(), empty_set()};
+inter_graph(X, L, LC, XC, CallAt) ->
+ G = xref_utils:relation_to_graph(LC),
+
+ Reachable0 = digraph_utils:reachable_neighbours(to_external(X), G),
+ Reachable = xref_utils:xset(Reachable0, [tspec(func)]),
+ % XL includes exports and locals that are not used by any exports
+ % (the locals are tacitly ignored in the comments below).
+ XL = union(difference(L, Reachable), X),
+
+ % Immediate local calls between the module's own exports are qualified.
+ LEs = restriction(restriction(2, LC, XL), XL),
+ % External calls to the module's exports are qualified.
+ XEs = restriction(XC, XL),
+ Es = union(LEs, XEs),
+
+ E1 = to_external(restriction(difference(LC, LEs), XL)),
+ R0 = xref_utils:xset(reachable(E1, G, []),
+ [{tspec(func), tspec(fun_edge)}]),
+ true = digraph:delete(G),
+
+ % RL is a set of indirect local calls to exports.
+ RL = restriction(R0, XL),
+ % RX is a set of indirect external calls to exports.
+ RX = relative_product1(R0, XC),
+ R = union(RL, converse(RX)),
+
+ EE0 = projection({external, fun({Ee2,{Ee1,_L}}) -> {Ee1,Ee2} end}, R),
+ EE = union(Es, EE0),
+
+ % The first call in each chain, {e1,l}, contributes with the line
+ % number(s) l.
+ SFun = {external, fun({Ee2,{Ee1,Ls}}) -> {{Ee1,Ls},{Ee1,Ee2}} end},
+ ECallAt1 = relative_product1(projection(SFun, R), CallAt),
+ ECallAt2 = union(ECallAt1, restriction(CallAt, Es)),
+ ECallAt = family_union(relation_to_family(ECallAt2)),
+
+ ?FORMAT("XL=~p~nXEs=~p~nLEs=~p~nE1=~p~nR0=~p~nRL=~p~nRX=~p~nR=~p~n"
+ "EE=~p~nECallAt1=~p~nECallAt2=~p~nECallAt=~p~n~n",
+ [XL, XEs, LEs, E1, R0, RL, RX, R, EE,
+ ECallAt1, ECallAt2, ECallAt]),
+ {EE, ECallAt}.
+
+%% -> set of {V2,{V1,L1}}
+reachable([E = {_X, L} | Xs], G, R) ->
+ Ns = digraph_utils:reachable([L], G),
+ reachable(Xs, G, reach(Ns, E, R));
+reachable([], _G, R) ->
+ R.
+
+reach([N | Ns], E, L) ->
+ reach(Ns, E, [{N, E} | L]);
+reach([], _E, L) ->
+ L.
+
+tspec(func) -> {atom, atom, atom};
+tspec(fun_edge) -> {tspec(func), tspec(func)};
+tspec(def_at) -> {tspec(func), atom};
+tspec(pre_call_at) -> {tspec(fun_edge), atom}.
+
+%% -> {ok, OldXrefRel, NewState} | throw(Error)
+do_remove_release(S, RelName) ->
+ case dict:find(RelName, S#xref.releases) of
+ error ->
+ throw_error({no_such_release, RelName});
+ {ok, XRel} ->
+ S1 = take_down(S),
+ S2 = remove_rel(S1, RelName),
+ {ok, XRel, S2}
+ end.
+
+%% -> {ok, OldXrefApp, NewState} | throw(Error)
+do_remove_application(S, AppName) ->
+ case dict:find(AppName, S#xref.applications) of
+ error ->
+ throw_error({no_such_application, AppName});
+ {ok, XApp} ->
+ S1 = take_down(S),
+ S2 = remove_apps(S1, [AppName]),
+ {ok, XApp, S2}
+ end.
+
+%% -> {ok, OldXMod, NewState} | throw(Error)
+do_remove_module(S, Module) ->
+ case dict:find(Module, S#xref.modules) of
+ error ->
+ throw_error({no_such_module, Module});
+ {ok, XMod} ->
+ S1 = take_down(S),
+ {ok, XMod, remove_modules(S1, [Module])}
+ end.
+
+remove_rel(S, RelName) ->
+ Rels = [RelName],
+ Fun = fun({A,XApp}, L) when XApp#xref_app.rel_name =:= Rels ->
+ [A | L];
+ (_, L) -> L
+ end,
+ Apps = foldl(Fun, [], dict:to_list(S#xref.applications)),
+ S1 = remove_apps(S, Apps),
+ NewReleases = remove_erase(Rels, S1#xref.releases),
+ S1#xref{releases = NewReleases}.
+
+remove_apps(S, Apps) ->
+ Fun = fun({M,XMod}, L) ->
+ case XMod#xref_mod.app_name of
+ [] -> L;
+ [AppName] -> [{AppName,M} | L]
+ end
+ end,
+ Ms = foldl(Fun, [], dict:to_list(S#xref.modules)),
+ Modules = to_external(image(relation(Ms), set(Apps))),
+ S1 = remove_modules(S, Modules),
+ NewApplications = remove_erase(Apps, S1#xref.applications),
+ S1#xref{applications = NewApplications}.
+
+remove_modules(S, Modules) ->
+ NewModules = remove_erase(Modules, S#xref.modules),
+ S#xref{modules = NewModules}.
+
+remove_erase([K | Ks], D) ->
+ remove_erase(Ks, dict:erase(K, D));
+remove_erase([], D) ->
+ D.
+
+do_add_libraries(Path, Verbose, State) ->
+ message(Verbose, lib_search, []),
+ {C, E} = xref_utils:list_path(Path, [?Suffix]),
+ message(Verbose, done, []),
+ MDs = to_external(relation_to_family(relation(C))),
+ %% message(Verbose, lib_check, []),
+ Reply = check_file(MDs, [], E, Path, State),
+ %% message(Verbose, done, []),
+ Reply.
+
+%%check_file([{_M, [{_N, Dir, File} | _]} | MDs], L, E, Path, State) ->
+%% case beam_lib:version(filename:join(Dir, File)) of
+%% {ok, {Module, _Version}} ->
+%% XLib = #xref_lib{name = Module, dir = Dir},
+%% check_file(MDs, [{Module,XLib} | L], E, Path, State);
+%% Error ->
+%% check_file(MDs, L, [Error | E], Path, State)
+%% end;
+check_file([{Module, [{_N, Dir, _File} | _]} | MDs], L, E, Path, State) ->
+ XLib = #xref_lib{name = Module, dir = Dir},
+ check_file(MDs, [{Module,XLib} | L], E, Path, State);
+check_file([], L, [], Path, State) ->
+ D = dict:from_list(L),
+ State1 = State#xref{library_path = Path, libraries = D},
+ %% Take down everything, that's simplest.
+ NewState = take_down(State1),
+ {ok, NewState};
+check_file([], _L, [E | _], _Path, _State) ->
+ E.
+
+%% -> {ok, NewState} | Error
+%% Finding libraries may fail.
+do_set_up(S, _VerboseOpt) when S#xref.variables =/= not_set_up ->
+ {ok, S};
+do_set_up(S, VerboseOpt) ->
+ message(VerboseOpt, set_up, []),
+ Reply = (catch do_set_up(S)),
+ message(VerboseOpt, done, []),
+ Reply.
+
+%% If data has been supplied using add_module/9 (and that is the only
+%% sanctioned way), then DefAt, L, X, LCallAt, XCallAt, CallAt, XC, LC,
+%% and LU are guaranteed to be functions (with all supplied
+%% modules as domain (disregarding unknown modules, that is, modules
+%% not supplied but hosting unknown functions)).
+%% As a consequence, V and E are also functions. V is defined for unknown
+%% modules also.
+%% UU is also a function (thanks to sofs:family_difference/2...).
+%% XU on the other hand can be a partial function (that is, not defined
+%% for all modules). U is derived from XU, so U is also partial.
+%% The inverse variables - LC_1, XC_1, E_1 and EE_1 - are all partial.
+%% B is also partial.
+do_set_up(S) when S#xref.mode =:= functions ->
+ ModDictList = dict:to_list(S#xref.modules),
+ [DefAt0, L, X0, LCallAt, XCallAt, CallAt, LC, XC, LU,
+ EE0, ECallAt, UC, LPredefined,
+ Mod_DF,Mod_DF_1,Mod_DF_2,Mod_DF_3] = make_families(ModDictList, 18),
+
+ {XC_1, XU, XPredefined} = do_set_up_1(XC),
+ LC_1 = user_family(union_of_family(LC)),
+ E_1 = family_union(XC_1, LC_1),
+ Predefined = family_union(XPredefined, LPredefined),
+
+ %% Add "hidden" functions to the exports.
+ X1 = family_union(X0, Predefined),
+
+ F1 = family_union(L, X1),
+ V = family_union(F1, XU),
+ E = family_union(LC, XC),
+
+ M = domain(V),
+ M2A = make_M2A(ModDictList),
+ {A2R,A} = make_A2R(S#xref.applications),
+ R = set(dict:fetch_keys(S#xref.releases)),
+
+ %% Converting from edges of functions to edges of modules.
+ VEs = union_of_family(E),
+ Fun = {external, fun({{M1,_F1,_A1},{M2,_F2,_A2}}) -> {M1,M2} end},
+ ME = projection(Fun, VEs),
+ ME2AE = multiple_relative_product({M2A, M2A}, ME),
+
+ AE = range(ME2AE),
+ AE2RE = multiple_relative_product({A2R, A2R}, AE),
+ RE = range(AE2RE),
+
+ AM = domain(F1),
+ %% Undef is the union of U0 and Lib:
+ {Undef, U0, Lib, Lib_DF, Lib_DF_1, Lib_DF_2, Lib_DF_3} =
+ make_libs(XU, F1, AM, S#xref.library_path, S#xref.libraries),
+ {B, U} = make_builtins(U0),
+ X1_B = family_union(X1, B),
+ F = family_union(F1, Lib),
+ DF = family_union(family_intersection(Mod_DF, X1_B), Lib_DF),
+ DF_1 = family_union(family_intersection(Mod_DF_1, X1_B), Lib_DF_1),
+ DF_2 = family_union(family_intersection(Mod_DF_2, X1_B), Lib_DF_2),
+ DF_3 = family_union(family_intersection(Mod_DF_3, X1_B), Lib_DF_3),
+ % If we have 'used' too, then there will be a set LU U XU...
+ UU = family_difference(family_difference(F1, LU), XU),
+ DefAt = make_defat(Undef, DefAt0),
+
+ LM = domain(Lib),
+ UM = difference(difference(domain(U), AM), LM),
+ X = family_union(X1, Lib),
+
+ %% Inter Call Graph. Calls to exported functions (library
+ %% functions inclusive) as well as calls within modules. This is a
+ %% way to discard calls to local functions in other modules.
+ EE_conv = converse(union_of_family(EE0)),
+ EE_exported = restriction(EE_conv, union_of_family(X)),
+ EE_local =
+ specification({external, fun({{M1,_,_},{M2,_,_}}) -> M1 =:= M2 end},
+ EE_conv),
+ EE_0 = converse(union(EE_local, EE_exported)),
+ EE_1 = user_family(EE_0),
+ EE1 = partition_family({external, fun({{M1,_,_}, _MFA2}) -> M1 end},
+ EE_0),
+ %% Make sure EE is defined for all modules:
+ EE = family_union(family_difference(EE0, EE0), EE1),
+ IFun =
+ fun({Mod,EE_M}, XMods) ->
+ IMFun =
+ fun(XrefMod) ->
+ [NoCalls, NoFunctionCalls,
+ NoFunctions, _NoInter] = XrefMod#xref_mod.info,
+ NewInfo = [NoCalls, NoFunctionCalls, NoFunctions,
+ {no_inter_function_calls,length(EE_M)}],
+ XrefMod#xref_mod{info = NewInfo}
+ end,
+ dict:update(Mod, IMFun,XMods)
+ end,
+ XrefMods1 = foldl(IFun, S#xref.modules, to_external(EE)),
+ S1 = S#xref{modules = XrefMods1},
+
+ UC_1 = user_family(union_of_family(UC)),
+
+ ?FORMAT("DefAt ~p~n", [DefAt]),
+ ?FORMAT("U=~p~nLib=~p~nB=~p~nLU=~p~nXU=~p~nUU=~p~n", [U,Lib,B,LU,XU,UU]),
+ ?FORMAT("E_1=~p~nLC_1=~p~nXC_1=~p~n", [E_1,LC_1,XC_1]),
+ ?FORMAT("EE=~p~nEE_1=~p~nECallAt=~p~n", [EE, EE_1, ECallAt]),
+ ?FORMAT("DF=~p~nDF_1=~p~nDF_2=~p~nDF_3=~p~n", [DF, DF_1, DF_2, DF_3]),
+
+ Vs = [{'L',L}, {'X',X},{'F',F},{'U',U},{'B',B},{'UU',UU},
+ {'XU',XU},{'LU',LU},{'V',V},{v,V},
+ {'LC',{LC,LC_1}},{'XC',{XC,XC_1}},{'E',{E,E_1}},{e,{E,E_1}},
+ {'EE',{EE,EE_1}},{'UC',{UC,UC_1}},
+ {'M',M},{'A',A},{'R',R},
+ {'AM',AM},{'UM',UM},{'LM',LM},
+ {'ME',ME},{'AE',AE},{'RE',RE},
+ {'DF',DF},{'DF_1',DF_1},{'DF_2',DF_2},{'DF_3',DF_3},
+ {me2ae, ME2AE},{ae, AE2RE},{m2a, M2A},{a2r, A2R},
+ {def_at, DefAt}, {call_at, CallAt}, {e_call_at, ECallAt},
+ {l_call_at, LCallAt}, {x_call_at, XCallAt}],
+ finish_set_up(S1, Vs);
+do_set_up(S) when S#xref.mode =:= modules ->
+ ModDictList = dict:to_list(S#xref.modules),
+ [X0, I0, Mod_DF, Mod_DF_1, Mod_DF_2, Mod_DF_3] =
+ make_families(ModDictList, 7),
+ I = union_of_family(I0),
+ AM = domain(X0),
+
+ {XU, Predefined} = make_predefined(I, AM),
+ %% Add "hidden" functions to the exports.
+ X1 = family_union(X0, Predefined),
+ V = family_union(X1, XU),
+
+ M = union(AM, domain(XU)),
+ M2A = make_M2A(ModDictList),
+ {A2R,A} = make_A2R(S#xref.applications),
+ R = set(dict:fetch_keys(S#xref.releases)),
+
+ ME = projection({external, fun({M1,{M2,_F2,_A2}}) -> {M1,M2} end},
+ family_to_relation(I0)),
+ ME2AE = multiple_relative_product({M2A, M2A}, ME),
+
+ AE = range(ME2AE),
+ AE2RE = multiple_relative_product({A2R, A2R}, AE),
+ RE = range(AE2RE),
+
+ %% Undef is the union of U0 and Lib:
+ {_Undef, U0, Lib, Lib_DF, Lib_DF_1, Lib_DF_2, Lib_DF_3} =
+ make_libs(XU, X1, AM, S#xref.library_path, S#xref.libraries),
+ {B, U} = make_builtins(U0),
+ X1_B = family_union(X1, B),
+ DF = family_union(family_intersection(Mod_DF, X1_B), Lib_DF),
+ DF_1 = family_union(family_intersection(Mod_DF_1, X1_B), Lib_DF_1),
+ DF_2 = family_union(family_intersection(Mod_DF_2, X1_B), Lib_DF_2),
+ DF_3 = family_union(family_intersection(Mod_DF_3, X1_B), Lib_DF_3),
+
+ LM = domain(Lib),
+ UM = difference(difference(domain(U), AM), LM),
+ X = family_union(X1, Lib),
+
+ Empty = empty_set(),
+ Vs = [{'X',X},{'U',U},{'B',B},{'XU',XU},{v,V},
+ {e,{Empty,Empty}},
+ {'M',M},{'A',A},{'R',R},
+ {'AM',AM},{'UM',UM},{'LM',LM},
+ {'ME',ME},{'AE',AE},{'RE',RE},
+ {'DF',DF},{'DF_1',DF_1},{'DF_2',DF_2},{'DF_3',DF_3},
+ {me2ae, ME2AE},{ae, AE2RE},{m2a, M2A},{a2r, A2R},
+ {def_at, Empty}, {call_at, Empty}, {e_call_at, Empty},
+ {l_call_at, Empty}, {x_call_at, Empty}],
+ finish_set_up(S, Vs).
+
+finish_set_up(S, Vs) ->
+ T = do_finish_set_up(Vs, dict:new()),
+ S1 = S#xref{variables = T},
+ %% io:format("~p <= state <= ~p~n", [pack:lsize(S), pack:usize(S)]),
+ {ok, S1}.
+
+do_finish_set_up([{Key, Value} | Vs], T) ->
+ {Type, OType} = var_type(Key),
+ Val = #xref_var{name = Key, value = Value, vtype = predef,
+ otype = OType, type = Type},
+ T1 = dict:store(Key, Val, T),
+ do_finish_set_up(Vs, T1);
+do_finish_set_up([], T) ->
+ T.
+
+var_type('B') -> {function, vertex};
+var_type('F') -> {function, vertex};
+var_type('L') -> {function, vertex};
+var_type('LU') -> {function, vertex};
+var_type('U') -> {function, vertex};
+var_type('UU') -> {function, vertex};
+var_type('V') -> {function, vertex};
+var_type('X') -> {function, vertex};
+var_type('XU') -> {function, vertex};
+var_type('DF') -> {function, vertex};
+var_type('DF_1') -> {function, vertex};
+var_type('DF_2') -> {function, vertex};
+var_type('DF_3') -> {function, vertex};
+var_type('A') -> {application, vertex};
+var_type('AM') -> {module, vertex};
+var_type('LM') -> {module, vertex};
+var_type('M') -> {module, vertex};
+var_type('UM') -> {module, vertex};
+var_type('R') -> {release, vertex};
+var_type('E') -> {function, edge};
+var_type('EE') -> {function, edge};
+var_type('LC') -> {function, edge};
+var_type('UC') -> {function, edge};
+var_type('XC') -> {function, edge};
+var_type('AE') -> {application, edge};
+var_type('ME') -> {module, edge};
+var_type('RE') -> {release, edge};
+var_type(_) -> {foo, bar}.
+
+make_families(ModDictList, N) ->
+ Fun1 = fun({_,XMod}) -> XMod#xref_mod.data end,
+ Ss = from_sets(map(Fun1, ModDictList)),
+ %% io:format("~n~p <= module data <= ~p~n",
+ %% [pack:lsize(Ss), pack:usize(Ss)]),
+ make_fams(N, Ss, []).
+
+make_fams(1, _Ss, L) ->
+ L;
+make_fams(I, Ss, L) ->
+ Fun = {external, fun(R) -> {element(1, R), element(I, R)} end},
+ make_fams(I-1, Ss, [projection(Fun, Ss) | L]).
+
+make_M2A(ModDictList) ->
+ Fun = fun({M,XMod}) -> {M, XMod#xref_mod.app_name} end,
+ Mod0 = family(map(Fun, ModDictList)),
+ Mod = family_to_relation(Mod0),
+ Mod.
+
+make_A2R(ApplDict) ->
+ AppDict = dict:to_list(ApplDict),
+ Fun = fun({A,XApp}) -> {A, XApp#xref_app.rel_name} end,
+ Appl0 = family(map(Fun, AppDict)),
+ AllApps = domain(Appl0),
+ Appl = family_to_relation(Appl0),
+ {Appl, AllApps}.
+
+do_set_up_1(XC) ->
+ %% Call Graph cross reference...
+ XCp = union_of_family(XC),
+ XC_1 = user_family(XCp),
+
+ %% I - functions used externally from some module
+ %% XU - functions used externally per module.
+ I = range(XCp),
+
+ {XU, XPredefined} = make_predefined(I, domain(XC)),
+ {XC_1, XU, XPredefined}.
+
+make_predefined(I, CallingModules) ->
+ XPredefined0 = predefined_funs(I),
+ XPredefined1 = converse(substitution(1, XPredefined0)),
+ %% predefined funs in undefined modules are still undefined...
+ XPredefined2 = restriction(XPredefined1, CallingModules),
+ XPredefined = relation_to_family(XPredefined2),
+ XU = partition_family(1, I),
+ {XU, XPredefined}.
+
+predefined_funs(Functions) ->
+ specification({external, predef_fun()}, Functions).
+
+predef_fun() ->
+ PredefinedFuns = xref_utils:predefined_functions(),
+ fun({_M,F,A}) -> member({F,A}, PredefinedFuns) end.
+
+make_defat(Undef, DefAt0) ->
+ % Complete DefAt with unknown functions:
+ Zero = from_term(0),
+ DAL = family_projection(fun(S) -> constant_function(S, Zero) end, Undef),
+ family_union(DefAt0, DAL).
+
+%% -> {Unknown U Lib, Unknown, Lib} | throw(Error)
+make_libs(XU, F, AM, LibPath, LibDict) ->
+ Undef = family_difference(XU, F),
+ UM = difference(domain(family_to_relation(Undef)), AM),
+ Fs = case is_empty_set(UM) of
+ true ->
+ [];
+ false when LibPath =:= code_path ->
+ BFun = fun(M, A) -> case xref_utils:find_beam(M) of
+ {ok, File} -> [File | A];
+ _ -> A
+ end
+ end,
+ foldl(BFun, [], to_external(UM));
+ false ->
+ Libraries = dict:to_list(LibDict),
+ Lb = restriction(a_function(Libraries), UM),
+ MFun = fun({M,XLib}) ->
+ #xref_lib{dir = Dir} = XLib,
+ xref_utils:module_filename(Dir, M)
+ end,
+ map(MFun, to_external(Lb))
+ end,
+ Fun = fun(FileName, Deprs) ->
+ case beam_lib:chunks(FileName, [exports, attributes]) of
+ {ok, {M, [{exports,X}, {attributes,A}]}} ->
+ Exports = mfa_exports(X, A, M),
+ %% No warnings for bad attributes...
+ {Deprecated,_Bad} = deprecated(A, Exports, M),
+ {{M,Exports}, [{M,Deprecated} | Deprs]};
+ Error ->
+ throw(Error)
+ end
+ end,
+ {XL, DL} = mapfoldl(Fun, [], Fs),
+ LF = from_term(XL),
+ %% Undef is the first argument to make sure that the whole of LF
+ %% becomes garbage:
+ Lib = family_intersection(Undef, LF),
+ {B,_} = make_builtins(Undef),
+ DLib = family_union(Lib, B),
+ [DF_1,DF_21,DF_31,DF1] = depr_lib(4, DL, DL, [], [], DLib),
+ DF_2 = family_union(DF_21, DF_1),
+ DF_3 = family_union(DF_31, DF_2),
+ DF = family_union(DF1, DF_3),
+ U = family_difference(Undef, Lib),
+ {Undef, U, Lib, DF, DF_1, DF_2, DF_3}.
+
+depr_lib(0, _, _, LL, [], _Lib) ->
+ LL;
+depr_lib(I, [], DL, LL, L, Lib) ->
+ DT = family_intersection(Lib, from_term(L)),
+ depr_lib(I-1, DL, DL, [DT | LL], [], Lib);
+depr_lib(I, [{M,D} | Ds], DL, LL, L, Lib) ->
+ depr_lib(I, Ds, DL, LL, [{M,element(I, D)} | L], Lib).
+
+make_builtins(U0) ->
+ Tmp = family_to_relation(U0),
+ Fun2 = {external, fun({_M,{M,F,A}}) -> xref_utils:is_builtin(M, F, A) end},
+ B = relation_to_family(specification(Fun2, Tmp)),
+ U = family_difference(U0, B),
+ {B, U}.
+
+% Returns a family that may not be defined for all modules.
+user_family(R) ->
+ partition_family({external, fun({_MFA1, {M2,_,_}}) -> M2 end}, R).
+
+do_variables(State) ->
+ Fun = fun({Name, #xref_var{vtype = user}}, {P,U}) ->
+ {P,[Name | U]};
+ ({Name, #xref_var{vtype = predef}}, A={P,U}) ->
+ case atom_to_list(Name) of
+ [H|_] when H>= $a, H=<$z -> A;
+ _Else -> {[Name | P], U}
+ end;
+ ({{tmp, V}, _}, A) ->
+ io:format("Bug in ~p: temporary ~p~n", [?MODULE, V]), A;
+ (_V, A) -> A
+ end,
+ {U,P} = foldl(Fun, {[],[]}, dict:to_list(State#xref.variables)),
+ {sort(P), sort(U)}.
+
+%% Throws away the variables derived from raw data.
+take_down(S) when S#xref.variables =:= not_set_up ->
+ S;
+take_down(S) ->
+ S#xref{variables = not_set_up}.
+
+make_query(Format, Args) ->
+ flatten(io_lib:format(Format, Args)).
+
+set_defaults([O | Os], [[V] | Vs], State) ->
+ NewState = set_def(O, V, State),
+ set_defaults(Os, Vs, NewState);
+set_defaults([], [], State) ->
+ State.
+
+set_def(builtins, Value, State) ->
+ State#xref{builtins_default = Value};
+set_def(recurse, Value, State) ->
+ State#xref{recurse_default = Value};
+set_def(verbose, Value, State) ->
+ State#xref{verbose_default = Value};
+set_def(warnings, Value, State) ->
+ State#xref{warnings_default = Value}.
+
+option_values([Option | Options], State) ->
+ Default = current_default(State, Option),
+ [{Option, [Default,true,false]} | option_values(Options, State)];
+option_values([], _State) ->
+ [].
+
+current_default(State, builtins) ->
+ State#xref.builtins_default;
+current_default(State, recurse) ->
+ State#xref.recurse_default;
+current_default(State, verbose) ->
+ State#xref.verbose_default;
+current_default(State, warnings) ->
+ State#xref.warnings_default.
+
+%% sets are used here to avoid long execution times
+do_info(S, modules) ->
+ D = sort(dict:to_list(S#xref.modules)),
+ map(fun({_M,XMod}) -> mod_info(XMod) end, D);
+do_info(S, applications) ->
+ AppMods = to_external(relation_to_family(relation(app_mods(S)))),
+ Sum = sum_mods(S, AppMods),
+ map(fun(AppSum) -> app_info(AppSum, S) end, Sum);
+do_info(S, releases) ->
+ {RA, RRA} = rel_apps(S),
+ rel_apps_sums(RA, RRA, S);
+do_info(S, libraries) ->
+ D = sort(dict:to_list(S#xref.libraries)),
+ map(fun({_L,XLib}) -> lib_info(XLib) end, D);
+do_info(_S, I) ->
+ error({no_such_info, I}).
+
+do_info(S, Type, E) when is_atom(E) ->
+ do_info(S, Type, [E]);
+do_info(S, modules, Modules0) when is_list(Modules0) ->
+ Modules = to_external(set(Modules0)),
+ XMods = find_info(Modules, S#xref.modules, no_such_module),
+ map(fun(XMod) -> mod_info(XMod) end, XMods);
+do_info(S, applications, Applications) when is_list(Applications) ->
+ _XA = find_info(Applications, S#xref.applications, no_such_application),
+ AM = relation(app_mods(S)),
+ App = set(Applications),
+ AppMods_S = relation_to_family(restriction(AM, App)),
+ AppSums = sum_mods(S, to_external(AppMods_S)),
+ map(fun(AppSum) -> app_info(AppSum, S) end, AppSums);
+do_info(S, releases, Releases) when is_list(Releases) ->
+ _XR = find_info(Releases, S#xref.releases, no_such_release),
+ {AR, RRA} = rel_apps(S),
+ AR_S = restriction(2, relation(AR), set(Releases)),
+ rel_apps_sums(to_external(AR_S), RRA, S);
+do_info(S, libraries, Libraries0) when is_list(Libraries0) ->
+ Libraries = to_external(set(Libraries0)),
+ XLibs = find_info(Libraries, S#xref.libraries, no_such_library),
+ map(fun(XLib) -> lib_info(XLib) end, XLibs);
+do_info(_S, I, J) when is_list(J) ->
+ throw_error({no_such_info, I}).
+
+find_info([E | Es], Dict, Error) ->
+ case dict:find(E, Dict) of
+ error ->
+ throw_error({Error, E});
+ {ok, X} ->
+ [X | find_info(Es, Dict, Error)]
+ end;
+find_info([], _Dict, _Error) ->
+ [].
+
+%% -> {[{AppName, RelName}], [{RelName, XApp}]}
+rel_apps(S) ->
+ D = sort(dict:to_list(S#xref.applications)),
+ Fun = fun({_A, XApp}, Acc={AR, RRA}) ->
+ case XApp#xref_app.rel_name of
+ [] -> Acc;
+ [R] ->
+ AppName = XApp#xref_app.name,
+ {[{AppName, R} | AR], [{R, XApp} | RRA]}
+ end
+ end,
+ foldl(Fun, {[], []}, D).
+
+%% -> [{{RelName, [XApp]}, Sums}]
+rel_apps_sums(AR, RRA0, S) ->
+ AppMods = app_mods(S), % [{AppName, XMod}]
+ RRA1 = relation_to_family(relation(RRA0)),
+ RRA = inverse(substitution(1, RRA1)),
+ %% RRA is [{RelName,{RelName,[XApp]}}]
+ RelMods = relative_product1(relation(AR), relation(AppMods)),
+ RelAppsMods = relative_product1(RRA, RelMods),
+ RelsAppsMods = to_external(relation_to_family(RelAppsMods)),
+ %% [{{RelName, [XApp]}, [XMod]}]
+ Sum = sum_mods(S, RelsAppsMods),
+ map(fun(RelAppsSums) -> rel_info(RelAppsSums, S) end, Sum).
+
+%% -> [{AppName, XMod}]
+app_mods(S) ->
+ D = sort(dict:to_list(S#xref.modules)),
+ Fun = fun({_M,XMod}, Acc) ->
+ case XMod#xref_mod.app_name of
+ [] -> Acc;
+ [AppName] -> [{AppName, XMod} | Acc]
+ end
+ end,
+ foldl(Fun, [], D).
+
+mod_info(XMod) ->
+ #xref_mod{name = M, app_name = AppName, builtins = BuiltIns,
+ dir = Dir, info = Info} = XMod,
+ App = sup_info(AppName),
+ {M, [{application, App}, {builtins, BuiltIns}, {directory, Dir} | Info]}.
+
+app_info({AppName, ModSums}, S) ->
+ XApp = dict:fetch(AppName, S#xref.applications),
+ #xref_app{rel_name = RelName, vsn = Vsn, dir = Dir} = XApp,
+ Release = sup_info(RelName),
+ {AppName, [{directory,Dir}, {release, Release}, {version,Vsn} | ModSums]}.
+
+rel_info({{RelName, XApps}, ModSums}, S) ->
+ NoApps = length(XApps),
+ XRel = dict:fetch(RelName, S#xref.releases),
+ Dir = XRel#xref_rel.dir,
+ {RelName, [{directory, Dir}, {no_applications, NoApps} | ModSums]}.
+
+lib_info(XLib) ->
+ #xref_lib{name = LibName, dir = Dir} = XLib,
+ {LibName, [{directory,Dir}]}.
+
+sup_info([]) -> [];
+sup_info([Name]) ->
+ [Name].
+
+sum_mods(S, AppsMods) ->
+ sum_mods(S, AppsMods, []).
+
+sum_mods(S, [{N, XMods} | NX], L) ->
+ sum_mods(S, NX, [{N, no_sum(S, XMods)} | L]);
+sum_mods(_S, [], L) ->
+ reverse(L).
+
+no_sum(S, L) when S#xref.mode =:= functions ->
+ no_sum(L, 0, 0, 0, 0, 0, 0, 0, 0, length(L));
+no_sum(S, L) when S#xref.mode =:= modules ->
+ [{no_analyzed_modules, length(L)}].
+
+no_sum([XMod | D], C0, UC0, LC0, XC0, UFC0, L0, X0, EV0, NoM) ->
+ [{no_calls, {C,UC}},
+ {no_function_calls, {LC,XC,UFC}},
+ {no_functions, {L,X}},
+ {no_inter_function_calls, EV}] = XMod#xref_mod.info,
+ no_sum(D, C0+C, UC0+UC, LC0+LC, XC0+XC, UFC0+UFC, L0+L, X0+X, EV0+EV, NoM);
+no_sum([], C, UC, LC, XC, UFC, L, X, EV, NoM) ->
+ [{no_analyzed_modules, NoM},
+ {no_calls, {C,UC}},
+ {no_function_calls, {LC,XC,UFC}},
+ {no_functions, {L,X}},
+ {no_inter_function_calls, EV}].
+
+%% -> ok | throw(Error)
+is_filename(F) when is_atom(F) ->
+ ok;
+is_filename(F) ->
+ case xref_utils:is_string(F, 31) of
+ true ->
+ ok;
+ false ->
+ throw_error({invalid_filename, F})
+ end.
+
+module_file(XMod) ->
+ xref_utils:module_filename(XMod#xref_mod.dir, XMod#xref_mod.name).
+
+warnings(_Flag, _Message, []) -> true;
+warnings(Flag, Message, [F | Fs]) ->
+ message(Flag, Message, F),
+ warnings(Flag, Message, Fs).
+
+%% pack(term()) -> term()
+%%
+%% The identify function. The returned term does not use more heap
+%% than the given term. Tuples that are equal (=:=/2) are made
+%% "the same".
+%%
+%% The process dictionary is used because it seems to be faster than
+%% anything else right now...
+%%
+%pack(T) -> T;
+pack(T) ->
+ PD = erase(),
+ NT = pack1(T),
+ %% true = T =:= NT,
+ %% io:format("erasing ~p elements...~n", [length(erase())]),
+ erase(), % wasting heap (and time)...
+ map(fun({K,V}) -> put(K, V) end, PD),
+ NT.
+
+pack1(C) when not is_tuple(C), not is_list(C) ->
+ C;
+pack1([T | Ts]) ->
+ %% don't store conscells...
+ [pack1(T) | pack1(Ts)];
+%% Optimization.
+pack1(T={Mod,Fun,_}) when is_atom(Mod), is_atom(Fun) -> % MFA
+ case get(T) of
+ undefined -> put(T, T), T;
+ NT -> NT
+ end;
+pack1({C, L}) when is_list(L) -> % CallAt
+ {pack1(C), L};
+pack1({MFA, L}) when is_integer(L) -> % DefAt
+ {pack1(MFA), L};
+%% End optimization.
+pack1([]) ->
+ [];
+pack1(T) -> % when is_tuple(T)
+ case get(T) of
+ undefined ->
+ NT = tpack(T, tuple_size(T), []),
+ put(NT, NT),
+ NT;
+ NT ->
+ NT
+ end.
+
+tpack(_T, 0, L) ->
+ list_to_tuple(L);
+tpack(T, I, L) ->
+ tpack(T, I-1, [pack1(element(I, T)) | L]).
+
+message(true, What, Arg) ->
+ case What of
+ reading_beam ->
+ io:format("~s... ", Arg);
+ skipped_beam ->
+ io:format("skipped (no debug information)~n", Arg);
+ no_debug_info ->
+ io:format("Skipping ~s (no debug information)~n", Arg);
+ unresolved_summary1 ->
+ io:format("~p: 1 unresolved call~n", Arg);
+ unresolved_summary ->
+ io:format("~p: ~p unresolved calls~n", Arg);
+ jam ->
+ io:format("Skipping ~s (probably JAM file)~n", [Arg]);
+ unreadable ->
+ io:format("Skipping ~s (unreadable)~n", [Arg]);
+ xref_attr ->
+ io:format("~s: Skipping 'xref' attribute ~w~n", Arg);
+ depr_attr ->
+ io:format("~s: Skipping 'deprecated' attribute ~w~n", Arg);
+ lib_search ->
+ io:format("Scanning library path for BEAM files... ", []);
+ lib_check ->
+ io:format("Checking library files... ", []);
+ set_up ->
+ io:format("Setting up...", Arg);
+ done ->
+ io:format("done~n", Arg);
+ error ->
+ io:format("error~n", Arg);
+ Else ->
+ io:format("~p~n", [{Else,Arg}])
+ end;
+message(_, _, _) ->
+ true.
+
+throw_error(Reason) ->
+ throw(error(Reason)).
+
+error(Reason) ->
+ {error, ?MODULE, Reason}.
diff --git a/lib/tools/src/xref_compiler.erl b/lib/tools/src/xref_compiler.erl
new file mode 100644
index 0000000000..67ac8c617d
--- /dev/null
+++ b/lib/tools/src/xref_compiler.erl
@@ -0,0 +1,928 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+
+-module(xref_compiler).
+
+-include("xref.hrl").
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(FORMAT(P, A), io:format(P, A)).
+-define(CALL(F), F).
+-else.
+-define(FORMAT(P, A), ok).
+-define(CALL(F), ok).
+-endif.
+
+-export([compile/2]).
+
+-export([update_graph_counter/3]).
+
+-export([format_error/1]).
+
+-import(lists,
+ [concat/1, foldl/3, nthtail/2, reverse/1, sort/1, sublist/2]).
+
+-import(sofs,
+ [composite/2, difference/2, empty_set/0, from_term/1,
+ intersection/2, is_empty_set/1, multiple_relative_product/2,
+ projection/2, relation/1, relation_to_family/1,
+ restriction/2, substitution/2, to_external/1, union/2,
+ union_of_family/1]).
+
+%%
+%% Exported functions
+%%
+
+compile(Chars, Table) ->
+ case xref_scanner:scan(Chars) of
+ {ok, Tokens} ->
+ case xref_parser:parse(Tokens) of
+ {ok, ParseTree} ->
+ ?FORMAT("ParseTree ~p~n", [ParseTree]),
+ case catch statements(ParseTree, Table) of
+ E={error, _, _} ->
+ E;
+ {ok, UV, P} ->
+ %% User variables to be.
+ Table1 = user_vars(UV, Table),
+ ?CALL(statistics(runtime)),
+ Reply = i(P, Table1),
+ ?CALL({_, Time} = statistics(runtime)),
+ ?FORMAT("Result in ~p ms~n",[Time]),
+ Reply
+ end;
+ {error, {Line, _Module, Error}} ->
+ error({parse_error, Line, Error})
+ end;
+ {error, Info, Line} ->
+ error({parse_error, Line, Info})
+ end.
+
+format_error({error, Module, Error}) ->
+ Module:format_error(Error);
+format_error({parse_error, Line, Error}) ->
+ format_parse_error(Error, format_line(Line));
+format_error({variable_reassigned, Expr}) ->
+ io_lib:format("Variable assigned more than once: ~s~n", [Expr]);
+format_error({unknown_variable, Name}) ->
+ io_lib:format("Variable ~p used before set~n", [Name]);
+format_error({type_error, Expr}) ->
+ io_lib:format("Operator applied to argument(s) of different or "
+ "invalid type(s): ~s~n", [Expr]);
+format_error({type_mismatch, Expr1, Expr2}) ->
+ io_lib:format("Constants of different types: ~s, ~s~n",
+ [Expr1, Expr2]);
+format_error({unknown_constant, Constant}) ->
+ io_lib:format("Unknown constant ~s~n", [Constant]);
+format_error(E) ->
+ io_lib:format("~p~n", [E]).
+
+%%
+%% Local functions
+%%
+
+user_vars([{{user,Name}, Val} | UV], Table) ->
+ user_vars(UV, dict:store(Name, Val, Table));
+user_vars([_V | UV], Table) ->
+ user_vars(UV, Table);
+user_vars([], Table) ->
+ Table.
+
+statements(Stmts, Table) ->
+ statements(Stmts, Table, [], []).
+
+statements([Stmt={assign, VarType, Name, E} | Stmts0], Table, L, UV) ->
+ case dict:find(Name, Table) of
+ {ok, _} ->
+ throw_error({variable_reassigned, xref_parser:t2s(Stmt)});
+ error ->
+ {Type, OType, NewE} = t_expr(E, Table),
+ Val = #xref_var{name = Name, vtype = VarType,
+ otype = OType, type = Type},
+ NewTable = dict:store(Name, Val, Table),
+ Stmts = if Stmts0 =:= [] -> [{variable, Name}]; true -> Stmts0 end,
+ Variable = {VarType, Name},
+ Put = {put, Variable, NewE},
+ statements(Stmts, NewTable, [Put | L], [{Variable,Val} | UV])
+ end;
+statements([Expr], Table, L, UV) ->
+ {Type, OType, NewE} = t_expr(Expr, Table),
+ E1 = un_familiarize(Type, OType, NewE),
+ NE = case {Type, OType} of
+ %% Edges with empty sets of line numbers are removed.
+ {{line, _}, edge} ->
+ {relation_to_family, E1};
+ {_Type, edge_closure} ->
+ %% Fake a closure usage, just to make sure it is destroyed.
+ E2 = {fun graph_access/2, E1, E1},
+ {fun(_E) -> 'closure()' end, E2};
+ _Else -> E1
+ end,
+ {ok, UV, stats(L, NE)}.
+
+stats([{put, V, X} | Ss], E) ->
+ stats(Ss, {put, V, X, E});
+stats([], E) ->
+ E.
+
+t_expr(E, Table) ->
+ {expr, Type, OType, E1} = check_expr(E, Table),
+ ?FORMAT("TExpr:~n~p~n",[E1]),
+ E2 = convert(E1),
+ ?FORMAT("After conversion:~n~p~n",[E2]),
+ {Type, OType, E2}.
+
+%%% check_expr/2 translates Expr in xref_parser.yrl into TExpr:
+%%%
+%%% TExpr = {expr, Type, ObjectType, Expr}
+%%% Expr = {constants, [Constant]}
+%%% | {variable, {VarType, VarName}}
+%%% | {call, Call, Expr}
+%%% | {call, Call, Expr, Expr}
+%%% | {call, restriction, integer(), Expr, Expr}
+%%% | {convert, ObjectType, Type, Type}
+%%% | {convert, Type, Type}
+%%% Constant = atom() | {atom(), atom()} | MFA | {MFA, MFA}
+%%% Call = atom() % function in the sofs module
+%%% | fun()
+%%% Type = {line, LineType} | function | module | application | release
+%%% | number
+%%% LineType = line | local_call | external_call | export_call | all_line_call
+%%% VarType = predef | user | tmp
+%%% ObjectType = vertex | vertex_set | edge | edge_set | edge_closure | path
+%%% | number
+%%% MFA = {atom(), atom(), integer()}
+
+%% -> TExpr
+check_expr({list, L}, Table) ->
+ check_constants(L, Table);
+check_expr({tuple, L}, Table) ->
+ {expr, Type, vertex, _Consts} = check_constants(L, Table),
+ Cs = reverse(constant_vertices(L, [])),
+ {expr, Type, path, {constants, Cs}};
+check_expr({variable, Name}, Table) ->
+ case dict:find(Name, Table) of
+ {ok, #xref_var{vtype = VarType, otype = OType, type = Type}} ->
+ V0 = {variable, {VarType, Name}},
+ V = case {VarType, Type, OType} of
+ {predef, release, _} -> V0;
+ {predef, application, _} -> V0;
+ {predef, module, _} -> V0;
+ {predef, function, vertex} -> V0;
+ {predef, function, edge} -> {call, union_of_family, V0};
+ _Else -> V0
+ end,
+ {expr, Type, OType, V};
+ error ->
+ throw_error({unknown_variable, Name})
+ end;
+check_expr({type, {type, _Type}, E}, Table) ->
+ check_expr(E, Table);
+check_expr(Expr={type, {convert, NewType0}, E}, Table) ->
+ NewType = what_type(NewType0),
+ {expr, OldType, OType, NE} = check_expr(E, Table),
+ ok = check_conversion(OType, OldType, NewType, Expr),
+ {expr, NewType, OType, {convert, OType, OldType, NewType, NE}};
+check_expr(Expr={set, SOp, E}, Table) ->
+ {expr, Type, OType0, E1} = check_expr(E, Table),
+ OType = case {OType0, SOp} of
+ {edge, range} -> vertex;
+ {edge, domain} -> vertex;
+ {edge, weak} -> edge;
+ {edge, strict} -> edge;
+ {edge_set, range} -> vertex_set;
+ {edge_set, domain} -> vertex_set;
+ {edge_set, weak} -> edge_set;
+ {edge_set, strict} -> edge_set;
+ _ ->
+ throw_error({type_error, xref_parser:t2s(Expr)})
+ end,
+ Op = set_op(SOp),
+ NE = function_vertices_to_family(Type, OType, {call, Op, E1}),
+ {expr, Type, OType, NE};
+check_expr(Expr={graph, Op, E}, Table) ->
+ {expr, Type, NOType, E1} = check_expr(E, Table),
+ case Type of
+ {line, _LineType} ->
+ throw_error({type_error, xref_parser:t2s(Expr)});
+ _Else ->
+ ok
+ end,
+ OType =
+ case {NOType, Op} of
+ {edge, components} -> vertex_set;
+ {edge, condensation} -> edge_set;
+ {edge, closure} -> edge_closure;
+ {edge_closure, components} -> vertex_set;
+ {edge_closure, condensation} -> edge_set;
+ {edge_closure, closure} -> edge_closure;
+ %% Neither need nor want these ones:
+ %% {edge_set, closure} -> edge_set_closure;
+ %% {edge_set, components} -> vertex_set_set;
+ _ ->
+ throw_error({type_error, xref_parser:t2s(Expr)})
+ end,
+ E2 = {convert, NOType, edge_closure, E1},
+ NE = case Op of
+ closure -> E2;
+ _Op -> use_of_closure(Op, E2)
+ end,
+ {expr, Type, OType, NE};
+check_expr(Expr={numeric, '#', E}, Table) ->
+ {expr, Type, OType, E1} = check_expr(E, Table),
+ case OType of
+ vertex -> ok;
+ vertex_set -> ok;
+ edge -> ok;
+ edge_set -> ok;
+ _Else -> throw_error({type_error, xref_parser:t2s(Expr)})
+ end,
+ NE = {convert, OType, Type, number, E1},
+ {expr, number, number, {call, no_elements, NE}};
+check_expr(Expr={set, SOp, E1, E2}, Table) ->
+ %% sets and numbers...
+ {expr, Type1, OType1, NE1} = check_expr(E1, Table),
+ {expr, Type2, OType2, NE2} = check_expr(E2, Table),
+ OType = case {OType1, OType2} of
+ {vertex, vertex} -> vertex;
+ {edge, edge} -> edge;
+ {number, number} -> number;
+ _ -> throw_error({type_error, xref_parser:t2s(Expr)})
+ end,
+ case OType of
+ number ->
+ {expr, number, number, {call, ari_op(SOp), NE1, NE2}};
+ _Else -> % set
+ {Type, NewE1, NewE2} =
+ case {type_ord(Type1), type_ord(Type2)} of
+ {T1, T2} when T1 =:= T2 ->
+ %% Example: if Type1 = {line, line} and
+ %% Type2 = {line, export_line}, then this is not
+ %% correct, but works:
+ {Type1, NE1, NE2};
+ {T1, T2} when T1 < 2; T2 < 2 ->
+ throw_error({type_error, xref_parser:t2s(Expr)});
+ {T1, T2} when T1 > T2 ->
+ {Type2, {convert, OType, Type1, Type2, NE1}, NE2};
+ {T1, T2} when T1 < T2 ->
+ {Type1, NE1, {convert, OType, Type2, Type1, NE2}}
+ end,
+ Op = set_op(SOp, Type, OType),
+ {expr, Type, OType, {call, Op, NewE1, NewE2}}
+ end;
+check_expr(Expr={restr, ROp, E1, E2}, Table) ->
+ {expr, Type1, OType1, NE1} = check_expr(E1, Table),
+ {expr, Type2, OType2, NE2} = check_expr(E2, Table),
+ case {Type1, Type2} of
+ {{line, _LineType1}, _Type2} ->
+ throw_error({type_error, xref_parser:t2s(Expr)});
+ {_Type1, {line, _LineType2}} ->
+ throw_error({type_error, xref_parser:t2s(Expr)});
+ _ ->
+ ok
+ end,
+ case {OType1, OType2} of
+ {edge, vertex} when ROp =:= '|||' ->
+ {expr, _, _, R1} = restriction('|', E1, Type1, NE1, Type2, NE2),
+ {expr, _, _, R2} = restriction('||', E1, Type1, NE1, Type2, NE2),
+ {expr, Type1, edge, {call, intersection, R1, R2}};
+ {edge, vertex} ->
+ restriction(ROp, E1, Type1, NE1, Type2, NE2);
+ {edge_closure, vertex} when ROp =:= '|||' ->
+ {expr, _, _, R1} =
+ closure_restriction('|', Type1, Type2, OType2, NE1, NE2),
+ {expr, _, _, R2} =
+ closure_restriction('||', Type1, Type2, OType2, NE1, NE2),
+ {expr, Type1, edge, {call, intersection, R1, R2}};
+ {edge_closure, vertex} ->
+ closure_restriction(ROp, Type1, Type2, OType2, NE1, NE2);
+ _ ->
+ throw_error({type_error, xref_parser:t2s(Expr)})
+ end;
+check_expr(Expr={path, E1, E2}, Table) ->
+ {expr, Type1, OType1a, E1a} = check_expr(E1, Table),
+ {expr, Type2, OType2, E2a} = check_expr(E2, Table),
+ case {Type1, Type2} of
+ {{line, _LineType1}, _Type2} ->
+ throw_error({type_error, xref_parser:t2s(Expr)});
+ {_Type1, {line, _LineType2}} ->
+ throw_error({type_error, xref_parser:t2s(Expr)});
+ _Else ->
+ ok
+ end,
+ E2b = {convert, OType2, Type2, Type1, E2a},
+ {OType1, NE1} = path_arg(OType1a, E1a),
+ NE2 = case {OType1, OType2} of
+ {path, edge} -> {convert, OType2, edge_closure, E2b};
+ {path, edge_closure} when Type1 =:= Type2 -> E2b;
+ _ -> throw_error({type_error, xref_parser:t2s(Expr)})
+ end,
+ {expr, Type1, path, use_of_closure(path, NE2, NE1)};
+check_expr({regexpr, RExpr, Type0}, _Table) ->
+ %% Using the "universal" variables is not optimal as regards speed,
+ %% but it is simple...
+ Type = what_type(Type0),
+ V = case Type of
+ function -> v;
+ module -> 'M';
+ application -> 'A';
+ release -> 'R'
+ end,
+ Var = {variable, {predef, V}},
+ Call = {call, fun(E, V2) -> xref_utils:regexpr(E, V2) end,
+ {constants, RExpr}, Var},
+ {expr, Type, vertex, Call};
+check_expr(C={constant, _Type, _OType, _C}, Table) ->
+ check_constants([C], Table).
+
+path_arg(edge, E={constants, C}) ->
+ case to_external(C) of
+ [{V1,V2}] -> {path, {constants, [V1, V2]}};
+ _ -> {edge, E}
+ end;
+path_arg(OType, E) ->
+ {OType, E}.
+
+check_conversion(OType, Type1, Type2, Expr) ->
+ case conversions(OType, Type1, Type2) of
+ ok -> ok;
+ not_ok -> throw_error({type_error, xref_parser:t2s(Expr)})
+ end.
+
+%% Allowed conversions.
+conversions(_OType, {line, LineType}, {line, LineType}) -> ok;
+conversions(edge, {line, _}, {line, all_line_call}) -> ok;
+conversions(edge, From, {line, Line})
+ when is_atom(From), Line =/= all_line_call -> ok;
+conversions(vertex, From, {line, line}) when is_atom(From) -> ok;
+conversions(vertex, From, To) when is_atom(From), is_atom(To) -> ok;
+conversions(edge, From, To) when is_atom(From), is_atom(To) -> ok;
+%% "Extra":
+conversions(edge, {line, Line}, To)
+ when is_atom(To), Line =/= all_line_call -> ok;
+conversions(vertex, {line, line}, To) when is_atom(To) -> ok;
+conversions(_OType, _From, _To) -> not_ok.
+
+set_op(union, {line, _LineType}, edge) -> family_union;
+set_op(intersection, {line, _LineType}, edge) -> family_intersection;
+set_op(difference, {line, _LineType}, edge) -> family_difference;
+set_op(union, function, vertex) -> family_union;
+set_op(intersection, function, vertex) -> family_intersection;
+set_op(difference, function, vertex) -> family_difference;
+set_op(SOp, _Type, _OType) -> SOp.
+
+set_op(weak) -> weak_relation;
+set_op(strict) -> strict_relation;
+set_op(Op) -> Op.
+
+ari_op(union) -> fun(X, Y) -> X + Y end;
+ari_op(intersection) -> fun(X, Y) -> X * Y end;
+ari_op(difference) -> fun(X, Y) -> X - Y end.
+
+restriction(ROp, E1, Type1, NE1, Type2, NE2) ->
+ {Column, _} = restr_op(ROp),
+ case NE1 of
+ {call, union_of_family, _E} when ROp =:= '|' ->
+ restriction(Column, Type1, E1, Type2, NE2);
+ {call, union_of_family, _E} when ROp =:= '||' ->
+ E1p = {inverse, E1},
+ restriction(Column, Type1, E1p, Type2, NE2);
+ _ ->
+ NE2a = {convert, vertex, Type2, Type1, NE2},
+ NE2b = family_to_function_vertices(Type1, vertex, NE2a),
+ {expr, Type1, edge, {call, restriction, Column, NE1, NE2b}}
+ end.
+
+restriction(Column, Type1, VE, Type2, E2) when Type1 =:= function ->
+ M = {convert, vertex, Type2, module, E2},
+ Restr = {call, union_of_family, {call, restriction, VE, M}},
+ C = {convert, vertex, Type2, Type1, E2},
+ F = family_to_function_vertices(Type1, vertex, C),
+ {expr, Type1, edge, {call, restriction, Column, Restr, F}}.
+
+closure_restriction(Op, Type1, Type2, OType2, E1, E2) ->
+ {_, Fun} = restr_op(Op),
+ E2a = {convert, OType2, Type2, Type1, E2},
+ E2b = family_to_function_vertices(Type1, vertex, E2a),
+ {expr, Type1, edge, use_of_closure(Fun, E1, E2b)}.
+
+restr_op('|') -> {1, call};
+restr_op('||') -> {2, use}.
+
+%% Closures (digraphs) must be deleted, but not too soon. A wrapper
+%% is inserted here for every use of a closure, to make sure that a
+%% 'save' and an 'unput' instruction are inserted for every digraph, in
+%% particular the temporary ones. The 'unput' instruction must occur
+%% _after_ the call to the function that uses the digraph (the default
+%% is that it is inserted _before_ the call).
+use_of_closure(Op, C) ->
+ access_of_closure(C, {call, fun(X) -> xref_utils:Op(X) end, C}).
+
+use_of_closure(Op, C, E) ->
+ access_of_closure(C, {call, fun(X, Y) -> xref_utils:Op(X, Y) end, C, E}).
+
+access_of_closure(C, E) ->
+ {call, fun graph_access/2, C, E}.
+
+check_constants(Cs=[C={constant, Type0, OType, _Con} | Cs1], Table) ->
+ check_mix(Cs1, Type0, OType, C),
+ Types = case Type0 of
+ unknown -> ['Rel', 'App', 'Mod'];
+ T -> [T]
+ end,
+ case split(Types, Cs, Table) of
+ [{TypeToBe, _Cs}] ->
+ S = from_term([Con || {constant, _T, _OT, Con} <- Cs]),
+ Type = what_type(TypeToBe),
+ E = function_vertices_to_family(Type, OType, {constants, S}),
+ {expr, Type, OType, E};
+ [{Type1, [C1|_]}, {Type2, [C2|_]} | _] ->
+ throw_error({type_mismatch,
+ make_vertex(Type1, C1),
+ make_vertex(Type2, C2)})
+ end.
+
+check_mix([C={constant, 'Fun', OType, _Con} | Cs], 'Fun', OType, _C0) ->
+ check_mix(Cs, 'Fun', OType, C);
+check_mix([C={constant, Type, OType, _Con} | Cs], Type0, OType, _C0)
+ when Type =/= 'Fun', Type0 =/= 'Fun' ->
+ check_mix(Cs, Type, OType, C);
+check_mix([C | _], _Type0, _OType0, C0) ->
+ throw_error({type_mismatch, xref_parser:t2s(C0), xref_parser:t2s(C)});
+check_mix([], _Type0, _OType0, _C0) ->
+ ok.
+
+split(Types, Cs, Table) ->
+ Vs = from_term(constant_vertices(Cs, [])),
+ split(Types, Vs, empty_set(), unknown, Table, []).
+
+split([Type | Types], Vs, AllSoFar, _Type, Table, L) ->
+ S0 = known_vertices(Type, Vs, Table),
+ S = difference(S0, AllSoFar),
+ case is_empty_set(S) of
+ true ->
+ split(Types, Vs, AllSoFar, Type, Table, L);
+ false ->
+ All = union(AllSoFar, S0),
+ split(Types, Vs, All, Type, Table,
+ [{Type, to_external(S)} | L])
+ end;
+split([], Vs, All, Type, _Table, L) ->
+ case to_external(difference(Vs, All)) of
+ [] -> L;
+ [C|_] -> throw_error({unknown_constant, make_vertex(Type, C)})
+ end.
+
+make_vertex(Type, C) ->
+ xref_parser:t2s({constant, Type, vertex, C}).
+
+constant_vertices([{constant, _Type, edge, {A,B}} | Cs], L) ->
+ constant_vertices(Cs, [A, B | L]);
+constant_vertices([{constant, _Type, vertex, V} | Cs], L) ->
+ constant_vertices(Cs, [V | L]);
+constant_vertices([], L) ->
+ L.
+
+known_vertices('Fun', Cs, T) ->
+ M = projection(1, Cs),
+ F = union_of_family(restriction(fetch_value(v, T), M)),
+ intersection(Cs, F);
+known_vertices('Mod', Cs, T) ->
+ intersection(Cs, fetch_value('M', T));
+known_vertices('App', Cs, T) ->
+ intersection(Cs, fetch_value('A', T));
+known_vertices('Rel', Cs, T) ->
+ intersection(Cs, fetch_value('R', T)).
+
+function_vertices_to_family(function, vertex, E) ->
+ {call, partition_family, 1, E};
+function_vertices_to_family(_Type, _OType, E) ->
+ E.
+
+family_to_function_vertices(function, vertex, E) ->
+ {call, union_of_family, E};
+family_to_function_vertices(_Type, _OType, E) ->
+ E.
+
+-define(Q(E), {quote, E}).
+
+convert({inverse, {variable, Variable}}) ->
+ {get, {inverse, var_name(Variable)}};
+convert({variable, Variable}) ->
+ {get, var_name(Variable)};
+convert({convert, FromOType, ToOType, E}) ->
+ convert(convert(E), FromOType, ToOType);
+convert({convert, OType, FromType, ToType, E}) ->
+ convert(convert(E), OType, FromType, ToType);
+convert({call, Op, E}) ->
+ {Op, convert(E)};
+convert({call, Op, E1, E2}) ->
+ {Op, convert(E1), convert(E2)};
+convert({call, Op, E1, E2, E3}) ->
+ {Op, convert(E1), convert(E2), convert(E3)};
+convert({constants, Constants}) ->
+ ?Q(Constants);
+convert(I) when is_integer(I) ->
+ ?Q(I).
+
+var_name({predef, VarName}) -> VarName;
+var_name(Variable) -> Variable.
+
+convert(E, OType, OType) ->
+ E;
+convert(E, edge, edge_closure) ->
+ {fun(S) -> xref_utils:closure(S) end, E}.
+
+convert(E, OType, FromType, number) ->
+ un_familiarize(FromType, OType, E);
+convert(E, OType, FromType, ToType) ->
+ case {type_ord(FromType), type_ord(ToType)} of
+ {FT, To} when FT =:= To ->
+ E;
+ {FT, ToT} when FT > ToT ->
+ special(OType, FromType, ToType, E);
+ {FT, ToT} when FT < ToT ->
+ general(OType, FromType, ToType, E)
+ end.
+
+-define(T(V), {tmp, V}).
+
+general(_ObjectType, FromType, ToType, X) when FromType =:= ToType ->
+ X;
+general(edge, {line, _LineType}, ToType, LEs) ->
+ VEs = {projection, ?Q({external, fun({V1V2,_Ls}) -> V1V2 end}), LEs},
+ general(edge, function, ToType, VEs);
+general(edge, function, ToType, VEs) ->
+ MEs = {projection,
+ ?Q({external, fun({{M1,_,_},{M2,_,_}}) -> {M1,M2} end}),
+ VEs},
+ general(edge, module, ToType, MEs);
+general(edge, module, ToType, MEs) ->
+ AEs = {image, {get, me2ae}, MEs},
+ general(edge, application, ToType, AEs);
+general(edge, application, release, AEs) ->
+ {image, {get, ae}, AEs};
+general(vertex, {line, _LineType}, ToType, L) ->
+ V = {partition_family, ?Q(1), {domain, L}},
+ general(vertex, function, ToType, V);
+general(vertex, function, ToType, V) ->
+ M = {domain, V},
+ general(vertex, module, ToType, M);
+general(vertex, module, ToType, M) ->
+ A = {image, {get, m2a}, M},
+ general(vertex, application, ToType, A);
+general(vertex, application, release, A) ->
+ {image, {get, a2r}, A}.
+
+special(_ObjectType, FromType, ToType, X) when FromType =:= ToType ->
+ X;
+special(edge, {line, _LineType}, {line, all_line_call}, Calls) ->
+ {put, ?T(mods),
+ {projection,
+ ?Q({external, fun({{{M1,_,_},{M2,_,_}},_}) -> {M1,M2} end}),
+ Calls},
+ {put, ?T(def_at),
+ {union, {image, {get, def_at},
+ {union, {domain, {get, ?T(mods)}},
+ {range, {get, ?T(mods)}}}}},
+ {fun funs_to_lines/2,
+ {get, ?T(def_at)}, Calls}}};
+special(edge, function, {line, LineType}, VEs) ->
+ Var = if
+ LineType =:= line -> call_at;
+ LineType =:= export_call -> e_call_at;
+ LineType =:= local_call -> l_call_at;
+ LineType =:= external_call -> x_call_at
+ end,
+ line_edges(VEs, Var);
+special(edge, module, ToType, MEs) ->
+ VEs = {image,
+ {projection,
+ ?Q({external, fun(FE={{M1,_,_},{M2,_,_}}) -> {{M1,M2},FE} end}),
+ {union,
+ {image, {get, e},
+ {projection, ?Q({external, fun({M1,_M2}) -> M1 end}), MEs}}}},
+ MEs},
+ special(edge, function, ToType, VEs);
+special(edge, application, ToType, AEs) ->
+ MEs = {inverse_image, {get, me2ae}, AEs},
+ special(edge, module, ToType, MEs);
+special(edge, release, ToType, REs) ->
+ AEs = {inverse_image, {get, ae}, REs},
+ special(edge, application, ToType, AEs);
+special(vertex, function, {line, _LineType}, V) ->
+ {restriction,
+ {union_of_family, {restriction, {get, def_at}, {domain, V}}},
+ {union_of_family, V}};
+special(vertex, module, ToType, M) ->
+ V = {restriction, {get, v}, M},
+ special(vertex, function, ToType, V);
+special(vertex, application, ToType, A) ->
+ M = {inverse_image, {get, m2a}, A},
+ special(vertex, module, ToType, M);
+special(vertex, release, ToType, R) ->
+ A = {inverse_image, {get, a2r}, R},
+ special(vertex, application, ToType, A).
+
+line_edges(VEs, CallAt) ->
+ {put, ?T(ves), VEs,
+ {put, ?T(m1),
+ {projection, ?Q({external, fun({{M1,_,_},_}) -> M1 end}),
+ {get, ?T(ves)}},
+ {image, {projection, ?Q({external, fun(C={VV,_L}) -> {VV,C} end}),
+ {union, {image, {get, CallAt}, {get, ?T(m1)}}}},
+ {get, ?T(ves)}}}}.
+
+%% {(((v1,l1),(v2,l2)),l) :
+%% (v1,l1) in DefAt and (v2,l2) in DefAt and ((v1,v2),L) in CallAt}
+funs_to_lines(DefAt, CallAt) ->
+ T1 = multiple_relative_product({DefAt, DefAt}, projection(1, CallAt)),
+ T2 = composite(substitution(1, T1), CallAt),
+ Fun = fun({{{V1,V2},{L1,L2}},Ls}) -> {{{V1,L1},{V2,L2}},Ls} end,
+ projection({external, Fun}, T2).
+
+what_type('Rel') -> release;
+what_type('App') -> application;
+what_type('Mod') -> module;
+what_type('Fun') -> function;
+what_type('Lin') -> {line, line};
+what_type('LLin') -> {line, local_call};
+what_type('XLin') -> {line, external_call};
+what_type('ELin') -> {line, export_call};
+what_type('XXL') -> {line, all_line_call}.
+
+type_ord({line, all_line_call}) -> 0;
+type_ord({line, _LT}) -> 1;
+type_ord(function) -> 2;
+type_ord(module) -> 3;
+type_ord(application) -> 4;
+type_ord(release) -> 5.
+
+%% While evaluating, sets of vertices are represented as families.
+%% Sets of edges are not families, but plain sets (this might change).
+%% Calls (with line numbers) are "straightened" out here, but will be
+%% families again shortly, unless just counted.
+un_familiarize(function, vertex, E) ->
+ {union_of_family, E};
+un_familiarize({line, _}, edge, E) ->
+ {family_to_relation, E};
+un_familiarize(_Type, _OType, E) ->
+ E.
+
+%% Expressions are evaluated using a stack and tail recursion.
+%% Common subexpressions are evaluated once only, using a table for
+%% storing temporary results.
+%% (Using a table _and_ a stack is perhaps not a very good way of
+%% doing things.)
+i(E, Table) ->
+ Start = 1,
+ {N, _NE, _NI, NT} = find_nodes(E, Start, dict:new()),
+ {Vs, UVs0, L} = save_vars(dict:to_list(NT), NT, [], [], []),
+
+ VarsToSave = to_external(relation_to_family(relation(Vs))),
+ Fun = fun({NN,S}, D) ->
+ dict:store(NN, {extra,S,dict:fetch(NN, D)}, D)
+ end,
+ D = foldl(Fun, dict:from_list(L), VarsToSave),
+
+ UVs = reverse(sort(UVs0)),
+ {_D, Is0} = make_instructions(N, UVs, D),
+ Is = insert_unput(Is0),
+ ?FORMAT("Instructions:~n~p~n~n~n", [Is]),
+ %% Well, compiles _and_ evaluates...
+ evaluate(Is, Table, []).
+
+%% Traverses the expression tree in postorder, giving a unique number
+%% to each node. A table is created, and common subexpressions found.
+find_nodes(E={quote,_}, I, T) ->
+ find_node(E, I, T);
+find_nodes({get, Var}, I, T) ->
+ find_node({var,Var}, I, T);
+find_nodes({put, Var, E1, E2}, I, T) ->
+ {_NE1_N, NE1, I1, T1} = find_nodes(E1, I, T),
+ %% Now NE1 is considered used once, which is wrong. Fixed below.
+ NT = dict:store({var, Var}, NE1, T1),
+ find_nodes(E2, I1, NT);
+find_nodes(Tuple, I, T) when is_tuple(Tuple) ->
+ [Tag0 | L] = tuple_to_list(Tuple),
+ Fun = fun(A, {L0, I0, T0}) ->
+ {NA, _E, NI, NT} = find_nodes(A, I0, T0),
+ {[NA | L0], NI, NT}
+ end,
+ {NL, NI, T1} = foldl(Fun, {[], I, T}, L),
+ Tag = case Tag0 of
+ _ when is_function(Tag0) -> Tag0;
+ _ when is_atom(Tag0) -> {sofs, Tag0}
+ end,
+ find_node({apply, Tag, NL}, NI, T1).
+
+find_node(E, I, T) ->
+ case dict:find(E, T) of
+ {ok, {reuse, N}} ->
+ {N, E, I, T};
+ {ok, N} when is_integer(N) ->
+ {N, E, I, dict:store(E, {reuse, N}, T)};
+ {ok, E1} ->
+ find_node(E1, I, T);
+ error ->
+ {I, E, I+1, dict:store(E, I, T)}
+ end.
+
+%% Creates save instructions for those values (stored on the stack while
+%% evaluating) that are to be used after the result has been popped.
+save_vars([{I, {reuse,N}} | DL], D, Vs, UVs, L) ->
+ save_vars(DL, D, [{N, {save, {tmp, N}}} | Vs], UVs, [{N, I} | L]);
+save_vars([{I, N} | DL], D, Vs, UVs, L) when is_integer(N) ->
+ save_vars(DL, D, Vs, UVs, [{N, I} | L]);
+save_vars([{{var,V={user,_}}, I} | DL], D, Vs, UVs, L) ->
+ N = case dict:fetch(I, D) of
+ {reuse, N0} -> N0;
+ N0 -> N0
+ end,
+ save_vars(DL, D, [{N, {save, V}} | Vs], [N | UVs], L);
+save_vars([{{var,{tmp,_}}, _I} | DL], D, Vs, UVs, L) ->
+ save_vars(DL, D, Vs, UVs, L);
+save_vars([], _D, Vs, UVs, L) ->
+ {Vs, UVs, L}.
+
+%% Traverses the expression again, this time using more or less the
+%% inverse of the table created by find_nodes. The first time a node
+%% is visited, its children are traversed, the following times a
+%% get instructions are inserted (using the saved value).
+make_instructions(N, UserVars, D) ->
+ {D1, Is0} = make_instrs(N, D, []),
+ %% Assignments the results of which are not used by the final
+ %% expression are handled here. Instructions are created for user
+ %% variables only (assignment of a closure is handled properly
+ %% without further action).
+ make_more_instrs(UserVars, D1, Is0).
+
+make_more_instrs([UV | UVs], D, Is) ->
+ case dict:find(UV, D) of
+ error ->
+ make_more_instrs(UVs, D, Is);
+ _Else ->
+ {ND, NIs} = make_instrs(UV, D, Is),
+ make_more_instrs(UVs, ND, [pop | NIs])
+ end;
+make_more_instrs([], D, Is) ->
+ {D, Is}.
+
+make_instrs(N, D, Is) ->
+ case dict:find(N, D) of
+ {ok, {extra, Save, Val}} ->
+ {D1, Is1} = make_instr(Val, D, Is),
+ {dict:erase(N, D1), Save ++ Is1};
+ {ok, Val} ->
+ {D1, Is1} = make_instr(Val, D, Is),
+ {dict:erase(N, D1), Is1};
+ error ->
+ {D, [{get, {tmp, N}} | Is]}
+ end.
+
+make_instr({var, V}, D, Is) ->
+ {D, [{get, V} | Is]};
+make_instr(Q = {quote, _T}, D, Is) ->
+ {D, [Q | Is]};
+make_instr({apply, MF, Ns}, D, Is) ->
+ Fun = fun(N, {D0, Is0}) -> make_instrs(N, D0, Is0) end,
+ {D1, Is1} = foldl(Fun, {D, Is}, Ns),
+ {D1, [{apply, MF, length(Ns)} | Is1]}.
+
+%% Makes sure that temporary results are removed from the table as soon
+%% as they are no longer needed.
+%% Assignments may create extra save instructions, which are removed here.
+insert_unput(L) ->
+ insert_unput(L, dict:new(), []).
+
+insert_unput([I={get, V={tmp, _}} | Is], D, L) ->
+ case dict:find(V, D) of
+ {ok, _} -> insert_unput(Is, D, [I | L]);
+ error -> insert_unput(Is, dict:store(V, [], D), [I, {unput, V} | L])
+ end;
+insert_unput([I={save, V={tmp,_}} | Is], D, L) ->
+ case dict:find(V, D) of
+ {ok, _} ->
+ insert_unput(Is, dict:erase(V, D), [I | L]);
+ error ->
+ %% Extra save removed.
+ insert_unput(Is, dict:erase(V, D), L)
+ end;
+insert_unput([I | Is], D, L) ->
+ insert_unput(Is, D, [I | L]);
+insert_unput([], _D, L) ->
+ L.
+
+graph_access(_G, V) ->
+ %% _G may have been deleted by an unput already
+ V.
+
+evaluate([{apply, MF, NoAs} | P], T, S) ->
+ Args = sublist(S, NoAs),
+ NewS = nthtail(NoAs, S),
+ ?FORMAT("Applying ~p/~p~n", [MF,NoAs]),
+ evaluate(P, T, [apply(MF, Args) | NewS]);
+evaluate([{quote, Val} | P], T, S) ->
+ evaluate(P, T, [Val | S]);
+evaluate([{get, Var} | P], T, S) when is_atom(Var) -> % predefined
+ Value = fetch_value(Var, T),
+ Val = case Value of
+ {R, _} -> R; % relation
+ _ -> Value % simple set
+ end,
+ evaluate(P, T, [Val | S]);
+evaluate([{get, {inverse, Var}} | P], T, S) -> % predefined, inverse
+ {_, R} = fetch_value(Var, T),
+ evaluate(P, T, [R | S]);
+evaluate([{get, {user, Var}} | P], T, S) ->
+ Val = fetch_value(Var, T),
+ evaluate(P, T, [Val | S]);
+evaluate([{get, Var} | P], T, S) -> % tmp
+ evaluate(P, T, [dict:fetch(Var, T) | S]);
+evaluate([{save, Var={tmp, _}} | P], T, S=[Val | _]) ->
+ T1 = update_graph_counter(Val, +1, T),
+ evaluate(P, dict:store(Var, Val, T1), S);
+evaluate([{save, {user, Name}} | P], T, S=[Val | _]) ->
+ #xref_var{vtype = user, otype = OType, type = Type} = dict:fetch(Name, T),
+ NewVar = #xref_var{name = Name, value = Val,
+ vtype = user, otype = OType, type = Type},
+ T1 = update_graph_counter(Val, +1, T),
+ NT = dict:store(Name, NewVar, T1),
+ evaluate(P, NT, S);
+evaluate([{unput, Var} | P], T, S) ->
+ T1 = update_graph_counter(dict:fetch(Var, T), -1, T),
+ evaluate(P, dict:erase(Var, T1), S);
+evaluate([pop | P], T, [_ | S]) ->
+ evaluate(P, T, S);
+evaluate([], T, [R]) ->
+ {T, R}.
+
+%% (PossibleGraph, 1 | -1, dict()) -> dict()
+%% Use the same table for everything... Here: Reference counters for digraphs.
+update_graph_counter(Value, Inc, T) ->
+ case catch digraph:info(Value) of
+ Info when is_list(Info) ->
+ case dict:find(Value, T) of
+ {ok, 1} when Inc =:= -1 ->
+ true = digraph:delete(Value),
+ dict:erase(Value, T);
+ {ok, C} ->
+ dict:store(Value, C+Inc, T);
+ error when Inc =:= 1 ->
+ dict:store(Value, 1, T)
+ end;
+ _EXIT ->
+ T
+ end.
+
+fetch_value(V, D) ->
+ #xref_var{value = Value} = dict:fetch(V, D),
+ Value.
+
+format_parse_error(["invalid_regexp", String, Error], Line) ->
+ io_lib:format("Invalid regular expression \"~s\"~s: ~s~n",
+ [String, Line, lists:flatten(Error)]);
+format_parse_error(["invalid_regexp_variable", Var], Line) ->
+ io_lib:format("Invalid wildcard variable ~p~s "
+ "(only '_' is allowed)~n", [Var, Line]);
+format_parse_error(["missing_type", Expr], Line) ->
+ io_lib:format("Missing type of regular expression ~s~s~n",
+ [Expr, Line]);
+format_parse_error(["type_mismatch", Expr], Line) ->
+ io_lib:format("Type does not match structure of constant~s: ~s~n",
+ [Line, Expr]);
+format_parse_error(["invalid_operator", Op], Line) ->
+ io_lib:format("Invalid operator ~p~s~n", [Op, Line]);
+format_parse_error(Error, Line) ->
+ io_lib:format("Parse error~s: ~s~n", [Line, lists:flatten(Error)]).
+
+format_line(-1) ->
+ " at end of string";
+format_line(0) ->
+ "";
+format_line(Line) when is_integer(Line) ->
+ concat([" on line ", Line]).
+
+throw_error(Reason) ->
+ throw(error(Reason)).
+
+error(Reason) ->
+ {error, ?MODULE, Reason}.
diff --git a/lib/tools/src/xref_parser.yrl b/lib/tools/src/xref_parser.yrl
new file mode 100644
index 0000000000..e23dce1dec
--- /dev/null
+++ b/lib/tools/src/xref_parser.yrl
@@ -0,0 +1,303 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+
+Nonterminals
+xref statements statement expr constants constant const
+assign_op prefix_op add_op mult_op count_op restr_op path_op cast_op
+regexp regatom regint regvar regstr
+variable id type.
+
+Terminals
+edge vertex var atom decl cast 'of' string integer
+'(' ')' '[' ']' ',' '+' '-' '*' '|' '||' '|||' '=' ':=' '#' '{' '}' ':' '/'.
+
+Rootsymbol xref.
+
+Endsymbol '$end'.
+
+xref -> statements : '$1'.
+
+assign_op -> '=' : tmp.
+assign_op -> ':=' : user.
+add_op -> '+' : union.
+add_op -> '-' : difference.
+mult_op -> '*' : intersection.
+count_op -> '#' : '#'.
+restr_op -> '|' : '|'.
+restr_op -> '||' : '||'.
+restr_op -> '|||' : '|||'.
+path_op -> 'of' : 'of'.
+cast_op -> '(' cast ')' : value_of('$2').
+prefix_op -> id : '$1'.
+
+Left 200 add_op.
+Left 300 mult_op.
+Left 400 count_op.
+Left 500 restr_op.
+Left 600 path_op.
+Unary 700 cast_op.
+Unary 700 prefix_op.
+
+statements -> statement : ['$1'].
+statements -> expr : ['$1'].
+statements -> statement ',' statements : ['$1' | '$3'].
+
+statement -> variable assign_op expr : {assign, '$2', '$1', '$3'}.
+
+expr -> '[' constant constants ']' type : type({list, ['$2' | '$3']}, '$5').
+expr -> '{' constant constants '}' type : type({tuple, ['$2' | '$3']}, '$5').
+expr -> constant type : type('$1', '$2').
+expr -> variable : {variable, '$1'}.
+expr -> expr add_op expr : {set, '$2', '$1', '$3'}.
+expr -> expr mult_op expr : {set, '$2', '$1', '$3'}.
+expr -> count_op expr : prefix('$1', '$2').
+expr -> expr restr_op expr : {restr, '$2', '$1', '$3'}.
+expr -> expr path_op expr : {path, '$1', '$3'}.
+expr -> cast_op expr : {type, {convert, '$1'}, '$2'}.
+expr -> prefix_op expr : prefix('$1', '$2').
+expr -> regexp : '$1'.
+expr -> '(' expr ')' : '$2'.
+
+constants -> '$empty' : [].
+constants -> ',' constant constants : ['$2' | '$3'].
+
+constant -> const : '$1'.
+
+const -> id : {constant, unknown, vertex, '$1'}.
+const -> edge : value_of('$1').
+const -> vertex : value_of('$1').
+
+regexp -> regstr type : regexp(atom, '$1', '$2').
+regexp -> regatom ':' regatom '/' regint type :
+ regexp(func, {'$1', '$3', '$5'}, '$6').
+
+regatom -> regstr : '$1'.
+regatom -> id : {atom, '$1'}.
+regatom -> regvar : '$1'.
+
+regint -> regstr : '$1'.
+regint -> integer : {integer, value_of('$1')}.
+regint -> regvar : '$1'.
+
+regstr -> string : check_regexp(value_of('$1')).
+regvar -> variable : check_regexp_variable('$1').
+
+id -> atom : value_of('$1').
+variable -> var : value_of('$1').
+
+type -> decl : value_of('$1').
+type -> '$empty' : unknown.
+
+Erlang code.
+
+-export([t2s/1]).
+
+-import(lists, [concat/1, flatten/1]).
+
+%%% Syntax of the parse tree:
+%%% Start = [Statement]
+%%% Statement = {assign, AOp, VarName, Expr}
+%%% | Expr
+%%% AOp = tmp | user
+%%% Expr = Constants | Variable | Unary | Binary | RegExpr
+%%% Constants = {list, [Constant]} % not empty list
+%%% | {tuple, [Constant]}
+%%% | Constant % only to avoid [ and ] in error messages...
+%%% Constant = {constant, 'Fun', vertex, MFA} |
+%%% {constant, AtomType, vertex, atom()} |
+%%% {constant, 'Fun', edge, {MFA, MFA}} |
+%%% {constant, AtomType, edge, {atom(), atom()}}
+%%% Variable = {variable, VarName}
+%%% VarName = atom()
+%%% Unary = {set, SetUOp, Expr}
+%%% | {graph, GraphUOp, Expr}
+%%% | {type, {TypeOp, Type}, Expr}
+%%% | {numeric, NumOp, Expr, Expr}
+%%% SetUOp = range | domain | weak | strict
+%%% GraphUOp = components | condensation | closure
+%%% Binary = {set, SetBOp, Expr, Expr}
+%%% | {restr, RestrOp, Expr, Expr}
+%%% | {path, Expr, Expr}
+%%% SetBOp = union | intersection | difference
+%%% RestrOp = '|' | '||' | '|||'
+%%% TypeOp = type | convert
+%%% NumOp = '#'
+%%% RegExpr = {regexpr, RExpr, Type}
+%%% RExpr = string() | {AtomReg, AtomReg, IntReg}
+%%% AtomReg = string() | atom() | variable()
+%%% IntReg = string() | integer()
+%%% MFA = {atom(), atom(), integer()}
+%%% Type = 'Rel' | 'App' | 'Mod' | 'Fun'
+%%% | 'Lin' | 'LLin' | 'XLin' | 'ELin' | 'XXL'
+%%% AtomType = unknown | 'Rel' | 'App' | 'Mod'
+
+value_of(Token) ->
+ element(3, Token).
+
+prefix(Op, Expr) ->
+ case is_prefix_op(Op) of
+ false ->
+ return_error(0, ["invalid_operator", Op]);
+ UOp ->
+ {UOp, Op, Expr}
+ end.
+
+is_prefix_op(range) -> set;
+is_prefix_op(domain) -> set;
+is_prefix_op(weak) -> set;
+is_prefix_op(strict) -> set;
+is_prefix_op(components) -> graph;
+is_prefix_op(condensation) -> graph;
+is_prefix_op(closure) -> graph;
+is_prefix_op('#') -> numeric;
+is_prefix_op(_) -> false.
+
+check_regexp(String) ->
+ case regexp:parse(String) of
+ {ok, _Expr} ->
+ {regexpr, String};
+ {error, Reason} ->
+ F = regexp:format_error(Reason),
+ return_error(0, ["invalid_regexp", String, F])
+ end.
+
+check_regexp_variable('_') ->
+ variable;
+check_regexp_variable(Var) ->
+ return_error(0, ["invalid_regexp_variable", Var]).
+
+regexp(func, RExpr, unknown) ->
+ {regexpr, RExpr, 'Fun'};
+regexp(_, RExpr, unknown) ->
+ return_error(0, ["missing_type", t2s({regexpr, RExpr, unknown})]);
+regexp(Kind, RExpr, Type) ->
+ E = {type, {type, Type}, {regexpr, RExpr, Type}},
+ case Type of
+ 'Fun' when Kind =:= func -> E;
+ 'Mod' when Kind =:= atom -> E;
+ 'App' when Kind =:= atom -> E;
+ 'Rel' when Kind =:= atom -> E;
+ _Else -> return_error(0, ["type_mismatch", t2s(E)])
+ end.
+
+type(Expr, unknown) ->
+ Expr;
+type(Expr, Type) ->
+ {type, {type, Type}, type_constants(Expr, Type, Expr)}.
+
+type_constants({list, L}, Type, E) ->
+ {list, type_constants(L, Type, E)};
+type_constants({tuple, L}, Type, E) ->
+ {tuple, type_constants(L, Type, E)};
+type_constants([C | Cs], Type, E) ->
+ [type_constants(C, Type, E) | type_constants(Cs, Type, E)];
+type_constants([], _Type, _E) ->
+ [];
+type_constants({constant, unknown, OType, Con}, 'Rel', _E) ->
+ {constant, 'Rel', OType, Con};
+type_constants({constant, unknown, OType, Con}, 'App', _E) ->
+ {constant, 'App', OType, Con};
+type_constants({constant, unknown, OType, Con}, 'Mod', _E) ->
+ {constant, 'Mod', OType, Con};
+type_constants(C={constant, Type, _OType, _Con}, Type, _E) ->
+ C;
+type_constants(_C, Type, E) ->
+ return_error(0, ["type_mismatch", t2s({type, {type, Type}, E})]).
+
+t2s(T) ->
+ concat(flatten(e2s(T, 0))).
+
+%% Does not handle list of statements.
+e2s({assign, VarType, Name, E}, P) ->
+ [left(P, 100), Name, name_it(VarType), e2s(E, 100), right(P, 100)];
+e2s({constant, 'Fun', vertex, MFA}, _P) ->
+ mfa2s(MFA);
+e2s({constant, _Type, vertex, A}, _P) ->
+ [c2s(A)];
+e2s({constant, 'Fun', edge, {MFA1,MFA2}}, _P) ->
+ [mfa2s(MFA1),' -> ',mfa2s(MFA2)];
+e2s({constant, _Type, edge, {A1,A2}}, _P) ->
+ [c2s(A1),' -> ',c2s(A2)];
+e2s({variable, Name}, _P) ->
+ [Name];
+e2s({list, E}, _P) ->
+ ['[', e2s(E, 0), ']'];
+e2s({tuple, E}, _P) ->
+ ['{', e2s(E, 0), '}'];
+e2s({type, {convert, Type}, E}, P) ->
+ [left(P, 700), '(',Type,') ', e2s(E, 700), right(P, 700)];
+e2s({type, {type, Type}, E}, P) ->
+ [left(P, 700), e2s(E, 700), ' : ', Type, right(P, 700)];
+e2s({set, Op, E}, P) ->
+ [left(P, 700), name_it(Op), ' ', e2s(E, 700), right(P, 700)];
+e2s({graph, Op, E}, P) ->
+ [left(P, 700), name_it(Op), ' ', e2s(E, 700), right(P, 700)];
+e2s({numeric, Op, E}, P) ->
+ [left(P, 400), name_it(Op), ' ', e2s(E, 400), right(P, 400)];
+e2s({set, Op, E1, E2}, P) ->
+ P1 = prio(Op),
+ [left(P, P1), e2s(E1, P1),name_it(Op),e2s(E2, P1+50), right(P, P1)];
+e2s({path, E1, E2}, P) ->
+ P1 = 600,
+ [left(P, P1), e2s(E1, P1),' of ',e2s(E2, P1+50), right(P, P1)];
+e2s({regexpr, Expr={regexpr,_}, _Type}, _P) ->
+ [re(Expr)];
+e2s({regexpr, {M,F,A}, _Type}, _P) ->
+ [re(M),':',re(F),'/', re(A)];
+e2s({restr, Op, E1, E2}, P) ->
+ P1 = 500,
+ [left(P, P1), e2s(E1, P1),name_it(Op),e2s(E2, P1+50), right(P, P1)];
+e2s([], _P) ->
+ [];
+e2s([E], P) ->
+ e2s(E, P);
+e2s([E | Es], P) ->
+ [e2s(E, P),', ',e2s(Es, P)].
+
+mfa2s({M,F,A}) ->
+ [c2s(M),':',c2s(F),'/',A].
+
+c2s(C) ->
+ [S] = io_lib:format("~p", [C]),
+ list_to_atom(S).
+
+re(variable) -> ['_'];
+re({atom, Atom}) -> [Atom];
+re({integer, Int}) -> [Int];
+re({regexpr, Str}) -> ['"',erlang:list_to_atom(Str),'"'].
+
+left(P1, P2) when P1 > P2 -> ['('];
+left(_P1, _P2) -> [].
+
+right(P1, P2) when P1 > P2 -> [')'];
+right(_P1, _P2) -> [].
+
+prio(intersection) -> 300;
+prio(difference) -> 200;
+prio(union) -> 200.
+
+name_it(tmp) -> ' = ';
+name_it(user) -> ' := ';
+name_it('|') -> ' | ';
+name_it('||') -> ' || ';
+name_it('|||') -> ' ||| ';
+name_it(union) -> ' + ';
+name_it(intersection) -> ' * ';
+name_it(difference) -> ' - ';
+name_it(Name) -> Name.
diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl
new file mode 100644
index 0000000000..db755c31d8
--- /dev/null
+++ b/lib/tools/src/xref_reader.erl
@@ -0,0 +1,352 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+-module(xref_reader).
+
+-export([module/5]).
+
+-import(lists, [keysearch/3, member/2, reverse/1]).
+
+-record(xrefr,
+ {module=[],
+ function=[],
+ def_at=[],
+ l_call_at=[],
+ x_call_at=[],
+ el=[],
+ ex=[],
+ x=[],
+ df,
+ builtins_too=false,
+ is_abstr, % abstract module?
+ funvars=[], % records variables bound to funs
+ % (for coping with list comprehension)
+ matches=[], % records other bound variables
+ unresolved=[], % unresolved calls, {{mfa(),mfa()},Line}
+ %% experimental; -xref(FunEdge) is recognized.
+ lattrs=[], % local calls, {{mfa(),mfa()},Line}
+ xattrs=[], % external calls, -"-
+ battrs=[] % badly formed xref attributes, term().
+ }).
+
+-include("xref.hrl").
+
+%% sys_pre_expand has modified the forms slightly compared to what
+%% erl_id_trans recognizes.
+
+%% The versions of the abstract code are as follows:
+%% R7: abstract_v1
+%% R8: abstract_v2
+
+%% -> {ok, Module, {DefAt, CallAt, LC, XC, X, Attrs}, Unresolved}} | EXIT
+%% Attrs = {ALC, AXC, Bad}
+%% ALC, AXC and Bad are extracted from the attribute 'xref'. An experiment.
+module(Module, Forms, CollectBuiltins, X, DF) ->
+ Attrs = [{Attr,V} || {attribute,_Line,Attr,V} <- Forms],
+ IsAbstract = xref_utils:is_abstract_module(Attrs),
+ S = #xrefr{module = Module, builtins_too = CollectBuiltins,
+ is_abstr = IsAbstract, x = X, df = DF},
+ forms(Forms, S).
+
+forms([F | Fs], S) ->
+ S1 = form(F, S),
+ forms(Fs, S1);
+forms([], S) ->
+ #xrefr{module = M, def_at = DefAt,
+ l_call_at = LCallAt, x_call_at = XCallAt,
+ el = LC, ex = XC, x = X, df = Depr,
+ lattrs = AL, xattrs = AX, battrs = B, unresolved = U} = S,
+ Attrs = {lists:reverse(AL), lists:reverse(AX), lists:reverse(B)},
+ {ok, M, {DefAt, LCallAt, XCallAt, LC, XC, X, Attrs, Depr}, U}.
+
+form({attribute, Line, xref, Calls}, S) -> % experimental
+ #xrefr{module = M, function = Fun,
+ lattrs = L, xattrs = X, battrs = B} = S,
+ attr(Calls, Line, M, Fun, L, X, B, S);
+form({attribute, _Line, _Attr, _Val}, S) ->
+ S;
+form({function, 0, 'MNEMOSYNE RULE', 1, _Clauses}, S) ->
+ S;
+form({function, 0, 'MNEMOSYNE QUERY', 2, _Clauses}, S) ->
+ S;
+form({function, 0, 'MNEMOSYNE RECFUNDEF', 1, _Clauses}, S) ->
+ S;
+form({function, 0, module_info, 0, _Clauses}, S) ->
+ S;
+form({function, 0, module_info, 1, _Clauses}, S) ->
+ S;
+form({function, Line, Name, Arity, Clauses}, S) ->
+ MFA0 = {S#xrefr.module, Name, Arity},
+ MFA = adjust_arity(S, MFA0),
+ S1 = S#xrefr{function = MFA},
+ S2 = S1#xrefr{def_at = [{MFA,Line} | S#xrefr.def_at]},
+ S3 = clauses(Clauses, S2),
+ S3#xrefr{function = []}.
+
+clauses(Cls, S) ->
+ #xrefr{funvars = FunVars, matches = Matches} = S,
+ clauses(Cls, FunVars, Matches, S).
+
+clauses([{clause, _Line, _H, G, B} | Cs], FunVars, Matches, S) ->
+ S1 = case S#xrefr.builtins_too of
+ true -> expr(G, S);
+ false -> S
+ end,
+ S2 = expr(B, S1),
+ S3 = S2#xrefr{funvars = FunVars, matches = Matches},
+ clauses(Cs, S3);
+clauses([], _FunVars, _Matches, S) ->
+ S.
+
+attr([E={From, To} | As], Ln, M, Fun, AL, AX, B, S) ->
+ case mfa(From, M) of
+ {_, _, MFA} when MFA =:= Fun; [] =:= Fun ->
+ attr(From, To, Ln, M, Fun, AL, AX, B, S, As, E);
+ {_, _, _} ->
+ attr(As, Ln, M, Fun, AL, AX, [E | B], S);
+ _ ->
+ attr(Fun, E, Ln, M, Fun, AL, AX, B, S, As, E)
+ end;
+attr([To | As], Ln, M, Fun, AL, AX, B, S) ->
+ attr(Fun, To, Ln, M, Fun, AL, AX, B, S, As, To);
+attr([], _Ln, _M, _Fun, AL, AX, B, S) ->
+ S#xrefr{lattrs = AL, xattrs = AX, battrs = B}.
+
+attr(From, To, Ln, M, Fun, AL, AX, B, S, As, E) ->
+ case {mfa(From, M), mfa(To, M)} of
+ {{true,_,F}, {_,external,T}} ->
+ attr(As, Ln, M, Fun, AL, [{{F,T},Ln} | AX], B, S);
+ {{true,_,F}, {_,local,T}} ->
+ attr(As, Ln, M, Fun, [{{F,T},Ln} | AL], AX, B, S);
+ _ -> attr(As, Ln, M, Fun, AL, AX, [E | B], S)
+ end.
+
+mfa({F,A}, M) when is_atom(F), is_integer(A) ->
+ {true, local, {M,F,A}};
+mfa(MFA={M,F,A}, M1) when is_atom(M), is_atom(F), is_integer(A) ->
+ {M=:=M1, external, MFA};
+mfa(_, _M) -> false.
+
+expr({'if', _Line, Cs}, S) ->
+ clauses(Cs, S);
+expr({'case', _Line, E, Cs}, S) ->
+ S1 = expr(E, S),
+ clauses(Cs, S1);
+expr({'receive', _Line, Cs}, S) ->
+ clauses(Cs, S);
+expr({'receive', _Line, Cs, To, ToEs}, S) ->
+ S1 = expr(To, S),
+ S2 = expr(ToEs, S1),
+ clauses(Cs, S2);
+expr({'try',_Line,Es,Scs,Ccs,As}, S) ->
+ S1 = expr(Es, S),
+ S2 = clauses(Scs, S1),
+ S3 = clauses(Ccs, S2),
+ expr(As, S3);
+expr({call, Line,
+ {remote, _, {atom,_,erlang}, {atom,_,make_fun}},
+ [{atom,_,Mod}, {atom,_,Fun}, {integer,_,Arity}]}, S) ->
+ %% Added in R10B-6. M:F/A.
+ expr({'fun', Line, {function, Mod, Fun, Arity}}, S);
+expr({'fun', Line, {function, Mod, Name, Arity}}, S) ->
+ %% Added in R10B-6. M:F/A.
+ As = lists:duplicate(Arity, {atom, Line, foo}),
+ external_call(Mod, Name, As, Line, false, S);
+expr({'fun', Line, {function, Name, Arity}, _Extra}, S) ->
+ %% Added in R8.
+ handle_call(local, S#xrefr.module, Name, Arity, Line, S);
+expr({'fun', _Line, {clauses, Cs}, _Extra}, S) ->
+ clauses(Cs, S);
+expr({call, Line, {atom, _, Name}, As}, S) ->
+ S1 = handle_call(local, S#xrefr.module, Name, length(As), Line, S),
+ expr(As, S1);
+expr({call, Line, {remote, _Line, {atom,_,Mod}, {atom,_,Name}}, As}, S) ->
+ external_call(Mod, Name, As, Line, false, S);
+expr({call, Line, {remote, _Line, Mod, Name}, As}, S) ->
+ %% Added in R8.
+ external_call(erlang, apply, [Mod, Name, list2term(As)], Line, true, S);
+expr({call, Line, F, As}, S) ->
+ external_call(erlang, apply, [F, list2term(As)], Line, true, S);
+expr({match, _Line, {var,_,Var}, {'fun', _, {clauses, Cs}, _Extra}}, S) ->
+ %% This is what is needed in R7 to avoid warnings for the functions
+ %% that are passed around by the "expansion" of list comprehension.
+ S1 = S#xrefr{funvars = [Var | S#xrefr.funvars]},
+ clauses(Cs, S1);
+expr({match, _Line, {var,_,Var}, E}, S) ->
+ %% Used for resolving code like
+ %% Args = [A,B], apply(m, f, Args)
+ S1 = S#xrefr{matches = [{Var, E} | S#xrefr.matches]},
+ expr(E, S1);
+expr(T, S) when is_tuple(T) ->
+ expr(tuple_to_list(T), S);
+expr([E | Es], S) ->
+ expr(Es, expr(E, S));
+expr(_E, S) ->
+ S.
+
+%% Mod and Fun may not correspond to something in the abstract code,
+%% which is signalled by X =:= true.
+external_call(Mod, Fun, ArgsList, Line, X, S) ->
+ Arity = length(ArgsList),
+ W = case xref_utils:is_funfun(Mod, Fun, Arity) of
+ true when erlang =:= Mod, apply =:= Fun, 2 =:= Arity -> apply2;
+ true when erts_debug =:= Mod, apply =:= Fun,4 =:= Arity -> debug4;
+ true when erlang =:= Mod, spawn_opt =:= Fun -> Arity - 1;
+ true -> Arity;
+ false when Mod =:= erlang ->
+ case erl_internal:type_test(Fun, Arity) of
+ true -> type;
+ false -> false
+ end;
+ false -> false
+ end,
+ S1 = if
+ W =:= type; X ->
+ S;
+ true ->
+ handle_call(external, Mod, Fun, Arity, Line, S)
+ end,
+ case {W, ArgsList} of
+ {false, _} ->
+ expr(ArgsList, S1);
+ {type, _} ->
+ expr(ArgsList, S1);
+ {apply2, [{tuple, _, [M,F]}, ArgsTerm]} ->
+ eval_args(M, F, ArgsTerm, Line, S1, ArgsList, []);
+ {1, [{tuple, _, [M,F]} | R]} -> % R = [] unless spawn_opt
+ eval_args(M, F, list2term([]), Line, S1, ArgsList, R);
+ {2, [Node, {tuple, _, [M,F]} | R]} -> % R = [] unless spawn_opt
+ eval_args(M, F, list2term([]), Line, S1, ArgsList, [Node | R]);
+ {3, [M, F, ArgsTerm | R]} -> % R = [] unless spawn_opt
+ eval_args(M, F, ArgsTerm, Line, S1, ArgsList, R);
+ {4, [Node, M, F, ArgsTerm | R]} -> % R = [] unless spawn_opt
+ eval_args(M, F, ArgsTerm, Line, S1, ArgsList, [Node | R]);
+ {debug4, [M, F, ArgsTerm, _]} ->
+ eval_args(M, F, ArgsTerm, Line, S1, ArgsList, []);
+ _Else -> % apply2, 1 or 2
+ check_funarg(W, ArgsList, Line, S1)
+ end.
+
+eval_args(Mod, Fun, ArgsTerm, Line, S, ArgsList, Extra) ->
+ {IsSimpleCall, M, F} = mod_fun(Mod, Fun),
+ case term2list(ArgsTerm, [], S) of
+ undefined ->
+ S1 = unresolved(M, F, -1, Line, S),
+ expr(ArgsList, S1);
+ ArgsList2 when not IsSimpleCall ->
+ S1 = unresolved(M, F, length(ArgsList2), Line, S),
+ expr(ArgsList, S1);
+ ArgsList2 when IsSimpleCall ->
+ S1 = expr(Extra, S),
+ external_call(M, F, ArgsList2, Line, false, S1)
+ end.
+
+mod_fun({atom,_,M1}, {atom,_,F1}) -> {true, M1, F1};
+mod_fun({atom,_,M1}, _) -> {false, M1, ?VAR_EXPR};
+mod_fun(_, {atom,_,F1}) -> {false, ?MOD_EXPR, F1};
+mod_fun(_, _) -> {false, ?MOD_EXPR, ?VAR_EXPR}.
+
+check_funarg(W, ArgsList, Line, S) ->
+ {FunArg, Args} = fun_args(W, ArgsList),
+ S1 = case funarg(FunArg, S) of
+ true ->
+ S;
+ false when is_integer(W) -> % 1 or 2
+ unresolved(?MOD_EXPR, ?VAR_EXPR, 0, Line, S);
+ false -> % apply2
+ N = case term2list(Args, [], S) of
+ undefined -> -1;
+ As -> length(As)
+ end,
+ unresolved(?MOD_EXPR, ?VAR_EXPR, N, Line, S)
+ end,
+ expr(ArgsList, S1).
+
+funarg({'fun', _, _Clauses, _Extra}, _S) -> true;
+funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars);
+funarg({call,_,{remote,_,{atom,_,erlang},{atom,_,make_fun}},_MFA}, _S) ->
+ %% R10B-6. M:F/A.
+ true;
+funarg(_, _S) -> false.
+
+fun_args(apply2, [FunArg, Args]) -> {FunArg, Args};
+fun_args(1, [FunArg | Args]) -> {FunArg, Args};
+fun_args(2, [_Node, FunArg | Args]) -> {FunArg, Args}.
+
+list2term([A | As]) ->
+ {cons, 0, A, list2term(As)};
+list2term([]) ->
+ {nil, 0}.
+
+term2list({cons, _Line, H, T}, L, S) ->
+ term2list(T, [H | L], S);
+term2list({nil, _Line}, L, _S) ->
+ reverse(L);
+term2list({var, _, Var}, L, S) ->
+ case keysearch(Var, 1, S#xrefr.matches) of
+ {value, {Var, E}} ->
+ term2list(E, L, S);
+ false ->
+ undefined
+ end;
+term2list(_Else, _L, _S) ->
+ undefined.
+
+unresolved(M, F, A, Line, S) ->
+ handle_call(external, {M,F,A}, Line, S, true).
+
+handle_call(Locality, Module, Name, Arity, Line, S) ->
+ case xref_utils:is_builtin(Module, Name, Arity) of
+ true when not S#xrefr.builtins_too -> S;
+ _Else ->
+ To = {Module, Name, Arity},
+ handle_call(Locality, To, Line, S, false)
+ end.
+
+handle_call(_Locality, {_, 'MNEMOSYNE RULE',1}, _Line, S, _) -> S;
+handle_call(_Locality, {_, 'MNEMOSYNE QUERY', 2}, _Line, S, _) -> S;
+handle_call(_Locality, {_, 'MNEMOSYNE RECFUNDEF',1}, _Line, S, _) -> S;
+handle_call(Locality, To0, Line, S, IsUnres) ->
+ From = S#xrefr.function,
+ To = adjust_arity(S, To0),
+ Call = {From, To},
+ CallAt = {Call, Line},
+ S1 = if
+ IsUnres ->
+ S#xrefr{unresolved = [CallAt | S#xrefr.unresolved]};
+ true ->
+ S
+ end,
+ case Locality of
+ local ->
+ S1#xrefr{el = [Call | S1#xrefr.el],
+ l_call_at = [CallAt | S1#xrefr.l_call_at]};
+ external ->
+ S1#xrefr{ex = [Call | S1#xrefr.ex],
+ x_call_at = [CallAt | S1#xrefr.x_call_at]}
+ end.
+
+adjust_arity(#xrefr{is_abstr = true, module = M}, {M, F, A} = MFA) ->
+ case xref_utils:is_static_function(F, A) of
+ true ->
+ MFA;
+ false ->
+ {M,F,A-1}
+ end;
+adjust_arity(_S, MFA) ->
+ MFA.
diff --git a/lib/tools/src/xref_scanner.erl b/lib/tools/src/xref_scanner.erl
new file mode 100644
index 0000000000..990f8aa87b
--- /dev/null
+++ b/lib/tools/src/xref_scanner.erl
@@ -0,0 +1,91 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+
+-module(xref_scanner).
+
+-export([scan/1]).
+
+scan(Chars) ->
+ case erl_scan:string(Chars) of
+ {ok, Tokens, _Line} ->
+ {ok, lex(a1(Tokens))};
+ {error, {Line,Module,Info}, _EndLine} ->
+ {error, Module:format_error(Info), Line}
+ end.
+
+a1([{'-',N},{integer,N,1} | L]) ->
+ [{integer,N,-1} | a1(L)];
+a1([T | L]) ->
+ [T | a1(L)];
+a1([]) ->
+ [].
+
+-define(MFA(M,F,A,N), {atom,N,M}, {':',_}, {atom,_,F}, {'/',_}, {integer,_,A}).
+-define(MFA2(M,F,A,N),
+ {'{',N},{atom,_,M},{',',_},{atom,_,F},{',',_},{integer,_,A},{'}',_}).
+-define(DECL(N1,N2,T), {':',N1},{var,N2,T}).
+
+lex([{atom,N,V1},{'->',_},{atom,_,V2} | L]) ->
+ Constant = {constant, unknown, edge, {V1,V2}},
+ [{edge,N,Constant} | lex(L)];
+lex([{'{',N},{atom,_,V1},{',',_},{atom,_,V2},{'}',_} | L]) ->
+ Constant = {constant, unknown, edge, {V1,V2}},
+ [{edge,N,Constant} | lex(L)];
+lex([?MFA(M,F,A,N),{'->',_},?MFA(M2,F2,A2,_) | L]) ->
+ Constant = {constant, 'Fun', edge, {{M,F,A},{M2,F2,A2}}},
+ [{edge,N,Constant} | lex(L)];
+lex([?MFA(M,F,A,N) | L]) ->
+ Constant = {constant, 'Fun', vertex, {M,F,A}},
+ [{vertex,N,Constant} | lex(L)];
+lex([{'{',N},?MFA2(M,F,A,_),{',',_},?MFA2(M2,F2,A2,_),{'}',_} | L]) ->
+ Constant = {constant, 'Fun', edge, {{M,F,A},{M2,F2,A2}}},
+ [{edge,N,Constant} | lex(L)];
+lex([?MFA2(M,F,A,N) | L]) ->
+ Constant = {constant, 'Fun', vertex, {M,F,A}},
+ [{vertex,N,Constant} | lex(L)];
+lex([?DECL(N1,N2,Decl) | L]) ->
+ case is_type(Decl) of
+ false -> [?DECL(N1, N2, Decl) | lex(L)];
+ true -> [{decl,N1,Decl} | lex(L)]
+ end;
+lex([{':',N},{'=',_} | L]) ->
+ [{':=',N} | lex(L)];
+lex([{'||',N},{'|',_} | L]) ->
+ [{'|||',N} | lex(L)];
+lex([V={var,N,Var} | L]) ->
+ T = case is_type(Var) of
+ false -> V;
+ true -> {cast,N,Var}
+ end,
+ [T | lex(L)];
+lex([T | Ts]) ->
+ [T | lex(Ts)];
+lex([]) ->
+ [{'$end', -1}].
+
+is_type('Rel') -> true;
+is_type('App') -> true;
+is_type('Mod') -> true;
+is_type('Fun') -> true;
+is_type('Lin') -> true;
+is_type('LLin') -> true;
+is_type('XLin') -> true;
+is_type('ELin') -> true;
+is_type('XXL') -> true;
+is_type(_) -> false.
diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl
new file mode 100644
index 0000000000..aeb7bf9f1c
--- /dev/null
+++ b/lib/tools/src/xref_utils.erl
@@ -0,0 +1,725 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-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%
+%%
+-module(xref_utils).
+
+-export([xset/2]).
+
+-export([is_directory/1, file_info/1, fa_to_mfa/2]).
+
+-export([is_string/2, is_path/1]).
+
+-export([module_filename/2, application_filename/1, application_filename/2]).
+
+-export([release_directory/3, select_application_directories/2,
+ filename_to_application/1, select_last_application_version/1,
+ split_filename/2, scan_directory/4, list_path/2]).
+
+-export([predefined_functions/0, is_funfun/3, is_builtin/3]).
+
+-export([is_static_function/2, is_abstract_module/1]).
+
+-export([closure/1, components/1, condensation/1, path/2, use/2, call/2]).
+
+-export([regexpr/2]).
+
+-export([relation_to_graph/1]).
+
+-export([find_beam/1]).
+
+-export([options/2]).
+
+-export([subprocess/2]).
+
+-export([format_error/1]).
+
+-import(lists, [append/1, delete/2, filter/2, foldl/3, foreach/2,
+ keydelete/3, keysearch/3, keysort/2, last/1, map/2,
+ member/2, reverse/1, sort/1]).
+
+-import(sofs,
+ [difference/2, domain/1, family/1,
+ family_to_relation/1, from_external/2, from_term/2,
+ intersection/2, partition/2, relation/1, relation_to_family/1,
+ restriction/2, set/1, to_external/1, type/1]).
+
+-include_lib("kernel/include/file.hrl").
+
+%%
+%% Exported functions
+%%
+
+xset(L, T) when is_list(L) ->
+ from_external(lists:usort(L), T);
+xset(S, T) ->
+ from_external(S, T).
+
+%% -> true | false | {error, ?MODULE, Reason}
+%is_directory(F) ->
+% filelib:is_dir(F);
+is_directory(F) ->
+ case file:read_file_info(F) of
+ {ok, Info} ->
+ Info#file_info.type =:= directory;
+ {error, Error} ->
+ file_error(F, Error)
+ end.
+
+%% file_info(FileName) -> {ok, FileInfo} | {error, ?MODULE, Reason}
+%% FileInfo = {FileName, DirOrFile, Readable, ModificationTime}
+%% DirOrFile = directory | file
+%% Readable = readable | unreadable
+%% ModificationTime = {{Year, Month, Day}, {Hour, Minute, Second}}
+%%
+%% DirOrFile is equal to 'directory' ('file') if FileName is a
+%% directory (regular file).
+%% Readable is equal 'readable' ('unreadable') if FileName is readable
+%% (unreadable).
+%% ModificationTime is copied from file_info.mtime.
+%%
+file_info(F) ->
+ case file:read_file_info(F) of
+ {ok, Info} ->
+ Readable = case Info#file_info.access of
+ Access when Access =:= read;
+ Access =:= read_write ->
+ readable;
+ _ ->
+ unreadable
+ end,
+ Type = case Info#file_info.type of
+ directory -> directory;
+ regular -> file;
+ _ -> error
+ end,
+ case Type of
+ error -> error({unrecognized_file, F});
+ _ -> {ok, {F, Type, Readable, Info#file_info.mtime}}
+ end;
+ {error, Error} ->
+ file_error(F, Error)
+ end.
+
+
+fa_to_mfa(FAs, Mod) ->
+ fa_to_mfa(FAs, Mod, []).
+
+fa_to_mfa([{F,A} | MFs], Mod, L) ->
+ fa_to_mfa(MFs, Mod, [{Mod,F,A} | L]);
+fa_to_mfa([], _Mod, L) ->
+ reverse(L).
+
+module_filename(Dir, Module) ->
+ filename:join(Dir, to_list(Module) ++ code:objfile_extension()).
+
+application_filename(AppName) ->
+ to_list(AppName) ++ ".app".
+
+application_filename(Dir, AppName) ->
+ filename:join(to_list(Dir), application_filename(AppName)).
+
+%% -> bool()
+is_string([], _) ->
+ false;
+is_string(Term, C) ->
+ is_string1(Term, C).
+
+is_string1([H | T], C) when H > C, H < 127 ->
+ is_string1(T, C);
+is_string1([], _) ->
+ true;
+is_string1(_, _) ->
+ false.
+
+%% -> bool()
+is_path([S | Ss]) ->
+ case is_string(S, 31) of
+ true ->
+ is_path(Ss);
+ false ->
+ false
+ end;
+is_path([]) ->
+ true;
+is_path(_) ->
+ false.
+
+%====================================
+% Release and application functions.
+%====================================
+
+%%% ApplDir = {ApplicationName,NumericApplicationVersion,ApplicationDirectory}
+%%% ApplicationName = atom()
+%%% ApplicationDirectory = string()
+%%% NumericApplicationVersion = [integer()] ("3.1.7" becomes [3,1,7]).
+%%% [] means that the application has no version...
+%%%
+%%% ModuleName = ModuleFileName = string()
+%%% ReleaseName = atom()
+
+%% release_directory(Directory, CheckLib, SubDirectory) ->
+%% {ok, ReleaseName, AppDir, [ApplDir]} | {error, ?MODULE, Reason}
+%% CheckLib = bool()
+%% AppDir = string()
+%% SubDirectory = string()
+%%
+%% Returns all sub directories of a given directory, assuming all sub
+%% directories are application directories. If a sub directory has a
+%% sub directory SubDirectory, that one is chosen as application
+%% directory. If Directory has a sub directory 'lib' and CheckLib is
+%% equal to 'true', applications are looked for on that
+%% directory. ApplDir is the directory where applications reside. In
+%% any case, the returned ReleaseName is the basename of the given
+%% directory.
+%%
+release_directory(Dir, UseLib, SubDir) ->
+ SDir = subdir(Dir, "lib", UseLib),
+ case file:list_dir(SDir) of
+ {ok, FileNames} ->
+ Files = [filename:join(SDir, File) || File <- FileNames],
+ case select_application_directories(Files, SubDir) of
+ {ok, ApplDirs} ->
+ {ok, list_to_atom(filename:basename(Dir)), SDir, ApplDirs};
+ Error ->
+ Error
+ end;
+ {error, Error} ->
+ file_error(SDir, Error)
+ end.
+
+%% select_application_directories([FileName], SubDirectory) ->
+%% {ok, [ApplDir]} | {error, ?MODULE, Error}
+%% SubDirectory = string()
+%%
+%% For each filename that is a directory, the filename is split into
+%% an application name and an application version, if possible, using
+%% '-' as separator. If not possible, the empty version - [] - is
+%% used. If a directory has a sub directory called SubDirectory, that
+%% one is returned as application directory rather than the directory
+%% itself.
+%%
+select_application_directories(FileNames, Dir) ->
+ select_application_directories(FileNames, Dir, Dir =/= [], []).
+
+%% filename_to_application(FileName) ->
+%% {ApplicationName,NumbericApplicationVersion}
+%%
+%% Interprets a filename as an application name and an application
+%% version. If the filename (the basename actually) cannot be split
+%% into two components using '-' as separator, the whole basename is
+%% used as application name, and the version returned is [].
+%%
+filename_to_application(FileName) ->
+ Basename = filename:basename(FileName),
+ case catch filename2appl(Basename) of
+ {'EXIT',_} ->
+ {list_to_atom(Basename),[]};
+ Split ->
+ Split
+ end.
+
+%% select_last_application_version([ApplDir]) -> [ApplDir]
+%%
+%% For each application that occurs with more than one version in the
+%% input list, only the one with the last version is kept.
+%%
+select_last_application_version(AppVs) ->
+ TL = to_external(partition(1, relation(AppVs))),
+ [last(keysort(2, L)) || L <- TL].
+
+%% scan_directory(Directory, Recurse, Collect, Watch) ->
+%% {Collected, Errors, Seen, Unreadable}
+%%
+%% Watch = Collect = [string()]
+%% Directory = string() | atom()
+%% Recurse = bool()
+%% Collected = [{Dir,Basename}]
+%% Dir = Basename = Seen = Unreadable = [string()]
+%%
+%% Collected (Seen) contains those regular files with extension
+%% occurring in Collect (Watch). Watch is tried only if a filename
+%% does not match Collect. Only readable files occur in Collected, the
+%% unreadable files (with extension matching Collect) go into
+%% Unreadable.
+%%
+scan_directory(File, Recurse, Collect, Watch) ->
+ Init = [[] | {[],[],[]}],
+ [L | {E,J,U}] = find_files_dir(File, Recurse, Collect, Watch, Init),
+ {reverse(L), reverse(E), reverse(J), reverse(U)}.
+
+%% {Dir, Basename} | false
+split_filename(File, Extension) ->
+ case catch begin
+ Dir = filename:dirname(File),
+ Basename = filename:basename(File, Extension),
+ {Dir, Basename++Extension}
+ end of
+ {'EXIT', _} ->
+ false;
+ R ->
+ R
+ end.
+
+%% list_path(Path, Extensions) ->
+%% {[{Module, {integer(), Directory, Basename}}], [error()]}
+%%
+%% Path = [Directory]
+%% Extensions = [string()]
+%% Module = atom()
+%% Directory = Basename = string()
+%%
+%% Files with any of the given extensions are searched for among
+%% the given directories (Path). Directories "below" some of the given
+%% directories are not searched (unless enumerated in Path). If some
+%% file is found on more than one directory, the first one found is
+%% returned (Path is searched from the beginning).
+%%
+list_path(P, Extensions) ->
+ list_dirs(P, 1, Extensions, [], []).
+
+list_dirs([D | Ds], I, Exts, CL, E) ->
+ Fun = fun(X, A) ->
+ File = filename:join(D, X),
+ case is_directory(File) of
+ false ->
+ Ext = filename:extension(X),
+ case member(Ext, Exts) of
+ true ->
+ M = list_to_atom(filename:basename(X, Ext)),
+ [{M, {I,D,X}} | A];
+ false ->
+ A
+ end;
+ true ->
+ A;
+ _Else ->
+ A
+ end
+ end,
+ {NCL, NE} = case file:list_dir(D) of
+ {ok, C0} ->
+ {foldl(Fun, CL, C0), E};
+ {error, Error} ->
+ {CL, [file_error(D, Error) | E]}
+ end,
+ list_dirs(Ds, I+1, Exts, NCL, NE);
+list_dirs([], _I, _Exts, C, E) ->
+ {C, E}.
+
+%% Returns functions that are present in all modules.
+predefined_functions() ->
+ [{module_info,0}, {module_info,1}].
+
+%% Returns true if an MFA takes functional arguments.
+is_funfun(erlang, apply, 2) -> true;
+is_funfun(erlang, apply, 3) -> true;
+is_funfun(erlang, spawn, 1) -> true;
+is_funfun(erlang, spawn, 2) -> true;
+is_funfun(erlang, spawn, 3) -> true;
+is_funfun(erlang, spawn, 4) -> true;
+is_funfun(erlang, spawn_link, 1) -> true;
+is_funfun(erlang, spawn_link, 2) -> true;
+is_funfun(erlang, spawn_link, 3) -> true;
+is_funfun(erlang, spawn_link, 4) -> true;
+is_funfun(erlang, spawn_opt, 2) -> true;
+is_funfun(erlang, spawn_opt, 3) -> true;
+is_funfun(erlang, spawn_opt, 4) -> true;
+is_funfun(erlang, spawn_opt, 5) -> true;
+is_funfun(erts_debug, apply, 4) -> true;
+is_funfun(_, _, _) -> false.
+
+is_builtin(erts_debug, apply, 4) -> true;
+is_builtin(M, F, A) ->
+ erlang:is_builtin(M, F, A).
+
+is_abstract_module(Attributes) ->
+ case keysearch(abstract, 1, Attributes) of
+ {value, {abstract, true}} ->
+ true;
+ {value, {abstract, Vals}} when is_list(Vals) ->
+ member(true, Vals);
+ _ ->
+ false
+ end.
+
+%% A "static function" is a function in an abstract module that may be
+%% called directly.
+is_static_function(module_info, 0) ->
+ true;
+is_static_function(module_info, 1) ->
+ true;
+is_static_function(new, _) ->
+ true;
+is_static_function(instance, _) ->
+ true;
+is_static_function(_F, _A) ->
+ false.
+
+%%% The following functions implement some of the operators recognized
+%%% in xref_compiler.erl.
+
+closure(S) ->
+ relation_to_graph(S).
+
+components(G) ->
+ %% Returns a plain set of sets.
+ from_term(digraph_utils:cyclic_strong_components(G), [[atom]]).
+
+condensation(G) ->
+ G2 = digraph_utils:condensation(G),
+ %% A relation. The result can be only be used by a few set operations.
+ R = graph_to_relation(G2),
+ true = digraph:delete(G2),
+ R.
+
+path(G, [E]) ->
+ path(G, [E,E]);
+path(G, P=[E1 | _]) ->
+ path(P, G, [[E1]]).
+
+use(G, V) ->
+ neighbours(to_external(V), G, reaching_neighbours, type(V)).
+
+call(G, V) ->
+ neighbours(to_external(V), G, reachable_neighbours, type(V)).
+
+regexpr({regexpr, RExpr}, Var) ->
+ Xs = match_list(to_external(Var), RExpr),
+ xset(Xs, type(Var));
+regexpr({ModExpr, FunExpr, ArityExpr}, Var) ->
+ Type = type(Var),
+ V1 = case {ModExpr,Type} of
+ {{atom, Mod},[{ModType, _}]} ->
+ restriction(Var, xset([Mod], [ModType]));
+ {{regexpr, MExpr},[{ModType, _}]} ->
+ Mods = match_list(to_external(domain(Var)), MExpr),
+ restriction(Var, xset(Mods, [ModType]));
+ {variable,_} ->
+ Var;
+ {_,_} -> % Var is the empty set
+ Var
+ end,
+ V2 = case FunExpr of
+ {atom, FunName} ->
+ V1L = to_external(V1),
+ xset(match_one(V1L, FunName, 2), Type);
+ {regexpr, FExpr} ->
+ V1L = to_external(V1),
+ xset(match_many(V1L, FExpr, 2), Type);
+ variable ->
+ V1
+ end,
+ case ArityExpr of
+ {integer, Arity} ->
+ V2L = to_external(V2),
+ xset(match_one(V2L, Arity, 3), Type);
+ {regexpr, Expr} ->
+ V2L = to_external(V2),
+ xset(match_many(V2L, Expr, 3), Type);
+ variable ->
+ V2
+ end.
+
+%% -> digraph()
+relation_to_graph(S) ->
+ G = digraph:new(),
+ Fun = fun({From, To}) ->
+ digraph:add_vertex(G, From),
+ digraph:add_vertex(G, To),
+ digraph:add_edge(G, From, To)
+ end,
+ foreach(Fun, to_external(S)),
+ G.
+
+%% -> {ok, FileName} | Error | fault()
+%% Finds a module's BEAM file.
+find_beam(Module) when is_atom(Module) ->
+ case code:which(Module) of
+ non_existing ->
+ error({no_such_module, Module});
+ preloaded ->
+ {_M, _Bin, File} = code:get_object_code(Module),
+ {ok, File};
+ cover_compiled ->
+ error({cover_compiled, Module});
+ File ->
+ {ok, File}
+ end;
+find_beam(Culprit) ->
+ erlang:error(badarg, [Culprit]).
+
+%% options(Options, ValidOptions) -> {OptionValues, InvalidOptions}
+%%
+%% Options = [Option] | Option
+%% ValidOptions = [atom() | {OptionName, ValidValues}]
+%% OptionValues = [bool() | {OptionName, [term()]}]
+%% OptionName = atom()
+%% InvalidOptions = [Option]
+%% Option = OptionName | {OptionName, term()}
+%% ValidValues = [] | [DefaultValue | [ValidValue]] | [DefaultValue, Tester]
+%% ValidValue = DefaultValue = term()
+%% Tester = fun([term()]) -> bool()
+%%
+%% A Boolean Option has a name (an atom). A Value Option has a name
+%% (an atom) and a value (a term).
+%%
+%% ValidOptions enumerates allowed options - a Boolean Option is
+%% enumerated with its name, and a Value Option is enumerated with a
+%% pair {Name, Values}, where Name is the option's name and Values is
+%% a list of allowed values for the Value Option, the first one being
+%% the default value (by convention). An empty list of allowed values
+%% means that all terms are allowed as value (and that there is no
+%% default value). Also if the only allowed value is the default
+%% value, all terms are allowed as value. A function argument (Tester)
+%% may be used for testing the supplied values (useful for a path...)
+%% An allowed option must not be enumerated more than once, but
+%% allowed values may be duplicated.
+%%
+%% OptionValues is a list of option values, where member i is the
+%% value of option i in ValidOptions. The value of a Boolean Option is
+%% 'true' if the option name is mentioned in Options, otherwise
+%% 'false'. The value of a Value Option is a list of the option values
+%% mentioned in Options for the Value Option. If the Value Option is
+%% not mentioned in Options, the list contains the default value (if
+%% there is no default value, the list is empty), and if it is
+%% mentioned more than once, the values are sorted in standard order.
+%%
+%% InvalidOptions is a list of those options present in Options that
+%% do not match any allowed option mentioned in ValidOptions.
+%%
+options(Options, Valid) ->
+ split_options(Options, [], [], [], Valid).
+
+subprocess(Fun, Opts) ->
+ Pid = spawn_opt(Fun, Opts),
+ receive
+ {Pid, Reply} -> Reply
+ end.
+
+format_error({error, Module, Error}) ->
+ Module:format_error(Error);
+format_error({file_error, FileName, Reason}) ->
+ io_lib:format("~s: ~p~n", [FileName, file:format_error(Reason)]);
+format_error({unrecognized_file, FileName}) ->
+ io_lib:format("~p is neither a regular file nor a directory~n",
+ [FileName]);
+format_error({no_such_module, Module}) ->
+ io_lib:format("Cannot find module ~p using the code path~n", [Module]);
+format_error({interpreted, Module}) ->
+ io_lib:format("Cannot use BEAM code of interpreted module ~p~n", [Module]);
+format_error(E) ->
+ io_lib:format("~p~n", [E]).
+
+%%
+%% Local functions
+%%
+
+to_list(X) when is_atom(X) -> atom_to_list(X);
+to_list(X) when is_list(X) -> X.
+
+select_application_directories([FileName|FileNames], Dir, Flag, L) ->
+ case is_directory(FileName) of
+ true ->
+ File = filename:basename(FileName),
+ {Name, Vsn} = filename_to_application(File),
+ ApplDir = {Name, Vsn, subdir(FileName, Dir, Flag)},
+ select_application_directories(FileNames, Dir, Flag, [ApplDir|L]);
+ false ->
+ select_application_directories(FileNames, Dir, Flag, L);
+ Error ->
+ Error
+ end;
+select_application_directories([], _Dir, _Flag, L) ->
+ {ok,reverse(L)}.
+
+subdir(Dir, _, false) ->
+ Dir;
+subdir(Dir, SubDir, true) ->
+ EDir = filename:join(Dir, SubDir),
+ case is_directory(EDir) of
+ true -> EDir;
+ _FalseOrError -> Dir
+ end.
+
+%% Avoid "App-01.01" - the zeroes will be lost.
+filename2appl(File) ->
+ Pos = string:rstr(File, "-"),
+ true = Pos > 1,
+ V = string:sub_string(File, Pos+1),
+ true = string:len(V) > 0,
+ VsnT = string:tokens(V, "."),
+ ApplName = string:sub_string(File, 1, Pos-1),
+ Vsn = [list_to_integer(Vsn) || Vsn <- VsnT],
+ {list_to_atom(ApplName),Vsn}.
+
+find_files_dir(Dir, Recurse, Collect, Watch, L) ->
+ case file:list_dir(Dir) of
+ {ok, Files} ->
+ find_files(sort(Files), Dir, Recurse, Collect, Watch, L);
+ {error, Error} ->
+ [B | {E,J,U}] = L,
+ [B | {[file_error(Dir, Error)|E],J,U}]
+ end.
+
+find_files([F | Fs], Dir, Recurse, Collect, Watch, L) ->
+ File = filename:join(Dir, F),
+ L1 = case file_info(File) of
+ {ok, {_, directory, readable, _}} when Recurse ->
+ find_files_dir(File, Recurse, Collect, Watch, L);
+ {ok, {_, directory, _, _}} ->
+ L;
+ Info ->
+ [B | EJU = {E,J,U}] = L,
+ Ext = filename:extension(File),
+ C = member(Ext, Collect),
+ case C of
+ true ->
+ case Info of
+ {ok, {_, file, readable, _}} ->
+ [[{Dir,F} | B] | EJU];
+ {ok, {_, file, unreadable, _}} ->
+ [B | {E,J,[File|U]}];
+ Error ->
+ [B | {[Error|E],J,U}]
+ end;
+ false ->
+ case member(Ext, Watch) of
+ true -> [B | {E,[File|J],U}];
+ false -> L
+ end
+ end
+ end,
+ find_files(Fs, Dir, Recurse, Collect, Watch, L1);
+find_files([], _Dir, _Recurse, _Collect, _Watch, L) ->
+ L.
+
+graph_to_relation(G) ->
+ Fun = fun(E) -> {_E, V1, V2, _Label} = digraph:edge(G, E), {V1, V2} end,
+ from_term(map(Fun, digraph:edges(G)), [{[atom],[atom]}]).
+
+path([E1, E2 | P], G, L) ->
+ case digraph:get_short_path(G, E1, E2) of
+ false ->
+ false;
+ [_V | Vs] ->
+ path([E2 | P], G, [Vs | L])
+ end;
+path([_], _G, L) ->
+ append(reverse(L)).
+
+neighbours(Vs, G, Fun, VT) ->
+ neighbours(Vs, G, Fun, VT, []).
+
+neighbours([V | Vs], G, Fun, VT, L) ->
+ Ns = digraph_utils:Fun([V], G),
+ neighbours(Ns, G, Fun, VT, L, V, Vs);
+neighbours([], _G, _Fun, [VT], L) ->
+ xset(L, [{VT,VT}]).
+
+neighbours([N | Ns], G, Fun, VT, L, V, Vs) when Fun =:= reachable_neighbours ->
+ neighbours(Ns, G, Fun, VT, [{V, N} | L], V, Vs);
+neighbours([N | Ns], G, Fun, VT, L, V, Vs) ->
+ neighbours(Ns, G, Fun, VT, [{N, V} | L], V, Vs);
+neighbours([], G, Fun, VT, L, _V, Vs) ->
+ neighbours(Vs, G, Fun, VT, L).
+
+match_list(L, RExpr) ->
+ {ok, Expr} = regexp:parse(RExpr),
+ filter(fun(E) -> match(E, Expr) end, L).
+
+match_one(VarL, Con, Col) ->
+ select_each(VarL, fun(E) -> Con =:= element(Col, E) end).
+
+match_many(VarL, RExpr, Col) ->
+ {ok, Expr} = regexp:parse(RExpr),
+ select_each(VarL, fun(E) -> match(element(Col, E), Expr) end).
+
+match(I, Expr) when is_integer(I) ->
+ S = integer_to_list(I),
+ {match, 1, length(S)} =:= regexp:first_match(S, Expr);
+match(A, Expr) when is_atom(A) ->
+ S = atom_to_list(A),
+ {match, 1, length(S)} =:= regexp:first_match(S, Expr).
+
+select_each([{Mod,Funs} | L], Pred) ->
+ case filter(Pred, Funs) of
+ [] ->
+ select_each(L, Pred);
+ NFuns ->
+ [{Mod,NFuns} | select_each(L, Pred)]
+ end;
+select_each([], _Pred) ->
+ [].
+
+split_options([O | Os], A, P, I, V) when is_atom(O) ->
+ split_options(Os, [O | A], P, I, V);
+split_options([O={Name,_} | Os], A, P, I, V) when is_atom(Name) ->
+ split_options(Os, A, [O | P], I, V);
+split_options([O | Os], A, P, I, V) ->
+ split_options(Os, A, P, [O | I], V);
+split_options([], A, P, I, V) ->
+ Atoms = to_external(set(A)),
+ Pairs = to_external(relation_to_family(relation(P))),
+ option_values(V, Atoms, Pairs, I, []);
+split_options(O, A, P, I, V) ->
+ split_options([O], A, P, I, V).
+
+option_values([O | Os], A, P, I, Vs) when is_atom(O) ->
+ option_values(Os, delete(O, A), P, I, [member(O, A) | Vs]);
+option_values([{Name, AllowedValues} | Os], A, P, I, Vs) ->
+ case keysearch(Name, 1, P) of
+ {value, {_, Values}} ->
+ option_value(Name, AllowedValues, Values, A, P, I, Vs, Os);
+ false when AllowedValues =:= [] ->
+ option_values(Os, A, P, I, [[] | Vs]);
+ false ->
+ [Default | _] = AllowedValues,
+ option_values(Os, A, P, I, [[Default] | Vs])
+ end;
+option_values([], A, P, Invalid, Values) ->
+ I2 = to_external(family_to_relation(family(P))),
+ {reverse(Values), Invalid ++ A ++ I2}.
+
+option_value(Name, [_Deflt, Fun], Vals, A, P, I, Vs, Os)
+ when is_function(Fun) ->
+ P1 = keydelete(Name, 1, P),
+ case Fun(Vals) of
+ true ->
+ option_values(Os, A, P1, I, [Vals | Vs]);
+ false ->
+ option_values(Os, A, [{Name,Vals} | P1], I, [[] | Vs])
+ end;
+option_value(Name, AllowedValues, Values, A, P, I, Vs, Os) ->
+ P1 = keydelete(Name, 1, P),
+ VS = set(Values),
+ AVS = set(AllowedValues),
+ V1 = to_external(intersection(VS, AVS)),
+ {V, NP} = case to_external(difference(VS, AVS)) of
+ _ when AllowedValues =:= [] -> {Values,P1};
+ [] -> {V1,P1};
+ _ when length(AllowedValues) =:= 1 ->
+ {Values,P1};
+ I1 -> {V1,[{Name,I1} | P1]}
+ end,
+ option_values(Os, A, NP, I, [V | Vs]).
+
+file_error(File, Error) ->
+ error({file_error, File, Error}).
+
+error(Error) ->
+ {error, ?MODULE, Error}.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-08 12:13:13 +0000