Skip to content

Commit a26f3ac

Browse files
committed
fixup! erts: Fix handling of Export.is_bif_traced for multi sessions
1 parent 311efb6 commit a26f3ac

File tree

4 files changed

+108
-65
lines changed

4 files changed

+108
-65
lines changed

erts/emulator/beam/beam_bp.c

Lines changed: 47 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -299,8 +299,36 @@ erts_bp_free_matched_functions(BpFunctions* f)
299299
else ASSERT(f->matched == 0);
300300
}
301301

302-
void
303-
erts_consolidate_export_bp_data(BpFunctions* f)
302+
/*
303+
* Set Export.is_bif_traced for BIFs
304+
* to true if breakpoint exist in either export trampoline or code
305+
* to false otherwise.
306+
*/
307+
static void set_export_is_bif_traced(Export *ep)
308+
{
309+
ErtsCodePtr code;
310+
const ErtsCodeInfo *ci;
311+
312+
if (ep->bif_number < 0) {
313+
ASSERT(!ep->is_bif_traced);
314+
return;
315+
}
316+
317+
if (ep->info.gen_bp && ep->is_bif_traced) {
318+
return;
319+
}
320+
321+
code = ep->dispatch.addresses[erts_active_code_ix()];
322+
ci = erts_code_to_codeinfo(code);
323+
ASSERT(ci->mfa.module == ep->info.mfa.module);
324+
ASSERT(ci->mfa.function == ep->info.mfa.function);
325+
ASSERT(ci->mfa.arity == ep->info.mfa.arity);
326+
327+
ep->is_bif_traced = (ep->info.gen_bp || ci->gen_bp);
328+
}
329+
330+
static void
331+
consolidate_export_bp_data(BpFunctions* f)
304332
{
305333
BpFunction* fs = f->matching;
306334
Uint i, n;
@@ -324,6 +352,8 @@ erts_consolidate_export_bp_data(BpFunctions* f)
324352
mi->code_length));
325353

326354
consolidate_bp_data(mi, ci_rw, 0);
355+
356+
set_export_is_bif_traced(ErtsContainerStruct(ci_rw, Export, info));
327357
}
328358
}
329359

@@ -365,6 +395,19 @@ erts_consolidate_local_bp_data(BpFunctions* f)
365395
}
366396
}
367397

