The R13B03 release.OTP_R13B03

6 files changed, 1135 insertions, 0 deletions

diff --git a/lib/hipe/tools/Makefile b/lib/hipe/tools/Makefile
new file mode 100644
index 0000000000..6ce5cb1b8b
--- /dev/null
+++ b/lib/hipe/tools/Makefile
@@ -0,0 +1,111 @@
+#
+# %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%
+#
+
+ifndef EBIN
+EBIN = ../ebin
+endif
+
+ifndef DOCS
+DOCS = ../doc
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(HIPE_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+MODULES = hipe_tool hipe_profile hipe_ceach hipe_jit
+#	  hipe_timer
+
+HRL_FILES=
+ERL_FILES= $(MODULES:%=%.erl)
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+DOC_FILES= $(MODULES:%=$(DOCS)/%.html)
+
+# APP_FILE= 
+# APP_SRC= $(APP_FILE).src
+# APP_TARGET= $(EBIN)/$(APP_FILE)
+#
+# APPUP_FILE= 
+# APPUP_SRC= $(APPUP_FILE).src
+# APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+include ../native.mk
+
+ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES) 
+
+docs: $(DOC_FILES)
+
+clean:
+	rm -f $(TARGET_FILES)
+	rm -f core
+
+$(DOCS)/%.html:%.erl
+	erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ---------------------------------------------------- 
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+	$(INSTALL_DIR) $(RELSYSDIR)/ebin
+	$(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+distclean:	clean
+realclean:	clean
+
+
+# ---------------------------------------------------- 
+# Include dependencies
+# ---------------------------------------------------- 
+
+$(EBIN)/hipe_ceach.beam: ../main/hipe.hrl
+$(EBIN)/hipe_tool.beam: ../main/hipe.hrl
+
diff --git a/lib/hipe/tools/hipe_ceach.erl b/lib/hipe/tools/hipe_ceach.erl
new file mode 100644
index 0000000000..b29615e169
--- /dev/null
+++ b/lib/hipe/tools/hipe_ceach.erl
@@ -0,0 +1,74 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %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%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson.  All Rights Reserved 
+%% ====================================================================
+%%  Module   :	hipe_ceach
+%%  Purpose  :  Compile each function in a module, possibly applying a
+%%              fun between each compilation. Useful for bug hunting by
+%%		pinpointing a function that when compiled causes a bug.
+%%  Notes    : 
+%%  History  :	* 2001-12-11 Erik Johansson ([email protected]): Created.
+%% ====================================================================
+%%  Exports  :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_ceach).
+
+-export([c/1, c/2, c/3]).
+
+-include("../main/hipe.hrl").
+
+%%---------------------------------------------------------------------
+
+-spec c(atom()) -> 'ok'.
+
+c(M) ->
+  lists:foreach(fun({F,A}) -> comp(M, F, A) end,
+		M:module_info(functions)).
+
+-spec c(atom(), comp_options()) -> 'ok'.
+
+c(M, Opts) ->
+  lists:foreach(fun({F,A}) -> comp(M, F, A, Opts) end,
+		M:module_info(functions)).
+
+-spec c(atom(), comp_options(), fun(() -> any())) -> 'ok'.
+
+c(M, Opts, Fn) ->
+  lists:foreach(fun({F,A}) -> comp(M, F, A, Opts), Fn() end,
+		M:module_info(functions)).
+
+-spec comp(atom(), atom(), arity()) -> 'ok'.
+
+comp(M, F, A) ->
+  io:format("~w:~w/~w... ", [M, F, A]),
+  MFA = {M, F, A},
+  {ok, MFA} = hipe:c(MFA),
+  io:format("OK\n").
+
+-spec comp(atom(), atom(), arity(), comp_options()) -> 'ok'.
+
+comp(M, F, A, Opts) ->
+  io:format("~w:~w/~w... ", [M, F, A]),
+  MFA = {M, F, A},
+  {ok, MFA} = hipe:c(MFA, Opts),
+  io:format("OK\n").
diff --git a/lib/hipe/tools/hipe_jit.erl b/lib/hipe/tools/hipe_jit.erl
new file mode 100644
index 0000000000..0ac84388ae
--- /dev/null
+++ b/lib/hipe/tools/hipe_jit.erl
@@ -0,0 +1,87 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %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%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2002 by Erik Johansson.  
+%% ====================================================================
+%%  Module   :	hipe_jit
+%%  Purpose  :  
+%%  Notes    : 
+%%  History  :	* 2002-03-14 Erik Johansson ([email protected]): Created.
+%% ====================================================================
+%% @doc
+%%    A tool to enable using the HiPE compiler as an automatic JIT
+%%    compiler rather than a user-controlled one.
+%% @end
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_jit).
+
+-export([start/0]).
+
+-record(state, {mode = start     :: 'sleep' | 'start' | 'wait',
+	       	threshold = 5000 :: non_neg_integer(),
+		sleep = 5000     :: non_neg_integer(),
+		time = 1000      :: non_neg_integer()}).
+
+%%---------------------------------------------------------------------
+
+-spec start() -> pid().
+%% @doc
+%%    Starts an Erlang process which calls the HiPE compiler every
+%%    now and then (when it sees it fit to do so).
+%% @end
+start() ->
+  spawn(fun () -> loop(#state{}) end).
+
+loop(State) ->
+  case State#state.mode of
+    start ->
+      start(State);
+    wait ->
+      wait(State);
+    _ ->
+      sleep(State)
+  end.
+
+sleep(State) ->
+  receive
+    quit -> ok
+  after State#state.sleep ->
+    loop(State#state{mode=start})
+  end.
+
+start(State) ->
+  catch hipe_profile:prof(),
+  catch hipe_profile:clear(),
+  loop(State#state{mode=wait}).
+
+wait(State) ->
+  receive
+    quit -> ok
+  after State#state.time ->
+    R = [M || {M,C} <- (catch hipe_profile:mods_res()),
+			C > State#state.threshold],
+    catch hipe_profile:prof_off(),
+    lists:foreach(fun(M) ->
+		    io:format("Compile ~w\n",[M]),
+		    hipe:c(M,[o2,verbose])
+		  end, R)
+  end,
+  loop(State#state{mode=sleep}).
diff --git a/lib/hipe/tools/hipe_profile.erl b/lib/hipe/tools/hipe_profile.erl
new file mode 100644
index 0000000000..7566acb8f4
--- /dev/null
+++ b/lib/hipe/tools/hipe_profile.erl
@@ -0,0 +1,191 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %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%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson.  All Rights Reserved 
+%% Time-stamp: <2008-04-20 14:53:42 richard>
+%% ====================================================================
+%%  Module   :	hipe_profile
+%%  Purpose  :  
+%%  History  :	* 2001-07-12 Erik Johansson ([email protected]): Created.
+%% ====================================================================
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_profile).
+
+-export([%% profile/1, mods_profile/1,
+	 prof/0, prof_off/0, clear/0, res/0,
+	 mods_res/0,
+	 %% clear_module/1, res_module/1,
+	 prof_module/1, prof_module_off/1]).
+
+%% %% @spec mods_profile(F) -> [{mod(),calls()}]
+%% %%       F = () -> term()
+%% %%       mod()  = atom()
+%% %%       calls()= integer()
+%% %%
+%% %% @doc  Returns the number of calls per module generated by
+%% %%       applying F().
+%% %%       The resulting lists is sorted with the most called
+%% %%       module first.
+%% mods_profile(F) ->
+%%   F(),
+%%   prof(),
+%%   clear(), 
+%%   F(), 
+%%   R = mods_res(),
+%%   prof_off(), 
+%%   R.
+
+-spec mods_res() -> [{atom(), non_neg_integer()}].
+%% @doc  Returns the number of calls per module currently 
+%%       recordeed since hipe_bifs:call_count_on().
+%%       The resulting list is sorted with the most called
+%%       module first.
+mods_res() ->
+  lists:reverse(lists:keysort(2, calls())).
+
+-spec calls() -> [{atom(), non_neg_integer()}].
+%% @doc  Returns the number of calls per module currently 
+%%       recordeed since hipe_bifs:call_count_on().
+calls() ->
+  [{Mod, total_calls(Mod)} || Mod <- mods(),
+			      total_calls(Mod) > 1,
+			      Mod =/= hipe_profile].
+
+%% %% @spec profile(F) -> [{mfa(),calls()}]
+%% %%       F = ()    -> term()
+%% %%       mfa()      = {mod(),function(),arity()}
+%% %%       function() = atom()
+%% %%       arity()    = intger()
+%% %%
+%% %% @doc  Returns the number of calls per module generated by
+%% %%       applying F().
+%% %%       The resulting lists is sorted with the most called
+%% %%       module first.
+%% profile(F) ->
+%%   %% Make sure all code is loaded.
+%%   F(),
+%%   %% Turn profiling on.
+%%   prof(),
+%%   clear(), 
+%%   %% Apply the closure to profile.
+%%   F(), 
+%%   %% Get result.
+%%   R = res(),
+%%   %% Turn of profiling.
+%%   prof_off(),
+%%   R.
+
+-spec prof() -> 'ok'.
+%% @doc Turns on profiling of all loaded modules.
+prof() ->
+  lists:foreach(fun prof_module/1, mods()).
+
+-spec prof_off() -> 'ok'.
+%% @doc Turns off profiling of all loaded modules.
+ prof_off() ->
+  lists:foreach(fun prof_module_off/1, mods()).
+
+-spec clear() -> 'ok'.
+%% @doc Clears all counters.
+clear() ->
+  lists:foreach(fun clear_module/1, mods()).
+
+-spec res() -> [{mfa(), non_neg_integer()}].
+%% @doc Returns a list of the numbers of calls to each profiled function.
+%%      The list is sorted with the most called function first.
+res() ->
+  lists:reverse(lists:keysort(2, lists:flatten([res_module(M) || M <- mods()]))).
+
+%% --------------------------------------------------------------------
+-spec mods() -> [atom()].
+%% @doc	 Returns a list of all loaded modules. 
+%@ --------------------------------------------------------------------
+
+mods() ->
+  [Mod || {Mod,_} <- code:all_loaded()].
+
+%% --------------------------------------------------------------------
+-spec prof_module(atom()) -> 'ok'.
+%% @doc	 Turns on profiling for given module. 
+%@ ____________________________________________________________________
+
+prof_module(Mod) ->
+  Funs = Mod:module_info(functions),
+  lists:foreach(fun ({F,A}) -> catch hipe_bifs:call_count_on({Mod,F,A}) end,
+		Funs),
+  ok.
+
+%% --------------------------------------------------------------------
+-spec prof_module_off(atom()) -> 'ok'.
+%% @doc	 Turns off profiling of the module Mod. 
+%@ --------------------------------------------------------------------
+
+prof_module_off(Mod) ->
+  Funs = Mod:module_info(functions),
+  lists:foreach(fun ({F,A}) -> catch hipe_bifs:call_count_off({Mod,F,A}) end,
+		Funs),
+  ok.
+
+%% --------------------------------------------------------------------
+-spec clear_module(atom()) -> 'ok'.
+%% @doc  Clears the call counters for all functions in module Mod.
+%@ --------------------------------------------------------------------
+
+clear_module(Mod) ->
+  Funs = Mod:module_info(functions),
+  lists:foreach(fun ({F,A}) -> catch hipe_bifs:call_count_clear({Mod,F,A}) end,
+		Funs),
+  ok.
+
+%% --------------------------------------------------------------------
+-spec res_module(atom()) -> [{mfa(), non_neg_integer()}].
+%% @doc	  Returns the number of profiled calls to each function (MFA) 
+%%        in the module Mod.
+%@ --------------------------------------------------------------------
+
+res_module(Mod) ->
+  Fun = fun ({F,A}) when is_atom(F), is_integer(A) ->
+	    MFA = {Mod,F,A},
+	    {MFA, try hipe_bifs:call_count_get(MFA) of 
+		    N when is_integer(N) -> N; 
+		    false -> 0
+		  catch
+		    _:_ -> 0
+		  end
+	    }
+	end,
+  lists:reverse(lists:keysort(2, [Fun(FA) || FA <- Mod:module_info(functions)])).
+
+-spec total_calls(atom()) -> non_neg_integer().
+
+total_calls(Mod) ->
+  Funs = Mod:module_info(functions),
+  SumF = fun ({F,A}, Acc) -> 
+	    MFA = {Mod,F,A},
+	    try hipe_bifs:call_count_get(MFA) of 
+	      N when is_integer(N) -> N+Acc; 
+	      false -> Acc
+	    catch
+	      _:_ -> Acc
+	    end;
+	     (_, Acc) -> Acc
+	end,
+  lists:foldl(SumF, 0, Funs).
diff --git a/lib/hipe/tools/hipe_timer.erl b/lib/hipe/tools/hipe_timer.erl
new file mode 100644
index 0000000000..03cc358f17
--- /dev/null
+++ b/lib/hipe/tools/hipe_timer.erl
@@ -0,0 +1,159 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %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%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2001 by Erik Johansson.  All Rights Reserved 
+%% Time-stamp: <2008-04-20 14:53:36 richard>
+%% ====================================================================
+%%  Module   :	hipe_timer
+%%  Purpose  :  
+%%  Notes    : 
+%%  History  :	* 2001-03-15 Erik Johansson ([email protected]): Created.
+%% ====================================================================
+%%  Exports  :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_timer).
+
+-export([tr/1, t/1, timer/1, time/1, empty_time/0]).
+-export([advanced/2]).
+
+t(F) ->
+  {EWT,ERT} = empty_time(),
+  {WT,RT} = time(F),
+  {WT-EWT,(RT-ERT)/1000}.
+
+tr(F) ->
+  {EWT,ERT} = empty_time(),
+  {R,{WT,RT}} = timer(F),
+  {R,{WT-EWT,(RT-ERT)/1000}}.
+
+empty_time() ->
+  {WT1,WT2,WT3} = erlang:now(),
+  {A,_} = erlang:statistics(runtime),
+  {WT12,WT22,WT32} = erlang:now(),
+  {B,_} = erlang:statistics(runtime),
+  {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}.
+
+time(F) -> 
+  {WT1,WT2,WT3} = erlang:now(),
+  {A,_} = erlang:statistics(runtime),
+  F(),
+  {WT12,WT22,WT32} = erlang:now(),
+  {B,_} = erlang:statistics(runtime),
+  {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}.
+
+timer(F) -> 
+  {WT1,WT2,WT3} = erlang:now(),
+  {A,_} = erlang:statistics(runtime),
+  R = F(),
+  {WT12,WT22,WT32} = erlang:now(),
+  {B,_} = erlang:statistics(runtime),
+  {R,{(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}}.
+
+advanced(_Fun, I) when I < 2 -> false;
+advanced(Fun, Iterations) ->
+  R = Fun(),
+  Measurements = [t(Fun) || _ <- lists:seq(1, Iterations)],
+  {Wallclock, RunTime} = split(Measurements),
+  WMin = lists:min(Wallclock),
+  RMin = lists:min(RunTime),
+  WMax = lists:max(Wallclock),
+  RMax = lists:max(RunTime),
+  WMean = mean(Wallclock),
+  RMean = mean(RunTime),
+  WMedian = median(Wallclock),
+  RMedian = median(RunTime),
+  WVariance = variance(Wallclock),
+  RVariance = variance(RunTime),
+  WStddev = stddev(Wallclock),
+  RStddev = stddev(RunTime),
+  WVarCoff = 100 * WStddev / WMean,
+  RVarCoff = 100 * RStddev / RMean,
+  WSum = lists:sum(Wallclock),
+  RSum = lists:sum(RunTime),
+  [{wallclock,[{min, WMin},
+	       {max, WMax},
+	       {mean, WMean},
+	       {median, WMedian},
+	       {variance, WVariance},
+	       {stdev, WStddev},
+	       {varcoff, WVarCoff},
+	       {sum, WSum},
+	       {values, Wallclock}]},
+   {runtime,[{min, RMin},
+	     {max, RMax},
+	     {mean, RMean},
+	     {median, RMedian},
+	     {variance, RVariance},
+	     {stdev, RStddev},
+	     {varcoff, RVarCoff},
+	     {sum, RSum},
+	     {values, RunTime}]},
+   {iterations, Iterations},
+   {result, R}].
+
+split(M) -> 
+  split(M, [], []).
+
+split([{W,R}|More], AccW, AccR) ->
+  split(More, [W|AccW], [R|AccR]);
+split([], AccW, AccR) ->
+  {AccW, AccR}.
+
+mean(L) ->
+  mean(L, 0, 0).
+
+mean([V|Vs], No, Sum) ->
+  mean(Vs, No+1, Sum+V);
+mean([], No, Sum) when No > 0 ->
+  Sum/No;
+mean([], _No, _Sum) ->
+  exit(empty_list).
+  
+median(L) ->
+  S = length(L),
+  SL = lists:sort(L),
+  case even(S) of
+    true ->
+      (lists:nth((S div 2), SL) + lists:nth((S div 2) + 1, SL)) / 2;
+    false ->
+      lists:nth((S div 2), SL)
+  end.
+
+even(S) ->
+  (S band 1) =:= 0.
+
+%% diffs(L, V) ->
+%%   [X - V || X <- L].
+
+square_diffs(L, V) ->
+  [(X - V) * (X - V) || X <- L].
+
+variance(L) ->
+  Mean = mean(L),
+  N = length(L),
+  if N > 1 ->
+      lists:sum(square_diffs(L,Mean)) / (N-1);
+     true -> exit('too few values')
+  end.
+
+stddev(L) ->
+  math:sqrt(variance(L)).
diff --git a/lib/hipe/tools/hipe_tool.erl b/lib/hipe/tools/hipe_tool.erl
new file mode 100644
index 0000000000..ae1cad06cc
--- /dev/null
+++ b/lib/hipe/tools/hipe_tool.erl
@@ -0,0 +1,513 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %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%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Copyright (c) 2002 by Erik Johansson.  
+%% ====================================================================
+%%  Module   :	hipe_tool
+%%  Purpose  :  
+%%  Notes    : 
+%%  History  :	* 2002-03-13 Erik Johansson ([email protected]): Created.
+%% ====================================================================
+%%  Exports  :
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(hipe_tool).
+
+-export([start/0]).
+
+%%---------------------------------------------------------------------
+
+-include("../main/hipe.hrl").
+
+%%---------------------------------------------------------------------
+
+-define(WINDOW_WIDTH, 920).
+-define(WINDOW_HEIGHT, 460).
+-define(DEFAULT_BG_COLOR, {217,217,217}).
+-define(POLL_INTERVAL, 5000).
+-define(FONT, {screen, 12}).
+-define(HEADER_FONT, {screen, [bold], 12}).
+-define(NORMAL_FG_COLOR, {0,0,0}).
+
+%%---------------------------------------------------------------------
+
+-type fa() :: {atom(), arity()}. % {Fun,Arity}
+-type fa_address() :: {atom(), arity(), non_neg_integer()}. % {F,A,Address}
+
+%%---------------------------------------------------------------------
+
+-record(state, {win_created = false	:: boolean(),
+		mindex = 0		:: integer(),
+		mod			:: module(),
+		funs = []		:: [fa()],
+		mods = [] 		:: [module()],
+		options = [o2]		:: comp_options(),
+		compiling = false	:: 'false' | pid()
+	       }).
+
+%%---------------------------------------------------------------------
+
+-spec start() -> pid().
+
+start() ->
+  spawn(fun () -> init() end).
+
+init() ->
+  process_flag(trap_exit, true), 
+  gs:start(),
+  S = init_window(#state{}),
+  loop(S).
+
+-spec loop(#state{}) -> no_return().
+
+loop(State) ->
+    receive
+      {gs, code_listbox, click, Data, [Idx, Txt | _]} ->
+	NewState = update_module_box(State,Idx,Data,Txt),
+	loop(NewState);
+      {gs, module_listbox, click, Data, [Idx, _Txt | _]} ->
+	NewState = update_fun(State,Idx,Data),
+	loop(NewState);
+      {gs, compmod, click, _, _} ->
+	loop(compile(State));
+      {gs, prof, click, [], ["Turn off\nProfiling"]} ->
+	hipe_profile:prof_module_off(State#state.mod),
+	loop(update_module_box(State,State#state.mindex,State#state.mods,""));
+      {gs, prof, click, [], _} ->
+	hipe_profile:prof_module(State#state.mod),
+	loop(update_module_box(State,State#state.mindex,State#state.mods,""));
+      {gs, win, configure, _, _} ->
+	gs:config(win, [{width, ?WINDOW_WIDTH}, {height, ?WINDOW_HEIGHT}]),
+	loop(State);
+
+      show_window when State#state.win_created =:= true ->
+	gs:config(win, [raise]),
+	loop(State);
+      show_window when State#state.win_created =:= false ->
+	loop((init_window(State))#state{win_created = true});
+
+      {gs, _Id, click, close_menu, _Args} ->
+	gs:destroy(win),
+	loop(State#state{win_created = false});
+      {gs, _Id, keypress, _Data, [c, _, 0, 1 | _]} ->
+	gs:destroy(win),
+	loop(State#state{win_created = false});
+      {gs, _Id, keypress, _Data, ['C', _, 1, 1 | _]} ->
+	gs:destroy(win),
+	loop(State#state{win_created = false});
+      {gs, _Id, keypress, _Data, _Args} ->
+	loop(State);
+      {gs, _, destroy, _, _} ->
+	loop(State#state{win_created = false});
+
+      {compilation_done, _Res, Sender} ->
+	case State#state.compiling of
+	  Sender ->
+	    catch gs:config(compmod, [{enable, true}]),
+	    update_text(compiling, ""),
+	    loop(update_module_box(State,
+				   State#state.mindex,
+				   State#state.mods, ""));
+	  _ ->
+	    loop(State)
+	end;
+
+      {'EXIT', _Pid, _Reason} ->
+	exit(normal);
+      _Other ->
+	io:format("HiPE window received message ~p ~n", [_Other]),
+	loop(State)
+    after 
+      ?POLL_INTERVAL ->
+	loop(update_code_listbox(State))
+    end.
+
+-spec init_window(#state{}) -> #state{}.
+
+init_window(State) ->
+  create_window(State),
+  gs:config(win, [{map,true}]),
+  update_code_listbox(State#state{win_created = true}).
+
+-spec create_window(#state{}) -> 'ok'.
+
+create_window(State) ->
+  gs:window(win, gs:start(), [{width, ?WINDOW_WIDTH},
+			      {height, ?WINDOW_HEIGHT},
+			      {bg, ?DEFAULT_BG_COLOR},
+			      {title, "[HiPE] Code list"},
+			      {configure, true},
+			      {destroy, true},
+			      {cursor, arrow},
+			      {keypress, true}
+			     ]),
+  create_menu(),
+  Xpos = 4, 
+  Ypos1 = 60, 
+  Width =  (?WINDOW_WIDTH - (Xpos*4)) div 3,
+  create_labels([{mods,Ypos1-20,"Loaded Modules"}], Xpos + 1 + 3),
+  Xpos2 = Xpos*2+Width,
+  create_labels([{mod,Ypos1-20,"Module:"++atom_to_list(State#state.mod)},
+		 {ver,Ypos1,""},
+		 {time,Ypos1+20,""},
+		 {native,Ypos1+40,""},
+		 {compiling,Ypos1+60,""}], Xpos2),
+  create_labels([{function,Ypos1-20,"Function:"},
+		 {nativefun,Ypos1,""}], Xpos*3+Width*2),
+  Ypos = 240,
+  Height1 = ?WINDOW_HEIGHT - Ypos1 - Xpos,
+  Height = ?WINDOW_HEIGHT - Ypos - Xpos,
+  gs:listbox(code_listbox, win, [{x, Xpos},
+				 {y, Ypos1},
+				 {width, Width},
+				 {height, Height1},
+				 {bg, {255,255,255}},
+				 {vscroll, right},
+				 {hscroll, true},
+				 {click, true}]),
+  gs:listbox(module_listbox, win, [{x, Xpos*2+Width},
+				   {y, Ypos},
+				   {width, Width},
+				   {height, Height},
+				   {bg, {255,255,255}},
+				   {vscroll, right},
+				   {hscroll, true},
+				   {click, true}]),
+  gs:listbox(profile_listbox, win, [{x, Xpos*3+Width*2},
+				    {y, Ypos1+40},
+				    {width, Width},
+				    {height, Height-60},
+				    {bg, {255,255,255}},
+				    {vscroll, right},
+				    {hscroll, true},
+				    {click, true}]),
+  gs:button(compmod,win,[{label,{text,"Compile\nModule"}},
+			 {justify,center},
+			 {x,Xpos*2+Width*1},
+			 {height,60},
+			 {y,Ypos-80}]),
+  gs:button(prof,win,[{label,{text,"Profile\nModule"}},
+		      {justify,center},
+		      {x,Xpos*2+Width*1+100},
+		      {height,60},
+		      {y,Ypos-80}]),
+  gs:button(clearprof,win,[{label, {text,"Clear\nProfile"}},
+			   {justify, center},
+			   {x, Xpos*2+Width*1+200},
+			   {height, 60},
+			   {y, Ypos-80}]),
+  gs:editor(edoc,win,[{x, Xpos*3+Width*2}, {y, Ypos},
+		      {width, Width}, {height, Height},
+		      {insert, {'end',"Edit this text!"}},
+		      {vscroll, right},
+		      {hscroll, true},
+		      {wrap, none}]),
+  ok.
+
+-spec create_menu() -> 'ok'.
+
+create_menu() ->
+  gs:menubar(menubar, win, [{bg, ?DEFAULT_BG_COLOR}]),
+  create_sub_menus([{mbutt, fmenu, " File",
+		     [{" Close    Ctrl-C ",close_menu}]},
+		    {mbuttc,cmenu, " Compile ",
+		     [{" Compile Module", comp_mod}]},
+		    {mbuttp,pmenu, " Profile ",
+		     [{" Profile Module", prof_mod}]},
+		    {mbutte,emenu, " Edoc", [separator]},
+		    {mbutta,amenu, " Analyze ", [separator]},
+		    {mbuttb,bmenu, " Benchmark ", [separator]},		    
+		    {mbuttj,jmenu, " Jit ", [separator]}]),
+  ok.
+
+create_menuitems(Parent, [{Text,Data}|Rest]) ->
+  gs:menuitem(Parent, [{bg, ?DEFAULT_BG_COLOR},
+		       {fg, {178, 34, 34}},
+		       {label, {text, Text}},
+		       {data, Data},
+		       {underline, 1}
+		      ]),
+  create_menuitems(Parent, Rest);
+create_menuitems(Parent, [separator|Rest]) ->
+  gs:menuitem(Parent, [{itemtype, separator}]),
+  create_menuitems(Parent, Rest);
+create_menuitems(_, []) -> ok.
+
+create_sub_menus([{Parent, Name, Text, Items}|Rest]) ->
+  BG = {bg, ?DEFAULT_BG_COLOR},
+  FG = {fg, {178, 34, 34}},  % firebrick
+  Label = {label, {text, Text}},
+  gs:menubutton(Parent, menubar, [BG, FG, Label, {underline, 1}]),
+  gs:menu(Name, Parent, [BG, FG]),
+  create_menuitems(Name, Items),
+  create_sub_menus(Rest);
+create_sub_menus([]) -> ok.
+
+create_labels([{Name,Y,Text}|Rest], Xpos) ->    
+  gs:label(Name, win, [{width, (?WINDOW_WIDTH - 16) div 3},
+		       {height, 20},
+		       {x, Xpos + 1 + 3},
+		       {y, Y},
+		       {bg, ?DEFAULT_BG_COLOR},
+		       {fg, ?NORMAL_FG_COLOR},
+		       {font, ?HEADER_FONT},
+		       {align, w},
+		       {label, {text, Text}}
+		      ]),
+  create_labels(Rest,Xpos);
+create_labels([],_) -> ok.
+
+-spec update_code_listbox(#state{}) -> #state{}.
+
+update_code_listbox(State) ->
+  Mods = lists:sort(mods()),
+  case State#state.win_created of
+    false ->
+      State;
+    true ->
+      case Mods =:= State#state.mods of
+	true -> State;
+	false ->
+	  update_text(mods,
+		      "Loaded Modules ("++
+		      integer_to_list(length(Mods))++")"),
+	  catch gs:config(code_listbox, [{data, Mods},
+					 {items, Mods},
+					 {selection, 0}
+					]),
+	  update_module_box(State#state{mods = Mods}, 0, Mods, "")  
+      end
+  end.
+
+-spec update_fun(#state{}, integer(), [mfa()]) -> #state{}.
+
+update_fun(State, Idx, Data) ->
+  case State#state.win_created of
+    false ->
+      State;
+    true ->
+      MFA = {M,F,A} = get_selection(Idx, Data, {?MODULE,start,0}),
+      update_text(function, "Function: "++mfa_to_string(MFA)),
+      case in_native(F, A, native_code(M)) of
+	true  -> update_text(nativefun, "Native");
+	false -> update_text(nativefun, "Emulated")
+      end,
+      State
+  end.
+
+get_selection(Idx, Data, Default) ->
+  try lists:nth(Idx+1, Data) catch _:_ -> Default end.
+
+-spec update_module_box(#state{}, integer(), [atom()], string()) -> #state{}.
+
+update_module_box(State, Idx, Data, _Txt) ->
+  case State#state.win_created of
+    false ->
+      State;
+    true ->
+      Mod = get_selection(Idx, Data, hipe_tool),
+      %% io:format("~w\n", [Mod:module_info()]),      
+      Info = Mod:module_info(),
+      Funs = lists:usort(funs(Mod)), 
+      MFAs = mfas(Mod, Funs),
+      ModText = atom_to_list(Mod),
+      update_text(mod, "Module:"++ModText),
+      update_text(compmod, "Compile\nModule\n"++ModText),
+      Options = get_compile(Info),
+      update_text(ver, get_version(Options)),
+      update_text(time, get_time(Options)),
+      NativeCode = native_code(Mod),
+
+      Prof = is_profiled(Mod),
+      if Prof -> update_text(prof, "Turn off\nProfiling");
+	 true -> update_text(prof, "Profile\n"++ModText)
+      end,
+ 
+      Mode = get_mode(Funs, NativeCode),
+      
+      update_text(native, Mode),
+      Items = fun_names(Mod, Funs, NativeCode, Prof),
+
+      Selection = {selection, 0},
+      catch gs:config(module_listbox, [{data, MFAs},
+				       {items, Items},
+				       Selection]),
+      ProfData = [mfa_to_string(element(1, X)) ++ " " ++
+				integer_to_list(element(2,X))
+		  || X <- hipe_profile:res(), element(2, X) > 0],
+      catch gs:config(profile_listbox, [{data, ProfData},
+					{items, ProfData},
+					Selection]),
+      get_edoc(Mod),
+      update_fun(State#state{mindex = Idx, mod = Mod, funs = Funs}, 0, MFAs)
+  end.
+
+update_text(Lab, Text) ->
+  catch gs:config(Lab, [{label, {text, Text}}]).
+
+%%---------------------------------------------------------------------
+%% @doc Returns a list of all loaded modules. 
+%%---------------------------------------------------------------------
+
+-spec mods() -> [module()].
+
+mods() ->
+  [Mod || {Mod,_File} <- code:all_loaded()].
+
+-spec funs(module()) -> [fa()].
+
+funs(Mod) -> 
+  Mod:module_info(functions).
+
+-spec native_code(module()) -> [fa_address()].
+
+native_code(Mod) ->
+  Mod:module_info(native_addresses).
+
+-spec mfas(module(), [fa()]) -> [mfa()].
+
+mfas(Mod, Funs) ->
+  [{Mod,F,A} || {F,A} <- Funs].
+
+-spec fun_names(module(), [fa()], [fa_address()], boolean()) -> string().
+
+fun_names(M, Funs, NativeCode, Prof) ->
+  [list_to_atom(atom_to_list(F) ++ "/" ++ integer_to_list(A) ++
+		(case in_native(F, A, NativeCode) of
+		   true -> " [native] ";
+		   false -> ""
+		 end)
+		++
+		if Prof -> 
+		    (catch integer_to_list(hipe_bifs:call_count_get({M,F,A})));
+		   true -> ""
+		end) ||
+      {F,A} <- Funs].
+
+-spec in_native(atom(), arity(), [fa_address()]) -> boolean().
+
+in_native(F, A, NativeCode) ->
+  lists:any(fun({Fun,Arity,_}) ->
+		(Fun =:= F andalso Arity =:= A)
+	    end,
+	    NativeCode).
+
+-spec mfa_to_string(mfa()) -> [char(),...].
+
+mfa_to_string({M,F,A}) ->
+  atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A).
+
+get_mode(Funs, NativeCode) ->
+  case NativeCode of
+    [] -> "Emulated";
+    InNative when is_list(InNative) ->
+      if length(InNative) =:= length(Funs) ->
+	  "Native";
+	 true -> "Mixed"
+      end
+  end.
+
+get_time(Comp) ->
+  case lists:keyfind(time, 1, Comp) of
+    {_, {Y,Month,D,H,Min,S}} ->
+      integer_to_list(Y) ++
+	"-" ++ integer_to_list(Month) ++
+	"-" ++ integer_to_list(D) ++ " " ++
+	integer_to_list(H) ++ ":" ++ integer_to_list(Min) ++
+	":"  ++ integer_to_list(S);
+    false -> ""
+  end.
+
+get_version(Comp) ->
+  case lists:keyfind(version, 1, Comp) of
+    {_, V} when is_list(V) -> V;
+    false -> ""
+  end.
+
+get_cwd(Options) ->
+  case lists:keyfind(cwd, 1, Options) of
+    {_, V} when is_atom(V) -> atom_to_list(V);
+    {_, V} -> V; 
+    false -> ""
+  end.
+
+get_options(Comp) ->
+  case lists:keyfind(options, 1, Comp) of
+    {_, V} when is_list(V) -> V;
+    false -> ""
+  end.
+
+get_compile(Info) ->
+  case lists:keyfind(compile, 1, Info) of
+    {_, O} when is_list(O) -> O;
+    false -> []
+  end.
+
+-spec is_profiled(module()) -> boolean().
+
+is_profiled(Mod) ->
+  case hipe_bifs:call_count_get({Mod,module_info,0}) of
+    false -> false;
+    C when is_integer(C) -> true
+  end.
+
+-spec compile(#state{}) -> #state{}.
+
+compile(State) ->
+  catch gs:config(compmod, [{enable, false}]),
+  update_text(compiling, "Compiling..."),
+  Parent = self(),
+  P = spawn(fun() -> c(Parent, State#state.mod, State#state.options) end),
+  State#state{compiling = P}.
+
+-spec c(pid(), module(), comp_options()) -> 'ok'.
+
+c(Parent, Mod, Options) ->
+  Res = hipe:c(Mod, Options),
+  Parent ! {compilation_done,Res,self()},
+  ok.
+
+get_edoc(Mod) ->
+  Info = Mod:module_info(),
+  Comp = get_compile(Info), 
+  Options = get_options(Comp),
+  Dir = get_cwd(Options),
+  File = 
+    case Dir of
+      "" ->  atom_to_list(Mod) ++ ".erl";
+      _ -> Dir ++"/" ++ atom_to_list(Mod) ++ ".erl"
+    end,
+  %% io:format("Get ~s\n", [File]),
+  Text = try edoc(File, [{xml_export,xmerl_text}, no_output])
+	 catch  _:_ -> "error"
+	 end,
+  gs:config(edoc, {enable, true}),
+  gs:config(edoc, clear),
+  gs:config(edoc, {insert, {insert, Text}}),
+  gs:config(edoc, {enable, false}),
+  ok.
+
+edoc(Name, Opts) ->
+  Doc = edoc:get_doc([Name, Opts]),
+  %% Comments = edoc:read_comments(Name, Opts),
+  %% Text = edoc:forms(Forms, Comments, Name, Opts),
+  edoc:layout([Doc, Opts]),
+  ok.