diff --git a/erts/doc/references/erl_nif.md b/erts/doc/references/erl_nif.md index 081fce3fa218..ca8ae3af3a7d 100644 --- a/erts/doc/references/erl_nif.md +++ b/erts/doc/references/erl_nif.md @@ -617,13 +617,8 @@ calling NIF API functions. Functions exist for the following functionality: scheduler thread. If the dirty NIF is expected to be CPU-bound, its `flags` field is to be set - to `ERL_NIF_DIRTY_JOB_CPU_BOUND` or `ERL_NIF_DIRTY_JOB_IO_BOUND`. - - > #### Note {: .info } - > - > If one of the `ERL_NIF_DIRTY_JOB_*_BOUND` flags is set, and the runtime - > system has no support for dirty schedulers, the runtime system refuses to - > load the NIF library. + to `ERL_NIF_DIRTY_JOB_CPU_BOUND`. If it's expected to be I/O-bound set + `flags` to `ERL_NIF_DIRTY_JOB_IO_BOUND`. - **`ErlNifBinary`**{: #ErlNifBinary } @@ -3227,12 +3222,9 @@ long-running work into multiple regular NIF calls or to schedule a If it cannot be converted to an atom, `enif_schedule_nif` returns a `badarg` exception. -- **`flags`** - Must be set to `0` for a regular NIF. If the emulator was built - with dirty scheduler support enabled, `flags` can be set to either +- **`flags`** - Must be set to `0` for a regular NIF, `ERL_NIF_DIRTY_JOB_CPU_BOUND` if the job is expected to be CPU-bound, or - `ERL_NIF_DIRTY_JOB_IO_BOUND` for jobs that will be I/O-bound. If dirty - scheduler threads are not available in the emulator, an attempt to schedule - such a job results in a `notsup` exception. + `ERL_NIF_DIRTY_JOB_IO_BOUND` for jobs that will be I/O-bound. - **`argc` and `argv`** - Can either be the originals passed into the calling NIF, or can be values created by the calling NIF. diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 4ae9aa59f207..71949f82876c 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -63,8 +63,6 @@ #define ERTS_BPF_ALL 0x3FF -erts_atomic32_t erts_active_bp_index; -erts_atomic32_t erts_staging_bp_index; erts_mtx_t erts_dirty_bp_ix_mtx; ErtsTraceSession* erts_staging_trace_session; diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index f5af81023577..bdc2cd13c91c 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -80,8 +80,6 @@ typedef struct GenericBpData { BpDataCallTrace* memory; /* For memory trace */ } GenericBpData; -#define ERTS_NUM_BP_IX 2 - typedef struct GenericBp { BeamInstr orig_instr; GenericBpData data[ERTS_NUM_BP_IX]; @@ -108,8 +106,6 @@ enum erts_break_op{ ERTS_BREAK_PAUSE }; -typedef Uint32 ErtsBpIndex; - typedef struct { const ErtsCodeInfo *code_info; Module* mod; @@ -195,9 +191,6 @@ const ErtsCodeInfo *erts_find_local_func(const ErtsCodeMFA *mfa); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -extern erts_atomic32_t erts_active_bp_index; -extern erts_atomic32_t erts_staging_bp_index; - ERTS_GLB_INLINE ErtsBpIndex erts_active_bp_ix(void) { return erts_atomic32_read_nob(&erts_active_bp_index); diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 798a7418d749..41998c51e17f 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -262,10 +262,6 @@ bif erlang:make_tuple/3 bif erlang:system_flag/2 bif erlang:system_info/1 -# New in R9C -bif erlang:system_monitor/0 -bif erlang:system_monitor/1 -bif erlang:system_monitor/2 # Added 2006-11-07 bif erlang:system_profile/2 # End Added 2006-11-07 @@ -805,3 +801,9 @@ bif erts_internal:trace_pattern/4 bif erts_internal:trace_info/3 bif erts_trace_cleaner:check/0 bif erts_trace_cleaner:send_trace_clean_signal/1 + +# +# New in 28 +# +bif erts_internal:system_monitor/1 +bif erts_internal:system_monitor/3 diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 920fa81f70b7..f179061d5640 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -3610,8 +3610,8 @@ erts_dsig_send(ErtsDSigSendContext *ctx) if (ctx->fragments) { ctx->c_p->flags |= F_FRAGMENTED_SEND; retval = ERTS_DSIG_SEND_CONTINUE; - if (!resume && erts_system_monitor_flags.busy_dist_port) - monitor_generic(ctx->c_p, am_busy_dist_port, cid); + if (!resume && erts_system_monitor_busy_dist_port_cnt) + monitor_busy_dist_port(ctx->c_p, cid); goto done; } } @@ -3635,8 +3635,9 @@ erts_dsig_send(ErtsDSigSendContext *ctx) port_str, remote_str, pid_str); } #endif - if (!resume && erts_system_monitor_flags.busy_dist_port) - monitor_generic(ctx->c_p, am_busy_dist_port, cid); + if (!resume && erts_system_monitor_busy_dist_port_cnt) { + monitor_busy_dist_port(ctx->c_p, cid); + } retval = ERTS_DSIG_SEND_YIELD; } else { retval = ERTS_DSIG_SEND_OK; diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 9f9d4e5f8f87..a7614403155e 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -26,6 +26,8 @@ # include "config.h" #endif +#include + #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -74,7 +76,7 @@ static int stage_trace_event_pattern(Eterm event, Binary*, int on); static void smp_bp_finisher(void* arg); static BIF_RETTYPE -system_monitor(Process *p, Eterm monitor_pid, Eterm list); +system_monitor(Process *p, ErtsTraceSession*, Eterm monitor_pid, Eterm list); static Eterm trace_session_create(Process*, Eterm name, Eterm tracer_term, Eterm opts); static void trace_session_destroy_aux(void *session_v); static void trace_session_destroy(ErtsTraceSession*); @@ -94,12 +96,16 @@ static Eterm trace_info_on_load(Process* p, ErtsTraceSession*, Eterm key); static Eterm trace_info_sessions(Process* p, Eterm What, Eterm key); static Eterm trace_info_event(Process* p, ErtsTraceSession*, Eterm event, Eterm key); +static Eterm trace_info_system(Process* p, ErtsTraceSession*); static void clear_event_trace(ErtsTracingEvent *et); static void set_event_trace(ErtsTracingEvent *et, Binary* match_spec); static void install_exp_breakpoints(BpFunctions* f); static void uninstall_exp_breakpoints(BpFunctions* f); static void clean_export_entries(BpFunctions* f); +static Eterm system_monitor_get(ErtsTraceSession*, Process*); +static Eterm system_monitor_make_list(Process*, ErtsTraceSession*, Eterm** hpp, Uint extra); +static void update_sysmon_globals(ErtsTraceSession*, struct system_monitor_session*); ErtsTraceSession erts_trace_session_0; erts_rwmtx_t erts_trace_session_list_lock; @@ -142,6 +148,15 @@ int erts_trace_session_init(ErtsTraceSession* s, ErtsTracer tracer, s->tracer = tracer; s->name_atom = name_atom; erts_atomic_init_nob(&s->state, ERTS_TRACE_SESSION_ALIVE); + + s->system_monitor.receiver = NIL; + for (int i = 0; i < ERTS_SYSMON_LIMIT_CNT; i++) { + s->system_monitor.limits[i] = 0; + } + s->system_monitor.flags.busy_port = false; + s->system_monitor.flags.busy_dist_port = false; + s->system_monitor.long_msgq_off = -1; + #ifdef DEBUG erts_refc_init(&s->dbg_bp_refc, 0); erts_refc_init(&s->dbg_p_refc, 0); @@ -174,7 +189,7 @@ int erts_trace_session_init(ErtsTraceSession* s, ErtsTracer tracer, * Does refc++ on returned trace session. */ static int term_to_session(Eterm term, ErtsTraceSession **session_p, - int allow_dead) + bool allow_dead) { ErtsTraceSession *s = NULL; Binary *bin; @@ -286,7 +301,7 @@ erts_internal_trace_pattern_4(BIF_ALIST_4) { ErtsTraceSession* session; - if (!term_to_session(BIF_ARG_1, &session, 0)) { + if (!term_to_session(BIF_ARG_1, &session, false)) { goto session_error; } @@ -881,7 +896,7 @@ Eterm erts_internal_trace_4(BIF_ALIST_4) ErtsTraceSession* session; Eterm ret; - if (!term_to_session(BIF_ARG_1, &session, 0)) { + if (!term_to_session(BIF_ARG_1, &session, false)) { goto session_error; } if (!erts_try_seize_code_mod_permission(BIF_P)) { @@ -1268,7 +1283,7 @@ Eterm erts_internal_trace_session_destroy_1(BIF_ALIST_1) { ErtsTraceSession* session; - if (!term_to_session(BIF_ARG_1, &session, 1)) { + if (!term_to_session(BIF_ARG_1, &session, true)) { BIF_P->fvalue = am_badopt; BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO); } @@ -1392,7 +1407,7 @@ Eterm erts_internal_trace_info_3(BIF_ALIST_3) /* trace:session_info */ session = NULL; } - else if (!term_to_session(BIF_ARG_1, &session, 0)) { + else if (!term_to_session(BIF_ARG_1, &session, true)) { goto session_error; } @@ -1433,6 +1448,8 @@ Eterm trace_info(Process* p, ErtsTraceSession* session, Eterm What, Eterm Key) res = trace_info_on_load(p, session, Key); } else if (What == am_send || What == am_receive) { res = trace_info_event(p, session, What, Key); + } else if (What == am_system && Key == am_all) { + res = trace_info_system(p, session); } else if (is_atom(What) || is_pid(What) || is_port(What)) { res = trace_info_pid(p, session, What, Key); } else if (is_tuple(What)) { @@ -2277,6 +2294,15 @@ trace_info_event(Process* p, ErtsTraceSession* session, Eterm event, Eterm key) BIF_ERROR(p, BADARG); } +static Eterm +trace_info_system(Process* p, ErtsTraceSession* session) +{ + Eterm *hp; + Eterm list; + + list = system_monitor_make_list(p, session, &hp, 3); + return TUPLE2(hp, am_system, list); +} #undef FUNC_TRACE_NOEXIST #undef FUNC_TRACE_UNTRACED @@ -3023,211 +3049,441 @@ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) BIF_RET(am_true); } -void erts_system_monitor_clear(Process *c_p) { - if (c_p) { - erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); - erts_thr_progress_block(); - } - erts_set_system_monitor(NIL); - erts_system_monitor_long_gc = 0; - erts_system_monitor_long_schedule = 0; - erts_system_monitor_large_heap = 0; - erts_system_monitor_flags.busy_port = 0; - erts_system_monitor_flags.busy_dist_port = 0; - erts_system_monitor_long_msgq_on = ERTS_SWORD_MAX; - erts_system_monitor_long_msgq_off = -1; - if (c_p) { - erts_thr_progress_unblock(); - erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); +void erts_system_monitor_clear(ErtsTraceSession *session) +{ + struct system_monitor_session prev = session->system_monitor; + + erts_set_system_monitor(session, NIL); + for (int i = 0; i < ERTS_SYSMON_LIMIT_CNT; i++) { + session->system_monitor.limits[i] = 0; } -} + session->system_monitor.flags.busy_port = false; + session->system_monitor.flags.busy_dist_port = false; + session->system_monitor.long_msgq_off = -1; + update_sysmon_globals(session, &prev); +} -static Eterm system_monitor_get(Process *p) +static Eterm system_monitor_get(ErtsTraceSession *session, Process *p) { Eterm *hp; - Eterm system_monitor = erts_get_system_monitor(); + Eterm res; + Eterm system_monitor = erts_get_system_monitor(session); if (system_monitor == NIL) { return am_undefined; - } else { - Eterm res; - Uint hsz = 3 + (erts_system_monitor_flags.busy_dist_port ? 2 : 0) + - (erts_system_monitor_flags.busy_port ? 2 : 0); - Eterm long_gc = NIL; - Eterm long_schedule = NIL; - Eterm large_heap = NIL; - Eterm long_msgq_off = NIL; - Eterm long_msgq_on = NIL; - - if (erts_system_monitor_long_msgq_off >= 0) { - ASSERT(erts_system_monitor_long_msgq_on - > erts_system_monitor_long_msgq_off); - hsz += 2+3+3; - (void) erts_bld_uint(NULL, &hsz, - (Sint) erts_system_monitor_long_msgq_off); - (void) erts_bld_uint(NULL, &hsz, - (Sint) erts_system_monitor_long_msgq_on); - } - if (erts_system_monitor_long_gc != 0) { - hsz += 2+3; - (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_gc); - } - if (erts_system_monitor_long_schedule != 0) { - hsz += 2+3; - (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_schedule); - } - if (erts_system_monitor_large_heap != 0) { - hsz += 2+3; - (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_large_heap); - } + } - hp = HAlloc(p, hsz); - if (erts_system_monitor_long_msgq_off >= 0) { - long_msgq_off = erts_bld_uint(&hp, NULL, - (Sint) erts_system_monitor_long_msgq_off); - long_msgq_on = erts_bld_uint(&hp, NULL, - (Sint) erts_system_monitor_long_msgq_on); + res = system_monitor_make_list(p, session, &hp, 3); + + return TUPLE2(hp, system_monitor, res); +} + +static Eterm system_monitor_make_list(Process *p, ErtsTraceSession *session, + Eterm** hpp, Uint extra) +{ + Uint hsz = ((session->system_monitor.flags.busy_dist_port ? 2 : 0) + + (session->system_monitor.flags.busy_port ? 2 : 0)); + Eterm long_gc = NIL; + Eterm long_schedule = NIL; + Eterm large_heap = NIL; + Eterm long_msgq_off = NIL; + Eterm long_msgq_on = NIL; + Eterm res; + Eterm *hp; +#ifdef DEBUG + Eterm *hp_end; +#endif + + if (session->system_monitor.long_msgq_off >= 0) { + ASSERT(session->system_monitor.limits[ERTS_SYSMON_LONG_MSGQ] + > (Uint)session->system_monitor.long_msgq_off); + hsz += 2+3+3; + (void) erts_bld_uint(NULL, &hsz, + (Uint) session->system_monitor.long_msgq_off); + (void) erts_bld_uint(NULL, &hsz, + session->system_monitor.limits[ERTS_SYSMON_LONG_MSGQ]); + } + if (session->system_monitor.limits[ERTS_SYSMON_LONG_GC] != 0) { + hsz += 2+3; + erts_bld_uint(NULL, &hsz, session->system_monitor.limits[ERTS_SYSMON_LONG_GC]); + } + if (session->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE] != 0) { + hsz += 2+3; + erts_bld_uint(NULL, &hsz, session->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE]); + } + if (session->system_monitor.limits[ERTS_SYSMON_LARGE_HEAP] != 0) { + hsz += 2+3; + erts_bld_uint(NULL, &hsz, session->system_monitor.limits[ERTS_SYSMON_LARGE_HEAP]); + } + + hp = HAlloc(p, hsz + extra); +#ifdef DEBUG + hp_end = hp + hsz; +#endif + if (session->system_monitor.long_msgq_off >= 0) { + long_msgq_off = erts_bld_uint(&hp, NULL, + session->system_monitor.long_msgq_off); + long_msgq_on = erts_bld_uint(&hp, NULL, + session->system_monitor.limits[ERTS_SYSMON_LONG_MSGQ]); + } + if (session->system_monitor.limits[ERTS_SYSMON_LONG_GC] != 0) { + long_gc = erts_bld_uint(&hp, NULL, session->system_monitor.limits[ERTS_SYSMON_LONG_GC]); + } + if (session->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE] != 0) { + long_schedule = erts_bld_uint(&hp, NULL, session->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE]); + } + if (session->system_monitor.limits[ERTS_SYSMON_LARGE_HEAP] != 0) { + large_heap = erts_bld_uint(&hp, NULL, session->system_monitor.limits[ERTS_SYSMON_LARGE_HEAP]); + } + res = NIL; + if (long_msgq_off != NIL) { + Eterm t; + ASSERT(long_msgq_on != NIL); + t = TUPLE2(hp, long_msgq_off, long_msgq_on); hp += 3; + t = TUPLE2(hp, am_long_message_queue, t); hp += 3; + res = CONS(hp, t, res); hp += 2; + } + if (long_gc != NIL) { + Eterm t = TUPLE2(hp, am_long_gc, long_gc); hp += 3; + res = CONS(hp, t, res); hp += 2; + } + if (long_schedule != NIL) { + Eterm t = TUPLE2(hp, am_long_schedule, long_schedule); hp += 3; + res = CONS(hp, t, res); hp += 2; + } + if (large_heap != NIL) { + Eterm t = TUPLE2(hp, am_large_heap, large_heap); hp += 3; + res = CONS(hp, t, res); hp += 2; + } + if (session->system_monitor.flags.busy_port) { + res = CONS(hp, am_busy_port, res); hp += 2; + } + if (session->system_monitor.flags.busy_dist_port) { + res = CONS(hp, am_busy_dist_port, res); hp += 2; + } + ASSERT(hp == hp_end); + *hpp = hp; + return res; +} + + +/* + * Backend for erlang:system_monitor/0 + * but also called directly by tests with undocumented tracer-less sesssions. +*/ +BIF_RETTYPE erts_internal_system_monitor_1(BIF_ALIST_1) +{ + ErtsTraceSession *session; + Eterm res; + + if (BIF_ARG_1 == am_legacy) { + session = &erts_trace_session_0; + } + else if (!term_to_session(BIF_ARG_1, &session, false)) { + BIF_ERROR(BIF_P, BADARG); + } + res = system_monitor_get(session, BIF_P); + erts_deref_trace_session(session); + BIF_RET(res); +} + +/* + * Backend for erlang:system_monitor/1,2 + * and trace:system/3 + * but also called directly by tests with undocumented tracer-less sesssions. +*/ +BIF_RETTYPE erts_internal_system_monitor_3(BIF_ALIST_3) +{ + ErtsTraceSession *session; + Eterm res; + + if (BIF_ARG_1 == am_legacy) { + session = &erts_trace_session_0; + } + else if (!term_to_session(BIF_ARG_1, &session, false)) { + BIF_ERROR(BIF_P, BADARG); + } + + res = system_monitor(BIF_P, session, BIF_ARG_2, BIF_ARG_3); + + erts_deref_trace_session(session); + return res; +} + +static Sint calc_sysmon_global_msgq_off_max(void) +{ + Sint max_limit = -1; + + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (s->system_monitor.long_msgq_off > max_limit) { + max_limit = s->system_monitor.long_msgq_off; } - if (erts_system_monitor_long_gc != 0) { - long_gc = erts_bld_uint(&hp, NULL, erts_system_monitor_long_gc); - } - if (erts_system_monitor_long_schedule != 0) { - long_schedule = erts_bld_uint(&hp, NULL, - erts_system_monitor_long_schedule); - } - if (erts_system_monitor_large_heap != 0) { - large_heap = erts_bld_uint(&hp, NULL, erts_system_monitor_large_heap); - } - res = NIL; - if (long_msgq_off != NIL) { - Eterm t; - ASSERT(long_msgq_on != NIL); - t = TUPLE2(hp, long_msgq_off, long_msgq_on); hp += 3; - t = TUPLE2(hp, am_long_message_queue, t); hp += 3; - res = CONS(hp, t, res); hp += 2; + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); + return max_limit; +} + +static Uint calc_sysmon_global_limit(Uint limit_ix) +{ + ErtsTraceSession *s; + Uint min_limit = 0; + + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (s = &erts_trace_session_0; s; s = s->next) { + if (s->system_monitor.limits[limit_ix]-1 < min_limit-1) { + min_limit = s->system_monitor.limits[limit_ix]; } - if (long_gc != NIL) { - Eterm t = TUPLE2(hp, am_long_gc, long_gc); hp += 3; - res = CONS(hp, t, res); hp += 2; - } - if (long_schedule != NIL) { - Eterm t = TUPLE2(hp, am_long_schedule, long_schedule); hp += 3; - res = CONS(hp, t, res); hp += 2; - } - if (large_heap != NIL) { - Eterm t = TUPLE2(hp, am_large_heap, large_heap); hp += 3; - res = CONS(hp, t, res); hp += 2; - } - if (erts_system_monitor_flags.busy_port) { - res = CONS(hp, am_busy_port, res); hp += 2; - } - if (erts_system_monitor_flags.busy_dist_port) { - res = CONS(hp, am_busy_dist_port, res); hp += 2; - } - return TUPLE2(hp, system_monitor, res); } + erts_rwmtx_runlock(&erts_trace_session_list_lock); + return min_limit; } +static void +set_sysmon_global_limit(Uint *global_limit, ErtsTraceSession *session, + Uint limit_ix) +{ + const Uint new_limit = session->system_monitor.limits[limit_ix]; -BIF_RETTYPE system_monitor_0(BIF_ALIST_0) + ASSERT(limit_ix < ERTS_SYSMON_LIMIT_CNT); + + /* Trick: Do -1 with underflow to compare 0 (off) as UINT_MAX */ + + if (new_limit - 1 < *global_limit - 1) { + /* Enable or lower limit */ + *global_limit = new_limit; + ASSERT(*global_limit == calc_sysmon_global_limit(limit_ix)); + } + else if (new_limit != *global_limit) { + *global_limit = calc_sysmon_global_limit(limit_ix); + } + else { + ASSERT(*global_limit == calc_sysmon_global_limit(limit_ix)); + } +} + +static void set_sysmon_global_enabled_cnt(bool was_enabled, bool is_enabled, + Sint *counter_p) { - BIF_RET(system_monitor_get(BIF_P)); + if (was_enabled != is_enabled) { + if (is_enabled) { + (*counter_p)++; + } + else { + ASSERT(was_enabled); + ASSERT(*counter_p > 0); + (*counter_p)--; + } + } } -BIF_RETTYPE system_monitor_1(BIF_ALIST_1) +static void update_sysmon_globals(ErtsTraceSession *s, + struct system_monitor_session* prev) { - Process* p = BIF_P; - Eterm spec = BIF_ARG_1; + ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); - if (spec == am_undefined) { - BIF_RET(system_monitor(p, spec, NIL)); - } else if (is_tuple(spec)) { - Eterm *tp = tuple_val(spec); - if (tp[0] != make_arityval(2)) goto error; - BIF_RET(system_monitor(p, tp[1], tp[2])); + set_sysmon_global_limit(&erts_system_monitor_long_gc, s, + ERTS_SYSMON_LONG_GC); + set_sysmon_global_limit(&erts_system_monitor_long_schedule, s, + ERTS_SYSMON_LONG_SCHEDULE); + set_sysmon_global_limit(&erts_system_monitor_large_heap, s, + ERTS_SYSMON_LARGE_HEAP); + set_sysmon_global_limit(&erts_system_monitor_long_msgq_on, s, + ERTS_SYSMON_LONG_MSGQ); + + if (s->system_monitor.long_msgq_off > erts_system_monitor_long_msgq_off) { + erts_system_monitor_long_msgq_off = s->system_monitor.long_msgq_off; + ASSERT(erts_system_monitor_long_msgq_off == calc_sysmon_global_msgq_off_max()); } - error: - BIF_ERROR(p, BADARG); + else if (s->system_monitor.long_msgq_off != erts_system_monitor_long_msgq_off) { + erts_system_monitor_long_msgq_off = calc_sysmon_global_msgq_off_max(); + } + else { + ASSERT(erts_system_monitor_long_msgq_off == calc_sysmon_global_msgq_off_max()); + } + + set_sysmon_global_enabled_cnt(prev->flags.busy_port, + s->system_monitor.flags.busy_port, + &erts_system_monitor_busy_port_cnt); + set_sysmon_global_enabled_cnt(prev->flags.busy_dist_port, + s->system_monitor.flags.busy_dist_port, + &erts_system_monitor_busy_dist_port_cnt); +#ifdef DEBUG + { + Sint busy_port_cnt = 0, busy_dist_port_cnt = 0; + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (s = &erts_trace_session_0; s; s = s->next) { + if (s->system_monitor.flags.busy_port) busy_port_cnt++; + if (s->system_monitor.flags.busy_dist_port) busy_dist_port_cnt++; + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); + ASSERT(busy_port_cnt == erts_system_monitor_busy_port_cnt); + ASSERT(busy_dist_port_cnt == erts_system_monitor_busy_dist_port_cnt); + } +#endif +} + +static bool term_to_limit(Eterm term, Uint *limit_p, Uint min_limit) +{ + if (term == am_false) { + *limit_p = 0; + return true; + } + if (term_to_Uint(term, limit_p)) { + if (*limit_p < min_limit) *limit_p = min_limit; + return true; + } + return false; } -BIF_RETTYPE system_monitor_2(BIF_ALIST_2) +static bool term_to_boolean(Eterm term, bool *bool_p) { - return system_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2); + switch (term) { + case am_true: *bool_p = true; return true; + case am_false: *bool_p = false; return true; + } + return false; } + static BIF_RETTYPE -system_monitor(Process *p, Eterm monitor_pid, Eterm list) +system_monitor(Process *p, ErtsTraceSession *session, + Eterm monitor_pid, Eterm list) { - Eterm prev; - int system_blocked = 0; + Eterm return_term; + bool system_blocked = false; - if (monitor_pid == am_undefined || list == NIL) { - prev = system_monitor_get(p); - erts_system_monitor_clear(p); - BIF_RET(prev); - } - if (is_not_list(list)) goto error; + if (is_not_list(list) && is_not_nil(list)) goto error; else { - Uint long_gc, long_schedule, large_heap; - Sint long_msgq_on, long_msgq_off; - int busy_port, busy_dist_port; + struct system_monitor_session prev; + struct system_monitor_session want; - system_blocked = 1; + if (!ERTS_TRACER_IS_NIL(session->tracer) + && !is_internal_pid(session->tracer)) { + /* ToDo: Should we support ports and NIFs for system_monitor? */ + goto error; + } + + system_blocked = true; erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN); erts_thr_progress_block(); - erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); - if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0)) - goto error; + prev = session->system_monitor; - for (long_gc = 0, long_schedule = 0, large_heap = 0, - busy_port = 0, busy_dist_port = 0, - long_msgq_on = ERTS_SWORD_MAX, long_msgq_off = -1; - is_list(list); - list = CDR(list_val(list))) { - Eterm t = CAR(list_val(list)); - if (is_tuple(t)) { - Eterm *tp = tuple_val(t); - if (arityval(tp[0]) != 2) goto error; - if (tp[1] == am_long_gc) { - if (! term_to_Uint(tp[2], &long_gc)) goto error; - if (long_gc < 1) long_gc = 1; - } else if (tp[1] == am_long_schedule) { - if (! term_to_Uint(tp[2], &long_schedule)) goto error; - if (long_schedule < 1) long_schedule = 1; - } else if (tp[1] == am_large_heap) { - if (! term_to_Uint(tp[2], &large_heap)) goto error; - if (large_heap < 16384) large_heap = 16384; - /* 16 Kword is not an unnatural heap size */ - } else if (tp[1] == am_long_message_queue) { - if (!is_tuple_arity(tp[2], 2)) goto error; + if (ERTS_TRACER_IS_NIL(session->tracer)) { + /* + * Old erlang:system_monitor API + * We use monitor_pid argument + * and treat list as the new state (missing items are disabled) + */ + if (monitor_pid == am_undefined || list == NIL) { + monitor_pid = NIL; + list = NIL; + } + else if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0)) + goto error; + return_term = system_monitor_get(session, p); + want.receiver = monitor_pid; + want.limits[ERTS_SYSMON_LONG_GC] = 0; + want.limits[ERTS_SYSMON_LONG_SCHEDULE] = 0; + want.limits[ERTS_SYSMON_LARGE_HEAP] = 0; + want.limits[ERTS_SYSMON_LONG_MSGQ] = 0; + want.long_msgq_off = -1; + want.flags.busy_port = false; + want.flags.busy_dist_port = false; + } + else { + /* + * New trace module API + * We use session tracer (ignore monitor_pid argument) + * and treat list as diff to apply (missing items are unchanged) + */ + if (monitor_pid != am_session) { + goto error; + } + want = prev; + want.receiver = session->tracer; + return_term = am_ok; + } + + for ( ; is_list(list); list = CDR(list_val(list))) { + Eterm t = CAR(list_val(list)); + Eterm *tp; + Eterm fake_tuple[3]; + + if (!is_tuple_arity(t,2)) { + if (is_atom(t)) { + t = TUPLE2(fake_tuple, t, am_true); + } + else { + goto error; + } + } + tp = tuple_val(t); + + switch (tp[1]) { + case am_long_gc: + if (!term_to_limit(tp[2], &want.limits[ERTS_SYSMON_LONG_GC], 1)) { + goto error; + } + break; + case am_long_schedule: + if (!term_to_limit(tp[2], &want.limits[ERTS_SYSMON_LONG_SCHEDULE], 1)) { + goto error; + } + break; + case am_large_heap: + /* 16 Kword is not an unnatural heap size */ + if (!term_to_limit(tp[2], &want.limits[ERTS_SYSMON_LARGE_HEAP], + 16384)) { + goto error; + } + break; + case am_long_message_queue: + if (tp[2] == am_false) { + want.limits[ERTS_SYSMON_LONG_MSGQ] = 0; + want.long_msgq_off = -1; + } else if (is_tuple_arity(tp[2], 2)) { tp = tuple_val(tp[2]); - if (!term_to_Sint(tp[1], &long_msgq_off)) goto error; - if (!term_to_Sint(tp[2], &long_msgq_on)) goto error; - if (long_msgq_off < 0) goto error; - if (long_msgq_on <= 0) goto error; - if (long_msgq_off >= long_msgq_on) goto error; - } else goto error; - } else if (t == am_busy_port) { - busy_port = !0; - } else if (t == am_busy_dist_port) { - busy_dist_port = !0; - } else goto error; + if (!term_to_Sint(tp[1], &want.long_msgq_off)) goto error; + if (!term_to_limit(tp[2], &want.limits[ERTS_SYSMON_LONG_MSGQ], + 0)) { + goto error; + } + if (want.long_msgq_off < 0 + || want.limits[ERTS_SYSMON_LONG_MSGQ] <= 0 + || want.long_msgq_off >= want.limits[ERTS_SYSMON_LONG_MSGQ]) { + goto error; + } + } else { + goto error; + } + break; + case am_busy_port: + if (!term_to_boolean(tp[2], &want.flags.busy_port)) { + goto error; + } + break; + case am_busy_dist_port: + if (!term_to_boolean(tp[2], &want.flags.busy_dist_port)) { + goto error; + } + break; + default: + goto error; + } } - if (is_not_nil(list)) goto error; - prev = system_monitor_get(p); - erts_set_system_monitor(monitor_pid); - erts_system_monitor_long_gc = long_gc; - erts_system_monitor_long_schedule = long_schedule; - erts_system_monitor_large_heap = large_heap; - erts_system_monitor_flags.busy_port = !!busy_port; - erts_system_monitor_flags.busy_dist_port = !!busy_dist_port; - erts_system_monitor_long_msgq_off = long_msgq_off; - erts_system_monitor_long_msgq_on = long_msgq_on; + if (is_not_nil(list)) { + goto error; + } - erts_thr_progress_unblock(); - BIF_RET(prev); + session->system_monitor = want; + update_sysmon_globals(session, &prev); + + erts_thr_progress_unblock(); + BIF_RET(return_term); } error: diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 9fe600911035..f1902a238ca5 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -730,7 +730,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, Uint ext_msg_usage = 0; Eterm gc_trace_end_tag; int reds; - ErtsMonotonicTime start_time; + ErtsMonotonicTime start_time = 0; ErtsSchedulerData *esdp = erts_proc_sched_data(p); erts_aint32_t state; #ifdef USE_VM_PROBES @@ -738,7 +738,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, #endif ERTS_MSACC_PUSH_STATE(); - ERTS_UNDEF(start_time, 0); ERTS_CHK_MBUF_SZ(p); ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) >= esdp->virtual_reds); @@ -766,7 +765,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_GC); erts_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); - if (erts_system_monitor_long_gc != 0) + if (erts_system_monitor_long_gc) start_time = erts_get_monotonic_time(esdp); ERTS_CHK_OFFHEAP(p); @@ -867,7 +866,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, trace_gc(p, gc_trace_end_tag, reclaimed_now, THE_NON_VALUE); } - if (erts_system_monitor_long_gc != 0) { + if (start_time && erts_system_monitor_long_gc) { ErtsMonotonicTime end_time; Uint gc_time; if (erts_test_long_gc_sleep) @@ -882,7 +881,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, Uint size = HEAP_SIZE(p); size += OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0; if (size >= erts_system_monitor_large_heap) - monitor_large_heap(p); + monitor_large_heap(p, size); } if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h index 6b4e22090b6e..e92db07c7773 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.h +++ b/erts/emulator/beam/erl_proc_sig_queue.h @@ -1928,25 +1928,22 @@ erts_proc_sig_queue_unget_buffers(ErtsSignalInQueueBufferArray* buffers, } } + ERTS_GLB_INLINE void erts_chk_sys_mon_long_msgq_on(Process *proc) { - if (((proc->sig_qs.flags & (FS_MON_MSGQ_LEN|FS_MON_MSGQ_LEN_LONG)) - == FS_MON_MSGQ_LEN) - && proc->sig_qs.mq_len >= erts_system_monitor_long_msgq_on) { - proc->sig_qs.flags |= FS_MON_MSGQ_LEN_LONG; - monitor_generic(proc, am_long_message_queue, am_true); + if ((proc->sig_qs.flags & FS_MON_MSGQ_LEN_HIGH) + && proc->sig_qs.mq_len >= (Sint)erts_system_monitor_long_msgq_on) { + monitor_long_msgq_on(proc); } } ERTS_GLB_INLINE void erts_chk_sys_mon_long_msgq_off(Process *proc) { - if (((proc->sig_qs.flags & (FS_MON_MSGQ_LEN|FS_MON_MSGQ_LEN_LONG)) - == (FS_MON_MSGQ_LEN|FS_MON_MSGQ_LEN_LONG)) + if ((proc->sig_qs.flags & FS_MON_MSGQ_LEN_LOW) && proc->sig_qs.mq_len <= erts_system_monitor_long_msgq_off) { - proc->sig_qs.flags &= ~FS_MON_MSGQ_LEN_LONG; - monitor_generic(proc, am_long_message_queue, am_false); + monitor_long_msgq_off(proc); } } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 8dbb4498c007..ee266a47ddf9 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -421,13 +421,25 @@ static ErtsAlignedBlockPollThreadData *ERTS_WRITE_UNLIKELY(block_poll_thread_dat static Uint last_reductions; static Uint last_exact_reductions; -Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor); -Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc); + +/* + * Cached lowest limits for fast check if any trace sessions are interested + * in a particular system_monitor limit. Zero means limit disabled. + */ +Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc); Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule); -Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap); -Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_msgq_on); +Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap); +Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_msgq_on); + +/* The highest msgq_off threshold of any trace session, -1 if disabled */ Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_msgq_off); -struct erts_system_monitor_flags_t erts_system_monitor_flags; + +/* + * The number of trace sessions that are interested in a particular + * system_monitor event. + */ +Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_busy_port_cnt); +Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_busy_dist_port_cnt); /* system performance monitor */ Eterm erts_system_profile; @@ -9259,8 +9271,9 @@ erts_suspend(Process* c_p, ErtsProcLocks c_p_locks, Port *busy_port) if (!(c_p_locks & ERTS_PROC_LOCK_STATUS)) erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); - if (suspend && busy_port && erts_system_monitor_flags.busy_port) - monitor_generic(c_p, am_busy_port, busy_port->common.id); + if (suspend && busy_port && erts_system_monitor_busy_port_cnt) { + monitor_busy_port(c_p, busy_port->common.id); + } } void @@ -9570,7 +9583,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) state = erts_atomic32_read_nob(&p->state); if ((state & ERTS_PSFLG_MSG_SIG_IN_Q) - && ((p->sig_qs.flags & FS_MON_MSGQ_LEN) + && ((p->sig_qs.flags & (FS_MON_MSGQ_LEN_HIGH | FS_MON_MSGQ_LEN_LOW)) || ERTS_MSG_RECV_TRACED(p)) && !(p->sig_qs.flags & FS_FLUSHING_SIGS)) { if (!(state & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_ACTIVE_SYS))) { @@ -10027,7 +10040,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) erts_runq_unlock(rq); erts_proc_lock(p, (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_MSGQ)); - if (((p->sig_qs.flags & FS_MON_MSGQ_LEN) + if (((p->sig_qs.flags & (FS_MON_MSGQ_LEN_HIGH|FS_MON_MSGQ_LEN_LOW)) || ERTS_MSG_RECV_TRACED(p)) && !(p->sig_qs.flags & FS_FLUSHING_SIGS)) { erts_proc_sig_fetch(p); @@ -10066,13 +10079,15 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); - if (erts_system_monitor_long_msgq_off < 0) { - if (p->sig_qs.flags & FS_MON_MSGQ_LEN) - p->sig_qs.flags &= ~(FS_MON_MSGQ_LEN|FS_MON_MSGQ_LEN_LONG); + if (!erts_system_monitor_long_msgq_on) { + erts_clear_all_msgq_low_sessions(p); + p->sig_qs.flags &= ~FS_MON_MSGQ_LEN_HIGH; } else { - if (!(p->sig_qs.flags & FS_MON_MSGQ_LEN)) - p->sig_qs.flags |= FS_MON_MSGQ_LEN; + if (p->sig_qs.flags & FS_MON_MSGQ_LEN_LOW) { + erts_consolidate_all_msgq_low_sessions(p); + } + p->sig_qs.flags |= FS_MON_MSGQ_LEN_HIGH; } state = erts_atomic32_read_nob(&p->state); @@ -13257,36 +13272,39 @@ delete_process(Process* p) /* free all pending messages */ erts_proc_sig_cleanup_queues(p); - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + /* Cleanup psd */ + + psd = (ErtsPSD *) erts_atomic_read_nob(&p->psd); + if (psd) { + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); - if (scb) { + if (scb) { #ifndef BEAMASM - p->fcalls += CONTEXT_REDS; /* Reduction counting depends on this... */ + p->fcalls += CONTEXT_REDS; /* Reduction counting depends on this... */ #endif - erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); - } - - pbt = ERTS_PROC_SET_CALL_TIME(p, NULL); - while (pbt) { - process_breakpoint_trace_t *next = pbt->next; - erts_free(ERTS_ALC_T_BPD, (void *) pbt); - pbt = next; - } - pbt = ERTS_PROC_SET_CALL_MEMORY(p, NULL); - while (pbt) { - process_breakpoint_trace_t *next = pbt->next; - erts_free(ERTS_ALC_T_BPD, (void *) pbt); - pbt = next; - } + erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); + } - erts_destroy_nfunc(p); + pbt = ERTS_PROC_SET_CALL_TIME(p, NULL); + while (pbt) { + process_breakpoint_trace_t *next = pbt->next; + erts_free(ERTS_ALC_T_BPD, (void *) pbt); + pbt = next; + } + pbt = ERTS_PROC_SET_CALL_MEMORY(p, NULL); + while (pbt) { + process_breakpoint_trace_t *next = pbt->next; + erts_free(ERTS_ALC_T_BPD, (void *) pbt); + pbt = next; + } - /* Cleanup psd */ + erts_destroy_nfunc(p); - psd = (ErtsPSD *) erts_atomic_read_nob(&p->psd); + if (psd->data[ERTS_PSD_SYSMON_MSGQ_LEN_LOW]) { + erts_clear_all_msgq_low_sessions(p); + } - if (psd) { erts_atomic_set_nob(&p->psd, (erts_aint_t) NULL); /* Reduction counting depends on this... */ erts_free(ERTS_ALC_T_PSD, psd); } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index d1f373d1fc0e..c84104bbaa14 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -879,9 +879,10 @@ erts_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_DIST_ENTRY 8 #define ERTS_PSD_CALL_MEMORY_BP 9 #define ERTS_PSD_TS_EVENT 10 -#define ERTS_PSD_PENDING_SUSPEND 11 /* keep last... */ +#define ERTS_PSD_SYSMON_MSGQ_LEN_LOW 11 +#define ERTS_PSD_PENDING_SUSPEND 12 /* keep last... */ -#define ERTS_PSD_SIZE 12 +#define ERTS_PSD_SIZE 13 typedef struct { void *data[ERTS_PSD_SIZE]; @@ -1575,21 +1576,18 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp) Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra); extern erts_rwmtx_t erts_cpu_bind_rwmtx; -/* If any of the erts_system_monitor_* variables are set (enabled), -** erts_system_monitor must be != NIL, to allow testing on just -** the erts_system_monitor_* variables. -*/ -extern Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor); + extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc); extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule); extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap); -extern Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_msgq_on); +extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_msgq_on); extern Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_msgq_off); +extern Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_busy_port_cnt); +extern Sint ERTS_WRITE_UNLIKELY(erts_system_monitor_busy_dist_port_cnt); struct erts_system_monitor_flags_t { - unsigned int busy_port : 1; - unsigned int busy_dist_port : 1; + bool busy_port; + bool busy_dist_port; }; -extern struct erts_system_monitor_flags_t erts_system_monitor_flags; /* system_profile, same rules as for system_monitor. erts_profile must be != NIL when @@ -1647,8 +1645,8 @@ extern int erts_system_profile_ts_type; #define FS_NON_FETCH_CNT1 (1 << 9) /* First bit of non-fetch signals counter */ #define FS_NON_FETCH_CNT2 (1 << 10)/* Second bit of non-fetch signals counter */ #define FS_NON_FETCH_CNT4 (1 << 11)/* Third bit of non-fetch signals counter */ -#define FS_MON_MSGQ_LEN (1 << 12) /* Monitor of msgq len enabled */ -#define FS_MON_MSGQ_LEN_LONG (1 << 13)/* --"-- and it is currently long */ +#define FS_MON_MSGQ_LEN_HIGH (1 << 12)/* Monitor of msgq high limit for some session(s) */ +#define FS_MON_MSGQ_LEN_LOW (1 << 13)/* Monitor of msgq low limit for some session(s) */ #define FS_NON_FETCH_CNT_MASK \ (FS_NON_FETCH_CNT1|FS_NON_FETCH_CNT2|FS_NON_FETCH_CNT4) diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index d5e5da81818c..8753ae9365e2 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -49,8 +49,8 @@ typedef struct ErtsTracee_ { ErtsTracerRef *first_ref; } ErtsTracee; -#define ERTS_TRACER_MODULE(T) (CAR(list_val(T))) -#define ERTS_TRACER_STATE(T) (CDR(list_val(T))) +#define ERTS_TRACER_MODULE(T) (is_internal_pid(T) ? am_erl_tracer : CAR(list_val(T))) +#define ERTS_TRACER_STATE(T) (is_internal_pid(T) ? T : CDR(list_val(T))) #define ERTS_P_LINKS(P) ((P)->common.u.alive.links) #define ERTS_P_MONITORS(P) ((P)->common.u.alive.monitors) diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 649fe15ffb8f..e28d4be00e6f 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -61,13 +61,15 @@ #undef DEBUG_PRINTOUTS #endif +erts_atomic32_t erts_active_bp_index; +erts_atomic32_t erts_staging_bp_index; + /* Pseudo export entries. Never filled in with data, only used to yield unique pointers of the correct type. */ Export exp_send, exp_receive, exp_timeout; static ErtsTracer system_seq_tracer; -static Eterm system_monitor; static Eterm system_profile; static erts_atomic_t system_logger; @@ -301,12 +303,14 @@ static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, Eterm from, Eterm to, Eterm msg, - ErlHeapFragment *bp); + ErlHeapFragment *bp, + ErtsTraceSession*); static void enqueue_sys_msg(enum ErtsSysMsgType type, Eterm from, Eterm to, Eterm msg, - ErlHeapFragment *bp); + ErlHeapFragment *bp, + ErtsTraceSession*); static void init_sys_msg_dispatcher(void); static void init_tracer_nif(void); @@ -329,7 +333,6 @@ void erts_init_trace(void) { erts_cpu_timestamp = 0; #endif erts_bif_trace_init(); - erts_system_monitor_clear(NULL); erts_system_profile_clear(NULL); system_seq_tracer = erts_tracer_nil; erts_atomic_init_nob(&system_logger, am_logger); @@ -401,28 +404,42 @@ erts_system_profile_setup_active_schedulers(void) static void exiting_reset(Eterm exiting) { + erts_rwmtx_rwlock(&erts_trace_session_list_lock); erts_rwmtx_rwlock(&sys_trace_rwmtx); - if (exiting == system_monitor) { - system_monitor = NIL; - /* Let the trace message dispatcher clear flags, etc */ + + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (exiting == s->system_monitor.receiver) { + s->system_monitor.receiver = NIL; + /* Let the trace message dispatcher clear flags, etc */ + } } + if (exiting == system_profile) { system_profile = NIL; /* Let the trace message dispatcher clear flags, etc */ } erts_rwmtx_rwunlock(&sys_trace_rwmtx); + erts_rwmtx_rwunlock(&erts_trace_session_list_lock); } void erts_trace_check_exiting(Eterm exiting) { int reset = 0; + erts_rwmtx_rlock(&erts_trace_session_list_lock); erts_rwmtx_rlock(&sys_trace_rwmtx); - if (exiting == system_monitor) - reset = 1; - else if (exiting == system_profile) - reset = 1; + + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (exiting == s->system_monitor.receiver) { + reset = 1; + break; + } + } + + if (exiting == system_profile) + reset = 1; erts_rwmtx_runlock(&sys_trace_rwmtx); + erts_rwmtx_runlock(&erts_trace_session_list_lock); if (reset) exiting_reset(exiting); } @@ -616,19 +633,19 @@ erts_get_new_port_tracing(ErtsTraceSession* session, } void -erts_set_system_monitor(Eterm monitor) +erts_set_system_monitor(ErtsTraceSession *session, Eterm monitor) { erts_rwmtx_rwlock(&sys_trace_rwmtx); - system_monitor = monitor; + session->system_monitor.receiver = monitor; erts_rwmtx_rwunlock(&sys_trace_rwmtx); } Eterm -erts_get_system_monitor(void) +erts_get_system_monitor(ErtsTraceSession *session) { Eterm monitor; erts_rwmtx_rlock(&sys_trace_rwmtx); - monitor = system_monitor; + monitor = session->system_monitor.receiver; erts_rwmtx_runlock(&sys_trace_rwmtx); return monitor; } @@ -1455,9 +1472,10 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg) erts_thr_progress_unmanaged_continue(dhndl); } -void -monitor_long_schedule_proc(Process *p, const ErtsCodeMFA *in_fp, - const ErtsCodeMFA *out_fp, Uint time) +static void +monitor_long_schedule_proc_session(Process *p, const ErtsCodeMFA *in_fp, + const ErtsCodeMFA *out_fp, Uint time, + ErtsTraceSession *session) { ErlHeapFragment *bp; ErlOffHeap *off_heap; @@ -1501,10 +1519,27 @@ monitor_long_schedule_proc(Process *p, const ErtsCodeMFA *in_fp, hp += 2; msg = TUPLE4(hp, am_monitor, p->common.id, am_long_schedule, list); hp += 5; - enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, + session->system_monitor.receiver, msg, bp, session); } + void -monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) +monitor_long_schedule_proc(Process *p, const ErtsCodeMFA *in_fp, + const ErtsCodeMFA *out_fp, Uint time) +{ + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (time-1 > s->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE]-1) { + monitor_long_schedule_proc_session(p, in_fp, out_fp, time, s); + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + + +static void +monitor_long_schedule_port_session(Port *pp, ErtsPortTaskType type, Uint time, + ErtsTraceSession *session) { ErlHeapFragment *bp; ErlOffHeap *off_heap; @@ -1547,11 +1582,26 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) hp += 2; msg = TUPLE4(hp, am_monitor, pp->common.id, am_long_schedule, list); hp += 5; - enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, + session->system_monitor.receiver, msg, bp, session); } void -monitor_long_gc(Process *p, Uint time) { +monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) +{ + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (time-1 > s->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE]-1) { + monitor_long_schedule_port_session(pp, type, time, s); + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + + +static void +monitor_long_gc_session(Process *p, Uint time, ErtsTraceSession* session) +{ ErlHeapFragment *bp; ErlOffHeap *off_heap; Uint hsz; @@ -1605,11 +1655,25 @@ monitor_long_gc(Process *p, Uint time) { ASSERT(hp == hp_end); #endif - enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, + session->system_monitor.receiver, msg, bp, session); } void -monitor_large_heap(Process *p) { +monitor_long_gc(Process *p, Uint time) +{ + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (time-1 > s->system_monitor.limits[ERTS_SYSMON_LONG_GC]-1) { + monitor_long_gc_session(p, time, s); + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + +static void +monitor_large_heap_session(Process *p, ErtsTraceSession *session) +{ ErlHeapFragment *bp; ErlOffHeap *off_heap; Uint hsz; @@ -1662,11 +1726,25 @@ monitor_large_heap(Process *p) { ASSERT(hp == hp_end); #endif - enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, + session->system_monitor.receiver, msg, bp, session); } void -monitor_generic(Process *p, Eterm type, Eterm spec) { +monitor_large_heap(Process *p, Uint size) +{ + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (size-1 > s->system_monitor.limits[ERTS_SYSMON_LARGE_HEAP]-1) { + monitor_large_heap_session(p, s); + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + +static void +monitor_generic(Process *p, Eterm type, Eterm spec, ErtsTraceSession *session) +{ ErlHeapFragment *bp; ErlOffHeap *off_heap; Eterm *hp, msg; @@ -1677,10 +1755,199 @@ monitor_generic(Process *p, Eterm type, Eterm spec) { msg = TUPLE4(hp, am_monitor, p->common.id, type, spec); hp += 5; - enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, + session->system_monitor.receiver, msg, bp, session); +} + +/* + * ERTS_PSD_SYSMON_MSGQ_LEN_LOW + * A trace session where this process have reached the upper msgq limit + * and is "on its way down" to the lower limit. + */ +typedef struct ErtsSysMonMsgqLow { + struct ErtsSysMonMsgqLow *next; + struct ErtsSysMonMsgqLow *prev; + Eterm session_weak_id; +} ErtsSysMonMsgqLow; + +static ErtsSysMonMsgqLow* +get_msgq_low_session(Process *p, ErtsTraceSession *session) +{ + ErtsSysMonMsgqLow *that = + (ErtsSysMonMsgqLow*) erts_psd_get(p, ERTS_PSD_SYSMON_MSGQ_LEN_LOW); + + ASSERT(!!that == !!(p->sig_qs.flags & FS_MON_MSGQ_LEN_LOW)); + while (that) { + if (that->session_weak_id == session->weak_id) { + return that; + } + that = that->next; + } + return NULL; +} + +static void +add_msgq_low_session(Process *p, ErtsTraceSession *session) +{ + ErtsSysMonMsgqLow *thiz = erts_alloc(ERTS_ALC_T_HEAP_FRAG, // ToDo type? + sizeof(ErtsSysMonMsgqLow)); + ErtsSysMonMsgqLow *was_first; + + thiz->session_weak_id = session->weak_id; + was_first = erts_psd_set(p, ERTS_PSD_SYSMON_MSGQ_LEN_LOW, thiz); + ASSERT(!was_first || !was_first->prev); + + thiz->next = was_first; + thiz->prev = NULL; + if (was_first) { + was_first->prev = thiz; + } + + p->sig_qs.flags |= FS_MON_MSGQ_LEN_LOW; } +static void +remove_msgq_low_session(Process *p, ErtsSysMonMsgqLow *thiz) +{ + ErtsSysMonMsgqLow *was_first; + + if (thiz->prev) { + thiz->prev->next = thiz->next; +#ifdef DEBUG + was_first = erts_psd_get(p, ERTS_PSD_SYSMON_MSGQ_LEN_LOW); + ASSERT(was_first && was_first != thiz); +#endif + } + else { + was_first = erts_psd_set(p, ERTS_PSD_SYSMON_MSGQ_LEN_LOW, thiz->next); + ASSERT(was_first == thiz); (void)was_first; + if (!thiz->next) { + p->sig_qs.flags &= ~FS_MON_MSGQ_LEN_LOW; + } + } + if (thiz->next) { + thiz->next->prev = thiz->prev; + } + erts_free(ERTS_ALC_T_HEAP_FRAG, thiz); // ToDo type? +} + +void +erts_clear_all_msgq_low_sessions(Process *p) +{ + ErtsSysMonMsgqLow *that, *next; + + that = erts_psd_set(p, ERTS_PSD_SYSMON_MSGQ_LEN_LOW, NULL); + while (that) { + next = that->next; + erts_free(ERTS_ALC_T_HEAP_FRAG, that); // ToDo type? + that = next; + } + p->sig_qs.flags &= ~FS_MON_MSGQ_LEN_LOW; +} + +void +erts_consolidate_all_msgq_low_sessions(Process *p) +{ + ErtsSysMonMsgqLow *that, *next; + ErtsTraceSession *s; + + that = (ErtsSysMonMsgqLow*) erts_psd_get(p, ERTS_PSD_SYSMON_MSGQ_LEN_LOW); + while (that) { + next = that->next; + + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (s = &erts_trace_session_0; s; s = s->next) { + if (s->weak_id == that->session_weak_id) { + if (s->system_monitor.long_msgq_off < 0) { + s = NULL; + } + break; + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); + if (!s) { + remove_msgq_low_session(p, that); + } + that = next; + } +} + +void +monitor_long_msgq_on(Process *p) +{ + p->sig_qs.flags &= ~FS_MON_MSGQ_LEN_HIGH; + + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (s->system_monitor.limits[ERTS_SYSMON_LONG_MSGQ]) { + ErtsSysMonMsgqLow *low = get_msgq_low_session(p, s); + + if (!low) { + if (p->sig_qs.mq_len >= s->system_monitor.limits[ERTS_SYSMON_LONG_MSGQ]) { + monitor_generic(p, am_long_message_queue, am_true, s); + add_msgq_low_session(p, s); + } + else { + /* still a session with a limit we have not reached */ + p->sig_qs.flags |= FS_MON_MSGQ_LEN_HIGH; + } + } + /* else we have already reached the upper limit for this session */ + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + +void +monitor_long_msgq_off(Process *p) +{ + ASSERT(p->sig_qs.flags & FS_MON_MSGQ_LEN_LOW); + + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + ErtsSysMonMsgqLow *low = get_msgq_low_session(p, s); + + if (low) { + if (p->sig_qs.mq_len <= s->system_monitor.long_msgq_off) { + monitor_generic(p, am_long_message_queue, am_false, s); + remove_msgq_low_session(p, low); + p->sig_qs.flags |= FS_MON_MSGQ_LEN_HIGH; + } + else if (s->system_monitor.long_msgq_off < 0) { + /* disabled */ + remove_msgq_low_session(p, low); + } + + } + /* else we have not reached the upper limit for this session */ + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + +void +monitor_busy_port(Process *p, Eterm spec) +{ + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (s->system_monitor.flags.busy_port) { + monitor_generic(p, am_busy_port, spec, s); + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} + +void +monitor_busy_dist_port(Process *p, Eterm spec) +{ + erts_rwmtx_rlock(&erts_trace_session_list_lock); + for (ErtsTraceSession *s = &erts_trace_session_0; s; s = s->next) { + if (s->system_monitor.flags.busy_dist_port) { + monitor_generic(p, am_busy_dist_port, spec, s); + } + } + erts_rwmtx_runlock(&erts_trace_session_list_lock); +} /* Begin system_profile tracing */ /* Scheduler profiling */ @@ -1719,7 +1986,7 @@ profile_scheduler(Eterm scheduler_id, Eterm state) { /* Write timestamp in element 6 of the 'msg' tuple */ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL); - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp, NULL); erts_mtx_unlock(&smq_mtx); } @@ -2080,7 +2347,7 @@ profile_runnable_port(Port *p, Eterm status) { /* Write timestamp in element 5 of the 'msg' tuple */ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL); - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, p->common.id, NIL, msg, bp); + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, p->common.id, NIL, msg, bp, NULL); erts_mtx_unlock(&smq_mtx); } @@ -2134,7 +2401,7 @@ profile_runnable_proc(Process *p, Eterm status){ /* Write timestamp in element 5 of the 'msg' tuple */ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL); - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, p->common.id, NIL, msg, bp); + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, p->common.id, NIL, msg, bp, NULL); erts_mtx_unlock(&smq_mtx); } /* End system_profile tracing */ @@ -2146,6 +2413,7 @@ typedef struct ErtsSysMsgQ_ ErtsSysMsgQ; struct ErtsSysMsgQ_ { ErtsSysMsgQ *next; enum ErtsSysMsgType type; + ErtsTraceSession *session; Eterm from; Eterm to; Eterm msg; @@ -2165,18 +2433,23 @@ enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, Eterm from, Eterm to, Eterm msg, - ErlHeapFragment *bp) + ErlHeapFragment *bp, + ErtsTraceSession *session) { ErtsSysMsgQ *smqp; smqp = smq_element_alloc(); smqp->next = NULL; smqp->type = type; + smqp->session = session; + if (session) { + erts_ref_trace_session(session); + } smqp->from = from; smqp->to = to; smqp->msg = msg; smqp->bp = bp; - + if (sys_message_queue_end) { ASSERT(sys_message_queue); sys_message_queue_end->next = smqp; @@ -2194,10 +2467,11 @@ enqueue_sys_msg(enum ErtsSysMsgType type, Eterm from, Eterm to, Eterm msg, - ErlHeapFragment *bp) + ErlHeapFragment *bp, + ErtsTraceSession *session) { erts_mtx_lock(&smq_mtx); - enqueue_sys_msg_unlocked(type, from, to, msg, bp); + enqueue_sys_msg_unlocked(type, from, to, msg, bp, session); erts_mtx_unlock(&smq_mtx); } @@ -2218,14 +2492,14 @@ erts_set_system_logger(Eterm logger) void erts_queue_error_logger_message(Eterm from, Eterm msg, ErlHeapFragment *bp) { - enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, erts_get_system_logger(), msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, erts_get_system_logger(), msg, bp, NULL); } void erts_send_sys_msg_proc(Eterm from, Eterm to, Eterm msg, ErlHeapFragment *bp) { ASSERT(is_internal_pid(to)); - enqueue_sys_msg(SYS_MSG_TYPE_PROC_MSG, from, to, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_PROC_MSG, from, to, msg, bp, NULL); } #ifdef DEBUG_PRINTOUTS @@ -2258,18 +2532,21 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) switch (smqp->type) { case SYS_MSG_TYPE_SYSMON: if (receiver == NIL - && !erts_system_monitor_long_gc - && !erts_system_monitor_long_schedule - && !erts_system_monitor_large_heap - && !erts_system_monitor_flags.busy_port - && !erts_system_monitor_flags.busy_dist_port) + && !smqp->session->system_monitor.limits[ERTS_SYSMON_LONG_GC] + && !smqp->session->system_monitor.limits[ERTS_SYSMON_LONG_SCHEDULE] + && !smqp->session->system_monitor.limits[ERTS_SYSMON_LARGE_HEAP] + && !smqp->session->system_monitor.limits[ERTS_SYSMON_LONG_MSGQ] + && !smqp->session->system_monitor.flags.busy_port + && !smqp->session->system_monitor.flags.busy_dist_port) break; /* Everything is disabled */ erts_thr_progress_block(); - if (system_monitor == receiver || receiver == NIL) - erts_system_monitor_clear(NULL); + if (receiver == smqp->session->system_monitor.receiver + || receiver == NIL) { + erts_system_monitor_clear(smqp->session); + } erts_thr_progress_unblock(); break; - case SYS_MSG_TYPE_SYSPROF: + case SYS_MSG_TYPE_SYSPROF: if (receiver == NIL && !erts_system_profile_flags.runnable_procs && !erts_system_profile_flags.runnable_ports @@ -2408,6 +2685,9 @@ sys_msg_dispatcher_func(void *unused) while (local_sys_message_queue) { smqp = local_sys_message_queue; local_sys_message_queue = smqp->next; + if (smqp->session) { + erts_deref_trace_session(smqp->session); + } smq_element_free(smqp); } @@ -2473,7 +2753,7 @@ sys_msg_dispatcher_func(void *unused) receiver = smqp->to; break; case SYS_MSG_TYPE_SYSMON: - receiver = erts_get_system_monitor(); + receiver = smqp->to; if (smqp->from == receiver) { #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "MSG=%T to %T... ", @@ -2598,7 +2878,7 @@ erts_debug_foreach_sys_msg_in_q(void (*func)(Eterm, Eterm to; switch (sm->type) { case SYS_MSG_TYPE_SYSMON: - to = erts_get_system_monitor(); + to = erts_get_system_monitor(sm->session); break; case SYS_MSG_TYPE_SYSPROF: to = erts_get_system_profile(); @@ -2810,7 +3090,11 @@ erts_term_to_tracer(Eterm prefix, Eterm t) { ErtsTracer tracer = erts_tracer_nil; ASSERT(is_atom(prefix) || prefix == THE_NON_VALUE); - if (!is_nil(t)) { + + if (is_internal_pid(t)) { + tracer = t; + } + else if (!is_nil(t)) { Eterm module = am_erl_tracer, state = THE_NON_VALUE; Eterm hp[2]; if (is_tuple(t)) { @@ -3151,8 +3435,19 @@ static void free_tracer(void *p) } } +bool erts_get_tracer_pid(ErtsTracer tracer, Eterm* pid) +{ + if (is_list(tracer) && ERTS_TRACER_MODULE(tracer) == am_erl_tracer + && is_internal_pid(ERTS_TRACER_STATE(tracer))) { + + *pid = ERTS_TRACER_STATE(tracer); + return true; + } + return false; +} + /* - * ErtsTracer is either NIL, 'true' or [Mod | State] + * ErtsTracer is either NIL, 'true', local pid or [Mod | State] * * - If State is immediate then the memory for * the cons cell is just two words + sizeof(ErtsThrPrgrLaterOp) large. @@ -3177,15 +3472,15 @@ static void free_tracer(void *p) * the refc when *tracer is NIL. */ void -erts_tracer_update_impl(ErtsTracer *tracer, const ErtsTracer new_tracer) +erts_tracer_update_impl(ErtsTracer *tracer, ErtsTracer new_tracer) { ErlHeapFragment *hf; - if (is_not_nil(*tracer)) { + if (is_list(*tracer)) { Uint offs = 2; UWord size = 2 * sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp); ErtsThrPrgrLaterOp *lop; - ASSERT(is_list(*tracer)); + if (is_not_immed(ERTS_TRACER_STATE(*tracer))) { hf = ErtsContainerStruct_(ptr_val(*tracer), ErlHeapFragment, mem); offs = hf->used_size; @@ -3212,7 +3507,15 @@ erts_tracer_update_impl(ErtsTracer *tracer, const ErtsTracer new_tracer) free_tracer, (void*)(*tracer), lop, size); } - if (is_nil(new_tracer)) { + if (is_list(new_tracer)) { + const Eterm module = ERTS_TRACER_MODULE(new_tracer); + const Eterm state = ERTS_TRACER_STATE(new_tracer); + if (module == am_erl_tracer && is_internal_pid(state)) { + new_tracer = state; + } + } + if (is_immed(new_tracer)) { + ASSERT(is_nil(new_tracer) || is_internal_pid(new_tracer)); *tracer = new_tracer; } else if (is_immed(ERTS_TRACER_STATE(new_tracer))) { /* If tracer state is an immediate we only allocate a 2 Eterm heap. diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 90a5d2b5e754..adbdd93099fb 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -62,10 +62,11 @@ typedef struct struct binary* match_spec; } ErtsTracingEvent; -#ifndef ERTS_NUM_BP_IX -//# include "beam_bp.h" -# define ERTS_NUM_BP_IX 2 // ToDo FIXME UGLY -#endif +#define ERTS_NUM_BP_IX 2 +typedef Uint32 ErtsBpIndex; +extern erts_atomic32_t erts_active_bp_index; +extern erts_atomic32_t erts_staging_bp_index; + struct trace_pattern_flags { unsigned int breakpoint : 1; /* Set if any other is set */ unsigned int local : 1; /* Local call trace breakpoint */ @@ -82,6 +83,15 @@ enum erts_trace_session_state { ERTS_TRACE_SESSION_DEAD }; +enum erts_sysmon_limit_index { + ERTS_SYSMON_LONG_GC = 0, + ERTS_SYSMON_LONG_SCHEDULE, + ERTS_SYSMON_LARGE_HEAP, + ERTS_SYSMON_LONG_MSGQ, + + ERTS_SYSMON_LIMIT_CNT +}; + typedef struct ErtsTraceSession { struct ErtsTraceSession* next; struct ErtsTraceSession* prev; @@ -105,6 +115,13 @@ typedef struct ErtsTraceSession { Uint32 new_ports_trace_flags; ErtsTracer new_ports_tracer; + struct system_monitor_session { + Eterm receiver; + Uint limits[ERTS_SYSMON_LIMIT_CNT]; + Sint long_msgq_off; + struct erts_system_monitor_flags_t flags; + } system_monitor; + #ifdef DEBUG erts_refc_t dbg_bp_refc; /* Number of breakpoints */ erts_refc_t dbg_p_refc; /* Number of processes and ports */ @@ -142,7 +159,7 @@ void erts_assert_tracer_refs(ErtsPTabElementCommon* t_p); /* erl_bif_trace.c */ Eterm erl_seq_trace_info(Process *p, Eterm arg1); -void erts_system_monitor_clear(Process *c_p); +void erts_system_monitor_clear(ErtsTraceSession*); void erts_system_profile_clear(Process *c_p); /* erl_trace.c */ @@ -162,8 +179,8 @@ void erts_change_new_ports_tracing(ErtsTraceSession* session, const ErtsTracer tracerp); void erts_get_new_port_tracing(ErtsTraceSession*, Uint32 *flagsp, ErtsTracer *tracerp); -void erts_set_system_monitor(Eterm monitor); -Eterm erts_get_system_monitor(void); +void erts_set_system_monitor(ErtsTraceSession*, Eterm monitor); +Eterm erts_get_system_monitor(ErtsTraceSession*); int erts_is_tracer_valid(Process* p); void erts_check_my_tracer_proc(Process *); @@ -217,8 +234,15 @@ void monitor_long_gc(Process *p, Uint time); void monitor_long_schedule_proc(Process *p, const ErtsCodeMFA *in_i, const ErtsCodeMFA *out_i, Uint time); void monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time); -void monitor_large_heap(Process *p); -void monitor_generic(Process *p, Eterm type, Eterm spec); +void monitor_large_heap(Process *p, Uint size); +void monitor_busy_port(Process *p, Eterm spec); +void monitor_busy_dist_port(Process *p, Eterm spec); +void monitor_long_msgq_on(Process*); +void monitor_long_msgq_off(Process*); +void erts_clear_all_msgq_low_sessions(Process *p); +void erts_consolidate_all_msgq_low_sessions(Process *p); + + Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(ErtsTraceSession*, Eterm List, Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp); @@ -275,6 +299,7 @@ void erts_tracer_replace(ErtsPTabElementCommon *t_p, const ErtsTracer new_tracer); void erts_tracer_update_impl(ErtsTracer *tracer, const ErtsTracer new_tracer); int erts_tracer_nif_clear(void); +bool erts_get_tracer_pid(ErtsTracer, Eterm* pid); #define erts_tracer_update(t,n) do { if (*(t) != (n)) erts_tracer_update_impl(t,n); } while(0) #define ERTS_TRACER_CLEAR(t) erts_tracer_update(t, erts_tracer_nil) @@ -293,6 +318,7 @@ ERTS_DECLARE_DUMMY(erts_tracer_nil) = NIL; #define IS_TRACER_VALID(tracer) \ (ERTS_TRACER_COMPARE(tracer,erts_tracer_true) \ || ERTS_TRACER_IS_NIL(tracer) \ + || is_internal_pid(tracer) \ || (is_list(tracer) && is_atom(CAR(list_val(tracer))))) #define ERTS_TRACER_FROM_ETERM(termp) \ diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index 84ac916daa03..a471c561ecd5 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -219,7 +219,7 @@ Export *erts_export_put(Eterm mod, Eterm func, unsigned int arity) * export entry (making a call through it will cause the error_handler to * be called). * - * Stub export entries will be placed in the loader export table. + * Stub export entries will be placed in the staging export table. */ Export *erts_export_get_or_make_stub(Eterm mod, Eterm func, unsigned int arity) diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index f90b9bfe6686..6527189e9ed1 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -309,6 +309,9 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f } while (0) #endif +/* C99: bool, true and false */ +#include + /* * Microsoft C/C++: We certainly want to use stdarg.h and prototypes. * But MSC doesn't define __STDC__, unless we compile with the -Za @@ -701,12 +704,13 @@ typedef struct preload { } Preload; /* - * ErtsTracer is either NIL, 'true' or [Mod | State] + * ErtsTracer is either NIL, 'true', LocalPid or [Mod | State] * * If set to NIL, it means no tracer. * If set to 'true' it means the current process' tracer. * If set to [Mod | State], there is a tracer. - * See erts_tracer_update for more details + * LocalPid is the optimized form of the common case [erl_tracer | LocalPid]. + * See erts_tracer_update_impl for more details */ typedef Eterm ErtsTracer; diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 868d1b243007..76784f74399e 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -38,6 +38,7 @@ set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, set_on_link/1, set_on_first_link/1, system_monitor_args/1, more_system_monitor_args/1, + system_monitor_badargs/1, system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, system_monitor_long_schedule/1, system_monitor_long_message_queue/1, @@ -74,6 +75,7 @@ testcases() -> new_clear, existing_clear, tracer_die, set_on_spawn, set_on_first_spawn, set_on_link, set_on_first_link, system_monitor_args, + system_monitor_badargs, more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, system_monitor_long_schedule, @@ -118,6 +120,13 @@ erlang_trace_pattern(A,B,C) -> erlang_trace_info(A,B) -> trace_sessions:erlang_trace_info(A,B). +erlang_system_monitor() -> + trace_sessions:erlang_system_monitor(). +erlang_system_monitor(A) -> + trace_sessions:erlang_system_monitor(A). +erlang_system_monitor(A,B) -> + trace_sessions:erlang_system_monitor(A,B). + %% No longer testing anything, just reporting whether cpu_timestamp %% is enabled or not. cpu_timestamp(Config) when is_list(Config) -> @@ -876,46 +885,50 @@ set_on_first_link(_Config) -> system_monitor_args(Config) when is_list(Config) -> Self = self(), %% - OldMonitor = erlang:system_monitor(undefined), - undefined = erlang:system_monitor(Self, [{long_gc,0}]), - MinT = case erlang:system_monitor() of + OldMonitor = erlang_system_monitor(undefined), + undefined = erlang_system_monitor(Self, [{long_gc,0}]), + MinT = case erlang_system_monitor() of {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T; - Other1 -> test_server:fault(Other1) + Other1 -> ct:fail(Other1) end, - {Self,[{long_gc,MinT}]} = erlang:system_monitor(), + {Self,[{long_gc,MinT}]} = erlang_system_monitor(), {Self,[{long_gc,MinT}]} = - erlang:system_monitor({Self,[{large_heap,0}]}), - MinN = case erlang:system_monitor() of + erlang_system_monitor({Self,[{large_heap,0}]}), + MinN = case erlang_system_monitor() of {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N; - Other2 -> test_server:fault(Other2) + Other2 -> ct:fail(Other2) end, - {Self,[{large_heap,MinN}]} = erlang:system_monitor(), + {Self,[{large_heap,MinN}]} = erlang_system_monitor(), {Self,[{large_heap,MinN}]} = - erlang:system_monitor(Self,[{long_message_queue, {100,101}}]), - {Self,[{long_message_queue,{100,101}}]} = erlang:system_monitor(), + erlang_system_monitor(Self,[{long_message_queue, {100,101}}]), + {Self,[{long_message_queue,{100,101}}]} = erlang_system_monitor(), {Self,[{long_message_queue,{100,101}}]} = - erlang:system_monitor(Self, [busy_port]), - {Self,[busy_port]} = erlang:system_monitor(), + erlang_system_monitor(Self, [busy_port]), + {Self,[busy_port]} = erlang_system_monitor(), {Self,[busy_port]} = - erlang:system_monitor({Self,[busy_dist_port]}), - {Self,[busy_dist_port]} = erlang:system_monitor(), + erlang_system_monitor({Self,[busy_dist_port]}), + {Self,[busy_dist_port]} = erlang_system_monitor(), All = lists:sort([busy_port,busy_dist_port, {long_gc,1},{large_heap,65535},{long_message_queue,{99,100}}]), - {Self,[busy_dist_port]} = erlang:system_monitor(Self, All), - {Self,A1} = erlang:system_monitor(), + {Self,[busy_dist_port]} = erlang_system_monitor(Self, All), + {Self,A1} = erlang_system_monitor(), All = lists:sort(A1), - {Self,A1} = erlang:system_monitor(Self, []), + {Self,A1} = erlang_system_monitor(Self, []), Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end), Mref = erlang:monitor(process, Pid), - undefined = erlang:system_monitor(Pid, All), - {Pid,A2} = erlang:system_monitor(), + undefined = erlang_system_monitor(Pid, All), + {Pid,A2} = erlang_system_monitor(), All = lists:sort(A2), Pid ! {Self,die}, receive {'DOWN',Mref,_,_,_} -> ok end, - undefined = erlang:system_monitor(OldMonitor), + undefined = erlang_system_monitor(OldMonitor), erlang:yield(), - OldMonitor = erlang:system_monitor(), - %% + OldMonitor = erlang_system_monitor(), + ok. + + +system_monitor_badargs(Config) when is_list(Config) -> + Self = self(), {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)), {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})), {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})), @@ -959,14 +972,14 @@ try_l(Val) -> Arbitrary1 = 77777, Arbitrary2 = 88888, - erlang:system_monitor(undefined), + erlang_system_monitor(undefined), - undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), + undefined = erlang_system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), - {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), + {Self,Comb0} = erlang_system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0), - {Self,Comb1} = erlang:system_monitor(undefined), + {Self,Comb1} = erlang_system_monitor(undefined), [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). monitor_sys(Parent) -> @@ -987,7 +1000,7 @@ monitor_sys(Parent) -> start_monitor() -> Parent = self(), Mpid = spawn_link(fun() -> monitor_sys(Parent) end), - erlang:system_monitor(Mpid,[{long_schedule,100}]), + erlang_system_monitor(Mpid,[{long_schedule,100}]), erlang:yield(), % Need to be rescheduled for the trace to take ok. @@ -1030,7 +1043,7 @@ do_system_monitor_long_schedule() -> ct:fail(no_trace_of_port) end, port_close(Port), - erlang:system_monitor(undefined), + erlang_system_monitor(undefined), ok. @@ -1093,11 +1106,11 @@ system_monitor_long_gc_2(Config) when is_list(Config) -> long_gc(LoadFun, ExpectMonMsg) -> Self = self(), Time = 1, - OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]), + OldMonitor = erlang_system_monitor(Self, [{long_gc,Time}]), Pid = LoadFun(), Ref = erlang:trace_delivered(Pid), receive {trace_delivered, Pid, Ref} -> ok end, - {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor), + {Self,[{long_gc,Time}]} = erlang_system_monitor(OldMonitor), case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of {ok, true} when Pid =/= Self -> ok; @@ -1181,11 +1194,11 @@ large_heap(LoadFun, ExpectMonMsg) -> Size = 65535, Self = self(), NewMonitor = {Self,[{large_heap,Size}]}, - OldMonitor = erlang:system_monitor(NewMonitor), + OldMonitor = erlang_system_monitor(NewMonitor), Pid = LoadFun(Size), Ref = erlang:trace_delivered(Pid), receive {trace_delivered, Pid, Ref} -> ok end, - {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor), + {Self,[{large_heap,Size}]} = erlang_system_monitor(OldMonitor), case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of {ok, true} when Pid =/= Self -> ok; @@ -1236,7 +1249,7 @@ large_heap_check(Pid, Size, Result) -> system_monitor_long_message_queue(Config) when is_list(Config) -> Self = self(), SMonPrxy = spawn_link(fun () -> smon_lmq_proxy(Self) end), - erlang:system_monitor(SMonPrxy,[{long_message_queue, {50,100}}]), + erlang_system_monitor(SMonPrxy,[{long_message_queue, {50,100}}]), erlang:yield(), lists:foreach(fun (_) -> self() ! hello end, lists:seq(1, 100)), receive {monitor,Self,long_message_queue,true} -> ok @@ -1280,7 +1293,7 @@ system_monitor_long_message_queue(Config) when is_list(Config) -> exit(SMonPrxy, kill), false = is_process_alive(SMonPrxy), - erlang:system_monitor(undefined), + erlang_system_monitor(undefined), ok. smon_lmq_proxy(To) -> @@ -1292,7 +1305,7 @@ system_monitor_long_message_queue_ignore(Config) when is_list(Config) -> %% Ensure that messages are delivered and monitored even if a %% process ignores the message queue while continuesly executing. %% - erlang:system_monitor(self(),[{long_message_queue, {50,100}}]), + erlang_system_monitor(self(),[{long_message_queue, {50,100}}]), Pid = spawn_opt(fun ignore_messages_working/0, [{priority,low}, link]), lists:foreach(fun (_) -> Pid ! hello end, lists:seq(1, 50)), receive {monitor,Pid,long_message_queue,_} = Msg0 -> ct:fail({unexpected_message, Msg0}) @@ -1308,7 +1321,7 @@ system_monitor_long_message_queue_ignore(Config) when is_list(Config) -> exit(Pid, kill), false = is_process_alive(Pid), - erlang:system_monitor(undefined), + erlang_system_monitor(undefined), ok. diff --git a/erts/emulator/test/trace_session_SUITE.erl b/erts/emulator/test/trace_session_SUITE.erl index 586ec177f8e1..23c1848e7465 100644 --- a/erts/emulator/test/trace_session_SUITE.erl +++ b/erts/emulator/test/trace_session_SUITE.erl @@ -34,6 +34,8 @@ meta/1, ms_enable_flags/1, return_to/1, + system_monitor_info/1, + system_monitor_long_msgq/1, destroy/1, negative/1, error_info/1, @@ -69,6 +71,8 @@ all() -> test_set_on_link, test_set_on_first_link, return_to, + system_monitor_info, + system_monitor_long_msgq, destroy, negative, error_info, @@ -1419,6 +1423,208 @@ io_format(Frmt, List) -> ok end. + +system_monitor_info(_Config) -> + undefined = erlang:system_monitor(), + + S = trace:session_create(system_monitor, self(), []), + + ok = trace:system(S, large_heap, 1_234_567), + {system, [{large_heap,1_234_567}]} = trace:info(S, system, all), + + ok = trace:system(S, long_gc, 2_345), + {system, L1} = trace:info(S, system, all), + [{large_heap,1_234_567}, {long_gc,2_345}] = lists:sort(L1), + + ok = trace:system(S, long_message_queue, {22,33}), + {system, L2} = trace:info(S, system, all), + [{large_heap,1_234_567}, {long_gc,2_345}, {long_message_queue,{22,33}}] = lists:sort(L2), + + ok = trace:system(S, long_schedule, 3_456), + {system, L3} = trace:info(S, system, all), + [{large_heap,1_234_567}, {long_gc,2_345}, + {long_message_queue,{22,33}}, + {long_schedule,3_456}] = lists:sort(L3), + + ok = trace:system(S, busy_port, true), + {system, L4} = trace:info(S, system, all), + [busy_port, + {large_heap,1_234_567}, {long_gc,2_345}, + {long_message_queue,{22,33}}, + {long_schedule,3_456}] = lists:sort(L4), + + ok = trace:system(S, busy_dist_port, true), + {system, L5} = trace:info(S, system, all), + L5s = lists:sort(L5), + [busy_dist_port, + busy_port, + {large_heap,1_234_567}, + {long_gc,2_345}, + {long_message_queue,{22,33}}, + {long_schedule,3_456}] = L5s, + + undefined = erlang:system_monitor(), + + ok = trace:system(S, large_heap, false), + {system, L6} = trace:info(S, system, all), + L6exp = lists:keydelete(large_heap, 1, L5s), + L6exp = lists:sort(L6), + + ok = trace:system(S, long_message_queue, false), + {system, L7} = trace:info(S, system, all), + L7exp = lists:keydelete(long_message_queue, 1, L6exp), + L7exp = lists:sort(L7), + + ok = trace:system(S, busy_port, false), + {system, L8} = trace:info(S, system, all), + L8exp = lists:delete(busy_port, L7exp), + L8exp = lists:sort(L8), + + ok = trace:system(S, long_schedule, false), + {system, L9} = trace:info(S, system, all), + L9exp = lists:keydelete(long_schedule, 1, L8exp), + L9exp = lists:sort(L9), + + ok = trace:system(S, busy_dist_port, false), + {system, L10} = trace:info(S, system, all), + L10exp = lists:delete(busy_dist_port, L9exp), + L10exp = lists:sort(L10), + + ok = trace:system(S, long_gc, false), + {system, []} = trace:info(S, system, all), + + undefined = erlang:system_monitor(), + ok. + + +system_monitor_long_msgq(_Config) -> + Tester = self(), + Receiver = spawn_link(fun () -> message_receiver() end), + + Tracer1 = spawn_link(fun() -> tracer("Tracer1", Tester) end), + Tracer2 = spawn_link(fun() -> tracer("Tracer2", Tester) end), + S1 = trace:session_create(system_monitor_long_msgq, Tracer1, []), + S2 = trace:session_create(system_monitor_long_msgq, Tracer2, []), + + sysmon_long_msgq(S1, Tracer1, S2, Tracer2, Receiver), + sysmon_long_msgq(S2, Tracer2, S1, Tracer1, Receiver), + + trace:session_destroy(S1), + trace:session_destroy(S2), + + unlink(Receiver), + exit(Receiver, die), + unlink(Tracer1), + exit(Tracer1, die), + unlink(Tracer2), + exit(Tracer2, die), + ok. + +sysmon_long_msgq(S1, Tracer1, S2, Tracer2, Receiver) -> + trace:system(S1, long_message_queue, {50,70}), + trace:system(S2, long_message_queue, {60,80}), + + [Receiver ! message || _ <- lists:seq(1,50)], % 50 + receive_nothing(), + + [begin + [begin + [Receiver ! message || _ <- lists:seq(1,10)], % 60 + receive_nothing(), + + [Receiver ! message || _ <- lists:seq(1,10)], % 70 + {Tracer1, {monitor,Receiver,long_message_queue,true}} = receive_any(), + receive_nothing(), + + [Receiver ! message || _ <- lists:seq(1,10)], % 80 + {Tracer2, {monitor,Receiver,long_message_queue,true}} = receive_any(), + receive_nothing(), + + message_receive_order(Receiver, 10), % 70 + receive_nothing(), + + [Receiver ! message || _ <- lists:seq(1,10)], % 80 + receive_nothing(), + + message_receive_order(Receiver, 20), % 60 + {Tracer2, {monitor,Receiver,long_message_queue,false}} = receive_any(), + receive_nothing(), + + [Receiver ! message || _ <- lists:seq(1,10)], % 70 + receive_nothing(), + + message_receive_order(Receiver, 20), % 50 + {Tracer1, {monitor,Receiver,long_message_queue,false}} = receive_any(), + receive_nothing() + end + || _ <- [1,2] + ], + + trace:system(S1, long_message_queue, false), + + [Receiver ! message || _ <- lists:seq(1,20)], % 70 + receive_nothing(), + + [Receiver ! message || _ <- lists:seq(1,10)], % 80 + {Tracer2, {monitor,Receiver,long_message_queue,true}} = receive_any(), + receive_nothing(), + + message_receive_order(Receiver, 10), % 70 + receive_nothing(), + + message_receive_order(Receiver, 10), % 60 + {Tracer2, {monitor,Receiver,long_message_queue,false}} = receive_any(), + receive_nothing(), + + message_receive_order(Receiver, 10), % 50 + receive_nothing(), + + trace:system(S1, long_message_queue, {50,70}) + end + || _ <- [1,2]], + + %% Set same limits as S2 + %% and test that we can produce more than one message at a time + trace:system(S1, long_message_queue, {60,80}), + + [Receiver ! message || _ <- lists:seq(1,29)], % 79 + receive_nothing(), + + [Receiver ! message || _ <- lists:seq(1,1)], % 80 + receive_parallel( + {[{Tracer1, {monitor,Receiver,long_message_queue,true}}], + [{Tracer2, {monitor,Receiver,long_message_queue,true}}]}), + receive_nothing(), + + message_receive_order(Receiver, 19), % 61 + receive_nothing(), + + message_receive_order(Receiver, 1), % 60 + receive_parallel( + {[{Tracer1, {monitor,Receiver,long_message_queue,false}}], + [{Tracer2, {monitor,Receiver,long_message_queue,false}}]}), + receive_nothing(), + + message_receive_order(Receiver, 60), % 0 + receive_nothing(), + + ok. + +message_receiver() -> + receive + {'receive', N, From} -> + [receive_any() || _ <- lists:seq(1,N)], + From ! {done, N, self()} + end, + message_receiver(). + +message_receive_order(Receiver, N) -> + Receiver ! {'receive', N, self()}, + receive + {done, N, Receiver} -> ok + end. + + destroy(_Config) -> Name = ?MODULE, {_,SName1}=S1 = trace:session_create(Name, self(), []), @@ -1643,7 +1849,7 @@ receive_any(Timeout) -> end. receive_nothing() -> - receive_any(10). + timeout = receive_any(10). %% Argument is a tuple of lists with expected messages to receive. %% Each list is internally ordered according to expected reception. diff --git a/erts/emulator/test/trace_sessions.erl b/erts/emulator/test/trace_sessions.erl index b544bc524d59..6ea585dc4108 100644 --- a/erts/emulator/test/trace_sessions.erl +++ b/erts/emulator/test/trace_sessions.erl @@ -34,7 +34,10 @@ erlang_trace/3, erlang_trace_info/2, erlang_trace_pattern/2, - erlang_trace_pattern/3 + erlang_trace_pattern/3, + erlang_system_monitor/0, + erlang_system_monitor/1, + erlang_system_monitor/2 ]). group_map() -> @@ -207,6 +210,27 @@ erlang_trace_info(PidPortFuncEvent, Item) -> trace:info(S, PidPortFuncEvent, Item) end. +erlang_system_monitor() -> + case ets:lookup(?MODULE, dynamic_session) of + [] -> + erlang:system_monitor(); + [{dynamic_session, S}] -> + erts_internal:system_monitor(S) + end. + +erlang_system_monitor(undefined) -> + erlang_system_monitor(undefined, []); +erlang_system_monitor({Pid, Opts}) -> + erlang_system_monitor(Pid, Opts). + +erlang_system_monitor(Pid, Opts) -> + case ets:lookup(?MODULE, dynamic_session) of + [] -> + erlang:system_monitor(Pid, Opts); + [{dynamic_session, S}] -> + erts_internal:system_monitor(S, Pid, Opts) + end. + init_per_group(Group, Config) -> init_group(group_tricks(Group), Config). diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index fcb0bf98155f..7ff17d42a8e3 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 9c98f1edf12a..c96be4c25dfb 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index feb9836c49ac..24ac4dc7cbc8 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -5941,7 +5941,7 @@ The order of the options can be different from the one that was set. MonitorPid :: pid(), Options :: [ system_monitor_option() ]. system_monitor() -> - erlang:nif_error(undefined). + erts_internal:system_monitor(legacy). %% system_monitor/1 -doc """ @@ -5960,115 +5960,46 @@ Returns the previous system monitor settings just like MonSettings :: undefined | { MonitorPid, Options }, MonitorPid :: pid(), Options :: [ system_monitor_option() ]. -system_monitor(_Arg) -> - erlang:nif_error(undefined). +system_monitor(undefined) -> + erts_internal:system_monitor(legacy, undefined, []); +system_monitor({MonitorPid, Options}=Arg) -> + try + erts_internal:system_monitor(legacy, MonitorPid, Options) + catch + error:Reason -> + error_with_info(Reason, [Arg]) + end; +system_monitor(Arg) -> + badarg_with_info([Arg]). + %% system_monitor/2 -doc """ -Sets the system performance monitoring options. `MonitorPid` is a local process +Sets the system event monitoring options. `MonitorPid` is a local process identifier (pid) receiving system monitor messages. -The second argument is a list of monitoring options: - -- **`{long_gc, Time}`** - If a garbage collection in the system takes at least - `Time` wall clock milliseconds, a message `{monitor, GcPid, long_gc, Info}` is - sent to `MonitorPid`. `GcPid` is the pid that was garbage collected. `Info` is - a list of two-element tuples describing the result of the garbage collection. - - One of the tuples is `{timeout, GcTime}`, where `GcTime` is the time for the - garbage collection in milliseconds. The other tuples are tagged with - `heap_size`, `heap_block_size`, `stack_size`, `mbuf_size`, `old_heap_size`, - and `old_heap_block_size`. These tuples are explained in the description of - trace message [`gc_minor_start`](`m:trace#gc_minor_start`) (see - `trace:process/4`). New tuples can be added, and the order of the - tuples in the `Info` list can be changed at any time without prior notice. - -- **`{long_message_queue, {Disable, Enable}}`** - If the message queue length of - a process in the system reach `Enable` length, a `long_message_queue` monitor - message is sent to the process identified by `MonitorPid`. The monitor message - will be on the form `{monitor, Pid, long_message_queue, Long}`, where `Pid` is - the process identifier of the process that got a long message queue and `Long` - will equal `true` indicating that it is in a _long message queue_ state. No - more `long_message_queue` monitor messages will be sent due to the process - identified by `Pid` until its message queue length falls down to a length of - `Disable` length. When this happens, a `long_message_queue` monitor message - with `Long` equal to `false` will be sent to the process identified by - `MonitorPid` indicating that the process is no longer in a _long message - queue_ state. As of this, if the message queue length should again reach - `Enable` length, a new `long_message_queue` monitor message with `Long` set to - `true` will again be sent. That is, a `long_message_queue` monitor message is - sent when a process enters or leaves a _long message queue_ state where these - state changes are defined by the `Enable` and `Disable` parameters. - - `Enable` length must be an integer larger than zero and `Disable` length must - be an integer larger than or equal to zero. `Disable` length must also be - smaller than `Enable` length. If the above is not satisfied the operation will - fail with a `badarg` error exception. You are recommended to use a much - smaller value for `Disable` length than `Enable` length in order not to be - flooded with `long_message_queue` monitor messages. - -- **`{long_schedule, Time}`** - If a process or port in the system runs - uninterrupted for at least `Time` wall clock milliseconds, a message - `{monitor, PidOrPort, long_schedule, Info}` is sent to `MonitorPid`. - `PidOrPort` is the process or port that was running. `Info` is a list of - two-element tuples describing the event. - - If a `t:pid/0`, the tuples `{timeout, Millis}`, `{in, Location}`, and - `{out, Location}` are present, where `Location` is either an MFA - (`{Module, Function, Arity}`) describing the function where the process was - scheduled in/out, or the atom `undefined`. - - If a `t:port/0`, the tuples `{timeout, Millis}` and `{port_op,Op}` are - present. `Op` is one of `proc_sig`, `timeout`, `input`, `output`, `event`, or - `dist_cmd`, depending on which driver callback was executing. - - `proc_sig` is an internal operation and is never to appear, while the others - represent the corresponding driver callbacks `timeout`, `ready_input`, - `ready_output`, `event`, and `outputv` (when the port is used by - distribution). Value `Millis` in tuple `timeout` informs about the - uninterrupted execution time of the process or port, which always is equal to - or higher than the `Time` value supplied when starting the trace. New tuples - can be added to the `Info` list in a future release. The order of the tuples - in the list can be changed at any time without prior notice. - - This can be used to detect problems with NIFs or drivers that take too long to - execute. 1 ms is considered a good maximum time for a driver callback or a - NIF. However, a time-sharing system is usually to consider everything < 100 ms - as "possible" and fairly "normal". However, longer schedule times can indicate - swapping or a misbehaving NIF/driver. Misbehaving NIFs and drivers can cause - bad resource utilization and bad overall system performance. - -- **`{large_heap, Size}`** - If a garbage collection in the system results in - the allocated size of a heap being at least `Size` words, a message - `{monitor, GcPid, large_heap, Info}` is sent to `MonitorPid`. `GcPid` and - `Info` are the same as for `long_gc` earlier, except that the tuple tagged - with `timeout` is not present. - - The monitor message is sent if the sum of the sizes of all memory blocks - allocated for all heap generations after a garbage collection is equal to or - higher than `Size`. - - When a process is killed by - [`max_heap_size`](#process_flag_max_heap_size), it is killed before - the garbage collection is complete and thus no large heap message is sent. - -- **`busy_port`** - If a process in the system gets suspended because it sends - to a busy port, a message `{monitor, SusPid, busy_port, Port}` is sent to - `MonitorPid`. `SusPid` is the pid that got suspended when sending to `Port`. - -- **`busy_dist_port`[](){: #busy_dist_port } ** - If a process in the system gets suspended because it sends to a process on a remote - node whose inter-node communication was handled by a busy port, a message `{monitor, SusPid, busy_dist_port, Port}` - is sent to `MonitorPid`. `SusPid` is the pid that got suspended when sending through - the inter-node communication port `Port`. - -Returns the previous system monitor settings just like -[`erlang:system_monitor/0`](`system_monitor/0`). - -The arguments to [`system_monitor/2`](`system_monitor/2`) specifies how all -system monitoring on the node should be done, not how it should be changed. This -means only one process at a time (`MonitorPid`) can be the receiver of system -monitor messages. Also, the way to clear a specific monitor option is to not + > #### Change {: .info } + > + > This function is superseded by `trace:system/3` that operate on + > dynamic trace sessions. + +The second argument is a list of monitoring options to enable: + +- **`{long_gc, Time}`** +- **`{long_message_queue, {Disable, Enable}}`** +- **`{long_schedule, Time}`** +- **`{large_heap, Size}`** +- **`busy_port`** +- **`busy_dist_port`** + +For more detailed descriptions about the monitoring options, see +`trace:system/3`. + +Unlink `trace:system/3`, the arguments to +[`system_monitor/2`](`system_monitor/2`) specifies how all system monitoring +should be set, not how it should be changed. This means only one process +at a time (`MonitorPid`) can be the receiver of messages from system monitoring set +with this function. Also, the way to clear a specific monitor option is to not include it in the list `Options`. All system monitoring will, however, be cleared if the process identified by `MonitorPid` terminates. @@ -6077,6 +6008,9 @@ options have a unspecified minimum value. Lower values will be adjusted to the minimum value. For example, it is currently not possible to monitor all garbage collections with `{long_gc, 0}`. +Returns the previous system monitor settings just like +[`erlang:system_monitor/0`](`system_monitor/0`). + > #### Note {: .info } > > If a monitoring process gets so large that it itself starts to cause system @@ -6099,8 +6033,13 @@ Failures: MonSettings :: undefined | { OldMonitorPid, OldOptions }, OldMonitorPid :: pid(), OldOptions :: [ system_monitor_option() ]. -system_monitor(_MonitorPid, _Options) -> - erlang:nif_error(undefined). +system_monitor(MonitorPid, Options) -> + try + erts_internal:system_monitor(legacy, MonitorPid, Options) + catch + error:Reason -> + error_with_info(Reason, [MonitorPid, Options]) + end. %% system_profile/0 -doc """ @@ -7399,8 +7338,8 @@ of the flag. > condition. Blocking due to disabled `async_dist` can be monitored by - [`erlang:system_monitor()`](`system_monitor/2`) using the - [`busy_dist_port`](#busy_dist_port) option. Only data buffered by + [`trace:system()`](`trace:system/3`) using the + [`busy_dist_port`](`m:trace#busy_dist_port`) option. Only data buffered by processes which (at the time of sending a signal) have disabled `async_dist` will be counted when determining whether or not an operation should block the caller. diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 8e9ebc6b4d93..e0aaf5ee6af8 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -127,6 +127,8 @@ -export([term_to_string/1, term_to_string/2]). +-export([system_monitor/1, system_monitor/3]). + %% %% Await result of send to port %% @@ -1150,3 +1152,17 @@ term_to_string(T) -> term_to_string(_T, _Limit) -> erlang:nif_error(undefined). + +-spec system_monitor(Session) -> Return when + Session :: term(), + Return :: undefined | {pid(), [term()]}. +system_monitor(_Session) -> + erlang:nif_error(undefined). + +-spec system_monitor(Session, MonitorPid, Options) -> Return when + Session :: term(), + MonitorPid :: undefined | session | pid(), + Options :: [term()], + Return :: undefined | ok | {pid(), Options}. +system_monitor(_Session, _MonitorPid, _Options) -> + erlang:nif_error(undefined). diff --git a/lib/kernel/src/trace.erl b/lib/kernel/src/trace.erl index 087bf005e4f3..1d5eb6f711e6 100644 --- a/lib/kernel/src/trace.erl +++ b/lib/kernel/src/trace.erl @@ -132,6 +132,7 @@ on the same local node as the call is made. To trace remote nodes use `m:dbg` or port/4, info/3, delivered/2, + system/3, session_create/3, session_destroy/1, session_info/1]). @@ -195,8 +196,7 @@ being destroyed when the last strong handle is garbage collected. -type trace_pattern_flag() :: global | local | - meta | {meta, Pid :: pid()} | - {meta, TracerModule :: module(), TracerState :: term()} | + meta | call_count | call_time | call_memory. @@ -211,13 +211,37 @@ being destroyed when the last strong handle is garbage collected. {call_time | call_memory, [{pid(), non_neg_integer(), non_neg_integer(), non_neg_integer()}] | boolean() | undefined}. +-type trace_info_system_item() :: + 'busy_port' | + 'busy_dist_port' | + {'long_gc', non_neg_integer()} | + {'long_message_queue', {Disable :: non_neg_integer(), + Enable :: pos_integer()}} | + {'long_schedule', non_neg_integer()} | + {'large_heap', non_neg_integer()}. + -type trace_info_return() :: undefined | {flags, [trace_info_flag()]} | {tracer, pid() | port() | []} | {tracer, module(), term()} | trace_info_item_result() | - {all, [ trace_info_item_result() ] | false | undefined}. + {all, [ trace_info_item_result() ] | false | undefined} | + {system, [trace_info_system_item()]}. + + +-type system_event() :: + busy_port | + busy_dist_port | + long_gc | + long_message_queue | + long_schedule | + large_heap. + +-type system_value() :: + true | false | + non_neg_integer() | + {Disable :: non_neg_integer(), Enable :: pos_integer()}. %% process/4 @@ -771,7 +795,7 @@ Must be combined with `process/4` to set the `call` trace flag for one or more processes. Conceptually, call tracing works as follows. In each trace session, a -set of processes and a set of functions haven been marked for +set of processes and a set of functions have been marked for tracing. If a traced process calls a traced function, the trace action is taken. Otherwise, nothing happens. @@ -1196,6 +1220,14 @@ One valid `Item` for events exists: - **`match_spec`** - Returns the match specification for this event, if it has one, or `true` if no match specification has been set. +**To get information about monitored system events**, `PidPortFuncEvent` is to + be the atom `system`. + +Only valid `Item` for `system` is + +- **`all`** - Returns a list of all monitored system events enabled by + `system/3`. + The return value is `{Item, Value}`, where `Value` is the requested information as described earlier. If a pid for a dead process was specified, or the name of a non-existing function, `Value` is `undefined`. @@ -1204,7 +1236,7 @@ a non-existing function, `Value` is `undefined`. -spec info(Session, PidPortFuncEvent, Item) -> Res when Session :: session(), PidPortFuncEvent :: pid() | port() | new | new_processes | new_ports - | MFA | on_load | send | 'receive', + | MFA | on_load | send | 'receive' | system, MFA :: {module(), atom(), arity()}, Item :: flags | tracer | traced | match_spec | meta | meta_match_spec | call_count | call_time | call_memory @@ -1226,6 +1258,140 @@ delivered(_Session , Tracee) -> erlang:trace_delivered(Tracee). +%% system/3 +-doc """ +Enable/disable monitoring of system events. + +Argument `Session` is the trace session to operate on as returned by +`session_create/3`. + +Argument `Event` is an atom describing the kind of system event to +monitor. To enable monitoring argument `Value` is, depending on event, either a +limit of that event or the atom `true`. To disable monitoring pass `Value` as the +atom `false`. + +When a monitored system event happens, a message is sent to the session +tracer. The session tracer must be a process otherwise the function call will +fail. + +The following `Event`s with `Value`s can be monitored: + +- **`long_gc, Time`** - If a garbage collection in the system takes at least + `Time` wall clock milliseconds, a message `{monitor, GcPid, long_gc, Info}` is + sent. `GcPid` is the pid that was garbage collected. `Info` is a list of + two-element tuples describing the result of the garbage collection. + + One of the tuples is `{timeout, GcTime}`, where `GcTime` is the time for the + garbage collection in milliseconds. The other tuples are tagged with + `heap_size`, `heap_block_size`, `stack_size`, `mbuf_size`, `old_heap_size`, + and `old_heap_block_size`. These tuples are explained in the description of + trace message [`gc_minor_start`](`m:trace#gc_minor_start`) (see + `trace:process/4`). New tuples can be added, and the order of the tuples in + the `Info` list can be changed at any time without prior notice. + +- **`long_message_queue, {Disable, Enable}`** - If the number of messages in the + message queue of a process reach `Enable`, a message `{monitor, Pid, + long_message_queue, Long}` is sent. `Pid` is the process identifier of the + process that got a long message queue and `Long` will equal `true` indicating + that it is in a _long message queue_ state. No more `long_message_queue` + monitor messages will be sent due to the process identified by `Pid` until its + message queue length falls down to a length of `Disable` length. When this + happens, a `long_message_queue` monitor message with `Long` equal to `false` + will be sent indicating that the process is no longer in a _long message + queue_ state. As of this, if the message queue length should again reach + `Enable` length, a new `long_message_queue` monitor message with `Long` set to + `true` will again be sent. That is, a `long_message_queue` monitor message is + sent when a process enters or leaves a _long message queue_ state where these + state changes are defined by the `Enable` and `Disable` parameters. + + `Enable` must be an integer larger than zero. `Disable` must be an integer + larger than or equal to zero and smaller than `Enable`. If the above is not + satisfied the operation will fail with a `badarg` error exception. You are + recommended to use a much smaller value for `Disable` length than `Enable` + length in order not to be flooded with `long_message_queue` monitor messages. + +- **`long_schedule, Time`** - If a process or port in the system runs + uninterrupted for at least `Time` wall clock milliseconds, a message + `{monitor, PidOrPort, long_schedule, Info}` is sent. + `PidOrPort` is the process or port that was running. `Info` is a list of + two-element tuples describing the event. + + If a `t:pid/0`, the tuples `{timeout, Millis}`, `{in, Location}`, and + `{out, Location}` are present, where `Location` is either an MFA + (`{Module, Function, Arity}`) describing the function where the process was + scheduled in/out, or the atom `undefined`. + + If a `t:port/0`, the tuples `{timeout, Millis}` and `{port_op,Op}` are + present. `Op` is one of `proc_sig`, `timeout`, `input`, `output`, `event`, or + `dist_cmd`, depending on which driver callback was executing. + + `proc_sig` is an internal operation and is never to appear, while the others + represent the corresponding driver callbacks `timeout`, `ready_input`, + `ready_output`, `event`, and `outputv` (when the port is used by + distribution). Value `Millis` in tuple `timeout` informs about the + uninterrupted execution time of the process or port, which always is equal to + or higher than the `Time` value supplied when starting the trace. New tuples + can be added to the `Info` list in a future release. The order of the tuples + in the list can be changed at any time without prior notice. + + This can be used to detect problems with NIFs or drivers that take too long to + execute. 1 ms is considered a good maximum time for a driver callback or a + NIF. However, a time-sharing system is usually to consider everything < 100 ms + as "possible" and fairly "normal". However, longer schedule times can indicate + swapping or a misbehaving NIF/driver. Misbehaving NIFs and drivers can cause + bad resource utilization and bad overall system performance. + +- **`large_heap, Size`** - If a garbage collection in the system results in + the allocated size of a heap being at least `Size` words, a message + `{monitor, GcPid, large_heap, Info}` is sent. `GcPid` and `Info` are the same + as for `long_gc` described above, except that the tuple tagged with `timeout` + is not present. + + The monitor message is sent if the sum of the sizes of all memory blocks + allocated for all heap generations after a garbage collection is equal to or + higher than `Size`. + + When a process is killed by + [`max_heap_size`](`e:erts:erlang#process_flag_max_heap_size`), it is killed before + the garbage collection is complete and thus no large heap message is sent. + +- **`busy_port, true`** - If a process in the system gets suspended because it sends + to a busy port, a message `{monitor, SusPid, busy_port, Port}` is + sent. `SusPid` is the pid that got suspended when sending to `Port`. + +- **`busy_dist_port, true`[](){: #busy_dist_port } ** + If a process in the system gets suspended because it sends to a process on a remote + node whose inter-node communication was handled by a busy port, a message + `{monitor, SusPid, busy_dist_port, Port}` is sent. `SusPid` is the pid that + got suspended when sending through the inter-node communication port `Port`. + +To disable system monitoring of a event pass the value as `false`. There are no +other special values (like zero) to disable monitoring of an event. Some of the +events have an unspecified minimum value. Lower values will be adjusted to the +minimum value. For example, it is currently not possible to monitor all garbage +collections with `{long_gc, 0}`. + +> #### Note {: .info } +> +> If the session tracer process gets so large that it itself starts to cause +> system monitor messages when garbage collecting, the messages enlarge the +> process message queue and probably make the problem worse. +> +> Keep the tracer process neat and do not set the system monitor limits too +> tight. + +Failures: + +- **`badarg`** - If the session tracer is not a local process. +""". +-spec system(Session :: session(), + Event :: system_event(), + Value :: system_value()) -> ok. +system(Session, Event, Value) -> + erts_internal:system_monitor(Session, session, [{Event,Value}]). + + + %% session_create/3 -doc """ Create a new trace session.