erts: Add erts_debug:lc_graph/0

Run debug VM or config with --enable-lock-checking.

Exercise VM and then run

erts_debug:lc_graph().

to create a file "lc_graph.<pid>" in current working directory.

4 files changed, 209 insertions, 3 deletions

diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index bdca93428e..874ac0f9e6 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -3928,6 +3928,15 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
             BIF_RET(am_false);
 #endif
         }
+        else if (ERTS_IS_ATOM_STR("lc_graph", BIF_ARG_1)) {
+#ifdef ERTS_ENABLE_LOCK_CHECK
+            Eterm res = erts_lc_dump_graph();
+            BIF_RET(res);
+#else
+            BIF_RET(am_notsup);
+#endif
+        }
+
     }
     else if (is_tuple(BIF_ARG_1)) {
 	Eterm* tp = tuple_val(BIF_ARG_1);
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 5d33de9e88..53edf6abc1 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -41,6 +41,7 @@
 #include "erl_lock_check.h"
 #include "erl_term.h"
 #include "erl_threads.h"
+#include "erl_atom_table.h"
 
 typedef struct {
     char *name;
@@ -75,6 +76,7 @@ static erts_lc_lock_order_t erts_lock_order[] = {
      *						 if only one lock use
      *						 the lock name)"
      */
+    {   "NO LOCK",                              NULL                    },
     {	"driver_lock",				"driver_name"		},
     {	"port_lock",				"port_id"		},
     {	"port_data_lock",			"address"		},
@@ -196,6 +198,19 @@ typedef struct {
     lc_locked_lock_t *last;
 } lc_locked_lock_list_t;
 
+typedef struct {
+    /*
+     * m[X][Y] & 1 if we locked X directly after Y was locked.
+     * m[X][Y] & 2 if we locked X indirectly after Y was locked.
+     * m[X][0] = 1 if we locked X when nothing else was locked.
+     * m[0][] is unused as it would represent locking "NO LOCK"
+     */
+    char m[ERTS_LOCK_ORDER_SIZE][ERTS_LOCK_ORDER_SIZE];
+
+} lc_matrix_t;
+
+static lc_matrix_t tot_lc_matrix;
+
 typedef struct lc_thread_t_ lc_thread_t;
 struct lc_thread_t_ {
     char *thread_name;
@@ -205,6 +220,7 @@ struct lc_thread_t_ {
     lc_thread_t *prev;
     lc_locked_lock_list_t locked;
     lc_locked_lock_list_t required;
+    lc_matrix_t matrix;
 };
 
 typedef union lc_free_block_t_ lc_free_block_t;
@@ -322,6 +338,7 @@ create_thread_data(char *thread_name)
     thr->locked.first = NULL;
     thr->locked.last = NULL;
     thr->prev = NULL;
+    sys_memzero(&thr->matrix, sizeof(thr->matrix));
 
     lc_lock();
     thr->next = lc_threads;
@@ -333,6 +350,8 @@ create_thread_data(char *thread_name)
     return thr;
 }
 
+static void collect_matrix(lc_matrix_t*);
+
 static void
 destroy_locked_locks(lc_thread_t *thr)
 {
@@ -352,6 +371,9 @@ destroy_locked_locks(lc_thread_t *thr)
     }
     if (thr->next)
 	thr->next->prev = thr->prev;
+
+    collect_matrix(&thr->matrix);
+
     lc_unlock();
 
     free((void *) thr);
@@ -394,7 +416,7 @@ static void
 raw_print_lock(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags,
 	       char* file, unsigned int line, char *suffix)
 {
-    char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE
+    char *lname = (1 <= id && id < ERTS_LOCK_ORDER_SIZE
 		   ? erts_lock_order[id].name
 		   : "unknown");
     erts_fprintf(stderr,"%s'%s:",prefix,lname);
@@ -1144,12 +1166,25 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
     if (!thr->locked.last) {
 	ASSERT(!thr->locked.first);
 	thr->locked.last = thr->locked.first = new_ll;
+        ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE);
+        thr->matrix.m[lck->id][0] = 1;
     }
     else if (thr->locked.last->id < lck->id
 	     || (thr->locked.last->id == lck->id
 		 && thr->locked.last->extra < lck->extra)) {
-	if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags))
+        lc_locked_lock_t* ll;
+	if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) {
 	    type_order_violation("locking ", thr, lck);
+        }
+
+        ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE);
+        ll = thr->locked.last;
+        thr->matrix.m[lck->id][ll->id] |= 1;
+        for (ll = ll->prev; ll; ll = ll->prev) {
+            ASSERT(0 < ll->id && ll->id < ERTS_LOCK_ORDER_SIZE);
+            thr->matrix.m[lck->id][ll->id] |= 2;
+        }
+
 	new_ll->prev = thr->locked.last;
 	thr->locked.last->next = new_ll;
 	thr->locked.last = new_ll;
@@ -1342,4 +1377,76 @@ erts_lc_pll(void)
     print_curr_locks(get_my_locked_locks());
 }
 
