File 5802-Improve-erts_debug-lc_graph-functions.patch of Package erlang
From ed484682f8103dcd656a6adc7066cd383bfd5b07 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson <sverker@erlang.org>
Date: Mon, 27 May 2024 20:44:03 +0200
Subject: [PATCH 2/4] Improve erts_debug:lc_graph* functions
Simplify dot files
by removing implicit indirect dependencies
A -> B -> C
do not show arrow A -> C
even if the lc_graph file has it as a direct dependency
as C has been locked after A without B being involved.
---
lib/kernel/src/erts_debug.erl | 86 ++++++++++++++++++++++++++---------
1 file changed, 64 insertions(+), 22 deletions(-)
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index fd86f870b3..4718920e7e 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -39,7 +39,8 @@
size_shared/1, copy_shared/1, copy_shared/2,
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/0, lc_graph_merge/1, lc_graph_merge/2,
alloc_blocks_size/1]).
%% Reroutes calls to the given MFA to error_handler:breakpoint/3
@@ -439,16 +440,14 @@ lc_graph() ->
%% Convert "lc_graph.<pid>" file to https://www.graphviz.org dot format.
lc_graph_to_dot(OutFile, InFile) ->
- {ok, [LL0]} = file:consult(InFile),
-
- [{"NO LOCK",0} | LL] = LL0,
- Map = #{Id => Name || {Name, Id, _, _} <- LL},
+ LL0 = lcg_read_file(InFile),
+ LL1 = lcg_simplify_graph(LL0),
case file:open(OutFile, [exclusive]) of
{ok, Out} ->
ok = file:write(Out, "digraph G {\n"),
- [dot_print_lock(Out, Lck, Map) || Lck <- LL],
+ [dot_print_lock(Out, Lck) || Lck <- LL1],
ok = file:write(Out, "}\n"),
ok = file:close(Out);
@@ -457,23 +456,25 @@ lc_graph_to_dot(OutFile, InFile) ->
{"File already exists", OutFile}
end.
-dot_print_lock(Out, {_Name, Id, Lst, _}, Map) ->
- [dot_print_edge(Out, From, Id, Map) || From <- Lst],
+dot_print_lock(Out, {Name, Direct, _Indirect}) ->
+ [dot_print_edge(Out, From, Name) || From <- Direct],
ok.
-dot_print_edge(_, 0, _, _) ->
- ignore; % "NO LOCK"
-dot_print_edge(Out, From, To, Map) ->
- io:format(Out, "~p -> ~p;\n", [maps:get(From,Map), maps:get(To,Map)]).
+dot_print_edge(Out, From, To) ->
+ io:format(Out, "~p -> ~p;\n", [From, To]).
%% Merge several "lc_graph" files into one file.
+lc_graph_merge() ->
+ lc_graph_merge("lc_graph.merged").
+
+lc_graph_merge(OutFile) ->
+ lc_graph_merge(OutFile, "lc_graph.*").
+
+lc_graph_merge(OutFile, [C|_]=Wildcard) when is_integer(C) ->
+ lc_graph_merge(OutFile, filelib:wildcard(Wildcard));
lc_graph_merge(OutFile, InFiles) ->
- LLs = lists:map(fun(InFile) ->
- {ok, [LL]} = file:consult(InFile),
- LL
- end,
- InFiles),
+ LLs = [lcg_read_file(File) || File <- InFiles],
Res = lists:foldl(fun(A, B) -> lcg_merge(A, B) end,
hd(LLs),
@@ -490,17 +491,58 @@ lc_graph_merge(OutFile, InFiles) ->
{"File already exists", OutFile}
end.
+lcg_read_file(File) ->
+ {ok, [LL]} = file:consult(File),
+ lcg_expand_lock_names(LL).
+
+lcg_expand_lock_names([{"NO LOCK", 0} | LL]) ->
+ Map = #{Id => Name || {Name, Id, _, _} <- LL},
+ [begin
+ Direct = [maps:get(From,Map) || From <- DirectIds, From =/= 0],
+ Indirect = [maps:get(From,Map) || From <- IndirectIds, From =/= 0],
+
+ {Name, Direct, Indirect}
+ end
+ || {Name, _Id, DirectIds, IndirectIds} <- LL];
+lcg_expand_lock_names(LL) ->
+ LL. % assume already expanded format
+
lcg_merge(A, B) ->
lists:zipwith(fun(LA, LB) -> lcg_merge_locks(LA, LB) end,
A, B).
lcg_merge_locks(L, L) ->
L;
-lcg_merge_locks({Name, Id, DA, IA}, {Name, Id, DB, IB}) ->
- Direct = lists:umerge(DA, DB),
- Indirect = lists:umerge(IA, IB),
- {Name, Id, Direct, Indirect -- Direct}.
-
+lcg_merge_locks({Name, DA, IA}, {Name, DB, IB}) ->
+ Direct = lists:umerge(lists:sort(DA), lists:sort(DB)),
+ Indirect = lists:umerge(lists:sort(IA), lists:sort(IB)),
+ {Name, Direct -- Indirect, Indirect -- Direct}.
+
+lcg_simplify_graph(LL) ->
+ [lcg_demote_indirects(L, LL) || L <- LL].
+
+lcg_demote_indirects({Name, Directs0, Indirects0}, LL) ->
+ BeforeDirects = lcg_locked_before(Name, Directs0, LL, []),
+ {Demoted, KeptDirects} =
+ lists:partition(fun(Direct) ->
+ lists:member(Direct, BeforeDirects)
+ end,
+ Directs0),
+ %% case Demoted of
+ %% [] -> ok;
+ %% _ -> io:format("Lock ~p demoted ~p\n", [Name, Demoted])
+ %% end,
+ {Name, KeptDirects, lists:usort(Indirects0 ++ Demoted)}.
+
+lcg_locked_before(_This, [], _LL, Acc) ->
+ lists:usort(Acc);
+lcg_locked_before(This, [This|Tail], LL, Acc) ->
+ lcg_locked_before(This, Tail, LL, Acc);
+lcg_locked_before(This, [Name|Tail], LL, Acc) ->
+ {Name, Directs0, _Indirects} = lists:keyfind(Name, 1, LL),
+ Directs1 = lists:delete(Name, Directs0),
+ DepthAcc = lcg_locked_before(Name, Directs1, LL, Acc),
+ lcg_locked_before(This, Tail, LL, Directs1 ++ DepthAcc).
lcg_print(Out, LL) ->
io:format(Out, "[", []),
--
2.35.3