From 97341be295369bf3b1fd03e7a6682ef1b5978e73 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 8 May 2024 19:01:32 +0200 Subject: [PATCH 1/4] erts: Add lock checker levels All locks within a level are unordered and not supposed to be seized at the same time. The lock checker will complain if that happens. The main purpose is to make it easier to reason and understand the lock order when need to change it arises. --- erts/emulator/beam/erl_lock_check.c | 353 ++++++++++++++++++---------- 1 file changed, 235 insertions(+), 118 deletions(-) diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index e8861b078ce2..0123f28ce75e 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -43,8 +43,9 @@ #include "erl_utils.h" typedef struct { - char *name; - char *internal_order; + const char * const name; + const char * const internal_order; + Sint16 level; } erts_lc_lock_order_t; /* @@ -67,7 +68,19 @@ typedef struct { * spinlocks and rwlocks have been unlocked. This restriction is not * reflected by the lock order below, but the lock checker will still * check for violations of this restriction. + * + * OTP 28: Lock order LEVELs. Different named locks within the same level + * cannot be locked at the same time. Levels are separated by the macro LEVEL. + * This will hopefully make it easier to edit the lock order while also + * enforce that intentionally unordered locks are not locked together. + * + * For an even better understanding use erts_debug:lc_graph() + * to dump the actual recorded locking order to a file which can be converted + * to a nice viewable graph. Some of our test suites already calls + * erts_debug:lc_graph() before the beam exists. Search for files "lc_graph.*". */ +#define LEVEL {NULL,NULL} + static erts_lc_lock_order_t erts_lock_order[] = { /* * "Lock name" "Internal lock order @@ -75,104 +88,116 @@ 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" }, - { "reg_tab", NULL }, - { "proc_main", "pid" }, - { "old_code", "address" }, - { "nif_call_tab", NULL }, - { "nodes_monitors", NULL }, - { "meta_name_tab", "address" }, - { "db_tab", "address" }, - { "db_tab_fix", "address" }, - { "db_hash_slot", "address" }, - { "erl_db_catree_base_node", NULL }, - { "erl_db_catree_route_node", "index" }, - { "resource_monitors", "address" }, - { "driver_list", NULL }, - { "dist_entry", "address" }, - { "proc_msgq", "pid" }, - { "proc_btm", "pid" }, - { "dist_entry_links", "address" }, - { "nif_load", NULL }, - { "update_persistent_term_permission", NULL }, - { "persistent_term_delete_permission", NULL }, - { "code_stage_permission", NULL }, - { "code_mod_permission", NULL }, - { "purge_state", NULL }, - { "proc_status", "pid" }, - { "proc_trace", "pid" }, - { "trace_session_list", NULL }, - { "trace_cleaner", NULL }, - { "node_table", NULL }, - { "dist_table", NULL }, - { "sys_tracers", NULL }, - { "export_tab", NULL }, - { "fun_tab", NULL }, - { "environ", NULL }, - { "release_literal_areas", NULL }, - { "on_halt", NULL }, - { "drv_ev_state_grow", NULL, }, - { "drv_ev_state", "address" }, - { "safe_hash", "address" }, - { "state_prealloc", NULL }, - { "schdlr_sspnd", NULL }, - { "migration_info_update", NULL }, - { "run_queue", "address" }, - { "dirty_run_queue_sleep_list", "address" }, - { "dirty_gc_info", NULL }, - { "dirty_break_point_index", NULL }, - { "process_table", NULL }, - { "cpu_info", NULL }, - { "pollset", "address" }, + {"NO LOCK", NULL}, + LEVEL, + {"driver_lock", "driver_name"}, + {"port_lock", "port_id"}, + {"async_enq_mtx", NULL}, + LEVEL, + {"port_data_lock", "address"}, + {"reg_tab", NULL}, + LEVEL, + {"proc_main", "pid"}, + LEVEL, + {"old_code", "address"}, + {"nif_call_tab", NULL}, + {"nodes_monitors", NULL}, + {"meta_name_tab", "address"}, + {"resource_monitors", "address"}, + {"driver_list", NULL}, + {"dist_entry", "address"}, + {"update_persistent_term_permission", NULL}, + {"persistent_term_delete_permission", NULL}, + {"code_stage_permission", NULL}, + {"code_mod_permission", NULL}, + {"trace_cleaner", NULL}, + {"export_tab", NULL}, + {"release_literal_areas", NULL}, + {"drv_ev_state_grow", NULL}, + {"schdlr_sspnd", NULL}, + {"dirty_gc_info", NULL}, + {"dirty_break_point_index", NULL}, + {"cpu_info", NULL}, + {"block_poll_thread", "index"}, + {"alcu_init_atoms", NULL}, + {"mseg_init_atoms", NULL}, + {"mmap_init_atoms", NULL}, + {"port_table", NULL}, + LEVEL, + {"db_tab", "address"}, + {"proc_msgq", "pid"}, + {"dist_entry_links", "address"}, + {"dist_entry_out_queue", "address"}, + {"nif_load", NULL}, + {"purge_state", NULL}, + {"environ", NULL}, + {"drv_ev_state", "address"}, + {"migration_info_update", NULL}, + {"drv_tsd", NULL}, + {"msacc_list_mutex", NULL}, + {"on_halt", NULL}, + LEVEL, + {"db_tab_fix", "address"}, + {"db_hash_slot", "address"}, + {"erl_db_catree_base_node", NULL}, + {"proc_btm", "pid"}, + {"safe_hash", "address"}, + {"pollset", "address"}, + LEVEL, + {"erl_db_catree_route_node", "index"}, + {"proc_status", "pid"}, + {"node_table", NULL}, + LEVEL, + {"proc_trace", "pid"}, + {"dist_table", NULL}, + LEVEL, + {"trace_session_list", NULL}, + {"run_queue", "address"}, + {"magic_ref_table", "address"}, + {"proc_sig_queue_buffer", "address"}, + LEVEL, + {"sys_tracers", NULL}, + {"dirty_run_queue_sleep_list", "address"}, + {"process_table", NULL}, + {"port_sched_lock", "port_id"}, + {"msacc_unmanaged_mutex", NULL}, + LEVEL, #ifdef __WIN32__ - { "pollwaiter", "address" }, - { "break_waiter_lock", NULL }, + {"pollwaiter", "address"}, + {"break_waiter_lock", NULL}, #endif /* __WIN32__ */ - { "block_poll_thread", "index" }, - { "alcu_init_atoms", NULL }, - { "mseg_init_atoms", NULL }, - { "mmap_init_atoms", NULL }, - { "drv_tsd", NULL }, - { "async_enq_mtx", NULL }, - { "msacc_list_mutex", NULL }, - { "msacc_unmanaged_mutex", NULL }, - { "atom_tab", NULL }, - { "dist_entry_out_queue", "address" }, - { "port_sched_lock", "port_id" }, - { "sys_msg_q", NULL }, - { "tracer_mtx", NULL }, - { "port_table", NULL }, - { "magic_ref_table", "address" }, - { "pid_ref_table", "address" }, - { "instr_x", NULL }, - { "instr", NULL }, - { "dyn_lock_check", NULL }, - { "alcu_allocator", "index" }, - { "mseg", NULL }, - { "get_time", NULL }, - { "get_corrected_time", NULL }, - { "runtime", NULL }, - { "pix_lock", "address" }, - { "sched_stat", NULL }, - { "async_init_mtx", NULL }, -#ifdef __WIN32__ -#ifdef DEBUG - { "save_ops_lock", NULL }, + {"tracer_mtx", NULL}, + {"sys_msg_q", NULL}, + {"fun_tab", NULL}, + {"atom_tab", NULL}, + LEVEL, + {"alcu_allocator", "index"}, + LEVEL, + {"mseg", NULL}, + {"perf", NULL}, + {"get_time", NULL}, + LEVEL, + {"runtime", NULL}, + LEVEL, + {"get_corrected_time", NULL}, + {"pix_lock", "address"}, + {"async_init_mtx", NULL}, +#if defined(__WIN32__) && defined(DEBUG) + {"save_ops_lock", NULL}, #endif -#endif - { "os_monotonic_time", NULL }, - { "erts_alloc_hard_debug", NULL }, - { "hard_dbg_mseg", NULL }, - { "perf", NULL }, - { "jit_debug_descriptor", NULL }, - { "erts_mmap", NULL }, - { "proc_sig_queue_buffer", "address" }, + {"os_monotonic_time", NULL}, + {"erts_alloc_hard_debug", NULL}, + {"hard_dbg_mseg", NULL}, + {"jit_debug_descriptor", NULL}, + {"erts_mmap", NULL}, #ifdef ERTS_ENSURE_OS_MONOTONIC_TIME - { "ensure_os_monotonic_time", NULL } + {"ensure_os_monotonic_time", NULL}, #endif + {"dyn_lock_check", NULL}, + LEVEL, + /* spin locks */ + {"state_prealloc", NULL}, + {"sched_stat", NULL} }; #define ERTS_LOCK_ORDER_SIZE \ @@ -223,11 +248,14 @@ union lc_free_block_t_ { lc_locked_lock_t lock; }; +#define DIRECT_AFTER 1 +#define INDIRECT_AFTER 2 + 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[X][Y] & DIRECT_AFTER if we locked X directly after Y was locked. + * m[X][Y] & INDIRECT_AFTER if we locked X indirectly after Y was locked. + * m[X][0] = DIRECT_AFTER 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]; @@ -434,10 +462,15 @@ static void raw_print_lock(char *prefix, Sint16 id, Eterm extra, erts_lock_flags_t flags, const char* file, unsigned int line, char *suffix) { - char *lname = (1 <= id && id < ERTS_LOCK_ORDER_SIZE - ? erts_lock_order[id].name - : "unknown"); - erts_fprintf(stderr,"%s'%s:",prefix,lname); + if (1 <= id && id < ERTS_LOCK_ORDER_SIZE + && erts_lock_order[id].name) { + erts_fprintf(stderr, "%s'%d.%s:", prefix, + erts_lock_order[id].level, + erts_lock_order[id].name); + } + else { + erts_fprintf(stderr, "%s'unknown(%d):", prefix, id); + } if (is_not_immed(extra)) erts_fprintf(stderr,"%p",_unchecked_boxed_val(extra)); @@ -487,13 +520,19 @@ print_lock_order(void) int i; erts_fprintf(stderr, "Lock order:\n"); for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) { + if (!erts_lock_order[i].name) { + continue; + } if (erts_lock_order[i].internal_order) erts_fprintf(stderr, - " %s:%s\n", + " %2d.%s:%s\n", + erts_lock_order[i].level, erts_lock_order[i].name, erts_lock_order[i].internal_order); else - erts_fprintf(stderr, " %s\n", erts_lock_order[i].name); + erts_fprintf(stderr, " %2d.%s\n", + erts_lock_order[i].level, + erts_lock_order[i].name); } } @@ -717,9 +756,11 @@ erts_lc_get_lock_order_id(const char *name) if (!name || name[0] == '\0') erts_fprintf(stderr, "Missing lock name\n"); else { - for (i = 0; i < ERTS_LOCK_ORDER_SIZE; i++) - if (sys_strcmp(erts_lock_order[i].name, name) == 0) - return i; + for (i = 0; i < ERTS_LOCK_ORDER_SIZE; i++) { + if (erts_lock_order[i].name + && sys_strcmp(erts_lock_order[i].name, name) == 0) + return i; + } erts_fprintf(stderr, "Lock name '%s' missing in lock order " "(update erl_lock_check.c)\n", @@ -737,6 +778,29 @@ lc_is_term_order(Sint16 id) } +static int compare_same_lock_id_extra(lc_locked_lock_t *, erts_lc_lock_t *); + +static int compare_lock_order(lc_locked_lock_t *locked_lock, + erts_lc_lock_t *want_lock) +{ + const Sint16 ll_level = erts_lock_order[locked_lock->id].level; + const Sint16 wl_level = erts_lock_order[want_lock->id].level; + + if (wl_level > ll_level) { + /* Want lock in higher level, ok */ + return -1; + } else if (wl_level < ll_level) { + /* Want lock in lower level, not ok*/ + return 1; + } else if (locked_lock->id != want_lock->id) { + /* Want different lock id in same level, not ok */ + return 1; + } + + /* Same lock id */ + return compare_same_lock_id_extra(locked_lock, want_lock); +} + static int compare_locked_by_id(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) { if(locked_lock->id < comparand->id) { @@ -755,6 +819,14 @@ static int compare_locked_by_id_extra(lc_locked_lock_t *ll, erts_lc_lock_t *comp if(order) { return order; } + + return compare_same_lock_id_extra(ll, comparand); +} + +static int compare_same_lock_id_extra(lc_locked_lock_t *ll, erts_lc_lock_t *comparand) +{ + ASSERT(ll->id == comparand->id); + if (ll->flags & ERTS_LOCK_FLAGS_PROPERTY_TERM_ORDER) { ASSERT(!is_header(ll->extra) && !is_header(comparand->extra)); return CMP(ll->extra, comparand->extra); @@ -1014,7 +1086,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) #endif ll = thr->locked.last; - order = compare_locked_by_id_extra(ll, lck); + order = compare_lock_order(ll, lck); if (order < 0) return 0; @@ -1030,7 +1102,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) ll = ll->prev; if (!ll) break; - order = compare_locked_by_id_extra(ll, lck); + order = compare_lock_order(ll, lck); } while (order >= 0); #ifndef ERTS_LC_ALLWAYS_FORCE_BUSY_TRYLOCK_ON_LOCK_ORDER_VIOLATION @@ -1078,7 +1150,7 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t #endif for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) { - int order = compare_locked_by_id_extra(tl_lck, lck); + int order = compare_lock_order(tl_lck, lck); if (order <= 0) { if (order == 0 && (tl_lck->lck == lck || !tl_lck->lck)) lock_twice("Trylocking", thr, lck, options); @@ -1199,10 +1271,10 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options, 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; + thr->matrix.m[lck->id][0] = DIRECT_AFTER; return; } - order = compare_locked_by_id_extra(thr->locked.last, lck); + order = compare_lock_order(thr->locked.last, lck); if (order < 0) { lc_locked_lock_t* ll; if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) { @@ -1211,10 +1283,10 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options, ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE); ll = thr->locked.last; - thr->matrix.m[lck->id][ll->id] |= 1; + thr->matrix.m[lck->id][ll->id] |= DIRECT_AFTER; 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; + thr->matrix.m[lck->id][ll->id] |= INDIRECT_AFTER; } new_ll->prev = thr->locked.last; @@ -1372,10 +1444,37 @@ erts_lc_destroy_lock(erts_lc_lock_t *lck) void erts_lc_init(void) { + int i, j, level; if (ethr_spinlock_init(&lc_threads_lock) != 0) ERTS_INTERNAL_ERROR("spinlock_init failed"); erts_tsd_key_create(&locks_key,"erts_lock_check_key"); + + /* Assert no duplicate lock names */ + for (i=0; i < ERTS_LOCK_ORDER_SIZE; i++) { + if (erts_lock_order[i].name) { + for (j = i + 1; j < ERTS_LOCK_ORDER_SIZE; j++) { + if (erts_lock_order[j].name) { + ERTS_ASSERT(sys_strcmp(erts_lock_order[i].name, + erts_lock_order[j].name) + != 0); + } + } + } + } + + /* Initialize lock levels */ + level = 0; + for (i = 0; i < ERTS_LOCK_ORDER_SIZE; i++) { + if (erts_lock_order[i].name) { + erts_lock_order[i].level = level; + } + else { + /* level separator */ + ASSERT(erts_lock_order[i].internal_order == NULL); + ++level; + } + } } void @@ -1412,6 +1511,16 @@ static void collect_matrix(lc_matrix_t* matrix) Eterm erts_lc_dump_graph(void) { + static const char comment[] = + "% This file was generated by erts_debug:lc_graph()\n" + "% It contains the recorded locking order from a running beam.\n" + "% Example to merge several files and generate a viewable graph:\n" + "%\n" + "% 1> erts_debug:lc_graph_merge(\"lc_graph\", \"lc_graph.*\").\n" + "% 2> erts_debug:lc_graph_to_dot(\"lc_graph.dot\", \"lc_graph\").\n" + "%\n" + "% $> dot -Tsvg -Nshape=box -Grankdir=LR -Granksep=2 lc_graph.dot > lc_graph.svg\n" + "\n"; const char* basename = "lc_graph."; char filename[40]; lc_matrix_t* tot = &tot_lc_matrix; @@ -1433,18 +1542,26 @@ erts_lc_dump_graph(void) return am_error; for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) { - int len = strlen(erts_lock_order[i].name); + int len; + if (!erts_lock_order[i].name) + continue; + + 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(comment, 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 = ""; + if (!erts_lock_order[i].name) + continue; 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) { + if (tot->m[i][j] & DIRECT_AFTER) { fprintf(ff, "%s%d", delim, j); delim = ","; } @@ -1452,7 +1569,7 @@ erts_lc_dump_graph(void) fprintf(ff, "], ["); delim = ""; for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) { - if (tot->m[i][j] == 2) { + if (tot->m[i][j] == INDIRECT_AFTER) { fprintf(ff, "%s%d", delim, j); delim = ","; } From ed484682f8103dcd656a6adc7066cd383bfd5b07 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson 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 fd86f870b326..4718920e7e60 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." 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, "[", []), From c99ad7461358a2428521b287e86e58d9e13167d3 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 28 May 2024 19:43:38 +0200 Subject: [PATCH 3/4] erts: Use strlen --- erts/emulator/beam/hash.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c index 5c8b43e6e26d..67febabe8fce 100644 --- a/erts/emulator/beam/hash.c +++ b/erts/emulator/beam/hash.c @@ -98,10 +98,8 @@ void hash_info(fmtfn_t to, void *arg, Hash* h) int hash_table_sz(Hash *h) { - int i; - for(i=0;h->name[i];i++); - i++; - return sizeof(Hash) + hash_get_slots(h)*sizeof(HashBucket*) + i; + const int name_len = strlen(h->name) + 1; + return sizeof(Hash) + hash_get_slots(h)*sizeof(HashBucket*) + name_len; } From 5f4b3cf6e97141ea2294439702203957a0d80975 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 4 Jun 2024 12:01:18 +0200 Subject: [PATCH 4/4] erts: Fail build if *.depend.mk files have compile errors Using pipe will lose the exit status of gcc gcc ... | sed ... > $@ Instead run sed separately gcc ... > $@.tmp sed $@.tmp > $@ We use a temporary file as sed option -i is not portable. --- erts/emulator/Makefile.in | 39 +++++++++++++++++++-------------------- 1 file changed, 19 insertions(+), 20 deletions(-) diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index e93f052d7520..f98301b6e709 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -1398,42 +1398,40 @@ DEPEND_DEPS=jit src drv nif sys target zlib ryu $(TTF_DIR)/src.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) $(BEAM_SRC) \ - | $(SED_DEPEND) > $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(BEAM_SRC) > $@.tmp + $(V_at)$(SED_DEPEND) $@.tmp > $@ $(TTF_DIR)/drv.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) -DLIBSCTP=$(LIBSCTP) $(DRV_COMMON_SRC) \ - | $(SED_DEPEND) > $@ - $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \ - | $(SED_DEPEND) >> $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) -DLIBSCTP=$(LIBSCTP) $(DRV_COMMON_SRC) > $@.tmp + $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) >> $@.tmp + $(V_at)$(SED_DEPEND) $@.tmp > $@ $(TTF_DIR)/nif.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) $(NIF_COMMON_SRC) \ - | $(SED_DEPEND) > $@ - $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(NIF_OSTYPE_SRC) \ - | $(SED_DEPEND) >> $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(NIF_COMMON_SRC) > $@.tmp + $(V_at)$(DEP_CC) $(DEP_FLAGS) -DLIBSCTP=$(LIBSCTP) -I../etc/$(ERLANG_OSTYPE) $(NIF_OSTYPE_SRC) >> $@.tmp + $(V_at)$(SED_DEPEND) $@.tmp > $@ $(TTF_DIR)/sys.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \ - | $(SED_DEPEND) > $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) > $@.tmp + $(V_at)$(SED_DEPEND) $@.tmp > $@ $(TTF_DIR)/target.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \ - | $(SED_DEPEND) > $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) > $@.tmp + $(V_at)$(SED_DEPEND) $@.tmp > $@ $(TTF_DIR)/zlib.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) $(ZLIB_SRC) \ - | $(SED_DEPEND_ZLIB) > $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(ZLIB_SRC) > $@.tmp + $(V_at)$(SED_DEPEND_ZLIB) $@.tmp > $@ $(TTF_DIR)/ryu.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) - $(V_at)$(DEP_CC) $(DEP_FLAGS) $(RYU_SRC) \ - | $(SED_DEPEND_ZLIB) > $@ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(RYU_SRC) > $@.tmp + $(V_at)$(SED_DEPEND_ZLIB) $@.tmp > $@ $(TTF_DIR)/jit.depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(gen_verbose) @touch $@ ifeq ($(JIT_ENABLED),yes) - $(V_at)$(DEP_CXX) $(DEP_CXXFLAGS) $(BEAM_CPP_SRC) \ - | $(SED_DEPEND) > $@ + $(V_at)$(DEP_CXX) $(DEP_CXXFLAGS) $(BEAM_CPP_SRC) > $@.tmp + $(V_at)$(SED_DEPEND) $@.tmp > $@ endif .PHONY: depend @@ -1444,6 +1442,7 @@ else depend: $(TTF_DIR)/depend.mk $(TTF_DIR)/depend.mk: $(foreach dep, $(DEPEND_DEPS), $(TTF_DIR)/$(dep).depend.mk) $(gen_verbose) + $(V_at)rm $(TTF_DIR)/*.tmp $(V_at)echo "" > "$@" $(V_at)for dep in "$^"; do cat $$dep >> "$@"; done $(V_at)cd $(ERTS_LIB_DIR) && $(MAKE) depend