+static void collect_matrix(lc_matrix_t* matrix)
+{
+    int i, j;
+    for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+        for (j = 0; j <= i; j++) {
+            tot_lc_matrix.m[i][j] |= matrix->m[i][j];
+        }
+#ifdef DEBUG
+        for ( ; j < ERTS_LOCK_ORDER_SIZE; j++) {
+            ASSERT(matrix->m[i][j] == 0);
+        }
+#endif
+    }
+}
+
+Eterm
+erts_lc_dump_graph(void)
+{
+    const char* basename = "lc_graph.";
+    char filename[40];
+    lc_matrix_t* tot = &tot_lc_matrix;
+    lc_thread_t* thr;
+    int i, j, name_max = 0;
+    FILE* ff;
+
+    lc_lock();
+    for (thr = lc_threads; thr; thr = thr->next) {
+        collect_matrix(&thr->matrix);
+    }
+    lc_unlock();
+
+    sys_strcpy(filename, basename);
+    sys_get_pid(filename + strlen(basename),
+                sizeof(filename) - strlen(basename));
+    ff = fopen(filename, "w");
+    if (!ff)
+        return am_error;
+
+    for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+        int len = strlen(erts_lock_order[i].name);
+        if (name_max < len)
+            name_max = len;
+    }
+    fputs("%This file was generated by erts_debug:lc_graph()\n\n", ff);
+    fputs("%{ThisLockName, ThisLockId, LockedDirectlyBeforeThis, LockedIndirectlyBeforeThis}\n", ff);
+    fprintf(ff, "[{%*s, %2d}", name_max, "\"NO LOCK\"", 0);
+    for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+        char* delim = "";
+        fprintf(ff, ",\n {%*s, %2d, [", name_max, erts_lock_order[i].name, i);
+        for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) {
+            if (tot->m[i][j] & 1) {
+                fprintf(ff, "%s%d", delim, j);
+                delim = ",";
+            }
+        }
+        fprintf(ff, "], [");
+        delim = "";
+        for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) {
+            if (tot->m[i][j] == 2) {
+                fprintf(ff, "%s%d", delim, j);
+                delim = ",";
+            }
+        }
+        fputs("]}", ff);
+    }
+    fputs("].", ff);
+    fclose(ff);
+    erts_fprintf(stderr, "Created file '%s' in current working directory\n",
+                 filename);
+    return am_ok;
+}
+
 #endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */
diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h
index 5c2c38e8f2..138bc810bd 100644
--- a/erts/emulator/beam/erl_lock_check.h
+++ b/erts/emulator/beam/erl_lock_check.h
@@ -94,6 +94,8 @@ void erts_lc_unrequire_lock(erts_lc_lock_t *lck);
 
 int erts_lc_is_emu_thr(void);
 
+Eterm erts_lc_dump_graph(void);
+
 #define ERTS_LC_ASSERT(A) \
     ((void) (((A) || ERTS_SOMEONE_IS_CRASH_DUMPING) ? 1 : erts_lc_assert_failed(__FILE__, __LINE__, #A)))
 #else /* #ifdef ERTS_ENABLE_LOCK_CHECK */
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 6f248626ca..1270de4144 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -35,7 +35,8 @@
          flat_size/1, get_internal_state/1, instructions/0,
          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]).
+         lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0,
+         lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2]).
 
 -spec breakpoint(MFA, Flag) -> non_neg_integer() when
       MFA :: {Module :: module(),
@@ -407,3 +408,90 @@ cont_dis(_, {_,_,_}, _) -> ok.
 
 map_info(_) ->
     erlang:nif_error(undef).
+
+%% Create file "lc_graph.<pid>" with all actual lock dependencies
+%% recorded so far by the VM.
+%% Needs debug VM or --enable-lock-checking config, returns 'notsup' otherwise.
+lc_graph() ->
+    erts_debug:set_internal_state(available_internal_state, true),
+    erts_debug:get_internal_state(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 = maps:from_list([{Id, Name} || {Name, Id, _, _} <- LL]),
+
+    case file:open(OutFile, [exclusive]) of
+        {ok, Out} ->
+            ok = file:write(Out, "digraph G {\n"),
+
+            [dot_print_lock(Out, Lck, Map) || Lck <- LL],
+
+            ok = file:write(Out, "}\n"),
+            ok = file:close(Out);
+
+        {error,eexist} ->
+            {"File already exists", OutFile}
+    end.
+
+dot_print_lock(Out, {_Name, Id, Lst, _}, Map) ->
+    [dot_print_edge(Out, From, Id, Map) || From <- Lst],
+    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)]).
+
+
+%% Merge several "lc_graph" files into one file.
+lc_graph_merge(OutFile, InFiles) ->
+    LLs = lists:map(fun(InFile) ->
+                            {ok, [LL]} = file:consult(InFile),
+                            LL
+                    end,
+                    InFiles),
+
+    Res = lists:foldl(fun(A, B) -> lcg_merge(A, B) end,
+                      hd(LLs),
+                      tl(LLs)),
+    case file:open(OutFile, [exclusive]) of
+        {ok, Out} ->
+            try
+                lcg_print(Out, Res)
+            after
+                file:close(Out)
+            end,
+            ok;
+        {error, eexist} ->
+            {"File already exists", OutFile}
+    end.
+
+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_print(Out, LL) ->
+    io:format(Out, "[", []),
+    lcg_print_locks(Out, LL),
+    io:format(Out, "].\n", []),
+    ok.
+
+lcg_print_locks(Out, [{_,_}=NoLock | Rest]) ->
+    io:format(Out, "~p,\n", [NoLock]),
+    lcg_print_locks(Out, Rest);
+lcg_print_locks(Out, [LastLock]) ->
+    io:format(Out, "~w", [LastLock]);
+lcg_print_locks(Out, [Lock | Rest]) ->
+    io:format(Out, "~w,\n", [Lock]),
+    lcg_print_locks(Out, Rest).