aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/kernel/src/erts_debug.erl58
-rw-r--r--lib/stdlib/test/ets_SUITE.erl35
-rw-r--r--lib/tools/doc/src/instrument.xml13
-rw-r--r--lib/tools/test/instrument_SUITE.erl30
4 files changed, 92 insertions, 44 deletions
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 1270de4144..c4d276f9e8 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -36,7 +36,8 @@
map_info/1, same/2, set_internal_state/2,
size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3,
lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0,
- lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2]).
+ lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2,
+ alloc_blocks_size/1]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -495,3 +496,58 @@ lcg_print_locks(Out, [LastLock]) ->
lcg_print_locks(Out, [Lock | Rest]) ->
io:format(Out, "~w,\n", [Lock]),
lcg_print_locks(Out, Rest).
+
+
+%% Returns the amount of memory allocated by the given allocator type.
+-spec alloc_blocks_size(Type) -> non_neg_integer() | undefined when
+ Type :: atom().
+
+alloc_blocks_size(Type) ->
+ Allocs = erlang:system_info(alloc_util_allocators),
+ Sizes = erlang:system_info({allocator_sizes, Allocs}),
+ alloc_blocks_size_1(Sizes, Type, 0).
+
+alloc_blocks_size_1([], _Type, 0) ->
+ undefined;
+alloc_blocks_size_1([{_Type, false} | Rest], Type, Acc) ->
+ alloc_blocks_size_1(Rest, Type, Acc);
+alloc_blocks_size_1([{Type, Instances} | Rest], Type, Acc0) ->
+ F = fun ({instance, _, L}, Acc) ->
+ MBCSPool = case lists:keyfind(mbcs_pool, 1, L) of
+ {_, Pool} -> Pool;
+ false -> []
+ end,
+ {_,MBCS} = lists:keyfind(mbcs, 1, L),
+ {_,SBCS} = lists:keyfind(sbcs, 1, L),
+ Acc +
+ sum_block_sizes(MBCSPool) +
+ sum_block_sizes(MBCS) +
+ sum_block_sizes(SBCS)
+ end,
+ alloc_blocks_size_1(Rest, Type, lists:foldl(F, Acc0, Instances));
+alloc_blocks_size_1([{_Type, Instances} | Rest], Type, Acc0) ->
+ F = fun ({instance, _, L}, Acc) ->
+ Acc + sum_foreign_sizes(Type, L)
+ end,
+ alloc_blocks_size_1(Rest, Type, lists:foldl(F, Acc0, Instances));
+alloc_blocks_size_1([], _Type, Acc) ->
+ Acc.
+
+sum_foreign_sizes(Type, L) ->
+ case lists:keyfind(mbcs_pool, 1, L) of
+ {_,Pool} ->
+ {_,ForeignBlocks} = lists:keyfind(foreign_blocks, 1, Pool),
+ case lists:keyfind(Type, 1, ForeignBlocks) of
+ {_,TypeSizes} -> sum_block_sizes(TypeSizes);
+ false -> 0
+ end;
+ _ ->
+ 0
+ end.
+
+sum_block_sizes(Blocks) ->
+ lists:foldl(
+ fun({blocks_size, Sz,_,_}, Sz0) -> Sz0+Sz;
+ ({blocks_size, Sz}, Sz0) -> Sz0+Sz;
+ (_, Sz) -> Sz
+ end, 0, Blocks).
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 7a48d1d55e..fee8b204f4 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -6112,40 +6112,11 @@ etsmem() ->
ets:info(T,memory),ets:info(T,type)}
end, ets:all()),
- EtsAllocInfo = erlang:system_info({allocator,ets_alloc}),
+ EtsAllocSize = erts_debug:alloc_blocks_size(ets_alloc),
ErlangMemoryEts = try erlang:memory(ets) catch error:notsup -> notsup end,
- Mem =
- {ErlangMemoryEts,
- case EtsAllocInfo of
- false -> undefined;
- MemInfo ->
- CS = lists:foldl(
- fun ({instance, _, L}, Acc) ->
- {value,{mbcs,MBCS}} = lists:keysearch(mbcs, 1, L),
- {value,{sbcs,SBCS}} = lists:keysearch(sbcs, 1, L),
- NewAcc = [MBCS, SBCS | Acc],
- case lists:keysearch(mbcs_pool, 1, L) of
- {value,{mbcs_pool, MBCS_POOL}} ->
- [MBCS_POOL|NewAcc];
- _ -> NewAcc
- end
- end,
- [],
- MemInfo),
- lists:foldl(
- fun(L, {Bl0,BlSz0}) ->
- {value,BlTup} = lists:keysearch(blocks, 1, L),
- blocks = element(1, BlTup),
- Bl = element(2, BlTup),
- {value,BlSzTup} = lists:keysearch(blocks_size, 1, L),
- blocks_size = element(1, BlSzTup),
- BlSz = element(2, BlSzTup),
- {Bl0+Bl,BlSz0+BlSz}
- end, {0,0}, CS)
- end},
- {Mem,AllTabs}.
-
+ Mem = {ErlangMemoryEts, EtsAllocSize},
+ {Mem, AllTabs}.
verify_etsmem(MI) ->
wait_for_test_procs(),
diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml
index 9fd9332373..79bacb2927 100644
--- a/lib/tools/doc/src/instrument.xml
+++ b/lib/tools/doc/src/instrument.xml
@@ -111,15 +111,18 @@
default, but this can be configured an a per-allocator basis with the
<seealso marker="erts:erts_alloc#M_atags"><c>+M&lt;S&gt;atags</c>
</seealso> emulator option.</p>
- <p>If tagged allocations are not enabled on any of the specified
- allocator types, the call will fail with
- <c>{error, not_enabled}</c>.</p>
+ <p>If the specified allocator types are not enabled, the call will fail
+ with <c>{error, not_enabled}</c>.</p>
<p>The following options can be used:</p>
<taglist>
<tag><c>allocator_types</c></tag>
<item>
- <p>The allocator types that will be searched. Defaults to all
- <c>alloc_util</c> allocators.</p>
+ <p>The allocator types that will be searched. Note that blocks can
+ move freely between allocator types, so restricting the search to
+ certain allocators may return unexpected types (e.g. process
+ heaps when searching binary_alloc), or hide blocks that were
+ migrated out.</p>
+ <p>Defaults to all <c>alloc_util</c> allocators.</p>
</item>
<tag><c>scheduler_ids</c></tag>
<item>
diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl
index 8c521b2e1a..33800c5934 100644
--- a/lib/tools/test/instrument_SUITE.erl
+++ b/lib/tools/test/instrument_SUITE.erl
@@ -77,6 +77,8 @@ allocations_ramv(Config) when is_list(Config) ->
verify_allocations_disabled(_AllocType, Result) ->
verify_allocations_disabled(Result).
+verify_allocations_disabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) ->
+ true = Allocs =:= #{};
verify_allocations_disabled({error, not_enabled}) ->
ok.
@@ -91,6 +93,13 @@ verify_allocations_enabled(_AllocType, Result) ->
verify_allocations_enabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) ->
true = Allocs =/= #{}.
+verify_allocations_output(#{}, {ok, {_, _, Allocs}}) when Allocs =:= #{} ->
+ %% This happens when the allocator is enabled but tagging is disabled. If
+ %% there's an error that causes Allocs to always be empty when enabled it
+ %% will be caught by verify_allocations_enabled.
+ ok;
+verify_allocations_output(#{}, {error, not_enabled}) ->
+ ok;
verify_allocations_output(#{ histogram_start := HistStart,
histogram_width := HistWidth },
{ok, {HistStart, _UnscannedBytes, ByOrigin}}) ->
@@ -124,8 +133,6 @@ verify_allocations_output(#{ histogram_start := HistStart,
[BlockCount, GenTotalBlockCount])
end,
- ok;
-verify_allocations_output(#{}, {error, not_enabled}) ->
ok.
%% %% %% %% %% %%
@@ -214,7 +221,8 @@ verify_carriers_output(#{ histogram_start := HistStart,
ct:fail("Carrier count is ~p, expected at least ~p (SBC).",
[CarrierCount, GenSBCCount]);
CarrierCount >= GenSBCCount ->
- ok
+ ct:pal("Found ~p blocks, required at least ~p (SBC)." ,
+ [CarrierCount, GenSBCCount])
end,
ok;
@@ -292,9 +300,19 @@ start_slave(Args) ->
MicroSecs = erlang:monotonic_time(),
Name = "instr" ++ integer_to_list(MicroSecs),
Pa = filename:dirname(code:which(?MODULE)),
- {ok, Node} = test_server:start_node(list_to_atom(Name),
- slave,
- [{args, "-pa " ++ Pa ++ " " ++ Args}]),
+
+ %% We pass arguments through ZFLAGS as the nightly tests rotate
+ %% +Meamax/+Meamin which breaks the _enabled and _disabled tests unless
+ %% overridden.
+ ZFlags = os:getenv("ERL_ZFLAGS", ""),
+ {ok, Node} = try
+ os:putenv("ERL_ZFLAGS", ZFlags ++ [" " | Args]),
+ test_server:start_node(list_to_atom(Name),
+ slave,
+ [{args, "-pa " ++ Pa}])
+ after
+ os:putenv("ERL_ZFLAGS", ZFlags)
+ end,
Node.
generate_test_blocks() ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-19 14:59:57 +0000