diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index e0cd379bab4b..a6b90c0f0b13 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -2237,10 +2237,7 @@ delete_code(Module* modp) } } - if (ep->bif_number != -1 && ep->is_bif_traced) { - /* Code unloading kills both global and local call tracing. */ - ep->is_bif_traced = 0; - } + ASSERT(!ep->is_bif_traced); ep->trampoline.common.op = BeamOpCodeAddr(op_call_error_handler); ep->trampoline.not_loaded.deferred = 0; diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 294fa6c7ca2a..5428a550d9ec 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -299,8 +299,34 @@ erts_bp_free_matched_functions(BpFunctions* f) else ASSERT(f->matched == 0); } -void -erts_consolidate_export_bp_data(BpFunctions* f) +/* + * Set Export.is_bif_traced for BIFs + * to true if breakpoint exist in either export trampoline or code + * to false otherwise. +*/ +void erts_update_export_is_bif_traced(Export *ep) +{ + if (ep->bif_number < 0) { + ASSERT(!ep->is_bif_traced); + return; + } + + if (ep->info.gen_bp) { + ep->is_bif_traced = 1; + } + else { + ErtsCodePtr code = ep->dispatch.addresses[erts_active_code_ix()]; + const ErtsCodeInfo *ci = erts_code_to_codeinfo(code); + ASSERT(ci->mfa.module == ep->info.mfa.module); + ASSERT(ci->mfa.function == ep->info.mfa.function); + ASSERT(ci->mfa.arity == ep->info.mfa.arity); + + ep->is_bif_traced = (ci->gen_bp != NULL); + } +} + +static void +consolidate_export_bp_data(BpFunctions* f) { BpFunction* fs = f->matching; Uint i, n; @@ -365,6 +391,19 @@ erts_consolidate_local_bp_data(BpFunctions* f) } } +void +erts_consolidate_all_bp_data(BpFunctions* f, BpFunctions* e) +{ + erts_consolidate_local_bp_data(f); + /* + * Must do export entries *after* module code + * so breakpoints in code have been cleared and + * Export.is_bif_traced can be updated accordingly. + */ + consolidate_export_bp_data(e); +} + + void erts_free_breakpoints(void) { @@ -387,7 +426,7 @@ consolidate_bp_data(struct erl_module_instance *mi, g = ci_rw->gen_bp; if (!g) { - return; + return; } prev_p = &ci_rw->gen_bp; @@ -423,7 +462,9 @@ consolidate_bp_data(struct erl_module_instance *mi, } #endif } - + if (!local) { + erts_update_export_is_bif_traced(ErtsContainerStruct(ci_rw, Export, info)); + } } @@ -710,9 +751,10 @@ erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, ErtsTracer tracer) } void -erts_set_export_trace(ErtsCodeInfo *ci, Binary *match_spec) +erts_set_export_trace(Export* ep, Binary *match_spec) { - set_function_break(ci, match_spec, ERTS_BPF_GLOBAL_TRACE, 0, erts_tracer_nil); + set_function_break(&ep->info, match_spec, ERTS_BPF_GLOBAL_TRACE, 0, + erts_tracer_nil); } void diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 3e8bca39c35f..143987bb5365 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -142,14 +142,15 @@ Uint erts_sum_all_session_flags(ErtsCodeInfo *ci_rw); void erts_uninstall_breakpoints(BpFunctions* f); void erts_consolidate_local_bp_data(BpFunctions* f); -void erts_consolidate_export_bp_data(BpFunctions* f); +void erts_consolidate_all_bp_data(BpFunctions* f, BpFunctions* e); void erts_free_breakpoints(void); void erts_set_trace_break(BpFunctions *f, Binary *match_spec); void erts_clear_trace_break(BpFunctions *f); -void erts_set_export_trace(ErtsCodeInfo *ci, Binary *match_spec); +void erts_set_export_trace(Export *ep, Binary *match_spec); void erts_clear_export_trace(ErtsCodeInfo *ci); +void erts_update_export_is_bif_traced(Export*); void erts_set_mtrace_break(BpFunctions *f, Binary *match_spec, ErtsTracer tracer); void erts_clear_mtrace_break(BpFunctions *f); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index eb57056c2bfa..d5b3c0110c7e 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -2387,54 +2387,13 @@ erts_set_trace_pattern(ErtsCodeMFA *mfa, int specified, ErtsTracer meta_tracer, int is_blocking) { const ErtsCodeIndex code_ix = erts_active_code_ix(); - Uint i, n, matches; + Uint i, n; + Uint matches = 0; BpFunction* fp; - erts_bp_match_export(&finish_bp.e, mfa, specified); - - fp = finish_bp.e.matching; - n = finish_bp.e.matched; - matches = 0; - - for (i = 0; i < n; i++) { - ErtsCodeInfo *ci_rw; - Export* ep; - - /* Export entries are always writable, discard const. */ - ci_rw = (ErtsCodeInfo *)fp[i].code_info; - ep = ErtsContainerStruct(ci_rw, Export, info); - - if (ep->bif_number != -1) { - ep->is_bif_traced = !!on; - } - - if (on && !flags.breakpoint) { - /* Turn on global call tracing */ - if (!erts_is_export_trampoline_active(ep, code_ix)) { - fp[i].mod->curr.num_traced_exports++; -#if defined(DEBUG) && !defined(BEAMASM) - ep->info.u.op = BeamOpCodeAddr(op_i_func_info_IaaI); -#endif - ep->trampoline.breakpoint.op = BeamOpCodeAddr(op_i_generic_breakpoint); - ep->trampoline.breakpoint.address = - (BeamInstr) ep->dispatch.addresses[code_ix]; - } - erts_set_export_trace(ci_rw, match_prog_set); - - } else if (!on && flags.breakpoint) { - /* Turn off breakpoint tracing -- nothing to do here. */ - } else { - /* - * Turn off global tracing, either explicitly or implicitly - * before turning on breakpoint tracing. - */ - erts_clear_export_trace(ci_rw); - } - } - /* - ** So, now for code breakpoint tracing - */ + * First do "local" code breakpoint tracing + */ erts_bp_match_functions(&finish_bp.f, mfa, specified); if (on) { @@ -2476,6 +2435,49 @@ erts_set_trace_pattern(ErtsCodeMFA *mfa, int specified, } } + /* + * Do export entries *after* module code, when breakpoints have been set + * and Export.is_bif_traced can be updated accordingly. + */ + erts_bp_match_export(&finish_bp.e, mfa, specified); + + fp = finish_bp.e.matching; + n = finish_bp.e.matched; + + for (i = 0; i < n; i++) { + ErtsCodeInfo *ci_rw; + Export* ep; + + /* Export entries are always writable, discard const. */ + ci_rw = (ErtsCodeInfo *)fp[i].code_info; + ep = ErtsContainerStruct(ci_rw, Export, info); + + if (on && !flags.breakpoint) { + /* Turn on global call tracing */ + if (!erts_is_export_trampoline_active(ep, code_ix)) { + fp[i].mod->curr.num_traced_exports++; +#if defined(DEBUG) && !defined(BEAMASM) + ep->info.u.op = BeamOpCodeAddr(op_i_func_info_IaaI); +#endif + ep->trampoline.breakpoint.op = BeamOpCodeAddr(op_i_generic_breakpoint); + ep->trampoline.breakpoint.address = + (BeamInstr) ep->dispatch.addresses[code_ix]; + } + erts_set_export_trace(ep, match_prog_set); + + } else if (!on && flags.breakpoint) { + /* Turn off breakpoint tracing -- nothing to do here. */ + } else { + /* + * Turn off global tracing, either explicitly or implicitly + * before turning on breakpoint tracing. + */ + erts_clear_export_trace(ci_rw); + } + + erts_update_export_is_bif_traced(ep); + } + finish_bp.current = 0; finish_bp.install = on; finish_bp.local = flags.breakpoint; @@ -2515,15 +2517,10 @@ prepare_clear_all_trace_pattern(ErtsTraceSession* session) for (i = 0; i < n; i++) { ErtsCodeInfo *ci_rw; - Export* ep; /* Export entries are always writable, discard const. */ ci_rw = (ErtsCodeInfo *)fp[i].code_info; - ep = ErtsContainerStruct(ci_rw, Export, info); - if (ep->bif_number != -1) { - ep->is_bif_traced = 0; // ToDo: multi sessions? - } erts_clear_export_trace(ci_rw); } @@ -2686,8 +2683,7 @@ erts_finish_breakpointing(void) * deallocate the GenericBp structs for them. */ clean_export_entries(&finish_bp.e); - erts_consolidate_export_bp_data(&finish_bp.e); - erts_consolidate_local_bp_data(&finish_bp.f); + erts_consolidate_all_bp_data(&finish_bp.f, &finish_bp.e); erts_bp_free_matched_functions(&finish_bp.e); erts_bp_free_matched_functions(&finish_bp.f); consolidate_event_tracing(erts_staging_trace_session->send_tracing); diff --git a/erts/emulator/test/trace_session_SUITE.erl b/erts/emulator/test/trace_session_SUITE.erl index f80bc4fa559a..dcbe6688bdd8 100644 --- a/erts/emulator/test/trace_session_SUITE.erl +++ b/erts/emulator/test/trace_session_SUITE.erl @@ -37,6 +37,8 @@ destroy/1, negative/1, error_info/1, + is_bif_traced/1, + end_of_list/1]). -include_lib("common_test/include/ct.hrl"). @@ -72,6 +74,8 @@ all() -> destroy, negative, error_info, + is_bif_traced, + end_of_list]. init_per_suite(Config) -> @@ -1634,6 +1638,86 @@ tracer_loop(Name, Tester) -> tracer_loop(Name, Tester). +%% OTP-19840: Verify setting/clearing of 'is_bif_traced' in export entry +%% works correctly for multiple sessions. +is_bif_traced(_Config) -> + CallTypes = [global, local], + [is_bif_traced_do(CT1, CT2, CT3) + || CT1 <- CallTypes, CT2 <- CallTypes, CT3 <- CallTypes], + ok. + +is_bif_traced_do(CT1, CT2, CT3) -> + io:format("CT1=~w, CT2=~w, CT3=~w\n", [CT1, CT2, CT3]), + + Tester = self(), + TracerFun = fun F() -> receive M -> Tester ! {self(), M} end, F() end, + T1 = spawn_link(TracerFun), + S1 = trace:session_create(one, T1, []), + + %% A benign BIF call that does not get optimized away + BIF = {erlang,phash2,1}, + {M,F,A} = BIF, + true = erlang:is_builtin(M,F,A), + + trace:function(S1, BIF, true, [CT1]), + trace:process(S1, self(), true, [call]), + + M:F("S1"), + {T1, {trace,Tester,call,{M,F,["S1"]}}} = receive_any(), + + T2 = spawn_link(TracerFun), + S2 = trace:session_create(two, T2, []), + trace:function(S2, BIF, true, [CT2]), + trace:process(S2, self(), true, [call]), + + M:F("S1 & S2"), + receive_parallel_list( + [[{T1, {trace,Tester,call,{M,F,["S1 & S2"]}}}], + [{T2, {trace,Tester,call,{M,F,["S1 & S2"]}}}]]), + + T3 = spawn_link(TracerFun), + S3 = trace:session_create(three, T3, []), + trace:function(S3, BIF, true, [CT3]), + trace:process(S3, self(), true, [call]), + + M:F("S1 & S2 & S3"), + receive_parallel_list( + [[{T1, {trace,Tester,call,{M,F,["S1 & S2 & S3"]}}}], + [{T2, {trace,Tester,call,{M,F,["S1 & S2 & S3"]}}}], + [{T3, {trace,Tester,call,{M,F,["S1 & S2 & S3"]}}}]]), + + %% Remove not last BIF trace nicely + trace:function(S1, BIF, false, [CT1]), + M:F("S2 & S3"), + receive_parallel_list( + [[{T2, {trace,Tester,call,{M,F,["S2 & S3"]}}}], + [{T3, {trace,Tester,call,{M,F,["S2 & S3"]}}}]]), + + %% Remove not last BIF trace by session destruction + trace:session_destroy(S2), + M:F("S3"), + receive_parallel_list( + [[{T3, {trace,Tester,call,{M,F,["S3"]}}}]]), + + %% Remove last BIF trace nicely + trace:function(S3, BIF, false, [CT3]), + M:F("no trace"), + receive_nothing(), + + trace:function(S1, BIF, true, [CT1]), + M:F("S1"), + receive_parallel_list( + [[{T1, {trace,Tester,call,{M,F,["S1"]}}}]]), + + %% Remove last BIF trace by session destruction + trace:session_destroy(S1), + M:F("no trace"), + receive_nothing(), + + trace:session_destroy(S3), + ok. + + receive_any() -> receive_any(1000). @@ -1643,7 +1727,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.