The R13B03 release.OTP_R13B03

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.
+