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

openSUSE Build Service is sponsored by