diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index d3296846b1f7..56ed5f679259 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -744,6 +744,7 @@ atom total_run_queue_lengths_all atom tpkt atom trace traced atom trace_control_word +atom trace_info_finish atom trace_status atom tracer atom trap_exit diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index e63e0665b49c..45c9e1534168 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -112,9 +112,9 @@ const ErtsCodeInfo* erts_trace_call_acc(Process* c_p, ErtsTraceSession*, process_breakpoint_trace_t *pbt, const ErtsCodeInfo *ci, - BpDataAccumulator accum, + BpTimemAccumulator accum, int psd_ix, - BpDataCallTrace* bdt); + BpTimemTrace* bdt); static ErtsTracer do_call_trace(Process* c_p, ErtsCodeInfo *info, Eterm* reg, int local, Binary* ms, @@ -123,6 +123,8 @@ static ErtsTracer do_call_trace(Process* c_p, ErtsCodeInfo *info, Eterm* reg, ErtsTracer tracer); static void set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, enum erts_break_op count_op, ErtsTracer tracer); +static GenericBp* get_bp_session(ErtsTraceSession*, const ErtsCodeInfo *ci, + int is_staging); static void set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, @@ -134,15 +136,15 @@ static void clear_function_break(const ErtsCodeInfo *ci, Uint break_flags); static void clear_all_sessions_function_break(const ErtsCodeInfo *ci); static void clear_function_break_session(GenericBp*, Uint break_flags); -static BpDataCallTrace* get_time_break(ErtsTraceSession*, const ErtsCodeInfo *ci); -static BpDataCallTrace* get_memory_break(ErtsTraceSession*, const ErtsCodeInfo *ci); +static BpTimemTrace* get_time_break(ErtsTraceSession*, const ErtsCodeInfo *ci); +static BpTimemTrace* get_memory_break(ErtsTraceSession*, const ErtsCodeInfo *ci); static GenericBpData* check_break(ErtsTraceSession *session, const ErtsCodeInfo *ci, Uint break_flags); static void bp_meta_unref(BpMetaTracer *bmt); static void bp_count_unref(BpCount *bcp); -static BpDataCallTrace* bp_calltrace_alloc(void); -static void bp_calltrace_unref(BpDataCallTrace *bdt); +static BpTimemTrace* bp_calltrace_alloc(void); +static void bp_calltrace_unref(BpTimemTrace *bdt); static void consolidate_bp_data(struct erl_module_instance *mi, ErtsCodeInfo *ci, int local); static void consolidate_bp_data_session(GenericBp* g); @@ -151,18 +153,19 @@ static void uninstall_breakpoint(ErtsCodeInfo *ci_rw, static Uint do_session_breakpoint(Process *c_p, ErtsCodeInfo *info, Eterm *reg, GenericBp* g); -/* bp_hash */ -#define BP_ACCUMULATE(pi0, pi1) \ - do { \ - (pi0)->count += (pi1)->count; \ - (pi0)->accumulator += (pi1)->accumulator; \ - } while(0) +static bp_pid_timem_hash_t *bp_hash_alloc(Uint n); +static bp_pid_timem_hash_t *bp_hash_rehash(bp_pid_timem_hash_t *hash, Uint n); +static ERTS_INLINE bp_pid_timem_bucket_t * bp_hash_get(bp_pid_timem_hash_t *hash, + const bp_pid_timem_bucket_t *sitem); +static ERTS_INLINE void bp_hash_put(bp_pid_timem_hash_t**, + const bp_pid_timem_bucket_t *sitem); +static void bp_hash_accum(bp_pid_timem_hash_t **hash_p, + const bp_pid_timem_bucket_t* sitem); +static void bp_hash_dealloc(bp_pid_timem_hash_t *hash); +static void bp_hash_reset(BpTimemTrace**); -static void bp_hash_init(bp_trace_hash_t *hash, Uint n); -static void bp_hash_rehash(bp_trace_hash_t *hash, Uint n); -static ERTS_INLINE bp_data_trace_item_t * bp_hash_get(bp_trace_hash_t *hash, bp_data_trace_item_t *sitem); -static ERTS_INLINE bp_data_trace_item_t * bp_hash_put(bp_trace_hash_t *hash, bp_data_trace_item_t *sitem); -static void bp_hash_delete(bp_trace_hash_t *hash); +static void collect_timem_info(BpTimemTrace* bdt, + bp_pid_timem_hash_t **tot_hash_p); /* ************************************************************************* ** External interfaces @@ -171,7 +174,6 @@ static void bp_hash_delete(bp_trace_hash_t *hash); void erts_bp_init(void) { erts_atomic32_init_nob(&erts_active_bp_index, 0); - erts_atomic32_init_nob(&erts_staging_bp_index, 1); erts_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index", NIL, ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG); } @@ -506,11 +508,10 @@ consolidate_bp_data_session(GenericBp* g) void erts_commit_staged_bp(void) { - ErtsBpIndex staging = erts_staging_bp_ix(); - ErtsBpIndex active = erts_active_bp_ix(); + const ErtsBpIndex new_active = erts_active_bp_ix() ^ 1; - erts_atomic32_set_nob(&erts_active_bp_index, staging); - erts_atomic32_set_nob(&erts_staging_bp_index, active); + ASSERT(new_active < 2); + erts_atomic32_set_nob(&erts_active_bp_index, new_active); } void @@ -1032,7 +1033,7 @@ do_session_breakpoint(Process *c_p, ErtsCodeInfo *info, Eterm *reg, Eterm* E; if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE) { - BpDataAccumulator time = get_mtime(c_p); + BpTimemAccumulator time = get_mtime(c_p); for (pbt = ERTS_PROC_GET_CALL_TIME(c_p); pbt; pbt = pbt->next) if (pbt->session == g->session) @@ -1043,7 +1044,7 @@ do_session_breakpoint(Process *c_p, ErtsCodeInfo *info, Eterm *reg, } if (bp_flags & ERTS_BPF_MEM_TRACE_ACTIVE) { - BpDataAccumulator allocated; + BpTimemAccumulator allocated; for (pbt = ERTS_PROC_GET_CALL_MEMORY(c_p); pbt; pbt = pbt->next) if (pbt->session == g->session) @@ -1222,13 +1223,12 @@ const ErtsCodeInfo* erts_trace_call_acc(Process* c_p, ErtsTraceSession *session, process_breakpoint_trace_t *pbt, - const ErtsCodeInfo *info, BpDataAccumulator accum, - int psd_ix, BpDataCallTrace* bdt) + const ErtsCodeInfo *info, BpTimemAccumulator accum, + int psd_ix, BpTimemTrace* bdt) { - bp_data_trace_item_t sitem, *item = NULL; - bp_trace_hash_t *h = NULL; - BpDataCallTrace *pbdt = NULL; - Uint32 six = acquire_bp_sched_ix(c_p); + bp_pid_timem_bucket_t sitem; + BpTimemTrace *pbdt = NULL; + const Uint32 six = acquire_bp_sched_ix(c_p); const ErtsCodeInfo* prev_info; ASSERT(c_p); @@ -1256,17 +1256,7 @@ erts_trace_call_acc(Process* c_p, /* if null then the breakpoint was removed */ if (pbdt) { - h = &(pbdt->hash[six]); - - ASSERT(h); - ASSERT(h->item); - - item = bp_hash_get(h, &sitem); - if (!item) { - item = bp_hash_put(h, &sitem); - } else { - BP_ACCUMULATE(item, &sitem); - } + bp_hash_accum(&(pbdt->threads[six]), &sitem); } } /*else caller is not call_time traced */ @@ -1277,18 +1267,7 @@ erts_trace_call_acc(Process* c_p, sitem.accumulator = 0; /* this breakpoint */ - ASSERT(bdt); - h = &(bdt->hash[six]); - - ASSERT(h); - ASSERT(h->item); - - item = bp_hash_get(h, &sitem); - if (!item) { - item = bp_hash_put(h, &sitem); - } else { - BP_ACCUMULATE(item, &sitem); - } + bp_hash_accum(&(bdt->threads[six]), &sitem); prev_info = pbt->ci; pbt->ci = info; @@ -1300,11 +1279,10 @@ erts_trace_call_acc(Process* c_p, static void -call_trace_add(Process *p, BpDataCallTrace *pbdt, Uint32 six, - BpDataAccumulator accum, BpDataAccumulator prev_accum) +call_trace_add(Process *p, BpTimemTrace *pbdt, Uint32 six, + BpTimemAccumulator accum, BpTimemAccumulator prev_accum) { - bp_data_trace_item_t sitem, *item = NULL; - bp_trace_hash_t *h = NULL; + bp_pid_timem_bucket_t sitem; sitem.accumulator = accum - prev_accum; sitem.pid = p->common.id; @@ -1312,18 +1290,7 @@ call_trace_add(Process *p, BpDataCallTrace *pbdt, Uint32 six, /* beware, the trace_pattern might have been removed */ if (pbdt) { - - h = &(pbdt->hash[six]); - - ASSERT(h); - ASSERT(h->item); - - item = bp_hash_get(h, &sitem); - if (!item) { - item = bp_hash_put(h, &sitem); - } else { - BP_ACCUMULATE(item, &sitem); - } + bp_hash_accum(&(pbdt->threads[six]), &sitem); } } @@ -1332,7 +1299,7 @@ erts_call_trace_return(Process *p, const ErtsCodeInfo *prev_info, Eterm bp_flags_term, Eterm session_weak_id) { process_breakpoint_trace_t *pbt = NULL; - BpDataCallTrace *pbdt; + BpTimemTrace *pbdt; Uint32 six; const Uint bp_flags = unsigned_val(bp_flags_term); ErtsTracerRef* ref; @@ -1442,53 +1409,228 @@ erts_is_count_break(ErtsTraceSession *session, const ErtsCodeInfo *ci, return 0; } -int erts_is_call_break(Process *p, ErtsTraceSession *session, int is_time, - const ErtsCodeInfo *ci, Eterm *retval) + +bool erts_is_time_break(ErtsTraceSession *session, const ErtsCodeInfo *ci) { - Uint i, ix; - bp_trace_hash_t hash; - bp_data_trace_item_t *item = NULL; - BpDataCallTrace *bdt = is_time ? get_time_break(session, ci) - : get_memory_break(session, ci); + return get_time_break(session, ci); +} - if (!bdt) - return 0; +bool erts_is_memory_break(ErtsTraceSession *session, const ErtsCodeInfo *ci) +{ + return get_memory_break(session, ci); +} - ASSERT(retval); - /* collect all hashes to one hash */ - bp_hash_init(&hash, 64); - /* foreach threadspecific hash */ - for (i = 0; i < bdt->n; i++) { - bp_data_trace_item_t *sitem; +/* + * Trap state for THE process doing trace:info + * to collect call_time and/or call_memory lists. +*/ +typedef struct { + Uint break_flags; + GenericBp *g; + bp_pid_timem_hash_t* time_tot_hash; + bp_pid_timem_hash_t* mem_tot_hash; +} FinishTimemInfo; + +static FinishTimemInfo finish_timem_info; + +bool erts_prepare_timem_trace_info(Process *p, + ErtsTraceSession *session, + bool want_call_time, + bool want_call_memory, + const ErtsCodeInfo *ci) +{ + GenericBp* g = get_bp_session(session, ci, 0); + GenericBpData* bp; + Uint break_flags; + +#ifndef BEAMASM + ASSERT(BeamIsOpCode(ci->u.op, op_i_func_info_IaaI)); +#endif + + if (!g) { + return false; + } + bp = &g->data[erts_staging_bp_ix()]; + ASSERT((bp->flags & ~ERTS_BPF_ALL) == 0); + ASSERT(!finish_timem_info.time_tot_hash); + ASSERT(!finish_timem_info.mem_tot_hash); + ASSERT(!finish_timem_info.break_flags); + ASSERT(!finish_timem_info.g); + + /* + * Paused call_time/memory counters can be collected right here + * while active ones need to be scheduled. + */ + + break_flags = 0; + if (want_call_time) { + const Uint time_flags = bp->flags & (ERTS_BPF_TIME_TRACE | + ERTS_BPF_TIME_TRACE_ACTIVE); + if (time_flags == ERTS_BPF_TIME_TRACE) { + collect_timem_info(bp->time, &finish_timem_info.time_tot_hash); + } + break_flags |= time_flags; + } + if (want_call_memory) { + const Uint mem_flags = bp->flags & (ERTS_BPF_MEM_TRACE | + ERTS_BPF_MEM_TRACE_ACTIVE); + if (mem_flags == ERTS_BPF_MEM_TRACE) { + collect_timem_info(bp->memory, &finish_timem_info.mem_tot_hash); + } + break_flags |= mem_flags; + } + + finish_timem_info.break_flags = break_flags; + + if (!(break_flags & (ERTS_BPF_TIME_TRACE_ACTIVE | + ERTS_BPF_MEM_TRACE_ACTIVE))) { + /* No active call_time or call_memory, no need for scheduling */ + return false; + } + + /* + * Ok, we must do some scheduling to safely collect active call_time/memory + * info from the thread specific hash tables. + * The strategy is: + * 1. Allocate temporary zeroed hashes for any traced calls that may happen + * during the call to trace:info. + * 2. Thread progress + * 3. Switch bp index to make the temp hashes active. + * 4. Thread progress. + * 5. Collect stats from the real hashes that are now unused and stable. + * 6. Switch back bp index to make the real hashes active again. + * 7. Thread progress. + * 8. Consolidate by collecting stats from the temp hashes into the + * active generation. + * 9. Deallocate the temp hashes and make the two halves of the breakpoint + * identical again using the same real hashes. + */ + if (break_flags & ERTS_BPF_TIME_TRACE_ACTIVE) { + ASSERT(bp->time); + bp_hash_reset(&bp->time); + ASSERT(finish_timem_info.time_tot_hash == NULL); + } + if (break_flags & ERTS_BPF_MEM_TRACE_ACTIVE) { + ASSERT(bp->memory); + bp_hash_reset(&bp->memory); + ASSERT(finish_timem_info.mem_tot_hash == NULL); + } + + finish_timem_info.g = g; + + return true; // Prepared to trap +} + +void erts_timem_info_collect(void) +{ + FinishTimemInfo *fin = &finish_timem_info; + GenericBpData *bp = &fin->g->data[erts_staging_bp_ix()]; + + ERTS_LC_ASSERT(erts_has_code_mod_permission()); + + /* Collect all thread hashes into temporary result hashes */ + + if (fin->break_flags & ERTS_BPF_TIME_TRACE_ACTIVE) { + ASSERT(fin->time_tot_hash == NULL); + collect_timem_info(bp->time, &fin->time_tot_hash); + } + + if (fin->break_flags & ERTS_BPF_MEM_TRACE_ACTIVE) { + ASSERT(fin->mem_tot_hash == NULL); + collect_timem_info(bp->memory, &fin->mem_tot_hash); + } +} + +static void collect_timem_info(BpTimemTrace* bdt, + bp_pid_timem_hash_t **tot_hash_p) +{ + ASSERT(bdt); + + /* foreach threadspecific hash */ + for (Uint i = 0; i < bdt->nthreads; i++) { + if (!bdt->threads[i]) { + continue; + } /* foreach hash bucket not NIL*/ - for(ix = 0; ix < bdt->hash[i].n; ix++) { - item = &(bdt->hash[i].item[ix]); + for(Uint ix = 0; ix < bdt->threads[i]->n; ix++) { + bp_pid_timem_bucket_t *item; + + item = &(bdt->threads[i]->buckets[ix]); if (item->pid != NIL) { - sitem = bp_hash_get(&hash, item); - if (sitem) { - BP_ACCUMULATE(sitem, item); - } else { - bp_hash_put(&hash, item); - } + bp_hash_accum(tot_hash_p, item); } } } - /* *retval should be NIL or term from previous bif in export entry */ +} - if (hash.used > 0) { - Uint size; - Eterm *hp, *hp_end, t; +void erts_timem_info_consolidate() +{ + FinishTimemInfo *fin = &finish_timem_info; + GenericBpData *staging = &fin->g->data[erts_staging_bp_ix()]; + GenericBpData *active = &fin->g->data[erts_active_bp_ix()]; + const Uint dirty_ix = erts_no_schedulers; - size = hash.used * (is_time ? (2+5) : (2+4+ERTS_MAX_SINT64_HEAP_SIZE)); - hp = HAlloc(p, size); - hp_end = hp + size; + ERTS_LC_ASSERT(erts_has_code_mod_permission()); + ASSERT(staging->flags == active->flags); + ASSERT(staging->flags & (ERTS_BPF_TIME_TRACE_ACTIVE | ERTS_BPF_MEM_TRACE_ACTIVE)); - for(ix = 0; ix < hash.n; ix++) { - item = &(hash.item[ix]); - if (item->pid != NIL) { - if (is_time) { - BpDataAccumulator sec, usec; + /* + * We consolidate by collecting any stats from temporary hashes, + * delete them and make the two breakpoint halves identical again. + * + * We collect stats into the active hashes for dirty schedulers. This is + * safe as the dirty hashes are lock proctected. An alternative solution + * could be to have dedicated consolidation hash tables to avoid + * the locking here. + */ + + erts_mtx_lock(&erts_dirty_bp_ix_mtx); + + if (fin->break_flags & ERTS_BPF_TIME_TRACE_ACTIVE) { + ASSERT(staging->flags & ERTS_BPF_TIME_TRACE_ACTIVE); + collect_timem_info(staging->time, &(active->time->threads[dirty_ix])); + + bp_calltrace_unref(staging->time); + staging->time = active->time; + erts_refc_inc(&staging->time->refc, 2); + } + if (fin->break_flags & ERTS_BPF_MEM_TRACE_ACTIVE) { + ASSERT(staging->flags & ERTS_BPF_MEM_TRACE_ACTIVE); + collect_timem_info(staging->memory, &(active->memory->threads[dirty_ix])); + + bp_calltrace_unref(staging->memory); + staging->memory = active->memory; + erts_refc_inc(&staging->memory->refc, 2); + } + + erts_mtx_unlock(&erts_dirty_bp_ix_mtx); +} + +void erts_build_timem_info(Process* p, + Eterm *call_time, + Eterm *call_memory) +{ + ERTS_LC_ASSERT(erts_has_code_mod_permission()); + + /* Build call_time list of {Pid, CallCount, Sec, USec} */ + if (finish_timem_info.break_flags & ERTS_BPF_TIME_TRACE) { + bp_pid_timem_hash_t* time_tot_hash = finish_timem_info.time_tot_hash; + Eterm list = NIL; + + if (time_tot_hash && time_tot_hash->used > 0) { + Uint size; + Eterm *hp, *hp_end; + + size = time_tot_hash->used * (2+5); + hp = HAlloc(p, size); + hp_end = hp + size; + + for(Uint ix = 0; ix < time_tot_hash->n; ix++) { + bp_pid_timem_bucket_t *item = &(time_tot_hash->buckets[ix]); + if (item->pid != NIL) { + BpTimemAccumulator sec, usec; + Eterm t; usec = ERTS_MONOTONIC_TO_USEC(item->accumulator); sec = usec / 1000000; usec = usec - sec*1000000; @@ -1497,24 +1639,67 @@ int erts_is_call_break(Process *p, ErtsTraceSession *session, int is_time, make_small((Uint) sec), make_small((Uint) usec)); hp += 5; + list = CONS(hp, t, list); + hp += 2; } - else { + } + ASSERT(hp <= hp_end); + HRelease(p, hp_end, hp); + } + *call_time = list; + } + + /* Build call_memory list of {Pid, CallCount, Words} */ + if (finish_timem_info.break_flags & ERTS_BPF_MEM_TRACE) { + bp_pid_timem_hash_t* mem_tot_hash = finish_timem_info.mem_tot_hash; + Eterm list = NIL; + + if (mem_tot_hash && mem_tot_hash->used > 0) { + Uint size; + Eterm *hp, *hp_end; + + size = mem_tot_hash->used * (2+4+ERTS_MAX_SINT64_HEAP_SIZE); + hp = HAlloc(p, size); + hp_end = hp + size; + + for(Uint ix = 0; ix < mem_tot_hash->n; ix++) { + bp_pid_timem_bucket_t *item = &(mem_tot_hash->buckets[ix]); + if (item->pid != NIL) { Eterm words = erts_bld_sint64(&hp, NULL, item->accumulator); - t = TUPLE3(hp, item->pid, - make_small(item->count), - words); + Eterm t = TUPLE3(hp, item->pid, + make_small(item->count), + words); hp += 4; + list = CONS(hp, t, list); + hp += 2; } - *retval = CONS(hp, t, *retval); hp += 2; } + ASSERT(hp <= hp_end); + HRelease(p, hp_end, hp); } - ASSERT(hp <= hp_end); - HRelease(p, hp_end, hp); + *call_memory = list; + } +} + +void erts_free_timem_info(void) +{ + FinishTimemInfo *fin = &finish_timem_info; + + ERTS_LC_ASSERT(erts_has_code_mod_permission()); + + if (fin->time_tot_hash) { + bp_hash_dealloc(fin->time_tot_hash); + fin->time_tot_hash = NULL; } - bp_hash_delete(&hash); - return 1; + if (fin->mem_tot_hash) { + bp_hash_dealloc(fin->mem_tot_hash); + fin->mem_tot_hash = NULL; + } + fin->break_flags = 0; + fin->g = NULL; } + void erts_install_line_breakpoint(struct erl_module_instance *mi, ErtsCodePtr cp_exec) { ErtsCodePtr cp_rw; @@ -1668,76 +1853,65 @@ erts_find_local_func(const ErtsCodeMFA *mfa) { return NULL; } -static void bp_hash_init(bp_trace_hash_t *hash, Uint n) { - Uint size = sizeof(bp_data_trace_item_t)*n; - Uint i; +static bp_pid_timem_hash_t *bp_hash_alloc(Uint n) +{ + bp_pid_timem_hash_t *hash; + const Uint size = sizeof(*hash) + n * sizeof(hash->buckets[0]); + + hash = Alloc(size); hash->n = n; hash->used = 0; - hash->item = (bp_data_trace_item_t *)Alloc(size); - sys_memzero(hash->item, size); - - for(i = 0; i < n; ++i) { - hash->item[i].pid = NIL; + for(Uint i = 0; i < n; ++i) { + hash->buckets[i].pid = NIL; } + return hash; } -static void bp_hash_rehash(bp_trace_hash_t *hash, Uint n) { - bp_data_trace_item_t *item = NULL; - Uint size = sizeof(bp_data_trace_item_t)*n; - Uint ix; - Uint hval; +static bp_pid_timem_hash_t *bp_hash_rehash(bp_pid_timem_hash_t *hash, Uint n) +{ + bp_pid_timem_hash_t* ERTS_RESTRICT dst; ASSERT(n > 0); - - item = (bp_data_trace_item_t *)Alloc(size); - sys_memzero(item, size); - - for( ix = 0; ix < n; ++ix) { - item[ix].pid = NIL; - } - + dst = bp_hash_alloc(n); /* rehash, old hash -> new hash */ - for( ix = 0; ix < hash->n; ix++) { - if (hash->item[ix].pid != NIL) { - - hval = ((hash->item[ix].pid) >> 4) % n; /* new n */ + for(Uint ix = 0; ix < hash->n; ix++) { + if (hash->buckets[ix].pid != NIL) { + Uint hval = ((hash->buckets[ix].pid) >> 4) % n; /* new n */ - while (item[hval].pid != NIL) { + while (dst->buckets[hval].pid != NIL) { hval = (hval + 1) % n; } - item[hval].pid = hash->item[ix].pid; - item[hval].count = hash->item[ix].count; - item[hval].accumulator = hash->item[ix].accumulator; + dst->buckets[hval] = hash->buckets[ix]; } } - - Free(hash->item); - hash->n = n; - hash->item = item; + dst->used = hash->used; + Free(hash); + return dst; } -static ERTS_INLINE bp_data_trace_item_t * bp_hash_get(bp_trace_hash_t *hash, bp_data_trace_item_t *sitem) { +static ERTS_INLINE +bp_pid_timem_bucket_t * bp_hash_get(bp_pid_timem_hash_t *hash, + const bp_pid_timem_bucket_t *sitem) { Eterm pid = sitem->pid; Uint hval = (pid >> 4) % hash->n; - bp_data_trace_item_t *item = NULL; - - item = hash->item; - while (item[hval].pid != pid) { - if (item[hval].pid == NIL) return NULL; + while (hash->buckets[hval].pid != pid) { + if (hash->buckets[hval].pid == NIL) return NULL; hval = (hval + 1) % hash->n; } - return &(item[hval]); + return &(hash->buckets[hval]); } -static ERTS_INLINE bp_data_trace_item_t * bp_hash_put(bp_trace_hash_t *hash, bp_data_trace_item_t* sitem) { +static ERTS_INLINE void bp_hash_put(bp_pid_timem_hash_t **hash_p, + const bp_pid_timem_bucket_t* sitem) +{ + bp_pid_timem_hash_t *hash = *hash_p; Uint hval; float r = 0.0; - bp_data_trace_item_t *item; /* make sure that the hash is not saturated */ /* if saturated, rehash it */ @@ -1745,44 +1919,51 @@ static ERTS_INLINE bp_data_trace_item_t * bp_hash_put(bp_trace_hash_t *hash, bp_ r = hash->used / (float) hash->n; if (r > 0.7f) { - bp_hash_rehash(hash, hash->n * 2); + hash = bp_hash_rehash(hash, hash->n * 2); + *hash_p = hash; } /* Do hval after rehash */ hval = (sitem->pid >> 4) % hash->n; - /* find free slot */ - item = hash->item; - - while (item[hval].pid != NIL) { + while (hash->buckets[hval].pid != NIL) { hval = (hval + 1) % hash->n; } - item = &(hash->item[hval]); - item->pid = sitem->pid; - item->accumulator = sitem->accumulator; - item->count = sitem->count; + hash->buckets[hval] = *sitem; hash->used++; +} + +static void bp_hash_accum(bp_pid_timem_hash_t **hash_p, + const bp_pid_timem_bucket_t* sitem) +{ + bp_pid_timem_bucket_t *item; + + if (*hash_p == NULL) { + *hash_p = bp_hash_alloc(32); + } - return item; + item = bp_hash_get(*hash_p, sitem); + if (!item) { + bp_hash_put(hash_p, sitem); + } else { + item->count += sitem->count; + item->accumulator += sitem->accumulator; + } } -static void bp_hash_delete(bp_trace_hash_t *hash) { - hash->n = 0; - hash->used = 0; - Free(hash->item); - hash->item = NULL; +static void bp_hash_dealloc(bp_pid_timem_hash_t *hash) { + Free(hash); } -static void bp_hash_reset(BpDataCallTrace** bdt_p) { +static void bp_hash_reset(BpTimemTrace** bdt_p) { bp_calltrace_unref(*bdt_p); *bdt_p = bp_calltrace_alloc(); } void erts_schedule_time_break(Process *p, Uint schedule) { process_breakpoint_trace_t *pbt = NULL; - bp_data_trace_item_t sitem, *item = NULL; - bp_trace_hash_t *h = NULL; - BpDataCallTrace *pbdt = NULL; + bp_pid_timem_bucket_t sitem; + BpTimemTrace *pbdt = NULL; Uint32 six = acquire_bp_sched_ix(p); ASSERT(p); @@ -1804,17 +1985,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { sitem.pid = p->common.id; sitem.count = 0; - h = &(pbdt->hash[six]); - - ASSERT(h); - ASSERT(h->item); - - item = bp_hash_get(h, &sitem); - if (!item) { - item = bp_hash_put(h, &sitem); - } else { - BP_ACCUMULATE(item, &sitem); - } + bp_hash_accum(&(pbdt->threads[six]), &sitem); } } } @@ -2051,7 +2222,7 @@ set_function_break(ErtsCodeInfo *ci, erts_atomic_init_nob(&bcp->acount, 0); bp->count = bcp; } else if (break_flags & (ERTS_BPF_TIME_TRACE | ERTS_BPF_MEM_TRACE)) { - BpDataCallTrace* bdt; + BpTimemTrace* bdt; ASSERT((break_flags & bp->flags & ERTS_BPF_TIME_TRACE) == 0); ASSERT((break_flags & bp->flags & ERTS_BPF_MEM_TRACE) == 0); @@ -2156,40 +2327,39 @@ bp_count_unref(BpCount* bcp) } } -static BpDataCallTrace* bp_calltrace_alloc(void) +static BpTimemTrace* bp_calltrace_alloc(void) { const Uint n = erts_no_schedulers + 1; - BpDataCallTrace *bdt = Alloc(offsetof(BpDataCallTrace,hash) + - sizeof(bp_trace_hash_t)*n); - bdt->n = n; + BpTimemTrace *bdt = Alloc(sizeof(*bdt) + n * sizeof(bdt->threads[0])); + bdt->nthreads = n; erts_refc_init(&bdt->refc, 1); for (Uint i = 0; i < n; i++) { - bp_hash_init(&(bdt->hash[i]), 32); + bdt->threads[i] = NULL; // allocate on demand } return bdt; } static void -bp_calltrace_unref(BpDataCallTrace* bdt) +bp_calltrace_unref(BpTimemTrace* bdt) { if (erts_refc_dectest(&bdt->refc, 0) <= 0) { - Uint i = 0; - - for (i = 0; i < bdt->n; ++i) { - bp_hash_delete(&(bdt->hash[i])); + for (Uint i = 0; i < bdt->nthreads; ++i) { + if (bdt->threads[i]) { + bp_hash_dealloc(bdt->threads[i]); + } } Free(bdt); } } -static BpDataCallTrace* +static BpTimemTrace* get_time_break(ErtsTraceSession *session, const ErtsCodeInfo *ci) { GenericBpData* bp = check_break(session, ci, ERTS_BPF_TIME_TRACE); return bp ? bp->time : 0; } -static BpDataCallTrace* +static BpTimemTrace* get_memory_break(ErtsTraceSession *session, const ErtsCodeInfo *ci) { GenericBpData* bp = check_break(session, ci, ERTS_BPF_MEM_TRACE); diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 388d3e02139d..0c3cab4b19b5 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -33,33 +33,33 @@ * to support anything other than a simple 8-byte number. When such * a use-case is identified, this type could be turned into a union. */ -typedef ErtsMonotonicTime BpDataAccumulator; +typedef ErtsMonotonicTime BpTimemAccumulator; typedef struct { Eterm pid; Sint count; - BpDataAccumulator accumulator; -} bp_data_trace_item_t; + BpTimemAccumulator accumulator; +} bp_pid_timem_bucket_t; typedef struct { Uint n; Uint used; - bp_data_trace_item_t *item; -} bp_trace_hash_t; + bp_pid_timem_bucket_t buckets[]; +} bp_pid_timem_hash_t; -typedef struct bp_data_time { /* Call time, Memory trace */ - Uint n; +typedef struct { /* Call time, Memory trace */ + Uint nthreads; erts_refc_t refc; - bp_trace_hash_t hash[1]; -} BpDataCallTrace; + bp_pid_timem_hash_t* threads[]; +} BpTimemTrace; typedef struct process_breakpoint_trace_t { struct process_breakpoint_trace_t *next; ErtsTraceSession *session; const ErtsCodeInfo *ci; - BpDataAccumulator accumulator; - BpDataAccumulator allocated; /* adjustment for GC and messages on the heap */ + BpTimemAccumulator accumulator; + BpTimemAccumulator allocated; /* adjustment for GC and messages on the heap */ } process_breakpoint_trace_t; /* used within psd */ typedef struct { @@ -78,8 +78,8 @@ typedef struct GenericBpData { Binary* meta_ms; /* Match spec for meta trace */ BpMetaTracer* meta_tracer; /* Meta tracer */ BpCount* count; /* For call count */ - BpDataCallTrace* time; /* For time trace */ - BpDataCallTrace* memory; /* For memory trace */ + BpTimemTrace* time; /* For time trace */ + BpTimemTrace* memory; /* For memory trace */ } GenericBpData; typedef struct GenericBp { @@ -180,8 +180,18 @@ int erts_is_mtrace_break(ErtsTraceSession *session, const ErtsCodeInfo *ci, int erts_is_count_break(ErtsTraceSession *session, const ErtsCodeInfo *ci, Uint *count_ret); -int erts_is_call_break(Process *p, ErtsTraceSession *session, int is_time, - const ErtsCodeInfo *ci, Eterm *call_time); +bool erts_is_time_break(ErtsTraceSession*, const ErtsCodeInfo*); +bool erts_is_memory_break(ErtsTraceSession*, const ErtsCodeInfo*); +bool erts_prepare_timem_trace_info(Process *p, + ErtsTraceSession*, + bool want_call_time, + bool want_call_memory, + const ErtsCodeInfo*); +void erts_timem_info_collect(void); +void erts_timem_info_consolidate(void); +void erts_build_timem_info(Process* p, + Eterm *call_time, Eterm *call_memory); +void erts_free_timem_info(void); void erts_call_trace_return(Process* c_p, const ErtsCodeInfo *ci, Eterm bp_flags_term, Eterm session_weak_id); @@ -223,7 +233,7 @@ ERTS_GLB_INLINE ErtsBpIndex erts_active_bp_ix(void) ERTS_GLB_INLINE ErtsBpIndex erts_staging_bp_ix(void) { - return erts_atomic32_read_nob(&erts_staging_bp_index); + return erts_atomic32_read_nob(&erts_active_bp_index) ^ 1; } ERTS_GLB_INLINE diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 3ab153e2a683..d381ffc2f09b 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -90,9 +90,13 @@ static void send_trace_clean_ack(Process *p); static void new_seq_trace_token(Process* p, int); /* help func for seq_trace_2*/ -static Eterm trace_info(Process*, ErtsTraceSession*, Eterm What, Eterm Key); +static Eterm trace_info(Process*, ErtsTraceSession*, Eterm What, Eterm Key, + bool *to_be_continued_p); static Eterm trace_info_pid(Process* p, ErtsTraceSession*, Eterm pid_spec, Eterm key); -static Eterm trace_info_func(Process* p, ErtsTraceSession*, Eterm pid_spec, Eterm key); +static Eterm trace_info_func(Process* p, ErtsTraceSession*, Eterm pid_spec, + Eterm key, bool *to_be_continued_p); +static Eterm trace_info_func_epilogue(Process*, ErtsTraceSession*, + const ErtsCodeMFA *mfa, Eterm key, int want); static Eterm trace_info_func_sessions(Process* p, Eterm func_spec, Eterm key); static Eterm trace_info_on_load(Process* p, ErtsTraceSession*, Eterm key); static Eterm trace_info_sessions(Process* p, Eterm What, Eterm key); @@ -114,12 +118,16 @@ erts_rwmtx_t erts_trace_session_list_lock; erts_refc_t erts_new_procs_trace_cnt; erts_refc_t erts_new_ports_trace_cnt; -ErtsTraceSession* erts_trace_cleaner_wait_list; -erts_mtx_t erts_trace_cleaner_lock; - -ErtsTraceSession* erts_trace_cleaner_do_list; +static ErtsTraceSession* erts_trace_cleaner_wait_list; +static erts_mtx_t erts_trace_cleaner_lock; +static ErtsTraceSession* erts_trace_cleaner_do_list; +static Eterm trace_info_trap_arg(Process*); +static int trace_info_trap_destructor(Binary*); +static void trace_info_finisher(void* null); +static Export bif_trace_info_finish_export; +static BIF_RETTYPE bif_trace_info_finish_trap(BIF_ALIST_1); static int erts_trace_session_init(ErtsTraceSession* s, ErtsTracer tracer, @@ -280,6 +288,11 @@ erts_bif_trace_init(void) ERTS_LOCK_FLAGS_CATEGORY_GENERIC); erts_refc_init(&erts_new_procs_trace_cnt, 0); erts_refc_init(&erts_new_ports_trace_cnt, 0); + + + erts_init_trap_export(&bif_trace_info_finish_export, + am_erlang, am_trace_info_finish, 1, + &bif_trace_info_finish_trap); } /* @@ -1386,23 +1399,28 @@ trace_session_destroy(ErtsTraceSession* session) */ Eterm trace_info_2(BIF_ALIST_2) { + bool to_be_continued = false; Eterm ret; + if (!erts_try_seize_code_mod_permission(BIF_P)) { ERTS_BIF_YIELD2(BIF_TRAP_EXPORT(BIF_trace_info_2), BIF_P, BIF_ARG_1, BIF_ARG_2); } - ret = trace_info(BIF_P, &erts_trace_session_0, BIF_ARG_1, BIF_ARG_2); - erts_release_code_mod_permission(); + ret = trace_info(BIF_P, &erts_trace_session_0, BIF_ARG_1, BIF_ARG_2, + &to_be_continued); + if (!to_be_continued) { + erts_release_code_mod_permission(); + } return ret; } -/* Called by erlang:trace_info/2 - * trace:info/3 +/* Called by trace:info/3 * trace:session_info/1 */ Eterm erts_internal_trace_info_3(BIF_ALIST_3) { ErtsTraceSession* session; + bool to_be_continued = false; Eterm ret; if (BIF_ARG_1 == am_any) { @@ -1428,10 +1446,12 @@ Eterm erts_internal_trace_info_3(BIF_ALIST_3) goto session_error; } - ret = trace_info(BIF_P, session, BIF_ARG_2, BIF_ARG_3); - erts_release_code_mod_permission(); - if (session) { - erts_deref_trace_session(session); + ret = trace_info(BIF_P, session, BIF_ARG_2, BIF_ARG_3, &to_be_continued); + if (!to_be_continued) { + erts_release_code_mod_permission(); + if (session) { + erts_deref_trace_session(session); + } } return ret; @@ -1441,7 +1461,8 @@ Eterm erts_internal_trace_info_3(BIF_ALIST_3) } static -Eterm trace_info(Process* p, ErtsTraceSession* session, Eterm What, Eterm Key) +Eterm trace_info(Process* p, ErtsTraceSession* session, Eterm What, Eterm Key, + bool *to_be_continued_p) { Eterm res = THE_NON_VALUE; @@ -1455,7 +1476,7 @@ Eterm trace_info(Process* p, ErtsTraceSession* session, Eterm What, Eterm Key) } else if (is_atom(What) || is_pid(What) || is_port(What)) { res = trace_info_pid(p, session, What, Key); } else if (is_tuple(What)) { - res = trace_info_func(p, session, What, Key); + res = trace_info_func(p, session, What, Key, to_be_continued_p); } else { goto badopt; } @@ -1798,51 +1819,58 @@ trace_info_pid(Process* p, ErtsTraceSession* session, Eterm pid_spec, Eterm key) static int function_is_traced(Process *p, ErtsTraceSession *session, const ErtsCodeMFA *mfa, + int want, Binary **ms, /* out */ Binary **ms_meta, /* out */ ErtsTracer *tracer_pid_meta, /* out */ - Uint *count, /* out */ - Eterm *call_time, /* out */ - Eterm *call_memory) /* out */ + Uint *count) /* out */ { const ErtsCodeInfo *ci; - const Export *ep; - Export e; /* First look for an export entry */ - e.info.mfa = *mfa; - if ((ep = export_get(&e)) != NULL) { - if (erts_is_export_trampoline_active(ep, erts_active_code_ix()) && - ! BeamIsOpCode(ep->trampoline.common.op, op_call_error_handler)) { + if (want & FUNC_TRACE_GLOBAL_TRACE) { + const Export *ep; + Export e; - ASSERT(BeamIsOpCode(ep->trampoline.common.op, op_i_generic_breakpoint)); + e.info.mfa = *mfa; + if ((ep = export_get(&e)) != NULL) { + if (erts_is_export_trampoline_active(ep, erts_active_code_ix()) && + ! BeamIsOpCode(ep->trampoline.common.op, op_call_error_handler)) { - if (erts_is_trace_break(session, &ep->info, ms, 0)) { - return FUNC_TRACE_GLOBAL_TRACE; - } + ASSERT(BeamIsOpCode(ep->trampoline.common.op, op_i_generic_breakpoint)); - ASSERT(!erts_is_trace_break(session, &ep->info, ms, 1)); - ASSERT(!erts_is_mtrace_break(session, &ep->info, ms_meta, tracer_pid_meta)); - ASSERT(!erts_is_call_break(p, session, 1, &ep->info, call_time)); - ASSERT(!erts_is_call_break(p, session, 0, &ep->info, call_memory)); - } + if (erts_is_trace_break(session, &ep->info, ms, 0)) { + return FUNC_TRACE_GLOBAL_TRACE; + } + + ASSERT(!erts_is_trace_break(session, &ep->info, ms, 1)); + ASSERT(!erts_is_mtrace_break(session, &ep->info, ms_meta, tracer_pid_meta)); + ASSERT(!erts_is_time_break(session, &ep->info)); + ASSERT(!erts_is_memory_break(session, &ep->info)); + } + } } /* OK, now look for breakpoint tracing */ if ((ci = erts_find_local_func(mfa)) != NULL) { - int r = 0; - if (erts_is_trace_break(session, ci, ms, 1)) - r |= FUNC_TRACE_LOCAL_TRACE; - if (erts_is_mtrace_break(session, ci, ms_meta, tracer_pid_meta)) - r |= FUNC_TRACE_META_TRACE; - if (erts_is_count_break(session, ci, count)) - r |= FUNC_TRACE_COUNT_TRACE; - if (erts_is_call_break(p, session, 1, ci, call_time)) - r |= FUNC_TRACE_TIME_TRACE; - if (erts_is_call_break(p, session, 0, ci, call_memory)) - r |= FUNC_TRACE_MEMORY_TRACE; - - return r ? r : FUNC_TRACE_UNTRACED; + int got = 0; + + if ((want & FUNC_TRACE_LOCAL_TRACE) && erts_is_trace_break(session, ci, ms, 1)) { + got |= FUNC_TRACE_LOCAL_TRACE; + } + if ((want & FUNC_TRACE_META_TRACE) && erts_is_mtrace_break(session, ci, ms_meta, tracer_pid_meta)) { + got |= FUNC_TRACE_META_TRACE; + } + if ((want & FUNC_TRACE_COUNT_TRACE) && erts_is_count_break(session, ci, count)) { + got |= FUNC_TRACE_COUNT_TRACE; + } + if ((want & FUNC_TRACE_TIME_TRACE) && erts_is_time_break(session, ci)) { + got |= FUNC_TRACE_TIME_TRACE; + } + if ((want & FUNC_TRACE_MEMORY_TRACE) && erts_is_memory_break(session, ci)) { + got |= FUNC_TRACE_MEMORY_TRACE; + } + return got ? got : FUNC_TRACE_UNTRACED; } return FUNC_TRACE_NOEXIST; } @@ -1905,21 +1933,23 @@ static int get_mfa_tuple(Eterm func_spec, ErtsCodeMFA* mfa) return 1; } +struct { + Process *p; + ErtsTraceSession *session; + ErtsCodeMFA mfa; + Eterm key; + int want; + int phase; + Binary *trap_mbin; + ErtsCodeBarrier barrier; +} trace_info_state; + static Eterm trace_info_func(Process* p, ErtsTraceSession* session, - Eterm func_spec, Eterm key) + Eterm func_spec, Eterm key, bool *to_be_continued_p) { - Eterm* hp; ErtsCodeMFA mfa; - Binary *ms = NULL, *ms_meta = NULL; - Uint count = 0; - Eterm traced = am_false; - Eterm match_spec = am_false; - Eterm retval = am_false; - ErtsTracer meta = erts_tracer_nil; - Eterm call_time = NIL; - Eterm call_memory = NIL; - int r; + int want; ASSERT(session); @@ -1927,34 +1957,242 @@ trace_info_func(Process* p, ErtsTraceSession* session, goto error; } - if (key == am_call_time || key == am_call_memory || key == am_all) { - erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_thr_progress_block(); - erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); + switch (key) { + case am_traced: + case am_match_spec: + want = FUNC_TRACE_GLOBAL_TRACE | FUNC_TRACE_LOCAL_TRACE; + break; + case am_meta: + case am_meta_match_spec: + want = FUNC_TRACE_META_TRACE; + break; + case am_call_count: + want = FUNC_TRACE_COUNT_TRACE; + break; + case am_call_time: + want = FUNC_TRACE_TIME_TRACE; + break; + case am_call_memory: + want = FUNC_TRACE_MEMORY_TRACE; + break; + case am_all: + want = FUNC_TRACE_GLOBAL_TRACE | FUNC_TRACE_LOCAL_TRACE + | FUNC_TRACE_META_TRACE | FUNC_TRACE_COUNT_TRACE + | FUNC_TRACE_TIME_TRACE | FUNC_TRACE_MEMORY_TRACE; + break; + default: + goto error; + } + + if (want & (FUNC_TRACE_TIME_TRACE | FUNC_TRACE_MEMORY_TRACE)) { + const ErtsCodeInfo *ci = erts_find_local_func(&mfa); + if (ci) { + Eterm trap_ret; + + if (erts_prepare_timem_trace_info(p, session, + want & FUNC_TRACE_TIME_TRACE, + want & FUNC_TRACE_MEMORY_TRACE, + ci)) { + Eterm trap_arg = trace_info_trap_arg(p); + + erts_proc_inc_refc(p); + erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_BIF_PREP_YIELD1(trap_ret, &bif_trace_info_finish_export, + p, trap_arg); + + trace_info_state.p = p; + trace_info_state.session = session; + trace_info_state.mfa = mfa; + trace_info_state.key = key; + trace_info_state.want = want; + trace_info_state.phase = 0; + erts_schedule_code_barrier(&trace_info_state.barrier, + trace_info_finisher, NULL); + + *to_be_continued_p = true; + return trap_ret; + } + } } - erts_mtx_lock(&erts_dirty_bp_ix_mtx); + /* + * No need for scheduling. Just build result and return it. + */ + return trace_info_func_epilogue(p, session, &mfa, key, want); - r = function_is_traced(p, session, &mfa, &ms, &ms_meta, &meta, &count, - &call_time, &call_memory); +error: + BIF_ERROR(p, BADARG); +} - erts_mtx_unlock(&erts_dirty_bp_ix_mtx); - if ( (key == am_call_time) || (key == am_call_memory) || (key == am_all)) { - erts_thr_progress_unblock(); +/* + * Magic binary for trace:info trap. + * The only purpose is to make sure we clean up if the trapping process + * would be killed while waiting to be resumed. + */ +typedef struct { + bool is_active; +} trace_info_trap_mbin_t; + +static Eterm trace_info_trap_arg(Process* p) +{ + Binary *mbin = erts_create_magic_binary_x(sizeof(trace_info_trap_mbin_t), + trace_info_trap_destructor, + ERTS_ALC_T_BINARY, + 0); + trace_info_trap_mbin_t* titm = (trace_info_trap_mbin_t*) ERTS_MAGIC_BIN_DATA(mbin); + Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + Eterm trap_arg; + + titm->is_active = true; + + trap_arg = erts_mk_magic_ref(&hp, &MSO(p), mbin); + /* + * Do extra refc bump of magic binary to ensure destructor is not called + * before trace_info_finisher() is done. + */ + trace_info_state.trap_mbin = mbin; + erts_refc_inc(&mbin->intern.refc, 1); + + return trap_arg; +} + +static int trace_info_trap_destructor(Binary *mbin) +{ + trace_info_trap_mbin_t *titm = (trace_info_trap_mbin_t*) ERTS_MAGIC_BIN_DATA(mbin); + + if (titm->is_active) { + ErtsTraceSession *session = trace_info_state.session; + /* + * The caller of trace:info must have been killed while waiting + * to be resumed. + */ + ASSERT(trace_info_state.p); + trace_info_state.p = NULL; + titm->is_active = false; + erts_free_timem_info(); + erts_release_code_mod_permission(); + erts_deref_trace_session(session); } + return 1; +} + +static void trace_info_finisher(void* null) +{ + ERTS_LC_ASSERT(erts_has_code_mod_permission()); + ASSERT(trace_info_state.p); + + switch (trace_info_state.phase++) { + case 0: + erts_commit_staged_bp(); + erts_schedule_code_barrier(&trace_info_state.barrier, + trace_info_finisher, NULL); + break; + + case 1: + erts_timem_info_collect(); + + /* Switch back and make the original hash tables active again. */ + erts_commit_staged_bp(); + + erts_schedule_code_barrier(&trace_info_state.barrier, + trace_info_finisher, NULL); + break; + case 2: { + Process *p = trace_info_state.p; + Binary *trap_mbin = trace_info_state.trap_mbin; + + erts_timem_info_consolidate(); + + trace_info_state.trap_mbin = NULL; + erts_bin_release(trap_mbin); + /* + * We are no longer guaranteed to be protected by code_mod_permission + * as trace_info_trap_destructor might have been called. + */ - switch (r) { + /* + * Resume caller of trace:info in bif_trace_info_finish_trap() + * (if still alive) + */ + erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(p); + break; + } + default: + ASSERT(!"Invalid trace_info_finisher phase"); + } +} + +static BIF_RETTYPE bif_trace_info_finish_trap(BIF_ALIST_1) +{ + Binary* bin; + trace_info_trap_mbin_t* titm; + ErtsTraceSession *session = trace_info_state.session; + Eterm bif_ret; + + ASSERT(BIF_P == trace_info_state.p); + + bif_ret = trace_info_func_epilogue(BIF_P, + trace_info_state.session, + &trace_info_state.mfa, + trace_info_state.key, + trace_info_state.want); + + bin = erts_magic_ref2bin(BIF_ARG_1); + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == trace_info_trap_destructor); + titm = (trace_info_trap_mbin_t*) ERTS_MAGIC_BIN_DATA(bin); + ASSERT(titm->is_active); + titm->is_active = false; + trace_info_state.p = NULL; + + erts_release_code_mod_permission(); + erts_deref_trace_session(session); + + return bif_ret; +} + +static Eterm +trace_info_func_epilogue(Process* p, + ErtsTraceSession* session, + const ErtsCodeMFA *mfa, + Eterm key, + int want) +{ + Eterm call_time = am_false; + Eterm call_memory = am_false; + Eterm traced = am_false; + Eterm match_spec = am_false; + Eterm retval = am_false; + Binary *ms = NULL, *ms_meta = NULL; + ErtsTracer meta = erts_tracer_nil; + Uint call_count = 0; + Eterm* hp; + int got; + + erts_build_timem_info(p, &call_time, &call_memory); + erts_free_timem_info(); + + got = function_is_traced(p, session, mfa, want, &ms, &ms_meta, &meta, + &call_count); + + switch (got) { case FUNC_TRACE_NOEXIST: + ASSERT(call_time == am_false && call_memory == am_false); hp = HAlloc(p, 3); return TUPLE2(hp, key, am_undefined); - case FUNC_TRACE_UNTRACED: - hp = HAlloc(p, 3); - return TUPLE2(hp, key, am_false); case FUNC_TRACE_GLOBAL_TRACE: + ASSERT(call_time == am_false && call_memory == am_false); traced = am_global; match_spec = NIL; /* Fix up later if it's asked for*/ break; + case FUNC_TRACE_UNTRACED: + hp = HAlloc(p, 3); + return TUPLE2(hp, key, am_false); default: - if (r & FUNC_TRACE_LOCAL_TRACE) { + if (got & FUNC_TRACE_LOCAL_TRACE) { traced = am_local; match_spec = NIL; /* Fix up later if it's asked for*/ } @@ -1979,7 +2217,7 @@ trace_info_func(Process* p, ErtsTraceSession* session, retval = NIL; break; case am_meta_match_spec: - if (r & FUNC_TRACE_META_TRACE) { + if (got & FUNC_TRACE_META_TRACE) { if (ms_meta) { retval = MatchSetGetSource(ms_meta); retval = copy_object(retval, p); @@ -1989,23 +2227,23 @@ trace_info_func(Process* p, ErtsTraceSession* session, } break; case am_call_count: - if (r & FUNC_TRACE_COUNT_TRACE) { - retval = erts_make_integer(count, p); + if (got & FUNC_TRACE_COUNT_TRACE) { + retval = erts_make_integer(call_count, p); } break; case am_call_time: - if (r & FUNC_TRACE_TIME_TRACE) { + if (got & FUNC_TRACE_TIME_TRACE) { retval = call_time; } break; case am_call_memory: - if (r & FUNC_TRACE_MEMORY_TRACE) { + if (got & FUNC_TRACE_MEMORY_TRACE) { retval = call_memory; } break; case am_all: { Eterm match_spec_meta = am_false; - Eterm call_count = am_false; + Eterm call_count_term = am_false; Eterm t, m; /* ToDo: Rewrite this to loop and reuse the above cases */ @@ -2014,20 +2252,20 @@ trace_info_func(Process* p, ErtsTraceSession* session, match_spec = MatchSetGetSource(ms); match_spec = copy_object(match_spec, p); } - if (r & FUNC_TRACE_META_TRACE) { + if (got & FUNC_TRACE_META_TRACE) { if (ms_meta) { match_spec_meta = MatchSetGetSource(ms_meta); match_spec_meta = copy_object(match_spec_meta, p); } else match_spec_meta = NIL; } - if (r & FUNC_TRACE_COUNT_TRACE) { - call_count = erts_make_integer(count, p); + if (got & FUNC_TRACE_COUNT_TRACE) { + call_count_term = erts_make_integer(call_count, p); } - if (!(r & FUNC_TRACE_TIME_TRACE)) { + if (!(got & FUNC_TRACE_TIME_TRACE)) { call_time = am_false; } - if (!(r & FUNC_TRACE_MEMORY_TRACE)) { + if (!(got & FUNC_TRACE_MEMORY_TRACE)) { call_memory = am_false; } @@ -2035,7 +2273,7 @@ trace_info_func(Process* p, ErtsTraceSession* session, hp = HAlloc(p, (3+2)*7); retval = NIL; - t = TUPLE2(hp, am_call_count, call_count); hp += 3; + t = TUPLE2(hp, am_call_count, call_count_term); hp += 3; retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_call_time, call_time); hp += 3; retval = CONS(hp, t, retval); hp += 2; @@ -2051,14 +2289,11 @@ trace_info_func(Process* p, ErtsTraceSession* session, retval = CONS(hp, t, retval); hp += 2; } break; default: - goto error; + erts_exit(ERTS_ABORT_EXIT, "Invalid key\n"); } hp = HAlloc(p, 3); return TUPLE2(hp, key, retval); - - error: - BIF_ERROR(p, BADARG); -} +} static Eterm trace_info_func_sessions(Process* p, Eterm func_spec, Eterm key) diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 74736f8ed7db..885b1c52a275 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -278,7 +278,6 @@ erl_init(int ncpu, BIN_VH_MIN_SIZE = erts_next_heap_size(BIN_VH_MIN_SIZE, 0); erts_init_debugger(); - erts_init_trace(); erts_code_ix_init(); erts_init_fun_table(); init_atom_table(); @@ -292,7 +291,8 @@ erl_init(int ncpu, erts_bif_info_init(); erts_ddll_init(); init_emulator(); - erts_ptab_init(); /* Must be after init_emulator() */ + erts_init_trace(); /* Must be after init_emulator() */ + erts_ptab_init(); /* Must be after init_emulator() */ erts_init_binary(); /* Must be after init_emulator() */ erts_init_iolist(); /* Must be after init_emulator() */ erts_bp_init(); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index c914d0b7e8d2..b4b9c6a0ceab 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -64,7 +64,6 @@ #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. */ diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 38d19b3d55f4..f750bd4b03cf 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -67,7 +67,6 @@ typedef struct #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 */ diff --git a/erts/emulator/internal_doc/Tracing.md b/erts/emulator/internal_doc/Tracing.md index d226b34add25..ad54b3c5d7fb 100644 --- a/erts/emulator/internal_doc/Tracing.md +++ b/erts/emulator/internal_doc/Tracing.md @@ -78,6 +78,13 @@ local breakpoints. Things get a bit more involved in the JIT. See `BeamAsm.md` for more details. +### Trace sessions + +Since OTP 27, isolated trace session can be dynamically created. Each trace +session is represented by an instance of struct `ErtsTraceSession`. The old +legacy session (kept for backward compatibility) is represented by the static +instance `erts_trace_session_0`. + ## Setting breakpoints ### Introduction @@ -88,29 +95,24 @@ was carried out in single threaded mode. Similar to code loading, this can impose a severe problem for availability that grows with the number of cores. -In OTP R16, breakpoints are set in the code without blocking the VM. +Since OTP R16, breakpoints are set in the code without blocking the VM. Erlang processes may continue executing undisturbed in parallel during the entire operation. The same base technique is used as for code loading. A staging area of breakpoints is prepared and then made active with a single atomic operation. -### Redesign of Breakpoint Wheel +### Breakpoints -To make it easier to manage breakpoints without single threaded mode a -redesign of the breakpoint mechanism has been made. The old -"breakpoint wheel" data structure was a circular double-linked list of -breakpoints for each instrumented function. It was invented before the -SMP emulator. To support it in the SMP emulator, is was essentially -expanded to one breakpoint wheel per scheduler. As more breakpoint -types have been added, the implementation have become messy and hard -to understand and maintain. +For call tracing, breakpoints are created and inserted in the ingress of each +traced Erlang function. A pointer to the allocated struct `GenericBp` is +inserted that holds all the data for all types of breakpoints. A bit-flag field +is used to indicate what different type of break actions that are +enabled. Struct `GenericBp` is session specific. If more than one trace session +affects a function, one `GenericBp` instance is created for each session. They +are linked together in a singly linked list that is traversed when the +breakpoint is hit. -In the new design the old wheel was dropped and instead replaced by -one struct (`GenericBp`) to hold the data for all types of breakpoints -for each instrumented function. A bit-flag field is used to indicate -what different type of break actions that are enabled. - -### Same Same but Different +### Similar to Code Loading but Different Even though `trace_pattern` use the same technique as the non-blocking code loading with replicated generations of data structures and an @@ -290,6 +292,35 @@ tracing is that we insert the `op_i_generic_breakpoint` instruction (with its pointer at offset -4) in the export entry rather than in the code. +### call_time and call_memory tracing + +For profiling, `call_time` and/or `call_memory` tracing can be set for a function. +This will measure the time/memory spent by a function. The measured +time/memory is kept in individual counters for every call traced process +calling that function. To ensure scalability, scheduler specific hash tables +(`BpTimemTrace`) are used in the breakpoint to map the calling process pid to +its time/memory counters. + +Function `trace:info` is used to collect stats for `call_time`, `call_memory` +or both (`all`). It has to aggregate the counters from all those scheduler +specific hash tables to build a list with one tuple with counters for each +pid. This cannot be done safely while the hash tables may be concurrently +updated by traced processes. + +Since OTP 29, `trace:info` collects `call_time` and `call_memory` stats without +blocking all schedulers from running. This is done by using the active and +staging halves of the breakpoint. During normal operations both halves of the +breakpoint refer to the same thread specific hash tables. To collect the stats +safely, temporary hash tables are created to be used by traced calls happening +during the call to `trace:info`. The temporary hash tables are being made active +while the "real" hash tables are made inactive in the staging half. When the hash +tables are inactive, they can be safely traversed. When done, the real +tables are made active again. A final consolidation step is done to collect any +stats from the temporary tables, delete them and make the two halves of the +breakpoint identical again using the same real hash tables. Scheduling with +thread progress is done between the switching to make sure the traversed hash +tables are not being concurrently updated. + ### Future work We still go to single threaded mode when new code is loaded for a diff --git a/erts/emulator/nifs/common/prim_tty_nif.c b/erts/emulator/nifs/common/prim_tty_nif.c index 6615c41065d2..115e48a0d7b7 100644 --- a/erts/emulator/nifs/common/prim_tty_nif.c +++ b/erts/emulator/nifs/common/prim_tty_nif.c @@ -299,7 +299,7 @@ static ERL_NIF_TERM tty_encoding_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER static ERL_NIF_TERM isprint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int i; if (enif_get_int(env, argv[0], &i)) { - ASSERT(i > 0 && i < 256); + ASSERT(i >= 0 && i < 256); return isprint((char)i) ? atom_true : atom_false; } return enif_make_badarg(env); diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 992408bdf1b5..93b476e7b489 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -37,6 +37,8 @@ -export([seq/3, seq_r/3]). -export([loaded/1, a_function/1, a_called_function/1, dec/1, nif_dec/1, dead_tracer/1, + trace_info_noblock/1, + trace_info_killed/1, return_stop/1,reset/1,catch_crash/1]). -define(US_ERROR, 10000). @@ -91,6 +93,8 @@ testcases() -> apply_bif_bug, combo, bif, nif, called_function, dead_tracer, return_stop, reset, + trace_info_noblock, + trace_info_killed, catch_crash]. init_per_suite(Config) -> @@ -992,3 +996,243 @@ abb_worker(Papa) -> abb_foo(M,F,Args) -> apply(M,F,Args). + +%% Test non-blocking trace:info for call_time and call_memory +%% and make sure it keeps correct count while traced processes are running. +trace_info_noblock(_Config) -> + NScheds = erlang:system_info(schedulers_online), + NWorkers = (NScheds * 3) div 2, + Tester = self(), + + WorkerPids = [spawn_opt(fun() -> tinb_worker(Tester) end, + [link, {scheduler, (I rem NScheds)+1}]) + || I <- lists:seq(1,NWorkers)], + + tinb_run(WorkerPids, call_time), + tinb_run(WorkerPids, call_memory), + tinb_run_both(WorkerPids, call_time, call_memory), + tinb_run_both(WorkerPids, call_memory, call_time), + ok. + +tinb_run(WorkerPids, TraceType) -> + [erlang_trace(Pid, true, [call]) || Pid <- WorkerPids], + 1 = erlang_trace_pattern({?MODULE,tinb_foo,0}, true, [TraceType]), + + [Pid ! start || Pid <- WorkerPids], + + timer:sleep(10), + CP_1 = tinb_get_checkpoints(WorkerPids), + TI_2 = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + CP_3 = tinb_get_checkpoints(WorkerPids), + + tinb_verify_call_count(CP_1, TI_2, CP_3), + + TI_4 = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + CP_5 = tinb_get_checkpoints(WorkerPids), + + tinb_verify_call_count(CP_3, TI_4, CP_5), + + %% Pause trace and see that we get the same counters + %% if we do repeated calls. + 1 = erlang_trace_pattern({?MODULE,tinb_foo,0}, pause, [TraceType]), + + TI_6a = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + CP_7 = tinb_get_checkpoints(WorkerPids), + TI_6b = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + + {TI_6a,TI_6a} = {TI_6a, TI_6b}, + + tinb_verify_call_count(CP_5, TI_6a, CP_7), + + %% Restart + tinb_stop(WorkerPids), + 1 = erlang_trace_pattern({?MODULE,tinb_foo,0}, restart, [TraceType]), + [Pid ! start || Pid <- WorkerPids], + + CP_8 = tinb_get_checkpoints(WorkerPids), + TI_9 = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + CP_10 = tinb_get_checkpoints(WorkerPids), + + tinb_verify_call_count(CP_8, TI_9, CP_10), + + %% Turn off call trace and see that we get the same counters + %% if we do repeated calls. + [erlang_trace(Pid, false, [call]) || Pid <- WorkerPids], + + TI_11a = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + CP_12 = tinb_get_checkpoints(WorkerPids), + TI_11b = timem_unify(erlang_trace_info({?MODULE, tinb_foo,0}, TraceType)), + + {TI_11a,TI_11a} = {TI_11a, TI_11b}, + + tinb_verify_call_count(CP_10, TI_11a, CP_12), + + erlang_trace_pattern({?MODULE,tinb_foo,0}, false, [TraceType]), + + tinb_stop(WorkerPids), + + ok. + +tinb_run_both(WorkerPids, TypeA, TypeB) -> + [erlang_trace(Pid, true, [call]) || Pid <- WorkerPids], + 1 = erlang_trace_pattern({?MODULE,tinb_foo,0}, true, [TypeA, TypeB]), + + [Pid ! start || Pid <- WorkerPids], + + timer:sleep(10), + CP_1 = tinb_get_checkpoints(WorkerPids), + {all, TI_2} = erlang_trace_info({?MODULE, tinb_foo,0}, all), + CP_3 = tinb_get_checkpoints(WorkerPids), + + {value,TI_A2_u} = lists:keysearch(TypeA, 1, TI_2), + {value,TI_B2_u} = lists:keysearch(TypeB, 1, TI_2), + + TI_A2 = timem_unify(TI_A2_u), + TI_B2 = timem_unify(TI_B2_u), + {TI_A2, TI_A2} = {TI_A2, TI_B2}, + + tinb_verify_call_count(CP_1, TI_A2, CP_3), + + %% Pause one of them and see that we get sane counters + 1 = erlang_trace_pattern({?MODULE,tinb_foo,0}, pause, [TypeA]), + + {all, TI_4} = erlang_trace_info({?MODULE, tinb_foo,0}, all), + CP_5 = tinb_get_checkpoints(WorkerPids), + + {value,TI_A4_u} = lists:keysearch(TypeA, 1, TI_4), + {value,TI_B4_u} = lists:keysearch(TypeB, 1, TI_4), + + TI_A4 = timem_unify(TI_A4_u), + TI_B4 = timem_unify(TI_B4_u), + + tinb_verify_call_count2(CP_3, TI_A4, TI_B4, CP_5), + + [erlang_trace(Pid, false, [call]) || Pid <- WorkerPids], + tinb_stop(WorkerPids), + erlang_trace_pattern({?MODULE,tinb_foo,0}, false, [TypeA, TypeB]), + ok. + +tinb_verify_call_count([], [], []) -> + ok; +tinb_verify_call_count([{Pid, C1} | T1], [{Pid, C2} | T2], [{Pid, C3} | T3]) -> + io:format("~p: ~p +~p +~p\n", [Pid,C1,C2-C1,C3-C2]), + true = (C1 =< C2), + true = (C2 =< C3), + tinb_verify_call_count(T1, T2, T3); +tinb_verify_call_count([{Pid, _} | _]=L1, ListWithoutPid, [{Pid, _} | _]=L3) -> + tinb_verify_call_count(L1, [{Pid, 0} | ListWithoutPid], L3). + +tinb_verify_call_count2([], [], [], []) -> + ok; +tinb_verify_call_count2([{Pid, C1} | T1], [{Pid, C2} | T2], [{Pid, C3} | T3], [{Pid, C4} | T4]) -> + io:format("~p: ~p +~p +~p +~p\n", [Pid,C1,C2-C1,C3-C2,C4-C3]), + true = (C1 =< C2), + true = (C2 =< C3), + true = (C3 =< C4), + tinb_verify_call_count2(T1, T2, T3, T4); +tinb_verify_call_count2([{Pid, _} | _]=L1, [{Pid, _} | _]=L2, ListWithoutPid, [{Pid, _} | _]=L4) -> + tinb_verify_call_count2(L1, L2, [{Pid, 0} | ListWithoutPid], L4); +tinb_verify_call_count2([{Pid, _} | _]=L1, ListWithoutPid, L3, [{Pid, _} | _]=L4) -> + tinb_verify_call_count2(L1, [{Pid, 0} | ListWithoutPid], L3, L4). + + +tinb_worker(Tester) -> + start = receive M -> M end, + tinb_worker(0, Tester). + +tinb_worker(Cnt, Tester) -> + receive + checkpoint -> + Tester ! {self(), Cnt}, + tinb_worker(Cnt, Tester); + stop -> + Tester ! {self(), stopped}, + tinb_worker(Tester) + after 0 -> + ok = tinb_foo(), + tinb_worker(Cnt+1, Tester) + end. + +tinb_get_checkpoints(Pids) -> + [P ! checkpoint || P <- Pids], + lists:sort([receive {_P, _}=M -> M end || _ <- Pids]). + +tinb_stop(Pids) -> + [P ! stop || P <- Pids], + [receive {_, stopped} -> ok end || _ <- Pids], + ok. + +tinb_foo() -> + ok. + +timem_unify({call_time, List}) -> + lists:sort([{Pid,Cnt} || {Pid,Cnt,_S,_US} <- List]); +timem_unify({call_memory, List}) -> + lists:sort([{Pid,Cnt} || {Pid,Cnt,_Mem} <- List]). + + +%% Kill process doing trapping call to trace:info(MFA, call_time|call_memory) +%% to provoke any kind of leakage. +trace_info_killed(_Config) -> + Sched1 = 1, + {Tester, Mon} = spawn_opt(fun() -> tik_tester(Sched1) end, + [link, monitor, {scheduler, Sched1}]), + {'DOWN', Mon, process, Tester, normal} = receive_any(), + ok. + +tik_tester(MySched) -> + tik_tester_run(MySched, call_time), + tik_tester_run(MySched, call_memory), + ok. + +tik_tester_run(MySched, TraceType) -> + %%NScheds = erlang:system_info(schedulers_online), + %%OtherSched = (MySched rem NScheds) + 1, + + Tester = self(), + MFA = {?MODULE, tik_foo, 0}, + 1 = erlang_trace_pattern(MFA, true, [local, TraceType]), + + {Victim, MRef} = spawn_opt(fun() -> + Tester ! {self(), ready}, + "go1" = receive_any(), + tik_foo(), + "go2" = receive_any(), + erlang_trace_info(MFA, TraceType), + "never reached" + end, + [monitor, {scheduler, MySched}]), + + {Victim, ready} = receive_any(), + + %% Trace our victim so we can kill it during trapping + 1 = erlang_trace(Victim, true, [call]), + TraceInfoBIFs = [{erlang, trace_info, 2}, + {erts_internal, trace_info, 3}], + [begin + true = erlang:is_builtin(M,F,A), + 1 = erlang_trace_pattern(BIF, true, [local]) + end + || {M,F,A}=BIF <- TraceInfoBIFs], + + Victim ! "go1", + {trace, Victim, call, {?MODULE, tik_foo, []}} = receive_any(), + Victim ! "go2", + {trace, Victim, call, {_, trace_info, _}} = receive_any(), + erlang:exit(Victim, abort), + {'DOWN', MRef, process, Victim, abort} = receive_any(), + + %% Verify trace:info still works ok + Result = erlang_trace_info(MFA, TraceType), + [{Victim, 1}] = timem_unify(Result), + + %% Cleanup + [1 = erlang_trace_pattern(BIF, false, [local]) || BIF <- TraceInfoBIFs], + 1 = erlang_trace_pattern(MFA, false, [TraceType]), + ok. + +tik_foo() -> + ok. + +receive_any() -> + receive M -> M end. diff --git a/erts/emulator/test/trace_session_SUITE.erl b/erts/emulator/test/trace_session_SUITE.erl index 427c8dfbbeed..11507a0d9892 100644 --- a/erts/emulator/test/trace_session_SUITE.erl +++ b/erts/emulator/test/trace_session_SUITE.erl @@ -41,6 +41,7 @@ destroy/1, negative/1, error_info/1, + timem_basic/1, end_of_list/1]). -include_lib("common_test/include/ct.hrl"). @@ -78,6 +79,7 @@ all() -> destroy, negative, error_info, + timem_basic, end_of_list]. init_per_suite(Config) -> @@ -1806,6 +1808,62 @@ error_info(_Config) -> end. +%% Some basic testing of call_time and call_memory +timem_basic(_Config) -> + Tracer = spawn(fun F() -> receive M -> io:format("~p~n",[M]), F() end end), + Session = trace:session_create(my_session, Tracer, []), + + Pid = self(), + 1 = trace:process(Session, Pid, true, [call]), + 1 = trace:function(Session, {lists,seq,2}, [], [call_time]), + {call_time, []} = trace:info(Session, {lists,seq,2}, call_time), + {call_memory, false} = trace:info(Session, {lists,seq,2}, call_memory), + + + lists:seq(1,10), + {call_time, [{Pid, 1, 0, T1}]}=CT1 = trace:info(Session, {lists,seq,2}, call_time), + {call_memory, false}=CMF = trace:info(Session, {lists,seq,2}, call_memory), + CT1 = trace:info(Session, {lists,seq,2}, call_time), + CMF = trace:info(Session, {lists,seq,2}, call_memory), + + lists:seq(1,10), + {call_time, [{Pid, 2, 0, T2}]}=CT2 = trace:info(Session, {lists,seq,2}, call_time), + true = (T2 >= T1), + CMF = trace:info(Session, {lists,seq,2}, call_memory), + CT2 = trace:info(Session, {lists,seq,2}, call_time), + + 1 = trace:function(Session, {lists,seq,2}, [], [call_memory]), + CT2 = trace:info(Session, {lists,seq,2}, call_time), + {call_memory, []} = trace:info(Session, {lists,seq,2}, call_memory), + + lists:seq(1,10), + {call_time, [{Pid, 3, 0, T3}]}=CT3 = trace:info(Session, {lists,seq,2}, call_time), + true = (T3 >= T2), + {call_memory, [{Pid, 1, M1}]}=CM1 = trace:info(Session, {lists,seq,2}, call_memory), + CT3 = trace:info(Session, {lists,seq,2}, call_time), + CM1 = trace:info(Session, {lists,seq,2}, call_memory), + + lists:seq(1,10), + {call_time, [{Pid, 4, 0, T4}]}=CT4 = trace:info(Session, {lists,seq,2}, call_time), + true = (T4 >= T3), + {call_memory, [{Pid, 2, M2}]}=CM2 = trace:info(Session, {lists,seq,2}, call_memory), + true = (M2 > M1), + CT4 = trace:info(Session, {lists,seq,2}, call_time), + CM2 = trace:info(Session, {lists,seq,2}, call_memory), + + %% Turn off call_time + 1 = trace:function(Session, {lists,seq,2}, false, [call_time]), + {call_time, false} = trace:info(Session, {lists,seq,2}, call_time), + CM2 = trace:info(Session, {lists,seq,2}, call_memory), + + lists:seq(1,10), + {call_time, false} = trace:info(Session, {lists,seq,2}, call_time), + {call_memory, [{Pid, 3, M3}]} = trace:info(Session, {lists,seq,2}, call_memory), + true = (M3 > M2), + + true = trace:session_destroy(Session), + ok. + wait_bp_finish() -> wait_thread_progress(5).