aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/tools/hipe_tool.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe/tools/hipe_tool.erl')
-rw-r--r--lib/hipe/tools/hipe_tool.erl513
1 files changed, 513 insertions, 0 deletions
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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 21:29:42 +0000