1 files changed, 134 insertions, 404 deletions

diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl
index 055f4a7afb..0203fefe13 100644
--- a/lib/tools/src/instrument.erl
+++ b/lib/tools/src/instrument.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %% 
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. 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.
@@ -19,410 +19,140 @@
 %%
 -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
+-export([allocations/0, allocations/1,
+         carriers/0, carriers/1]).
+
+-type block_histogram() :: tuple().
+
+-type allocation_summary() ::
+    {HistogramStart :: non_neg_integer(),
+     UnscannedSize :: non_neg_integer(),
+     Allocations :: #{ Origin :: atom() =>
+                       #{ Type :: atom() => block_histogram() }}}.
+
+-spec allocations() -> {ok, Result} | {error, Reason} when
+    Result :: allocation_summary(),
+    Reason :: not_enabled.
+allocations() ->
+    allocations(#{}).
+
+-spec allocations(Options) -> {ok, Result} | {error, Reason} when
+    Result :: allocation_summary(),
+    Reason :: not_enabled,
+    Options :: #{ scheduler_ids => list(non_neg_integer()),
+                  allocator_types => list(atom()),
+                  histogram_start => pos_integer(),
+                  histogram_width => pos_integer() }.
+allocations(Options) ->
+    Ref = make_ref(),
+
+    Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)),
+                  allocator_types => erlang:system_info(alloc_util_allocators),
+                  histogram_start => 128,
+                  histogram_width => 18 },
+
+    {HistStart, MsgCount} =
+        dispatch_gather(maps:merge(Defaults, Options), Ref,
+                        fun erts_internal:gather_alloc_histograms/1),
+
+    alloc_hist_receive(HistStart, MsgCount, Ref).
+
+alloc_hist_receive(_HistStart, 0, _Ref) ->
+    {error, not_enabled};
+alloc_hist_receive(HistStart, MsgCount, Ref) when MsgCount > 0 ->
+    {Unscanned, Histograms} = alloc_hist_receive_1(MsgCount, Ref, 0, #{}),
+    {ok, {HistStart, Unscanned, Histograms}}.
+
+alloc_hist_receive_1(0, _Ref, Unscanned, Result) ->
+    {Unscanned, Result};
+alloc_hist_receive_1(MsgCount, Ref, Unscanned0, Result0) ->
+    receive
+        {Ref, Unscanned, Tags} ->
+            Result = lists:foldl(fun alloc_hist_fold_result/2, Result0, Tags),
+            alloc_hist_receive_1(MsgCount - 1, Ref, Unscanned0 + Unscanned, Result)
     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
+alloc_hist_fold_result({Id, Type, BlockHist}, Result0) ->
+    IdAllocs0 = maps:get(Id, Result0, #{}),
+    MergedHists = case maps:find(Type, IdAllocs0) of
+                      {ok, PrevHist} ->
+                          alloc_hist_merge_hist(tuple_size(BlockHist),
+                                                BlockHist,
+                                                PrevHist);
+                      error ->
+                          BlockHist
+                  end,
+    IdAllocs = IdAllocs0#{ Type => MergedHists },
+    Result0#{ Id => IdAllocs }.
+
+alloc_hist_merge_hist(0, A, _B) ->
+    A;
+alloc_hist_merge_hist(Index, A, B) ->
+    Merged = setelement(Index, A, element(Index, A) + element(Index, B)),
+    alloc_hist_merge_hist(Index - 1, Merged, B).
+
+-type carrier_info_list() ::
+    {HistogramStart :: non_neg_integer(),
+     Carriers :: [{AllocatorType :: atom(),
+                   TotalSize :: non_neg_integer(),
+                   UnscannedSize :: non_neg_integer(),
+                   AllocatedSize :: non_neg_integer(),
+                   AllocatedCount :: non_neg_integer(),
+                   InPool :: boolean(),
+                   FreeBlocks :: block_histogram()}]}.
+
+-spec carriers() -> {ok, Result} | {error, Reason} when
+    Result :: carrier_info_list(),
+    Reason :: not_enabled.
+carriers() ->
+    carriers(#{}).
+
+-spec carriers(Options) -> {ok, Result} | {error, Reason} when
+    Result :: carrier_info_list(),
+    Reason :: not_enabled,
+    Options :: #{ scheduler_ids => list(non_neg_integer()),
+                  allocator_types => list(atom()),
+                  histogram_start => pos_integer(),
+                  histogram_width => pos_integer() }.
+carriers(Options) ->
+    Ref = make_ref(),
+
+    Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)),
+                  allocator_types => erlang:system_info(alloc_util_allocators),
+                  histogram_start => 512,
+                  histogram_width => 14 },
+
+    {HistStart, MsgCount} =
+        dispatch_gather(maps:merge(Defaults, Options), Ref,
+                        fun erts_internal:gather_carrier_info/1),
+
+    carrier_info_receive(HistStart, MsgCount, Ref).
+
+carrier_info_receive(_HistStart, 0, _Ref) ->
+    {error, not_enabled};
+carrier_info_receive(HistStart, MsgCount, Ref) ->
+    {ok, {HistStart, carrier_info_receive_1(MsgCount, Ref, [])}}.
+
+carrier_info_receive_1(0, _Ref, Result) ->
+    lists:flatten(Result);
+carrier_info_receive_1(MsgCount, Ref, Result0) ->
+    receive
+        {Ref, Carriers} ->
+            carrier_info_receive_1(MsgCount - 1, Ref, [Carriers, Result0])
     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.
-
+dispatch_gather(#{ allocator_types := AllocatorTypes,
+                   scheduler_ids := SchedulerIds,
+                   histogram_start := HistStart,
+                   histogram_width := HistWidth }, Ref, Gather)
+        when is_list(AllocatorTypes),
+             is_list(SchedulerIds),
+             HistStart >= 1, HistStart =< (1 bsl 28),
+             HistWidth >= 1, HistWidth =< 32 ->
+    MsgCount = lists:sum(
+        [Gather({AllocatorType, SchedId, HistWidth, HistStart, Ref}) ||
+         SchedId <- SchedulerIds,
+         AllocatorType <- AllocatorTypes]),
+    {HistStart, MsgCount};
+dispatch_gather(_, _, _) ->
+    error(badarg).