diff options
Diffstat (limited to 'lib/tools/src/instrument.erl')
-rw-r--r-- | lib/tools/src/instrument.erl | 427 |
1 files changed, 427 insertions, 0 deletions
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. + |