398+
void
399+
erts_consolidate_all_bp_data(BpFunctions* f, BpFunctions* e)
400+
{
401+
erts_consolidate_local_bp_data(f);
402+
/*
403+
* Must do export entries *after* module code
404+
* so breakpoints in code have been cleared and
405+
* Export.is_bif_traced can be updated accordingly.
406+
*/
407+
consolidate_export_bp_data(e);
408+
}
409+
410+
368411
void
369412
erts_free_breakpoints(void)
370413
{
@@ -387,7 +430,7 @@ consolidate_bp_data(struct erl_module_instance *mi,
387430

388431
g = ci_rw->gen_bp;
389432
if (!g) {
390-
return;
433+
return;
391434
}
392435

393436
prev_p = &ci_rw->gen_bp;
@@ -412,10 +455,6 @@ consolidate_bp_data(struct erl_module_instance *mi,
412455
if (local) {
413456
mi->num_breakpoints--;
414457
} else {
415-
Export *ep = ErtsContainerStruct(ci_rw, Export, info);
416-
if (ep->bif_number != -1) {
417-
ep->is_bif_traced = 0;
418-
}
419458
mi->num_traced_exports--;
420459
}
421460
ASSERT(mi->num_breakpoints >= 0);
@@ -719,12 +758,7 @@ erts_set_export_trace(Export* ep, Binary *match_spec)
719758
set_function_break(&ep->info, match_spec, ERTS_BPF_GLOBAL_TRACE, 0,
720759
erts_tracer_nil);
721760

722-
if (ep->info.gen_bp && ep->bif_number != -1) {
723-
ep->is_bif_traced = 1;
724-
}
725-
else {
726-
ASSERT(!ep->is_bif_traced);
727-
}
761+
set_export_is_bif_traced(ep);
728762
}
729763

730764
void

erts/emulator/beam/beam_bp.h

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -142,7 +142,7 @@ Uint erts_sum_all_session_flags(ErtsCodeInfo *ci_rw);
142142
void erts_uninstall_breakpoints(BpFunctions* f);
143143

144144
void erts_consolidate_local_bp_data(BpFunctions* f);
145-
void erts_consolidate_export_bp_data(BpFunctions* f);
145+
void erts_consolidate_all_bp_data(BpFunctions* f, BpFunctions* e);
146146
void erts_free_breakpoints(void);
147147

148148
void erts_set_trace_break(BpFunctions *f, Binary *match_spec);

erts/emulator/beam/erl_bif_trace.c

Lines changed: 46 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -2387,50 +2387,13 @@ erts_set_trace_pattern(ErtsCodeMFA *mfa, int specified,
23872387
ErtsTracer meta_tracer, int is_blocking)
23882388
{
23892389
const ErtsCodeIndex code_ix = erts_active_code_ix();
2390-
Uint i, n, matches;
2390+
Uint i, n;
2391+
Uint matches = 0;
23912392
BpFunction* fp;
23922393

2393-
erts_bp_match_export(&finish_bp.e, mfa, specified);
2394-
2395-
fp = finish_bp.e.matching;
2396-
n = finish_bp.e.matched;
2397-
matches = 0;
2398-
2399-
for (i = 0; i < n; i++) {
2400-
ErtsCodeInfo *ci_rw;
2401-
Export* ep;
2402-
2403-
/* Export entries are always writable, discard const. */
2404-
ci_rw = (ErtsCodeInfo *)fp[i].code_info;
2405-
ep = ErtsContainerStruct(ci_rw, Export, info);
2406-
2407-
if (on && !flags.breakpoint) {
2408-
/* Turn on global call tracing */
2409-
if (!erts_is_export_trampoline_active(ep, code_ix)) {
2410-
fp[i].mod->curr.num_traced_exports++;
2411-
#if defined(DEBUG) && !defined(BEAMASM)
2412-
ep->info.u.op = BeamOpCodeAddr(op_i_func_info_IaaI);
2413-
#endif
2414-
ep->trampoline.breakpoint.op = BeamOpCodeAddr(op_i_generic_breakpoint);
2415-
ep->trampoline.breakpoint.address =
2416-
(BeamInstr) ep->dispatch.addresses[code_ix];
2417-
}
2418-
erts_set_export_trace(ep, match_prog_set);
2419-
2420-
} else if (!on && flags.breakpoint) {
2421-
/* Turn off breakpoint tracing -- nothing to do here. */
2422-
} else {
2423-
/*
2424-
* Turn off global tracing, either explicitly or implicitly
2425-
* before turning on breakpoint tracing.
2426-
*/
2427-
erts_clear_export_trace(ci_rw);
2428-
}
2429-
}
2430-
24312394
/*
2432-
** So, now for code breakpoint tracing
2433-
*/
2395+
* First do "local" code breakpoint tracing
2396+
*/
24342397
erts_bp_match_functions(&finish_bp.f, mfa, specified);
24352398

24362399
if (on) {
@@ -2472,6 +2435,47 @@ erts_set_trace_pattern(ErtsCodeMFA *mfa, int specified,
24722435
}
24732436
}
24742437

2438+
/*
2439+
* Do export entries after module code so breakpoints have been set
2440+
* and Export.is_bif_traced can be updated accordingly.
2441+
*/
2442+
erts_bp_match_export(&finish_bp.e, mfa, specified);
2443+
2444+
fp = finish_bp.e.matching;
2445+
n = finish_bp.e.matched;
2446+
2447+
for (i = 0; i < n; i++) {
2448+
ErtsCodeInfo *ci_rw;
2449+
Export* ep;
2450+
2451+
/* Export entries are always writable, discard const. */
2452+
ci_rw = (ErtsCodeInfo *)fp[i].code_info;
2453+
ep = ErtsContainerStruct(ci_rw, Export, info);
2454+
2455+
if (on && !flags.breakpoint) {
2456+
/* Turn on global call tracing */
2457+
if (!erts_is_export_trampoline_active(ep, code_ix)) {
2458+
fp[i].mod->curr.num_traced_exports++;
2459+
#if defined(DEBUG) && !defined(BEAMASM)
2460+
ep->info.u.op = BeamOpCodeAddr(op_i_func_info_IaaI);
2461+
#endif
2462+
ep->trampoline.breakpoint.op = BeamOpCodeAddr(op_i_generic_breakpoint);
2463+
ep->trampoline.breakpoint.address =
2464+
(BeamInstr) ep->dispatch.addresses[code_ix];
2465+
}
2466+
erts_set_export_trace(ep, match_prog_set);
2467+
2468+
} else if (!on && flags.breakpoint) {
2469+
/* Turn off breakpoint tracing -- nothing to do here. */
2470+
} else {
2471+
/*
2472+
* Turn off global tracing, either explicitly or implicitly
2473+
* before turning on breakpoint tracing.
2474+
*/
2475+
erts_clear_export_trace(ci_rw);
2476+
}
2477+
}
2478+
24752479
finish_bp.current = 0;
24762480
finish_bp.install = on;
24772481
finish_bp.local = flags.breakpoint;
@@ -2677,8 +2681,7 @@ erts_finish_breakpointing(void)
26772681
* deallocate the GenericBp structs for them.
26782682
*/
26792683
clean_export_entries(&finish_bp.e);
2680-
erts_consolidate_export_bp_data(&finish_bp.e);
2681-
erts_consolidate_local_bp_data(&finish_bp.f);
2684+
erts_consolidate_all_bp_data(&finish_bp.f, &finish_bp.e);
26822685
erts_bp_free_matched_functions(&finish_bp.e);
26832686
erts_bp_free_matched_functions(&finish_bp.f);
26842687
consolidate_event_tracing(erts_staging_trace_session->send_tracing);

erts/emulator/test/trace_session_SUITE.erl

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1641,19 +1641,25 @@ tracer_loop(Name, Tester) ->
16411641
%% OTP-19840: Verify setting/clearing of 'is_bif_traced' in export entry
16421642
%% works correctly for multiple sessions.
16431643
is_bif_traced(_Config) ->
1644+
CallTypes = [global, local],
1645+
[is_bif_traced_do(CT1, CT2, CT3)
1646+
|| CT1 <- CallTypes, CT2 <- CallTypes, CT3 <- CallTypes],
1647+
ok.
1648+
1649+
is_bif_traced_do(CT1, CT2, CT3) ->
16441650
Tester = self(),
16451651
TracerFun = fun F() -> receive M -> Tester ! {self(), M} end, F() end,
16461652
T1 = spawn_link(TracerFun),
16471653
S1 = trace:session_create(one, T1, []),
1648-
trace:function(S1, {erlang,display,1}, true, [global]),
1654+
trace:function(S1, {erlang,display,1}, true, [CT1]),
16491655
trace:process(S1, self(), true, [call]),
16501656

16511657
erlang:display("S1"),
16521658
{T1, {trace,Tester,call,{erlang,display,["S1"]}}} = receive_any(),
16531659

16541660
T2 = spawn_link(TracerFun),
16551661
S2 = trace:session_create(two, T2, []),
1656-
trace:function(S2, {erlang,display,1}, true, [global]),
1662+
trace:function(S2, {erlang,display,1}, true, [CT2]),
16571663
trace:process(S2, self(), true, [call]),
16581664

16591665
erlang:display("S1 & S2"),
@@ -1662,8 +1668,8 @@ is_bif_traced(_Config) ->
16621668
[{T2, {trace,Tester,call,{erlang,display,["S1 & S2"]}}}]]),
16631669

16641670
T3 = spawn_link(TracerFun),
1665-
S3 = trace:session_create(two, T3, []),
1666-
trace:function(S3, {erlang,display,1}, true, [global]),
1671+
S3 = trace:session_create(three, T3, []),
1672+
trace:function(S3, {erlang,display,1}, true, [CT3]),
16671673
trace:process(S3, self(), true, [call]),
16681674

16691675
erlang:display("S1 & S2 & S3"),
@@ -1673,7 +1679,7 @@ is_bif_traced(_Config) ->
16731679
[{T3, {trace,Tester,call,{erlang,display,["S1 & S2 & S3"]}}}]]),
16741680

