diff options
Diffstat (limited to 'lib/hipe/tools')
| -rw-r--r-- | lib/hipe/tools/Makefile | 111 | ||||
| -rw-r--r-- | lib/hipe/tools/hipe_ceach.erl | 74 | ||||
| -rw-r--r-- | lib/hipe/tools/hipe_jit.erl | 87 | ||||
| -rw-r--r-- | lib/hipe/tools/hipe_profile.erl | 191 | ||||
| -rw-r--r-- | lib/hipe/tools/hipe_timer.erl | 159 | ||||
| -rw-r--r-- | lib/hipe/tools/hipe_tool.erl | 513 |
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. |