%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions 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.
