From eb73f3225f6eb6151f2cffe356be0eb45a0ebced Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 31 Oct 2023 23:57:34 +0100 Subject: [PATCH] [erts] Fix long signal delivery time for processes in dirty run queues OTP-18841 Commit (1) changed so that signals sent to processes scheduled for dirty execution didn't trigger rescheduling of such processes to normal schedulers in order to handle signals, but instead rely on the dirty signal handler processes to take care of handling the signals for such processes. This since a steady flow of incoming signals to processes scheduled for dirty execution caused such processes to bounce between schedulers and could prevent them from making progress. The dirty signal handler processes did however not take care of the signals until the receiving processes were selected for execution. As a result of this, if a process got stuck for a long time in a dirty run queue due to heavy usage of dirty schedulers, it took a long time until signals were delivered to such processes. As of this commit, dirty signal handler processes will also take care of signal handling for processes in dirty run queues. (1) 53b19837b188fb2e222804089313edb334e00a1e --- erts/emulator/beam/beam_bif_load.c | 10 +---- erts/emulator/beam/bif.c | 5 +-- erts/emulator/beam/erl_proc_sig_queue.c | 27 +++--------- erts/emulator/beam/erl_proc_sig_queue.h | 16 ++----- erts/emulator/beam/erl_process.c | 57 +++++++++++++++---------- erts/emulator/beam/erl_process.h | 28 ++++++++++++ erts/emulator/test/signal_SUITE.erl | 29 +++++++++++++ erts/etc/unix/etp-commands.in | 4 +- 8 files changed, 108 insertions(+), 68 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 853ae05d3f01..a8d736b6ddf2 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -645,7 +645,7 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) { erts_aint32_t state; Process *rp; - int dirty, busy, reds = 0; + int busy, reds = 0; Eterm res; if (BIF_P != erts_dirty_process_signal_handler @@ -667,13 +667,7 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) BIF_RET(am_false); state = erts_atomic32_read_nob(&rp->state); - dirty = (state & ERTS_PSFLG_DIRTY_RUNNING); - /* - * Ignore ERTS_PSFLG_DIRTY_RUNNING_SYS (see - * comment in erts_execute_dirty_system_task() - * in erl_process.c). - */ - if (!dirty) + if (!ERTS_PROC_IN_DIRTY_STATE(state)) BIF_RET(am_normal); busy = erts_proc_trylock(rp, ERTS_PROC_LOCK_MAIN) == EBUSY; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 808b23090d4d..f4da01a9c6c5 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1703,9 +1703,7 @@ static Eterm process_flag_aux(Process *c_p, int *redsp, Eterm flag, Eterm val) */ state = erts_atomic32_read_nob(&c_p->state); - if (state & (ERTS_PSFLG_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING)) { + if (!(state & ERTS_PSFLG_RUNNING)) { /* * We are either processing signals before * being executed or executing dirty. That @@ -1714,7 +1712,6 @@ static Eterm process_flag_aux(Process *c_p, int *redsp, Eterm flag, Eterm val) *redsp = 1; } else { - ASSERT(state & ERTS_PSFLG_RUNNING); /* * F_DELAY_GC is currently only set when diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 44c9dfa5ab64..ce5103d021f9 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -811,7 +811,7 @@ notify_dirty_signal_handler(Eterm pid, ErtsMessage *mp; Process *sig_handler; - ASSERT(state & ERTS_PSFLG_DIRTY_RUNNING); + ASSERT(state & (ERTS_PSFLGS_DIRTY_WORK|ERTS_PSFLG_DIRTY_RUNNING)); if (prio < 0) prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state); @@ -851,13 +851,10 @@ delayed_notify_dirty_signal_handler(void *vdshnp) if (proc) { erts_aint32_t state = erts_atomic32_read_acqb(&proc->state); /* - * Notify the dirty signal handler if it is still running - * dirty and still have signals to handle... + * Notify the dirty signal handler if it is still scheduled + * or running dirty and still have signals to handle... */ - if (!!(state & ERTS_PSFLG_DIRTY_RUNNING) - & !!(state & (ERTS_PSFLG_SIG_Q - | ERTS_PSFLG_NMSG_SIG_IN_Q - | ERTS_PSFLG_MSG_SIG_IN_Q))) { + if (ERTS_PROC_NEED_DIRTY_SIG_HANDLING(state)) { notify_dirty_signal_handler(dshnp->pid, state, dshnp->prio); } } @@ -1141,12 +1138,7 @@ maybe_elevate_sig_handling_prio(Process *c_p, int prio, Eterm other) if (res) { /* ensure handled if dirty executing... */ state = erts_atomic32_read_nob(&rp->state); - /* - * We ignore ERTS_PSFLG_DIRTY_RUNNING_SYS. For - * more info see erts_execute_dirty_system_task() - * in erl_process.c. - */ - if (state & ERTS_PSFLG_DIRTY_RUNNING) + if (ERTS_PROC_NEED_DIRTY_SIG_HANDLING(state)) erts_ensure_dirty_proc_signals_handled(rp, state, min_prio, 0); } @@ -8192,12 +8184,7 @@ erts_internal_dirty_process_handle_signals_1(BIF_ALIST_1) BIF_RET(am_noproc); state = erts_atomic32_read_acqb(&rp->state); - dirty = (state & ERTS_PSFLG_DIRTY_RUNNING); - /* - * Ignore ERTS_PSFLG_DIRTY_RUNNING_SYS (see - * comment in erts_execute_dirty_system_task() - * in erl_process.c). - */ + dirty = ERTS_PROC_IN_DIRTY_STATE(state); if (!dirty) BIF_RET(am_normal); @@ -8211,7 +8198,7 @@ erts_internal_dirty_process_handle_signals_1(BIF_ALIST_1) state = erts_atomic32_read_mb(&rp->state); noproc = (state & ERTS_PSFLG_FREE); - dirty = (state & ERTS_PSFLG_DIRTY_RUNNING); + dirty = ERTS_PROC_NEED_DIRTY_SIG_HANDLING(state); if (busy) { if (noproc) diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h index 663d42d59fad..e4cf50ca0776 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.h +++ b/erts/emulator/beam/erl_proc_sig_queue.h @@ -1919,16 +1919,13 @@ erts_proc_notify_new_sig(Process* rp, erts_aint32_t state, state = erts_proc_sys_schedule(rp, state, enable_flag); } - if (state & ERTS_PSFLG_DIRTY_RUNNING) { - /* - * We ignore ERTS_PSFLG_DIRTY_RUNNING_SYS. For - * more info see erts_execute_dirty_system_task() - * in erl_process.c. - */ + if (ERTS_PROC_IN_DIRTY_STATE(state)) { erts_ensure_dirty_proc_signals_handled(rp, state, -1, 0); } } + + ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) { @@ -1936,12 +1933,7 @@ erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) erts_aint32_t state = erts_atomic32_read_nob(&p->state); if (!(state & ERTS_PSFLG_ACTIVE)) erts_schedule_process(p, state, locks); - if (state & ERTS_PSFLG_DIRTY_RUNNING) { - /* - * We ignore ERTS_PSFLG_DIRTY_RUNNING_SYS. For - * more info see erts_execute_dirty_system_task() - * in erl_process.c. - */ + if (ERTS_PROC_NEED_DIRTY_SIG_HANDLING(state)) { erts_ensure_dirty_proc_signals_handled(p, state, -1, locks); } } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 08f670836406..49723d64e8a0 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -6588,19 +6588,19 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st * reference count on the process when done with it... */ static ERTS_INLINE int -schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, +schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t *statep, Process *p, Process *proxy, int is_normal_sched) { erts_aint32_t a, e, n, enq_prio = -1, running_flgs; int enqueue; /* < 0 -> use proxy */ ErtsRunQueue* runq; - ASSERT(!(state & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_CPU_PROC)) + a = *statep; + + ASSERT(!(a & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_CPU_PROC)) || (BeamIsOpCode(*(const BeamInstr*)p->i, op_call_nif_WWW) || BeamIsOpCode(*(const BeamInstr*)p->i, op_call_bif_W))); - a = state; - /* Clear activ-sys if needed... */ while (1) { n = e = a; @@ -6667,6 +6667,8 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, break; } + *statep = n; + runq = select_enqueue_run_queue(enqueue, enq_prio, p, n); if (!runq) { @@ -7117,10 +7119,13 @@ suspend_process(Process *c_p, Process *p) if (c_p == p) { state = erts_atomic32_read_bor_relb(&p->state, ERTS_PSFLG_SUSPENDED); - ASSERT(state & (ERTS_PSFLG_RUNNING - | ERTS_PSFLG_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)); + ASSERT((state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) + || ((ERTS_PROC_LOCK_MAIN + & erts_proc_lc_my_proc_locks(p)) + && (c_p->sig_qs.flags | FS_HANDLING_SIGS))); suspended = (state & ERTS_PSFLG_SUSPENDED) ? -1: 1; } else { @@ -9218,8 +9223,13 @@ void erts_suspend(Process* c_p, ErtsProcLocks c_p_locks, Port *busy_port) { int suspend; - - ASSERT(c_p == erts_get_current_process()); +#ifdef DEBUG + Process *curr_proc = erts_get_current_process(); + ASSERT(curr_proc == c_p + || curr_proc == erts_dirty_process_signal_handler + || curr_proc == erts_dirty_process_signal_handler_high + || curr_proc == erts_dirty_process_signal_handler_max); +#endif ERTS_LC_ASSERT(c_p_locks == erts_proc_lc_my_proc_locks(c_p)); if (!(c_p_locks & ERTS_PROC_LOCK_STATUS)) erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); @@ -9585,7 +9595,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) int dec_refc; /* schedule_out_process() returns with rq locked! */ - dec_refc = schedule_out_process(rq, state, p, + dec_refc = schedule_out_process(rq, &state, p, proxy_p, is_normal_sched); proxy_p = NULL; @@ -9602,6 +9612,20 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PROC_LOCK_STATUS | ERTS_PROC_LOCK_TRACE)); + if (ERTS_PROC_NEED_DIRTY_SIG_HANDLING(state)) { + /* + * Ensure signals are handled while scheduled + * or running dirty... + */ + int prio = ERTS_PSFLGS_GET_ACT_PRIO(state); + erts_runq_unlock(rq); + erts_ensure_dirty_proc_signals_handled(p, + state, + prio, + ERTS_PROC_LOCK_MAIN); + erts_runq_lock(rq); + } + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); if (state & ERTS_PSFLG_FREE) { @@ -10122,17 +10146,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!is_normal_sched) { /* On dirty scheduler */ - if (!!(state & ERTS_PSFLG_DIRTY_RUNNING) - & !!(state & (ERTS_PSFLG_SIG_Q - | ERTS_PSFLG_NMSG_SIG_IN_Q - | ERTS_PSFLG_MSG_SIG_IN_Q))) { - /* Ensure signals are handled while executing dirty... */ - int prio = ERTS_PSFLGS_GET_ACT_PRIO(state); - erts_ensure_dirty_proc_signals_handled(p, - state, - prio, - ERTS_PROC_LOCK_MAIN); - } } else { /* On normal scheduler */ diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 2f145fd5a06a..5e8e345148ff 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1314,6 +1314,34 @@ void erts_check_for_holes(Process* p); | ERTS_PSFLG_DIRTY_RUNNING \ | ERTS_PSFLG_DIRTY_RUNNING_SYS) +/* + * Process is in a dirty state if it got dirty work scheduled or + * is running dirty. We do not include the dirty-running-sys state + * since it executing while holding the main process lock which makes + * it hard or impossible to manipulate from the outside. The time spent + * in the dirty-running-sys is also limited compared to the other dirty + * states. + * + * For more info on why we ignore dirty running sys see + * erts_execute_dirty_system_task() in erl_process.c. + */ +#define ERTS_PROC_IN_DIRTY_STATE(S) \ + ((!!((S) & (ERTS_PSFLGS_DIRTY_WORK \ + | ERTS_PSFLG_DIRTY_RUNNING))) \ + & (!((S) & (ERTS_PSFLG_DIRTY_RUNNING_SYS \ + | ERTS_PSFLG_RUNNING_SYS \ + | ERTS_PSFLG_RUNNING)))) + +/* + * A process needs dirty signal handling if it has unhandled signals + * and is in a dirty state... + */ +#define ERTS_PROC_NEED_DIRTY_SIG_HANDLING(S) \ + ((!!((S) & (ERTS_PSFLG_SIG_Q \ + | ERTS_PSFLG_NMSG_SIG_IN_Q \ + | ERTS_PSFLG_MSG_SIG_IN_Q))) \ + & ERTS_PROC_IN_DIRTY_STATE((S))) + #define ERTS_PSFLGS_GET_ACT_PRIO(PSFLGS) \ (((PSFLGS) >> ERTS_PSFLGS_ACT_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) #define ERTS_PSFLGS_GET_USR_PRIO(PSFLGS) \ diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index c22296eae745..0ca6623261c8 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -39,6 +39,7 @@ kill2killed/1, contended_signal_handling/1, dirty_signal_handling_race/1, + dirty_signal_handling/1, busy_dist_exit_signal/1, busy_dist_demonitor_signal/1, busy_dist_down_signal/1, @@ -91,6 +92,7 @@ all() -> kill2killed, contended_signal_handling, dirty_signal_handling_race, + dirty_signal_handling, busy_dist_exit_signal, busy_dist_demonitor_signal, busy_dist_down_signal, @@ -388,6 +390,33 @@ move_dirty_signal_handlers_to_first_scheduler() -> end, ok. +dirty_signal_handling(Config) when is_list(Config) -> + %% + %% PR-7822 (third commit) + %% + %% Make sure signals are handled regardless of whether a process is + %% executing dirty or is scheduled for dirty execution... + + %% Make sure all dirty I/O schedulers are occupied with work... + Ps = lists:map(fun (_) -> + spawn(fun () -> + erts_debug:dirty_io(wait, 1000) + end) + end, lists:seq(1, erlang:system_info(dirty_io_schedulers))), + %% P ends up in the run queue waiting for a free dirty I/O scheduler... + P = spawn(fun () -> + erts_debug:dirty_io(wait, 1000) + end), + receive after 300 -> ok end, + %% current_function is added to prevent read of status from being optimized + %% to read status directly... + [{status,runnable},{current_function, _}] = process_info(P, [status,current_function]), + receive after 1000 -> ok end, + [{status,running},{current_function, _}] = process_info(P, [status,current_function]), + lists:foreach(fun (X) -> exit(X, kill) end, [P|Ps]), + lists:foreach(fun (X) -> false = is_process_alive(X) end, [P|Ps]), + ok. + busy_dist_exit_signal(Config) when is_list(Config) -> ct:timetrap({seconds, 10}), diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 0e764c24307b..05d1a46b64ce 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -2474,7 +2474,7 @@ define etp-proc-state-int printf "active-sys | " end if ($arg0 & 0x80000) - printf "sig-in-q | " + printf "nmsig-in-q | " end if ($arg0 & 0x40000) printf "sys-tasks | " @@ -2495,7 +2495,7 @@ define etp-proc-state-int printf "active | " end if ($arg0 & 0x1000) - printf "maybe-self-sigs | " + printf "msig-in-q | " end if ($arg0 & 0x800) printf "exiting | "