16751681
%% Remove not last BIF trace nicely
1676-
trace:function(S1, {erlang,display,1}, false, [global]),
1682+
trace:function(S1, {erlang,display,1}, false, [CT1]),
16771683
erlang:display("S2 & S3"),
16781684
receive_parallel_list(
16791685
[[{T2, {trace,Tester,call,{erlang,display,["S2 & S3"]}}}],
@@ -1686,11 +1692,11 @@ is_bif_traced(_Config) ->
16861692
[[{T3, {trace,Tester,call,{erlang,display,["S3"]}}}]]),
16871693

16881694
%% Remove last BIF trace nicely
1689-
trace:function(S3, {erlang,display,1}, false, [global]),
1695+
trace:function(S3, {erlang,display,1}, false, [CT3]),
16901696
erlang:display("no trace"),
16911697
timeout = receive_any(),
16921698

1693-
trace:function(S1, {erlang,display,1}, true, [global]),
1699+
trace:function(S1, {erlang,display,1}, true, [CT1]),
16941700
erlang:display("S1"),
16951701
receive_parallel_list(
16961702
[[{T1, {trace,Tester,call,{erlang,display,["S1"]}}}]]),
@@ -1700,7 +1706,7 @@ is_bif_traced(_Config) ->
17001706
erlang:display("no trace"),
17011707
timeout = receive_any(),
17021708

1703-
1709+
trace:session_destroy(S3),
17041710
ok.
17051711

17061712

0 commit comments

Comments
 (0)